Create Button

گردآوری شده از سایت های مختلف 

Const WS_EX_STATICEDGE=&H20000
Const WS_EX_WINDOWEDGE=&H100

Const WS_EX_CLIENTEDGE=&H200

Const WS_TABSTOP=&H10000

Const WS_CHILD=&H40000000

Const WS_VISIBLE=&H10000000

Const BS_ICON=&H40

Const WM_COMMAND=&H111

Const WM_SYSCOMMAND=&H112

Const WM_KEYUP=&H101

Const WM_LBUTTONUP=&H202

Const HWND_TOP=0

Const HWND_TOPMOST=-1

Const SWP_SHOWWINDOW=&H40

Const SWP_NOMOVE=&H2

Const SWP_NOSIZE=&H1

If bAlwaysOnTop Then fTop=HWND_TOPMOST
Else fTop=HWND_TOP
End If
SetWindowPo hWF,fTop,0,0,0,0,SWP_SHOWWINDOW+SWP_NOMOVE+SWP_NOSIZE

HCBT_CREATEWND '3

Dim Pt As POINTAPI

Dim MyRect As RECT

GetCursorPos Pt

GetClientRect hwnd,MyRect

ClientToScreen MyRect,Pt

Pt.x=(MyRect.Right-MyRect.Left)+5

Pt.y=(MyRect.Bottom-MyRect.Top)-20

nx=Pt.x+20

ny=Pt.y+10

hButton1 =CreateWindowEx(WS_EX_STATICEDGE,"Button","Close",WS_CHILDWINDOW+BS_PUSHBUTTON+WS_VISIBLE,Pt.x,Pt.y,nx,ny,hwnd,BTN1,Application.hwndAccessApp,0&)

hButton2 =CreateWindowEx(WS_EX_STATICEDGE,"BUTTON","Execute", WS_CHILDWINDOW+BS_PUSHBUTTON+WS_VISIBLE,15,175, 70, 30,hwnd,BTN2,Application.hwndAccessApp,0&)

