آموزش توابع API ویندوز گروه: Icons
منبع: انجمن تخصصی برنامه نویسان ایران
Private Declare Function CreateCursor Lib "user32" (ByVal hInstance As Long, ByVal nXhotspot As Long, ByVal nYhotspot As Long, ByVal nWidth As Long, ByVal nHeight As Long, lpANDbitPlane As Any, lpXORbitPlane As Any) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
' Create a 32x32 color cursor shaped somewhat like a yin-yang symbol.
' (The bit masks come from Microsoft's documentation on the API cursors function, just to
' give them their due credit.) Note how the masks are loaded into the arrays. The new
' cursor is then set to be the cursor for 10 seconds.
Dim hnewcursor As Long ' newly created cursor
Dim holdcursor As Long ' receives handle of default cursor
Dim andbuffer As String, xorbuffer As String ' buffers for masks
Dim andbits(0 To 127) As Byte ' stores the AND mask
Dim xorbits(0 To 127) As Byte ' stores the XOR mask
Dim c As Integer, retval As Long ' counter and return value
' Unfortunately, VB does not provide a nice way to load lots of information into an array.
' To load the AND and XOR masks, we put the raw hex values into the string buffers
' and use a loop to convert the hex values into numeric values and load them into
' the elements of the array. Yes, it's ugly, but there's no better way. Note the
' use of the line-continuation character here. Each sequence of eight hex
' characters represents one line in the 32x32 cursor.
andbuffer = "FFFC3FFF" & "FFC01FFF" & "FF003FFF" & "FE00FFFF" & _
"F701FFFF" & "F003FFFF" & "F003FFFF" & "E007FFFF" & _
"C007FFFF" & "C00FFFFF" & "800FFFFF" & "800FFFFF" & _
"8007FFFF" & "8007FFFF" & "0003FFFF" & "0000FFFF" & _
"00007FFF" & "00001FFF" & "00000FFF" & "80000FFF" & _
"800007FF" & "800007FF" & "C00007FF" & "C0000FFF" & _
"E0000FFF" & "F0001FFF" & "F0001FFF" & "F8003FFF" & _
"FE007FFF" & "FF00FFFF" & "FFC3FFFF" & "FFFFFFFF"
xorbuffer = "00000000" & "0003C000" & "003F0000" & "00FE0000" & _
"0EFC0000" & "07F80000" & "07F80000" & "0FF00000" & _
"1FF00000" & "1FE00000" & "3FE00000" & "3FE00000" & _
"3FF00000" & "7FF00000" & "7FF80000" & "7FFC0000" & _
"7FFF0000" & "7FFF8000" & "7FFFE000" & "3FFFE000" & _
"3FC7F000" & "3F83F000" & "1F83F000" & "1F83E000" & _
"0FC7E000" & "07FFC000" & "07FFC000" & "01FF8000" & _
"00FF0000" & "003C0000" & "00000000" & "00000000"
' Now load these hex values into the proper arrays.
For c = 0 To 127
andbits(c) = Val("&H" & Mid(andbuffer, 2 * c + 1, 2))
xorbits(c) = Val("&H" & Mid(xorbuffer, 2 * c + 1, 2))
Next c
' Finally, create this cursor! The hotspot is at (19,2) on the cursor.
hnewcursor = CreateCursor(App.hInstance, 19, 2, 32, 32, andbits(0), xorbits(0))
' Set the new cursor as the current cursor for 10 seconds and then switch back.
holdcursor = SetCursor(hnewcursor) ' change cursor
Sleep 10000 'Wait 10 seconds
retval = SetCursor(holdcursor) ' change cursor back
' Destroy the new cursor.
retval = DestroyCursor(hnewcursor)
End Sub Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetClassWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal wNewWord As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Const GCW_HCURSOR = (-12)
Const IDC_SIZEALL = 32646&
Dim SysCursHandle As Long, Curs1Handle As Long, Curs2Handle As Long
Private Sub Form_Load()
'Load a default cursor
Curs1Handle = LoadCursor(ByVal 0&, IDC_SIZEALL)
'Load a cursor from a file
Curs2Handle = LoadCursorFromFile("C:\Windows\Cursors\pen_1.cur")
'Set the form's mouse cursor
SysCursHandle = SetClassWord(Me.hwnd, GCW_HCURSOR, Curs1Handle)
'Set the button's cursor
SysCursHandle = SetClassWord(Command1.hwnd, GCW_HCURSOR, Curs2Handle)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Set the form's cursor back to the original cursor
SetClassWord Me.hwnd, GCW_HCURSOR, SysCursHandle
'Clean up
DestroyCursor Curs1Handle
DestroyCursor Curs2Handle
End Sub Create a new project, and add this code to Form1
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Paint()
Dim mIcon As Long
'Extract the associated icon
mIcon = ExtractAssociatedIcon(App.hInstance, "C:\Autoexec.bat", 2)
'Draw the icon on the form
DrawIconEx Me.hdc, 0, 0, mIcon, 0, 0, 0, 0, DI_NORMAL
'remove the icon from the memory
DestroyIcon mIcon
End Sub 'This project needs a PictureBox, called 'Picture1'
'In general section
Private Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim Path as String, strSave as string
'Create a buffer string
strSave = String(200, Chr$(0))
'Get the windows directory and append '\REGEdit.exe' to it
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) + "\REGEdit.exe"
'No pictures
Picture1.Picture = LoadPicture()
'Set graphicmode to 'persistent
Picture1.AutoRedraw = True
'Extract the icon from REGEdit
return1& = ExtractIcon(Me.hWnd, Path, 2)
'Draw the icon on the form
return2& = DrawIcon(Picture1.hdc, 0, 0, return1&)
End Sub Create a new project, and add this code to Form1
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Paint()
Dim mIcon As Long
'Extract the associated icon
mIcon = ExtractAssociatedIcon(App.hInstance, "C:\Autoexec.bat", 2)
'Draw the icon on the form
DrawIconEx Me.hdc, 0, 0, mIcon, 0, 0, 0, 0, DI_NORMAL
'remove the icon from the memory
DestroyIcon mIcon
End Sub Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim hHBr As Long, R As RECT, hFRgn As Long, hRRgn As Long, hRPen As Long, LP As LOGPEN
Dim hFFBrush As Long, mIcon As Long, Cnt As Long
'Clear the form
Me.Cls
'Set the rectangle's values
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
'Create a new brush
hHBr = CreateHatchBrush(HS_DIAGCROSS, vbRed)
'Draw a frame
FrameRect Me.hdc, R, hHBr
'Draw a rounded rectangle
hFRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, (Me.ScaleWidth / 3) * 2, (Me.ScaleHeight / 3) * 5)
'Draw a frame
FrameRgn Me.hdc, hFRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Invert a region
InvertRgn Me.hdc, hFRgn
'Move our region
OffsetRgn hFRgn, 10, 10
'Create a new region
hRRgn = CreateRectRgnIndirect(R)
'Combine our two regions
CombineRgn hRRgn, hFRgn, hRRgn, RGN_XOR
'Draw a frame
FrameRgn Me.hdc, hRRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Crete a new pen
hRPen = CreatePen(PS_SOLID, 5, vbBlue)
'Select our pen into the form's device context and delete the old pen
DeleteObject SelectObject(Me.hdc, hRPen)
'Draw a rectangle
Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
'Delete our pen
DeleteObject hRPen
LP.lopnStyle = PS_DOT
LP.lopnColor = vbGreen
'Create a new pen
hRPen = CreatePenIndirect(LP)
'Select our pen into the form's device context
SelectObject Me.hdc, hRPen
'Draw a rounded rectangle
RoundRect Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25, 50, 50
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbYellow)
'Select this brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Floodfill our form
FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
'Delete our brush
DeleteObject hFFBrush
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbMagenta)
'Select our solid brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Draw a Pie
Pie Me.hdc, Me.ScaleWidth / 2 - 15, Me.ScaleHeight / 2 - 15, Me.ScaleWidth / 2 + 15, Me.ScaleHeight / 2 + 15, 20, 20, 20, 20
'Extract icons from 'shell32.dll' and draw them on the form
For Cnt = 0 To Me.ScaleWidth / 32
ExtractIconEx "shell32.dll", Cnt, mIcon, ByVal 0&, 1
DrawIcon Me.hdc, 32 * Cnt, 0, mIcon
DestroyIcon mIcon
Next Cnt
'Clean up
DeleteObject hFFBrush
DeleteObject hRPen
DeleteObject hRRgn
DeleteObject hFRgn
DeleteObject hHBr
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub 'This project needs a PictureBox, called 'Picture1'
'In general section
Private Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim Path as String, strSave as string
'Create a buffer string
strSave = String(200, Chr$(0))
'Get the windows directory and append '\REGEdit.exe' to it
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) + "\REGEdit.exe"
'No pictures
Picture1.Picture = LoadPicture()
'Set graphicmode to 'persistent
Picture1.AutoRedraw = True
'Extract the icon from REGEdit
return1& = ExtractIcon(Me.hWnd, Path, 2)
'Draw the icon on the form
return2& = DrawIcon(Picture1.hdc, 0, 0, return1&)
End Sub 'This project needs a PictureBox, called 'Picture1'
'In general section
Private Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim Path as String, strSave as string
'Create a buffer string
strSave = String(200, Chr$(0))
'Get the windows directory and append '\REGEdit.exe' to it
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) + "\REGEdit.exe"
'No pictures
Picture1.Picture = LoadPicture()
'Set graphicmode to 'persistent
Picture1.AutoRedraw = True
'Extract the icon from REGEdit
return1& = ExtractIcon(Me.hWnd, Path, 2)
'Draw the icon on the form
return2& = DrawIcon(Picture1.hdc, 0, 0, return1&)
End Sub Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim hHBr As Long, R As RECT, hFRgn As Long, hRRgn As Long, hRPen As Long, LP As LOGPEN
Dim hFFBrush As Long, mIcon As Long, Cnt As Long
'Clear the form
Me.Cls
'Set the rectangle's values
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
'Create a new brush
hHBr = CreateHatchBrush(HS_DIAGCROSS, vbRed)
'Draw a frame
FrameRect Me.hdc, R, hHBr
'Draw a rounded rectangle
hFRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, (Me.ScaleWidth / 3) * 2, (Me.ScaleHeight / 3) * 5)
'Draw a frame
FrameRgn Me.hdc, hFRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Invert a region
InvertRgn Me.hdc, hFRgn
'Move our region
OffsetRgn hFRgn, 10, 10
'Create a new region
hRRgn = CreateRectRgnIndirect(R)
'Combine our two regions
CombineRgn hRRgn, hFRgn, hRRgn, RGN_XOR
'Draw a frame
FrameRgn Me.hdc, hRRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Crete a new pen
hRPen = CreatePen(PS_SOLID, 5, vbBlue)
'Select our pen into the form's device context and delete the old pen
DeleteObject SelectObject(Me.hdc, hRPen)
'Draw a rectangle
Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
'Delete our pen
DeleteObject hRPen
LP.lopnStyle = PS_DOT
LP.lopnColor = vbGreen
'Create a new pen
hRPen = CreatePenIndirect(LP)
'Select our pen into the form's device context
SelectObject Me.hdc, hRPen
'Draw a rounded rectangle
RoundRect Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25, 50, 50
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbYellow)
'Select this brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Floodfill our form
FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
'Delete our brush
DeleteObject hFFBrush
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbMagenta)
'Select our solid brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Draw a Pie
Pie Me.hdc, Me.ScaleWidth / 2 - 15, Me.ScaleHeight / 2 - 15, Me.ScaleWidth / 2 + 15, Me.ScaleHeight / 2 + 15, 20, 20, 20, 20
'Extract icons from 'shell32.dll' and draw them on the form
For Cnt = 0 To Me.ScaleWidth / 32
ExtractIconEx "shell32.dll", Cnt, mIcon, ByVal 0&, 1
DrawIcon Me.hdc, 32 * Cnt, 0, mIcon
DestroyIcon mIcon
Next Cnt
'Clean up
DeleteObject hFFBrush
DeleteObject hRPen
DeleteObject hRRgn
DeleteObject hFRgn
DeleteObject hHBr
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub ' Display the hourglass for three seconds, then restore
' the mouse cursor to whatever it was originally.
Dim holdcursor As Long ' receives handle to the original cursor
Dim hcursor As Long ' receives handle to the hourglass (wait) cursor
Dim retval As Long ' throw-away return value
holdcursor = GetCursor() ' get the handle of the current mouse cursor
hcursor = LoadCursor(0, IDC_WAIT) ' load the hourglass cursor
retval = SetCursor(hcursor) ' set the cursor to the hourglass
Sleep 3000 ' wait for three seconds
retval = SetCursor(holdcursor) ' restore the original cursor
نام تابع: CreateCursor
اعلان: Declare Function CreateCursor Lib "user32.dll" (ByVal hInstance As Long, ByVal nXhotspot As Long, ByVal nYhotspot As Long, ByVal nWidth As Long, ByVal nHeight As Long, lpANDbitPlane As Any, lpXORbitPlane As Any) As Long
سيستم عامل: NT , 98 , 95
توضيحات: اين تابع يك كرسر جديد را ايجاد ميكند تصوير كرسر ايجاد شده ميتواند با ضمينه AND و يا XOR شود كه بوسيله تابع مشخص ميگردد توابع منطقي ANDوXOR براي استفاده در هر نوع داده اي قابل استفاده ميباشند. اين تابع همچنين نقطه اصلي كرسر را مشخص ميكند(مانند نقطه نوك فلش در كرسر پيش فرض ويندوز)البته توجه داشته باشيد بهترين كار جهت ايجاد كرسر ذخيره آن در داخل يك فايل ميباشدو در صورت نياز ميتوانيد آن را فراخواني نماييد.(اين كار باعث ميگردد بتوان در هر زمان و در صورت نياز كرسر را بازخواني مجدد نمود).سايز كرسر بايد توسط سيستم عامل پشتيباني گردد از تابع GetSystemMetric براي چك كردن اين كار ميتوان استفاده نمود.اگر يك كرسر توسط اين تابع ايجاد شود بايد بعدا توسط تابع DestroyCursor از حافظه خارج گردد.در صورت بروز خطا در ايجاد كرسر صفر برميگردد و اگر تابع موفقيت آميز باشد مقدار غير صفر برميگردد. hInstance هندل برنامه اي كه اين تابع را فراخواني ميكند. nXhotspot مختصات X نوك كرسل(گوشه سمت چپ بالايي) nYhotspot مختصات Y نوك كرسل(گوشه سمت چپ بالايي) nWidth پهناي كرسل nHeight درازاي كرسل lpANDbitPlane ارايه براي AND كردن تصوير lpXORbitPlane ارايه براي XOR كردن تصوير
مقدار بازگشتي: ---
پارامترها: hInstance هندل برنامه اي كه اين تابع را فراخواني ميكند. nXhotspot مختصات X نوك كرسل(گوشه سمت چپ بالايي) nYhotspot مختصات Y نوك كرسل(گوشه سمت چپ بالايي) nWidth پهناي كرسل nHeight درازاي كرسل lpANDbitPlane ارايه براي AND كردن تصوير lpXORbitPlane ارايه براي XOR كردن تصوير
ثابتهاي مورد استفاده: ---
کتابخانه: User32
توابع مرتبط: DestroyCursor , SetCursor
نکات: ---
کد نمونه:
اعلان: Declare Function DestroyCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
سيستم عامل: NT , 98 , 95
توضيحات: يك كرسل را از بين ميبرد و هندل آن را حذف ميكند. يك كرسل بايد توسط تابع CreateCursor قبلا ايجاد شده باشد.از اين دستور براي از بين بردن كرسل هايي كه به روشي ديگر ايجاد شده اند استفاده نكنيد ! در صورت موفق بودن تابع مقدار يك برميگردد و در غير آن صفر برميگردد.
مقدار بازگشتي: ---
پارامترها: hCursor هندل كرسل جهت حذف
ثابتهاي مورد استفاده: ---
کتابخانه: User32
توابع مرتبط: CreateCursor , LoadCursor , LoadCursorFromFile
نکات: ---
کد نمونه:
اعلان: Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95 , CE 1.0
توضيحات: يك آيكون ايجاد شده را نابود ميكند و فضاي اشغال شده توسط آن را از ميان ميبرد.بعضي دستورها كه آيكون ميسازند (گاهي وقتها اما هميشه اينگونه نيست كه آيكون بوسيله توابع ساخته شود) برنامه نياز به استفاده از تابع فوق دارد بعد از اينكه از آيكون ساخته شده استفاده نمود. هرگاه آيكون از بين برود ديگر قابل استفاده توسط هيچ برنامه اي نيست.
مقدار بازگشتي: اگر با اشكال مواجه شود مقدار برگشتي صفر است (با تابع GetLastErrorنوع خطا مشخص ميگردد) و اگر موفق باشد مقدار غير صفر برميگردد.
پارامترها: hIcon هندل آيكون جهت از ميان بردن.
ثابتهاي مورد استفاده: ---
کتابخانه: User32
توابع مرتبط: DrawIcon , DrawIconEx , ExtractAssociatedIcon
نکات: ---
کد نمونه:
اعلان: Declare Function DrawIcon Lib "user32.dll" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95 , CE 1.0
توضيحات: اين تابع يك آيكون را داخل يك ديوايس ميكشد. مكان آيكون توسط يك جفت عدد پاس داده شده به تابع مشخص ميگردد (مختصات نقطه گوشه بالاي سمت چپ آيكون است) . آيكون اغلب در اندازه معمولي كشيده ميشود.
مقدار بازگشتي: اگر موفق باشد تابع مقدار غير صفر برميگرداند و در صورت برخورد به خطا مقدار صفر برميگردد.(با استفاده از تابع GetLastError نوع خطا مشخص ميگردد).
پارامترها: hDC هندل يك ديوايس كنتكست كه آيكون داخل آن كشيده ميشود. x مختصات X نقطه گوشه سمت چپ بالاي تصوير آيكون y مختصات Y نقطه گوشه سمت چپ بالاي تصوير آيكون hIcon هندل آيكون جهت كشيدن داخل ديوايس
ثابتهاي مورد استفاده: ---
کتابخانه: User32
توابع مرتبط: DrawIconEx , ExtractIcon , ExtractAssociatedIcon
نکات: ---
کد نمونه:
اعلان: Declare Function DrawIconEx Lib "user32.dll" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95 , CE 1.0
توضيحات: اين تابع يك آيكون يا يك كرسر(يا يك فريم از يك كرسر انيميشن) را در يك ديوايس نمايش ميدهد. با ارسال مختصات نقطه سمت چپ بالاي تصوير مكان نمايش مشخص ميگردد.اين دستور ميتواند تصوير را در هر دو مسير(درازا و پهنا)بكشد همانند ديگر پارامترها اين نيز مشخص ميگردد.
مقدار بازگشتي: اگر موفق باشد تابع مقدار غير صفر برميگرداند و در صورت برخورد به خطا مقدار صفر برميگردد.(با استفاده از تابع GetLastError نوع خطا مشخص ميگردد).
پارامترها: hdc يك هند مشخص كننده يك ديوايس كونتكست كه تصوير داخل آن كشيده ميشود. xLeft مختصات X نقطه بالاي سمت چپ مكان تصوير . yTop مختصات Y نقطه بالاي سمت چپ مكان تصوير . hIcon هندل آيكون يا كرسر براي كشيدن. cxWidth پهنا برحسب پيكسل براي مقدار كشيدگي تصوير آيكون يا كرسر . اگر مقدار فوق صفر باشد پهناي تصوير كشيده شده پهناي پيش فرض سيستم ميباشد. كه توسط idFlags تعيين ميگردد. cyWidth درازا برحسب پيكسل براي مقدار كشيدگي تصوير آيكون يا كرسر . اگر مقدار فوق صفر باشد درازاي تصوير كشيده شده درازاي پيش فرض سيستم ميباشد. كه توسط idFlags تعيين ميگردد. istepIfAniCursor اگر پارامتر hIcon هندل يك كرسر متحرك(انيميشن) باشد مقدار اين پارامتر شماره فريم جهت نمايش را معين ميكند. در غير اين صورت اين پارامتر بدون تاثير است. hbrFlickerFreeDraw هندل يك قلم مو جهت استفاده بعنوان پس زمينه آيكون يا كرسر. پس زمينه به تصوير آيكون يا كرسر اضافه ميشود.اگر پارامتر مقدار صفر داشته باشد تصوير مستقيما (بدون هيچ پس زمينه) داخل ديوايس كشيده ميشود. diFlags يك تركيب از فلگ هاي زير براي كشيدن آيكون و يا كرسر: DI_COMPAT تصوير يك آيكون يا كرسر پيش فرض سيستم را نمايش ميدهد بجاي نمايش تصوير تعيين شده كاربر DI_DEFAULTSIZE اگر دو مقدار cxWidth و cyWidth صفر باشند در اين صورت سيستم با اين فلگ ابعاد را بر اساس سيستم پيش فرض ميكشد و اگر اين فلگ اين مقدار را نداشته باشد ولي باز دو مقدار cxWidth و cyWidth صفر باشد بر اساس ابعاد تصوير كرسر يا آيكون ميكشد. DI_IMAGE تصوير را داخل ديوايس ميكشد. DI_MASK تصوير ماسك شده آيكون ويا كرسر را ميكشد. DI_NORMAL تصوير را هم ماسك و هم خود تصوير را ميكشد.
ثابتهاي مورد استفاده: Const DI_COMPAT = &H4 Const DI_DEFAULTSIZE = &H8 Const DI_IMAGE = &H2 Const DI_MASK = &H1 Const DI_NORMAL = &H3
کتابخانه: User32
توابع مرتبط: DrawIcon , DestroyIcon , ExtractAssociatedIcon
نکات: ---
کد نمونه:
اعلان: Declare Function EqualRgn Lib "gdi32.dll" (ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95 , CE 1.0
توضيحات: تعيين ميكند كه آيا دو ناحيه داراي يك مساحت ميباشند يا نه. اگر چه هندل هاي متفاوتي داشته باشند. آنها ميتوانند به ناحيه هايي با شكل و اندازه و مكان مشخص رجوع كنند.
مقدار بازگشتي: اگر دو ناحيه با هم برابر باشند تابع مقدار غير صفر برميگرداند. واگر متفاوت باشند مقدار صفر برميگرداند.
پارامترها: hSrcRgn1 هندل ناحيه نخست از دو ناحيه hSrcRgn2 هندل ناحيه دوم از دو ناحيه
ثابتهاي مورد استفاده: ---
کتابخانه: GDI32
توابع مرتبط: ExtractIcon , ExtractAssociatedIcon
نکات: ---
کد نمونه:
اعلان: Declare Function EqualRect Lib "user32.dll" (lpRect1 As RECT, lpRect2 As RECT) As Long
سيستم عامل: NT , 98 , 95
توضيحات: تعيين ميكند كه آيا دو مستطيل با هم مساوي هستند يا نه . دو مستطيل وقتي با هم برابر هستند كه دو گوشه سمت چپ بالا و سمت راست پايين نخستين مستطيل با دومي برابر باشد.برگشت مقدار يك به معني برابري دو مستطيل و مقدار صفر يعني دو مستطيل با هم برابر نيستند.
مقدار بازگشتي: ---
پارامترها: lpRect1 مستطيل نخست lpRect2 مستطيل دوم
ثابتهاي مورد استفاده: ---
کتابخانه: Shell32
توابع مرتبط: ExtractIconEx , ExtractAssociatedIcon , DrawIcon , DrawIconEx
نکات: ---
کد نمونه:
اعلان: Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst as Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95
توضيحات: اين تابع يك آيكون را از يك فايل استخراج ميكند. اين فايل ميتواند از نوع اجرايي(EXE) يا فايل كتابخانه اي (DLL) ويا فايل تصويري(ICO) باشد.همچنين اين تابع ميتواند تعداد آيكون هاي ذخيره شده در يك فايل را مشخص كند. آيكون ايجاد شده توسط اين تابع حتما بايد توسط تابع DestroyIcon بعداز پايان برنامه و پايان استفاده از آيكون نابود شود.
مقدار بازگشتي: اگر تابع به خطا برسد و مقدار يك برگرداند يعني فايل پيدا نشد. واگر تابع به خطا برسد و مقدار صفر برگرداند يعني آيكون مورد نظر پيدا نشد. و اگر تابع موفق باشد و ما بخواهيم تعداد آيكون هاي فايل را بدانيم مقدار برگشتي تعداد آيكونها خواهد بود و اگر تابع بتواند آيكوني را از درون يك فايل استخراج كند مقدار هندل آيكون را برميگرداند.
پارامترها: hInst هندل برنامه اي كه تابع توسط آن فرا خوانده شده. lpszExeFileName نام فايلي كه آيكون درون آن قرار دارد (نام به همراه مسير فايل) nIconIndex اگر مقدار منفي يك باشد تابع تعداد آيكونهاي موجود در فايل را برميگرداند و اگر عدد غير منفي باشد ايندكس آيكون را نشان ميدهد(صفر يعني نخستين آيكون و ...) If this is -1, the function returns the number of icons stored in the specified file. If this is a non-negative number, the function extracts the icon using this value as the zero-based index (an index of 0 identifies the first icon, etc.). در ويندوز 95و98وNT4.0وبالاتر و ويندوز 2000 اگر عدد منفي باشد و منهاي يك نباشد آنگاه اين تابع استخراج ميكند آيكون اصلي كه تعيين ميشود توسط مقدار قدر مطلق اين پارامتر. براي فهم بهتر به تابع ExtractIconEx مراجعه كنيد.
ثابتهاي مورد استفاده: ---
کتابخانه: Shell32
توابع مرتبط: ExtractIconEx , ExtractAssociatedIcon , DrawIcon , DrawIconEx
نکات: ---
کد نمونه:
اعلان: Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
سيستم عامل: NT , 2000 , 98 , 95 , CE 1.0
توضيحات: اين تابع چندين آيكون را ميتواند از يك فايل استخراج نمايد.اين فايل ميتواند از نوع اجرايي(EXE) يا فايل كتابخانه اي (DLL) ويا فايل تصويري(ICO) باشد . اين تابع ميتواند هم آيكون كوچك و هم آيكون بزرگ را استخراج نمايد كه هندل آنها داخل دو آرايه قرارداده ميشود. اين تابع همچنين ميتواند تعيين كند چه تعداد آيكون بزرگ (و كوچك) جفت در فايل ذخيره شده .هر آيكوني كه توسط اين تابع ايجاد شود بايد پس از پايان برنامه توسط تابع DestroyIcon حذف شود.
مقدار بازگشتي: اگر مقدار پارامتر nIconIndex منهاي يك باشد و پارامتر phiconSmall وphiconLarge صفر باشد تابع تعداد آيكونهاي ذخيره شده در فايل را برميگرداند. در غير اين صورت تعداد آيكونهايي را كه توانسته استخراج نمايد را برميگرداند.
پارامترها: lpszFile نام فايل ( ميتواند با پسوند .EXE يا .DLL يا .ICO باشد) nIconIndex اگر صفر باشد يعني نخستين آيكون را استخراج كن. اگر منفي يك باشد و هر دو پارامتر phiconLarge و phiconSmall صفر باشد تابع تعداد آيكونها را برميگرداند . در ويندوز 95و98وNT4.0و 2000 اگر اين پارامتر منفي باشد و هريك از دو پارامتر phiconLarge يا phiconSmall و يا هر دو غير صفر ياشند تابع مشخصه منبع آيكون معادل با مقدار قدر مطلق اين پارامتر را استخراج ميكند. phiconLarge يك آرايه كه دريافت ميكند هندلهاي آيكونهاي بزرگ استخراج شده از فايل را اگر نخواهيد از آيكونهاي بزرگ استفاده نماييد صفر را پاس بدهيد. phiconSmall يك آرايه كه دريافت ميكند هندلهاي آيكونهاي كوچك استخراج شده از فايل را اگر نخواهيد از آيكونهاي كوچك استفاده نماييد صفر را پاس بدهيد. nIcons تعداد آيكونهاي استخراج شده از فايل آيكونهاي استخراج شده به ترتيب پشت سر هم قراردارند و نخستين آيكون با پارامتر nIconIndex مشخص ميگردد.
ثابتهاي مورد استفاده: ---
کتابخانه: GDI32
توابع مرتبط: ExtractIcon , ExtractAssociatedIcon
نکات: وقتي كه مقدار صفر به يكي از دو پارامترphiconLarge يا phiconSmallداده ميشود بايد حتما صفر را با كلمه ByVal بكار برد. براي فهم بهتر به مثال توجه نماييد.
کد نمونه:
اعلان: Declare Function GetCursor Lib "user32.dll" () As Long
سيستم عامل: 32s , NT , 98 ,95
توضيحات: اين تابع كرسر جاري موس كه مورد استفاده ميباشد را پيدا كرده و هندل آن را برميگرداند. اين كرسر همان شكل اشاره گر موس در صفحه ميباشد. اگر موفق باشد هندل برميگرداند و ناموفق باشد مقدار صفر برميگردد.
مقدار بازگشتي: ---
پارامترها: ---
ثابتهاي مورد استفاده: ---
کتابخانه: User32
توابع مرتبط: SetCursor
نکات: ---
کد نمونه:
