 
- 帖子
- 715
- 积分
- 1298
- 技术
- 151
- 捐助
- 0
- 注册时间
- 2012-11-1
|
[转贴] VBS 使用 DynamicWrapper 调用 Windows API 绘制 GUI
VBS 使用 DynamicWrapper 调用 Windows API 绘制 GUI
DialogBox with only api calls
http://www.visualbasicscript.com/m43011.aspx
DialogBox with only api calls Thursday, February 08, 2007 2:01 AM (permalink)
0 hi,
two littles classes and a sample to create and display dialogbox "from scratch"
request Dynawrap component: http://freenet-homepage.de/gborn/WSHBazaar/WSHDynaCall.htm
cheers | Option Explicit | | | | | | | | | | | | | | | | | | Class Struct | | Public Property Get Ptr | | Ptr=GetBSTRPtr(sBuf) | | End Property | | Public Sub Add(sItem,sType,Data) | | Dim lVSize,iA,iB,iD | | iA=InStr(1,sType,"[",1) | | iB=InStr(1,sType,"]",1) | | iD="0" | | If iA>0 And iB>0 Then | | iD=Mid(sType,iA+1,iB-iA-1) | | If isNumeric(iD) Then | | sType=Left(sType,iA-1) | | Else | | Err.raise 10000,"Method Add","The index " & iD & " must be numeric" | | Exit Sub | | End If | | End If | | Select Case UCase(sType) | | | | Case "DWORD","LONG","WPARAM","LPARAM","POINTX","POINTY","ULONG","HANDLE","HWND","HINSTANCE","HDC","WNDPROC","HICON","HCURSOR","HBRUSH" | | lVSize=4 | | Case "LPBYTE","LPCTSTR","LPSTR","LPPRINTHOOKPROC","LPSETUPHOOKPROC","LPVOID","INT","UINT" | | lVSize=4 | | Case "WORD" | | lVSize=2 | | Case "BYTE" | | lVSize=1 | | Case "TCHAR" | | If CLng(iD)<1 Then lVSize="254" Else lVSize=iD | | Case Else | | Err.raise 10000,"Method Add","The type " & sType & " is not a Win32 type." | | Exit Sub | | End Select | | dBuf.Add sItem,lVSize | | sBuf=sBuf & String(lVSize/2+1,Chr(0)) | | SetDataBSTR GetBSTRPtr(sBuf),lVSize,Data,iOffset | | End Sub | | Public Function GetItem(sItem) | | Dim lOf,lSi,aItems,aKeys,i | | If dBuf.Exists(sItem) then | | lSi=CLng(dBuf.Item(sItem)) | | aKeys=dBuf.Keys | | aItems=dBuf.Items | | lOf=0 | | For i=0 To dBuf.Count-1 | | If aKeys(i)=sItem Then Exit For | | lOf=lOf+aItems(i) | | Next | | GetItem=GetDataBSTR(Ptr,lSi,lOf) | | Else | | GetItem="" | | err.raise 10000,"Method GetItem","The item " & sItem & " don't exist" | | End If | | End Function | | Public Function GetBSTRPtr(ByRef sData) | | | | Dim pSource | | Dim pDest | | If VarType(sData)<>vbString Then | | GetBSTRPtr=0 | | err.raise 10000, "GetBSTRPtr", "The variable is not a string" | | Exit Function | | End If | | pSource=oSCat.lstrcat(sData,"") | | pDest=oSCat.lstrcat(GetBSTRPtr,"") | | GetBSTRPtr=CLng(0) | | | | | | oMM.RtlMovememory pDest+8,pSource+8,4 | | End Function | | | | Private oMM,oSCat,oAnWi | | Private dBuf,sBuf,iOffset | | Private Sub Class_Initialize | | Set oMM=CreateObject("DynamicWrapper") | | oMM.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l" | | Set oSCat=CreateObject("DynamicWrapper") | | oSCat.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l" | | Set oAnWi=CreateObject("DynamicWrapper") | | oAnWi.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l" | | Set dBuf=CreateObject("Scripting.Dictionary") | | sBuf="" | | iOffset=0 | | End Sub | | Private Sub SetDataBSTR(lpData,iSize,Data,ByRef iOfs) | | | | Dim lW,hW,xBuf | | Select Case iSize | | Case 1 | | lW=Data mod 256 | | xBuf=ChrB(lW) | | Case 2 | | lW=Data mod 65536 | | xBuf=ChrW(lW) | | Case 4 | | hW=Fix(Data/65536) | | lW=Data mod 65536 | | xBuf=ChrW(lW) & ChrW(hW) | | Case Else | | xBuf=Data | | End Select | | oMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSize | | iOfs=iOfs+iSize | | End Sub | | Private Function GetDataBSTR(lpData,iSize,iOffset) | | | | Const CP_ACP=0 | | Dim pDest,tdOffset | | | | pDest=oSCat.lstrcat(GetDataBSTR,"") | | tdOffset=8 | | Select Case iSize | | Case 1 | | GetDataBSTR=CByte(0) | | Case 2 | | GetDataBSTR=CInt(0) | | Case 4 | | GetDataBSTR=CLng(0) | | Case Else | | GetDataBSTR=String(iSize/2,Chr(0)) | | | | pDest=GetBSTRPtr(GetDataBSTR) | | tdOffset=0 | | End Select | | | | oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize | | if tdOffset=0 Then | | oAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize | | GetDataBSTR=Replace(GetDataBSTR,Chr(0),"") | | End If | | End Function | | End Class | | | | Class XGui | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Public dFrmData | | Public Sub CreateForm(sCaption,lLeft,lTop,lWidth,lHeight,bOnTaskBar) | | | | | | | | | | | | | | | | Const WS_VISIBLE=&H10000000 | | Const WS_POPUP=&H80000000 | | Const WS_OVERLAPPEDWINDOW=&HCF0000 | | Dim hTask,fChild | | If bOnTaskBar Then | | hTask=0 | | fChild=0 | | Else | | hTask=hWsh | | fChild=WS_CHILD | | End If | | hWF=oWGui.CreateWindowExA(0,"#32770",sCaption&"",WS_OVERLAPPEDWINDOW+WS_POPUP+fChild,lLeft,lTop,lWidth,lHeight,hTask,0,hIns,0) | | End Sub | | Public Sub ShowForm(bAlwaysOnTop) | | | | | | | | | | Const HWND_TOP=0 | | Const HWND_TOPMOST=-1 | | Const SWP_SHOWWINDOW=&H40 | | Const SWP_NOMOVE=&H2 | | Const SWP_NOSIZE=&H1 | | Dim fTop | | | | If bAlwaysOnTop Then fTop=HWND_TOPMOST Else fTop=HWND_TOP | | oWGui.SetWindowPos hWF,fTop,0,0,0,0,SWP_SHOWWINDOW+SWP_NOMOVE+SWP_NOSIZE | | End Sub | | Public Sub RunForm() | | | | | | | | Const WM_COMMAND=&H111 | | Const WM_SYSCOMMAND=&H112 | | Const WM_KEYUP=&H101 | | Const WM_LBUTTONUP=&H202 | | Const GCW_ATOM=-32 | | Const LB_GETCURSEL=&H188 | | Const LB_ERR=-1 | | Const LB_GETTEXT=&H189 | | Const LB_GETTEXTLEN=&H18A | | Const GWL_STYLE=-16 | | Const WS_CHILD=&H40000000 | | Const WS_VISIBLE=&H10000000 | | Const WS_TABSTOP=&H10000 | | Const BS_AUTOCHECKBOX=&H3 | | Const BS_AUTORADIOBUTTON=&H9 | | Const BM_GETCHECK=&HF0 | | Const BST_UNCHECKED=&H0 | | Const BST_CHECKED=&H1 | | Const BST_INDETERMINATE=&H2 | | Const BST_PUSHED=&H4 | | Const BST_FOCUS=&H8 | | Const CP_ACP=0 | | Const GWL_ID=-12 | | Dim sCN,sCNW | | Dim aKData,aHData | | Dim lGetI | | Dim lStyle | | Dim lKCode | | Dim n | | | | Do While oWGui.GetMessageA(MSG.Ptr,hWF,0,0)>0 | | If oWGui.IsDialogMessageA(hWF,MSG.ptr)<>0 Then | | Select Case MSG.GetItem("message") | | Case WM_KEYUP,WM_LBUTTONUP | | lKCode=MSG.GetItem("wParam") | | If MSG.GetItem("message")=WM_LBUTTONUP Then lKCode=13 | | Select Case lKCode | | Case 27 | | dFrmData.RemoveAll | | oWGui.DestroyWindow hWF | | Exit Do | | Case 13,32 | | If oWGui.GetClassLongA(oWGui.GetFocus,GCW_ATOM)=49175 Then | | sCNW=UCase(GetBSTRCtrl(oWGui.GetFocus)) | | If sCNW="&OK" Then | | aKData=dFrmData.Keys | | aHData=dFrmData.Items | | | | For n=0 To dFrmData.Count-1 | | sCNW="" | | If oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49178 Then | | lGetI=oWGui.SendMessageA(aHData(n),LB_GETCURSEL,0,0) | | If lGetI<>LB_ERR Then | | sCN=String(127,Chr(0)) | | sCNW=String(oWGui.SendMessageA(aHData(n),LB_GETTEXT,lGetI,MSG.GetBSTRPtr(sCN)),Chr(0)) | | oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sCN),-1,MSG.GetBSTRPtr(sCNW),LenB(sCNW) | | End If | | Else | | If oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49175 Then | | lStyle=oWGui.GetWindowLongA(aHData(n),GWL_STYLE) | | If ((lStyle And BS_AUTOCHECKBOX)=BS_AUTOCHECKBOX) Or ((lStyle And BS_AUTORADIOBUTTON)=BS_AUTORADIOBUTTON) Then | | sCNW=False | | If oWGui.SendMessageA(aHData(n),BM_GETCHECK,0,0)=BST_CHECKED Then sCNW=True | | Else | | sCNW=GetBSTRCtrl(aHData(n)) | | End If | | Else | | sCNW=GetBSTRCtrl(aHData(n)) | | End If | | End If | | dFrmData.Item(aKData(n))=sCNW | | Next | | oWGui.DestroyWindow hWF | | Exit Do | | End If | | If sCNW="&ANNULER" Then | | dFrmData.RemoveAll | | oWGui.DestroyWindow hWF | | Exit Do | | End If | | End If | | End Select | | Case WM_COMMAND,WM_SYSCOMMAND | | If (MSG.GetItem("wParam")=2) Or (MSG.GetItem("wParam")=61536) Then | | dFrmData.RemoveAll | | oWGui.DestroyWindow hWF | | Exit Do | | End If | | End Select | | Else | | oWGui.TranslateMessage MSG.Ptr | | oWGui.DispatchMessageA MSG.Ptr | | End If | | Loop | | End Sub | | Public Sub AddControl(sName,sClass,sData,lLeft,lTop,lWidth,lHeight) | | | | | | | | | | | | | | | | | | Const WS_EX_CLIENTEDGE=&H200 | | Const DEFAULT_GUI_FONT=17 | | Const WM_SETFONT=&H30 | | Const WS_CHILD=&H40000000 | | Const WS_VISIBLE=&H10000000 | | Const WS_TABSTOP=&H10000 | | Const GWL_ID=-12 | | Const WS_VSCROLL=&H200000 | | Const BS_AUTOCHECKBOX=&H3 | | Const BS_AUTORADIOBUTTON=&H9 | | Const BS_GROUPBOX=&H7 | | Const BM_SETCHECK=&HF1 | | Const BST_CHECKED=1 | | Const LBS_HASSTRINGS=&H40 | | Const CBS_DROPDOWN=&H2 | | Const CB_ADDSTRING=&H143 | | Const LB_ADDSTRING=&H180 | | Const LBS_DISABLENOSCROLL=&H1000 | | Dim hWn | | Dim sD | | Dim cbBuf | | Dim sX | | Dim lStyle | | Dim lStyleEx | | Dim lSL | | Dim fC | | Dim fL | | Dim n | | | | fC=False | | fL=False | | | | Select Case UCase(sClass) | | Case "EDIT" | | sX=sClass | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP | | lStyleEx=WS_EX_CLIENTEDGE | | Case "STATIC" | | sX=sClass | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE | | lStyleEx=0 | | Case "COMBOBOX" | | sX=sClass | | sD="" | | lStyle=WS_CHILD+WS_VISIBLE+CBS_DROPDOWN+WS_TABSTOP | | lStyleEx=0 | | cbBuf=Split(sData,"|") | | fL=True | | lSL=CB_ADDSTRING | | Case "LISTBOX" | | sX=sClass | | sD="" | | lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+WS_VSCROLL+LBS_HASSTRINGS+LBS_DISABLENOSCROLL | | lStyleEx=WS_EX_CLIENTEDGE | | cbBuf=Split(sData,"|") | | fL=True | | lSL=LB_ADDSTRING | | Case "BUTTON" | | sX=sClass | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP | | lStyleEx=0 | | Case "GROUPBOX" | | sX="button" | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE+BS_GROUPBOX | | lStyleEx=0 | | Case "CHECKBOX" | | sX="button" | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTOCHECKBOX | | lStyleEx=0 | | fC=True | | Case "RADIOBUTTON" | | sX="button" | | sD=sData | | lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTORADIOBUTTON | | lStyleEx=0 | | fC=True | | Case Else | | Err.raise 10000,"Method AddControl","The class " & sClass & " is not a global system class" | | Exit Sub | | End Select | | hWn=oWGui.CreateWindowExA(lStyleEx,sX&"",sD&"",lStyle,lLeft,lTop,lWidth,lHeight,hWF,0,hIns,0) | | oWGui.SendMessageA hWn,WM_SETFONT,oWGui.GetStockObject(DEFAULT_GUI_FONT),-1 | | If fL Then | | For n=0 to UBound(cbBuf) | | oWsm.SendMessageA hWn,lSL,0,MSG.GetBSTRPtr(cbBuf(n)) | | Next | | End If | | If fC Then | | If UCase(Right(sName,1))="K" Then oWGui.SendMessageA hWn,BM_SETCHECK,BST_CHECKED,0 | | End If | | dFrmData.Add sName,hWn | | End Sub | | | | Private oWGui | | Private oWsm | | Private oWaw | | | | Private MSG | | Private hIns | | Private hWsh | | Private hWF | | | | Private Sub Class_Initialize | | Const GWL_HINSTANCE=-6 | | Set oWGui=CreateObject("DynamicWrapper") | | Set oWsm=CreateObject("DynamicWrapper") | | Set oWaw=CreateObject("DynamicWrapper") | | With oWGui | | .Register "user32.dll","FindWindowA","f=s","i=ss","r=l" | | .Register "user32.dll","CreateWindowExA","f=s","i=lsslllllllll","r=l" | | .Register "user32.dll","SetWindowPos","f=s","i=lllllll","r=l" | | .Register "user32.dll","GetMessageA","f=s","i=llll","r=l" | | .Register "user32.dll","DispatchMessageA","f=s","i=l","r=l" | | .Register "user32.dll","TranslateMessage","i=l","f=s","r=l" | | .Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l" | | .Register "user32.dll","SendMessageA","f=s","i=llll","r=l" | | .Register "user32.dll","SetWindowLongA","f=s","i=lll","r=l" | | .Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l" | | .Register "user32.dll","IsDialogMessageA","f=s","i=ll","r=l" | | .Register "user32.dll","DestroyWindow","f=s","i=l","r=l" | | .Register "user32.dll","GetFocus","f=s","r=l" | | .Register "user32.dll","GetWindowTextA","f=s","i=lll","r=l" | | .Register "user32.dll","GetWindowTextLengthA","f=s","i=l","r=l" | | .Register "user32.dll","GetClassLongA","f=s","i=ll","r=l" | | .Register "gdi32.dll","GetStockObject","f=s","i=l","r=l" | | End With | | oWsm.Register "user32.dll","SendMessageA","f=s","i=llls","r=l" | | oWaw.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l" | | Set MSG=New Struct | | With MSG | | .Add "hwnd","HWND",0 | | .Add "message","UINT",0 | | .Add "wParam","WPARAM",0 | | .Add "lParam","LPARAM",0 | | .Add "time","DWORD",0 | | .Add "ptx","POINTX",0 | | .Add "pty","POINTY",0 | | End With | | Set dFrmData=CreateObject("Scripting.Dictionary") | | hWsh=oWGui.FindWindowA("WSH-Timer",chr(0)) | | hIns=oWGui.GetWindowLongA(hWsh,GWL_HINSTANCE) | | End Sub | | Private Function GetBSTRCtrl(hdW) | | | | Const CP_ACP=0 | | Dim sBuf,sBufW | | sBuf=String(oWGui.GetWindowTextLengthA(hdW),Chr(0)) | | sBufW=String(oWGui.GetWindowTextA(hdW,MSG.GetBSTRPtr(sBuf),oWGui.GetWindowTextLengthA(hdW)+1),Chr(0)) | | oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sBuf),-1,MSG.GetBSTRPtr(sBufW),LenB(sBufW) | | GetBSTRCtrl=sBufW | | End Function | | End Class | | | | | | | | Dim oFrm | | Set oFrm=New XGui | | oFrm.CreateForm "DialogBox by omen999",150,300,480,300,-1 | | oFrm.AddControl "label1","static","&Last Name :",10,8,60,16 | | oFrm.AddControl "edit1","edit","",10,26,120,20 | | oFrm.AddControl "label2","static","&First Name :",10,50,60,16 | | oFrm.AddControl "edit2","edit","",10,68,120,20 | | oFrm.AddControl "label3","static","A&ddress :",10,94,100,16 | | oFrm.AddControl "edit3","edit","",10,112,150,20 | | oFrm.AddControl "label4","static","&City :",10,136,100,20 | | oFrm.AddControl "edit4","edit","",10,152,100,20 | | oFrm.AddControl "gbox1","groupbox"," Sex ",6,178,84,72 | | oFrm.AddControl "rdbox1","radiobutton","&Male",10,194,68,18 | | oFrm.AddControl "rdbox2k","radiobutton","&Female",10,212,68,18 | | oFrm.AddControl "rdbox3","radiobutton","&Don't know",10,230,74,18 | | oFrm.AddControl "label5","static","&Status :",146,8,40,16 | | oFrm.AddControl "cbox1","combobox","single|married|divorcee",146,26,150,80 | | oFrm.AddControl "label6","static","&Type :",310,8,40,16 | | oFrm.AddControl "lbox1","listbox","anorexic|very thin|thin|normal|fat|obese|dead",310,28,150,80 | | oFrm.AddControl "ckbox1k","checkbox","Mem&ber",310,90,68,20 | | oFrm.AddControl "button1","button","&OK",392,240,70,24 | | oFrm.AddControl "button2","button","&Cancel",312,240,70,24 | | oFrm.ShowForm False | | oFrm.RunForm | | | | | | MsgBox oFrm.dFrmData.Item("label1") & vbLf &_ | | oFrm.dFrmData.Item("edit1") & vbLf &_ | | oFrm.dFrmData.Item("label2") & vbLf &_ | | oFrm.dFrmData.Item("edit2") & vbLf &_ | | oFrm.dFrmData.Item("label3") & vbLf &_ | | oFrm.dFrmData.Item("edit3") & vbLf &_ | | oFrm.dFrmData.Item("label4") & vbLf &_ | | oFrm.dFrmData.Item("edit4") & vbLf &_ | | oFrm.dFrmData.Item("gbox1") & vbLf &_ | | oFrm.dFrmData.Item("rdbox1") & vbLf &_ | | oFrm.dFrmData.Item("rdbox2k") & vbLf &_ | | oFrm.dFrmData.Item("rdbox3") & vbLf &_ | | oFrm.dFrmData.Item("label5") & vbLf &_ | | oFrm.dFrmData.Item("cbox1") & vbLf &_ | | oFrm.dFrmData.Item("label6") & vbLf &_ | | oFrm.dFrmData.Item("lbox1") & vbLf &_ | | oFrm.dFrmData.Item("ckbox1k") & vbLf &_ | | oFrm.dFrmData.Item("button1") & vbLf &_ | | oFrm.dFrmData.Item("button2")COPY |
|
|