Function WndProc(ByVal hwnd As LongPtr,ByVal uMsg As LongPtr,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr

Select Case uMsg

case WM_COMMAND 

     Select Case wParam 

           Case BTN1

              DestroyWindow(hwnd)

              Exit Functuon

          Case BTN2

           MsgBox " You Clicked Me !!! "

Exit Function

    End Select

Case WM_DESTROY '&H2

SetWindowLongPtr hwnd,(-4),PrevProc

PrevProc=0

Exit Function

End Select

WndProc=CallWindowProc(hwnd,uMsg,wParam,lParam)

End Funct

MENUITEM : 

Public Const WM_MENUSELECT = &H11F

Public Const MF_SYSMENU = &H2000&

Public Const MIIM_TYPE = &H10

Public Const MIIM_DATA = &H20

Dim iHi As Integer, iLo As Integer

Select Case Msg

Case WM_MENUSELECT

Form_Form1.Label0.Caption=""

CopyMemory iLo, wParam, 2

CopyMemory iHi, ByVal VarPtr(wParam) + 2, 2

If (iHi And MF_SYSMENU) = 0 Then

Dim m As MENUITEMINFO, Cap As String

m.dwTypeData = Space$(64)

m.cbSize = Len(m)

m.cch = 64

m.fMask = MIIM_DATA Or MIIM_TYPE

If GetMenuItemInfo(lParam, CLng(iLo), False, m) Then

Cap = m.dwTypeData & Chr$(0)

Cap = Left$(Cap, InStr(Cap, Chr$(0)) - 1)

End If

Button Style ( BS )

shell32_dll icon id

ایجاد باتن که هم تکست بگیرد و هم آیکون ، اگر از BS_ICON بجای BS_TEXT استفاده شود فقط آیکون نمایش داده میشود 

'Don't set the BS_ICON or BS_BITMAP style (but do set 'the BS_TEXT style), and send a BM_SETIMAGE 'message once the button has been created.

ConsWM_SETICON=&H80&
Const BM_CLICK=&HF5&
Const BM_SETIMAGE=&HF7&

ID=110 است فرضا اگر از تابع GetDlgCtrlID استفاده کنید برای گرفتن هندل باتن می توانید از این تابع براحتی استفاده بنمائید.

case WM_CREATE

btn=CreateWindowExW(0, "BUTTON","Button text",WS_VISIBLE+WS_CHILD+BS_TEXT,10,10,200,50,hWnd,110,nullptr,

nullptr

HICON=LoadImageW(GetModuleHandle(nullptr),StrPath+StrFile,S IMAGE_ICON, 32, 32, &H0)

ارسال پیام SETIMAGE به پنجره باتن برای لود آیکون در آن

SendMessage btn,BM_SETIMAGE,IMAGE_ICON,icon)

Exit Function

Const IMAGE_BITMAP=0
Const IMAGE_ICON=1
Const IMAGE_CURSOR=2
Const LR_DEFAULTCOLOR=&H0
Const LR_LOADFROMFILE=&H10
Const LR_LOADTRANSPARENT=&H20

Const SS_BITMAP = &HE
Const SS_REALSIZECONTROL = &H40
Const SS_REALSIZEIMAGE = &H800
Const SS_CENTERIMAGE = &H200
Const STM_SETIMAGE = &H172

Lib "Shell32"

hIcon=ExtractAssociatedIconA(hInst,pszIconPath,piIcon)

Lib "User32"

DestroyIcon hIcon

in vb not vba

hIcon = ExtractIcon(Me.hWnd, "C:\Windows\System32\shell32.dll", 31) 'Recycle Bin
DrawIcon Picture1.hdc, 0, 0, hIcon

SubClass Window

Public origWndProc As Long

Public Sub SetHook(hwnd, bSet As Boolean)

If bSet Then

origWndProc = SetWindowLongPtr(hwnd, GWL_WNDPROC, AddressOf AppWndProc)

ElseIf origWndProc Then

Dim lRet As Long

lRet = SetWindowLongPtr(hwnd, GWL_WNDPROC, origWndProc)

origWndProc = 0

End If

End Sub

hStatic =CreateWindowEx(WS_EX_LAYERED+ WS_EX_NOACTIVATE+ WS_EX_TOPMOST,"STATIC", "", WS_POPUP Or SS_BITMAP, 0,0, 0, 0, 0, hwnd, GetModuleHandle(vbNullString), 0&
'hwnd.AccessApp
SetLayeredWindowAttributes(hStatic,0, 100, LWA_ALPHA)

SetWindowLongPtr hStatic, GWL_HWNDPARENT, hForm

hBitmap=LoadImage(Application.hwndAccessApp,"D:\image1.Bmp",IMAGE_ICON, 32, 32, &H0)

SendMessag hStatic,STM_SETIMAGE,IMAGE_BITMAP, ByVal hBitmap)

SetActiveWindow hForm

HookMsgbox :

Sub Sample()
HookIt = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
Msgbox "Prompt"
End Sub


Private Const WH_CBT=5
Const HCBT_CREATEWND=3
Const GWL_STYLE As Long = -16
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2&
Const GWL_WNDPROC=(-4)
Const WS_EX_LAYERED=&H80000
Const WM_COMMAND=&H1
Const WM_NCDESTROY=&H82
 
Type POINT_TYPE
x As Long
y As Long
End Type


Private Function HookProc(ByVal idHook As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim curStyle As LongPtr

if idHook = HCBT_CREATEWND Then
If GetClass(wParam) = "#32770" Then
hwndMsgBox = WParam
'Style = GetWindowLongPtr(hWnd, -16) And Not &HC00000
'SetWindowLongPtr hWnd, -16, Style
'DrawMenuBar hWnd
curStyle = GetWindowLongPtr(WParam, GWL_EXSTYLE)
NewStyle = curStyle Or WS_EX_LAYYERED
SetWindowLong WParam,GWL_EXSTYLE, NewStyle
SetLayeredWindowAttributes(hwndMsgBox,0, 255, LWA_ALPHA)
 MakePolygon hwndMsgBox
OldMBoxWinProc =SetWindowLongPtr(WParam, GWL_WNDPROC, AddressOf NewMsgBxWindowProc)
UnhookWindowsHookEx HookIt
End If
End If
 HookProc = CallNextHookEx(HookIt, idHook, ByVal WParam, ByVal lparam) End Function


Private Function NewMsgBxWindowProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal WParam As LongPtr, ByVal lparam As LongPtr) As LongPtr
 On Error Resume Next
Select Case uMsg
Case WM_NCDESTROY, WM_COMMAND SetWindowLongPtr hwnd, GWL_WNDPROC, OldMBoxWinProc
End Select
NewMsgBxWindowProc = CallWindowProc(OldMBoxWinProc, hwnd, MSG, WParam, lparam)
End Function

Function MakePolygon(hwnd As LongPtr)
Dim ptarr(0 To 28) As POINT_TYPE
ptarr(0).x = 104: ptarr(0).y = 30
ptarr(1).x = 504: ptarr(1).y = 30
ptarr(2).x = 404: ptarr(2).y = 180
ptarr(3).x = 4: ptarr(3).y = 180
ptarr(4).x = 104: ptarr(4).y = 30
hRegion=CreatePolygonRgn(ptarr(0),28, 1)
SetWindowRgn hwnd,hRegion,True
End Function