Muhammad Ikhsan

Buka project baru dengan commandbutton, ketikan kode berikut ini:

Option Explicit

Declare Function WNetAddConnection Lib “mpr.dll” Alias _
“WNetAddConnectionA” (ByVal lpszNetPath As String, _
ByVal lpszPassword As String, ByVal lpszLocalName _
As String) As Long

Declare Function WNetCancelConnection Lib “mpr.dll” _
Alias “WNetCancelConnectionA” (ByVal lpszName _
As String, ByVal bForce As Long) As Long

Const WN_SUCCESS = 0 ‘ The function was successful.
Const WN_NET_ERROR = 2 ‘ An error occurred on the network.
Const WN_BAD_PASSWORD = 6 ‘ The password was invalid.

Function AddConnection(MyShareName As String, _
MyPWD As String, UseLetter As String) As Integer

On Local Error GoTo AddConnection1_Err

AddConnection = WNetAddConnection(MyShareName, _
MyPWD, UseLetter)
AddConnection_End:

Exit Function

AddConnection_Err:
AddConnection = Err
MsgBox Error$

Resume AddConnection_End

End Function

Function CancelConnection(DriveLetter As String, _
Force As Integer) As Integer

On Local Error GoTo CancelConnection_Err
CancelConnection = WNetCancelConnection(DriveLetter, _
Force)
CancelConnection_End:

Exit Function

CancelConnection_Err:
CancelConnection = Err
MsgBox Error$

Resume CancelConnection_End

End Function

Untuk menambah network drive
varible = AddConnection(<SharePath>, <Password>, <DriveLetter>)

Untuk membatalkan
varible = CancelConnection(<SharePath, <Force>)

Buka project baru dan masukan commandbutton pada form1 dan ketikan kode beriku tini:

Private Declare Function ConfigurePort _
Lib “winspool.drv” Alias “ConfigurePortA” _
(ByVal pName As String, ByVal hwnd As Long, _
ByVal pPortName As String) As Long

Private Sub Command1_Click()
MsgBox ConfigurePort(”", Me.hwnd, “COM4″)
MsgBox ConfigurePort(”", Me.hwnd, “LPT1″)
End Sub

Declare Function GetUserName Lib “advapi32.dll” Alias _
“GetUserNameA” (ByVal lpBuffer As String, nSize As Long) _
As Long

Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser as String
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then curuser = Left$(s, cnt) Else curuser = “”

Use this subroutine to put text on your form or picture box at different angles. For vertically down, use the angle on 270, and vertically up, use the angle of 90. Declarations Public Declare Function CreateFont Lib _
“gdi32″ Alias “CreateFontA” (ByVal _
Height As Long, ByVal Width As Long, _
ByVal Escapement As Long, ByVal _
Orientation As Long, ByVal Weight _
As Long, ByVal Italic As Long, ByVal _
Underline As Long, ByVal StrikeOut As _
Long, ByVal CharSet As Long, ByVal _
OutputPrecision As Long, ByVal _
ClipPrecision As Long, ByVal Quality _
As Long, ByVal PitchAndFamily As _
Long, ByVal Face As String) As Long Public Declare Function SelectObject _
Lib “gdi32″ (ByVal hdc As Long, ByVal _
hObject As Long) As Long Public Declare Function DeleteObject _
Lib “gdi32″ (ByVal hObject As Long) As Long Public Const FW_BOLD = 700
Public Const FW_NORMAL = 400
Public Const ANSI_CHARSET = 0
Public Const OUT_DEFAULT_PRECIS = 0
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const PROOF_QUALITY = 2
Public Const DEFAULT_PITCH = 0
Public Const FF_DONTCARE = 0 Module Code Paste the following code into a module. Public Sub dotext(angpict As Object, _
angfont As StdFont, angtext As String, _
angle As Single) ‘ Parameters:
‘ angpict: picture box, etc to draw text in
‘ angfont: Font object with info about font to use
‘ angtext: text to print
‘ angle : angle, measured anti-clockwise from horizontal: —–> Dim newfont As Long
Dim oldfont As Long
Dim angweight As Long

If angfont.Bold = True Then
angweight = FW_BOLD
Else
angweight = FW_NORMAL
End If newfont = CreateFont(angfont.Size * 2, _
0, angle * 10, 0, angweight, _
angfont.Italic, angfont.Underline, _
angfont.Strikethrough, ANSI_CHARSET, _
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, _
angfont.Name) oldfont = SelectObject(angpict.hdc, newfont) angpict.CurrentX = 1000
angpict.CurrentY = 1000
angpict.Print angtext

newfont = SelectObject(angpict.hdc, oldfont) If DeleteObject(newfont) = 0 Then
‘ could not remove font from GDI heap
End If End Sub Breakdown: This sub works by creating a logical font in the GDI heap. It then sets the font of the control to this logical font, keeping a record of the old logical font. It then prints the font, then resets the old font. Lastly, to free up memory, it deletes the logical font from the GDI heap. Jargon GDI Heap:
Area of system memory used to store infomation about the graphical interface of windows. Logical font:
This a pointer to a physical font file on disk.

Declarations Declare Function SetPixel Lib _
“gdi32″ Alias “SetPixelV” _
(ByVal hdc As Long, ByVal x As
Long, ByVal y As Long, _
ByVal crColor As Long) As Long Declare Function GetPixel Lib _
“gdi32″ (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long) As Long Code Public Sub rotateimage()
Dim x As Long
Dim y As Long

Picture2.Height = Picture1.Width
Picture2.Width = Picture1.Height For x = 0 To Picture1.Width

For y = 0 To Picture1.Height
Call SetPixel(Picture2.hdc, _
y, x, GetPixel(Picture1.hdc, x, y))
Next If x Mod 50 = 0 Then
DoEvents
Picture2.Refresh
End If

Next

DoEvents
Picture2.Refresh

End Sub Notes Make sure that the Scalemode for both Picture1 and Picture2 are set to Pixels, otherwise, you will end up reading a lot of unnecessary points. Jargon RGB Value:
The colour code for a pixel. It measures the amout of Red, Green and Blue in a pixel to make the colour. Pixel:
The smallest graphic unit on the screen.