[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[转贴] 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
  1. Option Explicit
  2. '************************************
  3. '* Sample GUI only with API calls   *
  4. '* Need DynaWrap component          *
  5. '* Use Struct v1.1 Class            *
  6. '* syntax Win NT et >               *
  7. '* omen999 february 2007            *
  8. '************************************
  9. Class Struct ' v1.1  allow typedef with dynawrap calls
  10.   Public Property Get Ptr '******************************* Property Ptr
  11.     Ptr=GetBSTRPtr(sBuf)
  12.   End Property
  13.   Public Sub Add(sItem,sType,Data) '********************** Method Add
  14.     Dim lVSize,iA,iB,iD
  15.     iA=InStr(1,sType,"[",1)
  16.     iB=InStr(1,sType,"]",1)
  17.     iD="0"
  18.     If iA>0  And iB>0 Then
  19.       iD=Mid(sType,iA+1,iB-iA-1)
  20.       If isNumeric(iD) Then
  21.         sType=Left(sType,iA-1)
  22.       Else
  23.         Err.raise 10000,"Method Add","The index " & iD & " must be numeric"
  24.         Exit Sub
  25.       End If
  26.     End If
  27.     Select Case UCase(sType)'************************************************* COMPLETE WITH OTHERS WIN32 TYPES
  28.     'OS 32bits...
  29.     Case "DWORD","LONG","WPARAM","LPARAM","POINTX","POINTY","ULONG","HANDLE","HWND","HINSTANCE","HDC","WNDPROC","HICON","HCURSOR","HBRUSH"
  30.       lVSize=4
  31.     Case "LPBYTE","LPCTSTR","LPSTR","LPPRINTHOOKPROC","LPSETUPHOOKPROC","LPVOID","INT","UINT"
  32.       lVSize=4
  33.     Case "WORD"
  34.       lVSize=2
  35.     Case "BYTE"
  36.       lVSize=1
  37.     Case "TCHAR"
  38.       If CLng(iD)<1 Then lVSize="254" Else lVSize=iD
  39.     Case Else
  40.       Err.raise 10000,"Method Add","The type " & sType & " is not a Win32 type."
  41.       Exit Sub
  42.     End Select
  43.     dBuf.Add sItem,lVSize
  44.     sBuf=sBuf & String(lVSize/2+1,Chr(0))
  45.     SetDataBSTR GetBSTRPtr(sBuf),lVSize,Data,iOffset
  46.   End Sub
  47.   Public Function GetItem(sItem) '********************************************** Méthode GetItem
  48.     Dim lOf,lSi,aItems,aKeys,i
  49.     If dBuf.Exists(sItem) then
  50.       lSi=CLng(dBuf.Item(sItem))
  51.       aKeys=dBuf.Keys
  52.       aItems=dBuf.Items
  53.       lOf=0
  54.       For i=0  To dBuf.Count-1
  55.         If aKeys(i)=sItem Then Exit For
  56.         lOf=lOf+aItems(i)
  57.       Next
  58.       GetItem=GetDataBSTR(Ptr,lSi,lOf)
  59.     Else
  60.       GetItem=""
  61.       err.raise 10000,"Method GetItem","The item " & sItem & " don't exist"
  62.     End If
  63.   End Function
  64.   Public Function GetBSTRPtr(ByRef sData)
  65.   'retun the TRUE address (variant long) of the sData string BSTR
  66.     Dim pSource
  67.     Dim pDest
  68.     If VarType(sData)<>vbString Then 'little check
  69.       GetBSTRPtr=0
  70.       err.raise 10000, "GetBSTRPtr", "The variable is not a string"
  71.       Exit Function
  72.     End If
  73.     pSource=oSCat.lstrcat(sData,"")    'trick to return sData pointer
  74.     pDest=oSCat.lstrcat(GetBSTRPtr,"")  'idem
  75.     GetBSTRPtr=CLng(0)            'cast  function variable
  76.     'l'adresse du contenu réel de sBuf (4octets) écrase le contenu de la variable GetBSTPtr  
  77.     'les valeurs sont incrémentées de 8 octets pour  tenir compte du Type Descriptor
  78.     oMM.RtlMovememory pDest+8,pSource+8,4
  79.   End Function
  80. '**************************************************************************** IMPLEMENTATION
  81.   Private oMM,oSCat,oAnWi 'objets wrapper API
  82.   Private dBuf,sBuf,iOffset
  83.   Private  Sub Class_Initialize 'Constructeur
  84.     Set oMM=CreateObject("DynamicWrapper")
  85.     oMM.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"
  86.     Set oSCat=CreateObject("DynamicWrapper")
  87.     oSCat.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l"   
  88.     Set oAnWi=CreateObject("DynamicWrapper")            
  89.       oAnWi.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l"
  90.     Set dBuf=CreateObject("Scripting.Dictionary")
  91.     sBuf=""
  92.     iOffset=0
  93.   End Sub  
  94.   Private Sub SetDataBSTR(lpData,iSize,Data,ByRef iOfs)
  95.   'Place une valeur Data de taille iSize à l'adresse lpData+iOfs
  96.     Dim lW,hW,xBuf
  97.     Select Case iSize   'on commence par formater les valeurs numériques
  98.     Case 1
  99.       lW=Data mod 256   'formatage 8 bits
  100.       xBuf=ChrB(lW)
  101.     Case 2           'if any
  102.       lW=Data mod 65536 'formatage 16 bits
  103.       xBuf=ChrW(lW)    'formatage little-endian
  104.     Case 4
  105.       hW=Fix(Data/65536)'high word
  106.       lW=Data mod 65536 'low word
  107.       xBuf=ChrW(lW) & ChrW(hW) 'formatage little-endian
  108.     Case Else        'bytes array, size iSize
  109.       xBuf=Data
  110.     End Select
  111.     oMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSize
  112.     iOfs=iOfs+iSize 'maj l'offset
  113.   End Sub
  114.   Private Function GetDataBSTR(lpData,iSize,iOffset)
  115.   'Read an iSize data to lpData+iOffset address
  116.     Const CP_ACP=0       'code ANSI  
  117.     Dim pDest,tdOffset
  118.     'valeurs pour les données numériques
  119.     pDest=oSCat.lstrcat(GetDataBSTR,"")
  120.     tdOffset=8
  121.     Select Case iSize ' cast de la variable fonction
  122.     Case 1
  123.       GetDataBSTR=CByte(0)
  124.     Case 2
  125.       GetDataBSTR=CInt(0)
  126.     Case 4
  127.       GetDataBSTR=CLng(0)
  128.     Case Else  'a little bit more complicated with string data...
  129.         GetDataBSTR=String(iSize/2,Chr(0))
  130.         'la chaine variant BSTR stocke ses données ailleurs
  131.       pDest=GetBSTRPtr(GetDataBSTR)
  132.       tdOffset=0
  133.     End Select
  134.     'le contenu de la structure à l'offset iOffset écrase le contenu de la variable GetDataBSTR (tenir compte du TD)
  135.     oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize
  136.     if tdOffset=0 Then
  137.       oAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize 'don't forget conversion Ansi->Wide
  138.       GetDataBSTR=Replace(GetDataBSTR,Chr(0),"")                 'clean the trailer
  139.     End If
  140.   End Function
  141. End Class
  142. Class XGui 'v1.0
  143. ' this class create a dialogbox only by api calls
  144. ' it uses automation component DynaWrap and the struct class upper to allow typedef with dynawrap calls
  145. ' 4 public methods: CreateForm, ShowForm, RunForm et AddControl
  146. ' 1 public object dictionnary dFrmData which keys are name controls and stores data controls
  147. ' edit, static et button controls return content, listbox/combobox the selected item if exists, or empty string
  148. ' radiobutton and checkbox return true if checked or false
  149. ' groupbox control always return false
  150. ' each control must have unique name
  151. ' if the last letter of a checkbox ou radiobutton control name is "k", the control wil be checked
  152. ' close form without dictionnary data with esc key, Alt+F4, close button and system menu
  153. ' button controls haven't default behavior et must be manage by RunForm method
  154. ' this release 1.0  manages only "&ok" et "&cancel" buttons
  155. ' button ok closes the form and set data dictionnary, button cancel acts like esc key
  156. Public dFrmData ' object dictionnary
  157. Public Sub CreateForm(sCaption,lLeft,lTop,lWidth,lHeight,bOnTaskBar)
  158. 'Create a modeless invisible form
  159. 'sCaption: form caption
  160. 'lLeft,lTop: coordinates form
  161. 'lWidth, lHeight: form dimensions
  162. 'bOnTaskBar: if true (-1) form is display on taskbar
  163. 'no return value
  164.   Const WS_VISIBLE=&H10000000
  165.   Const WS_POPUP=&H80000000
  166.   Const WS_OVERLAPPEDWINDOW=&HCF0000
  167.   Dim hTask,fChild
  168.   If bOnTaskBar Then
  169.     hTask=0
  170.     fChild=0
  171.   Else
  172.     hTask=hWsh
  173.     fChild=WS_CHILD
  174.   End If
  175.   hWF=oWGui.CreateWindowExA(0,"#32770",sCaption&"",WS_OVERLAPPEDWINDOW+WS_POPUP+fChild,lLeft,lTop,lWidth,lHeight,hTask,0,hIns,0)
  176. End Sub
  177. Public Sub ShowForm(bAlwaysOnTop)
  178. 'display the form created by CreateForm
  179. 'bAlwaysOnTop: if true (-1) form always on top
  180. 'no return value
  181.   Const HWND_TOP=0
  182.   Const HWND_TOPMOST=-1
  183.   Const SWP_SHOWWINDOW=&H40
  184.   Const SWP_NOMOVE=&H2
  185.   Const SWP_NOSIZE=&H1
  186.   Dim fTop
  187.   
  188.   If bAlwaysOnTop Then fTop=HWND_TOPMOST Else fTop=HWND_TOP
  189.   oWGui.SetWindowPos hWF,fTop,0,0,0,0,SWP_SHOWWINDOW+SWP_NOMOVE+SWP_NOSIZE
  190. End Sub
  191. Public Sub RunForm()
  192. 'form messages pump and dictionnary gestion
  193. 'no return value
  194.   Const WM_COMMAND=&H111
  195.   Const WM_SYSCOMMAND=&H112
  196.   Const WM_KEYUP=&H101
  197.   Const WM_LBUTTONUP=&H202
  198.   Const GCW_ATOM=-32
  199.   Const LB_GETCURSEL=&H188
  200.   Const LB_ERR=-1
  201.   Const LB_GETTEXT=&H189
  202.   Const LB_GETTEXTLEN=&H18A
  203.   Const GWL_STYLE=-16
  204.   Const WS_CHILD=&H40000000
  205.   Const WS_VISIBLE=&H10000000
  206.   Const WS_TABSTOP=&H10000
  207.   Const BS_AUTOCHECKBOX=&H3
  208.   Const BS_AUTORADIOBUTTON=&H9
  209.   Const BM_GETCHECK=&HF0
  210.   Const BST_UNCHECKED=&H0
  211.   Const BST_CHECKED=&H1
  212.   Const BST_INDETERMINATE=&H2
  213.   Const BST_PUSHED=&H4
  214.   Const BST_FOCUS=&H8
  215.   Const CP_ACP=0
  216.   Const GWL_ID=-12
  217.   Dim sCN,sCNW     'control content ansi/wide
  218.   Dim aKData,aHData 'dictionnary contents keys/datas
  219.   Dim lGetI       'index selected item (listbox)
  220.   Dim lStyle       'button style
  221.   Dim lKCode      'param message
  222.   Dim n        'compteur
  223.   
  224.   Do While oWGui.GetMessageA(MSG.Ptr,hWF,0,0)>0 'Main loop messages pump
  225.     If oWGui.IsDialogMessageA(hWF,MSG.ptr)<>0 Then
  226.       Select Case MSG.GetItem("message")
  227.       Case WM_KEYUP,WM_LBUTTONUP
  228.         lKCode=MSG.GetItem("wParam")
  229.         If MSG.GetItem("message")=WM_LBUTTONUP Then lKCode=13 'left mouse click -> enterkey
  230.         Select Case lKCode
  231.         Case 27 'esc
  232.           dFrmData.RemoveAll
  233.           oWGui.DestroyWindow hWF
  234.           Exit Do
  235.         Case 13,32 'enter or space when is an button control
  236.           If oWGui.GetClassLongA(oWGui.GetFocus,GCW_ATOM)=49175 Then 'get atom button
  237.             sCNW=UCase(GetBSTRCtrl(oWGui.GetFocus))
  238.             If sCNW="&OK" Then   'it's ok button, so set dictionnary data and form close
  239.               aKData=dFrmData.Keys   'control names array
  240.               aHData=dFrmData.Items   'control handles array
  241.               
  242.               For n=0 To dFrmData.Count-1 'loop
  243.                 sCNW=""
  244.                 If oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49178 Then 'get atom listbox
  245.                   lGetI=oWGui.SendMessageA(aHData(n),LB_GETCURSEL,0,0)
  246.                   If lGetI<>LB_ERR Then 'get the selected item if any
  247.                     sCN=String(127,Chr(0))
  248.                     sCNW=String(oWGui.SendMessageA(aHData(n),LB_GETTEXT,lGetI,MSG.GetBSTRPtr(sCN)),Chr(0))
  249.                     oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sCN),-1,MSG.GetBSTRPtr(sCNW),LenB(sCNW)
  250.                   End If
  251.                 Else
  252.                   If oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49175 Then 'get atom button
  253.                     lStyle=oWGui.GetWindowLongA(aHData(n),GWL_STYLE)
  254.                     If ((lStyle And BS_AUTOCHECKBOX)=BS_AUTOCHECKBOX) Or ((lStyle And BS_AUTORADIOBUTTON)=BS_AUTORADIOBUTTON) Then
  255.                       sCNW=False
  256.                       If oWGui.SendMessageA(aHData(n),BM_GETCHECK,0,0)=BST_CHECKED Then sCNW=True
  257.                     Else 'other pushbouton
  258.                       sCNW=GetBSTRCtrl(aHData(n))
  259.                     End If
  260.                   Else 'get data for edit, combo, static...
  261.                     sCNW=GetBSTRCtrl(aHData(n))
  262.                   End If
  263.                 End If
  264.                 dFrmData.Item(aKData(n))=sCNW 'la maj
  265.               Next
  266.               oWGui.DestroyWindow hWF
  267.               Exit Do
  268.             End If
  269.             If sCNW="&ANNULER" Then
  270.               dFrmData.RemoveAll
  271.               oWGui.DestroyWindow hWF
  272.               Exit Do
  273.             End If  
  274.           End If
  275.         End Select
  276.       Case WM_COMMAND,WM_SYSCOMMAND
  277.         If (MSG.GetItem("wParam")=2) Or (MSG.GetItem("wParam")=61536) Then 'close button or system menu
  278.           dFrmData.RemoveAll
  279.           oWGui.DestroyWindow hWF
  280.           Exit Do
  281.         End If
  282.       End Select
  283.     Else
  284.       oWGui.TranslateMessage MSG.Ptr
  285.       oWGui.DispatchMessageA MSG.Ptr
  286.     End If  
  287.   Loop  
  288. End Sub
  289. Public Sub AddControl(sName,sClass,sData,lLeft,lTop,lWidth,lHeight)
  290. 'add a control on the form create by CreateForm method
  291. 'sName: unique control name
  292. 'sClass: one of global system class name
  293. 'sData: control data
  294. 'lLeft,lTop: control position on screen
  295. 'lWidth, lHeight: control dimensions
  296. 'no return value
  297.   
  298.   Const WS_EX_CLIENTEDGE=&H200
  299.   Const DEFAULT_GUI_FONT=17
  300.   Const WM_SETFONT=&H30
  301.   Const WS_CHILD=&H40000000
  302.   Const WS_VISIBLE=&H10000000
  303.   Const WS_TABSTOP=&H10000
  304.   Const GWL_ID=-12
  305.   Const WS_VSCROLL=&H200000
  306.   Const BS_AUTOCHECKBOX=&H3
  307.   Const BS_AUTORADIOBUTTON=&H9
  308.   Const BS_GROUPBOX=&H7
  309.   Const BM_SETCHECK=&HF1
  310.   Const BST_CHECKED=1
  311.   Const LBS_HASSTRINGS=&H40
  312.   Const CBS_DROPDOWN=&H2
  313.   Const CB_ADDSTRING=&H143
  314.   Const LB_ADDSTRING=&H180
  315.   Const LBS_DISABLENOSCROLL=&H1000
  316.   Dim hWn       'current control handle
  317.   Dim sD        'current control data
  318.   Dim cbBuf      'array list/combo data
  319.   Dim sX        'types buttons
  320.   Dim lStyle      'current control styles
  321.   Dim lStyleEx    'extended styles
  322.   Dim lSL        'style liste or combo
  323.   Dim fC        'flag check
  324.   Dim fL        'flag list
  325.   Dim n          'loop
  326.   
  327.   fC=False
  328.   fL=False
  329.   'parameters definition for CreateWindowEx according to class control
  330.   Select Case UCase(sClass)
  331.   Case "EDIT"
  332.     sX=sClass
  333.     sD=sData
  334.     lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP
  335.     lStyleEx=WS_EX_CLIENTEDGE
  336.   Case "STATIC"
  337.     sX=sClass
  338.     sD=sData
  339.     lStyle=WS_CHILD+WS_VISIBLE
  340.     lStyleEx=0
  341.   Case "COMBOBOX"
  342.     sX=sClass
  343.     sD=""
  344.     lStyle=WS_CHILD+WS_VISIBLE+CBS_DROPDOWN+WS_TABSTOP
  345.     lStyleEx=0
  346.     cbBuf=Split(sData,"|")
  347.     fL=True   
  348.     lSL=CB_ADDSTRING
  349.   Case "LISTBOX"
  350.     sX=sClass
  351.     sD=""
  352.     lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+WS_VSCROLL+LBS_HASSTRINGS+LBS_DISABLENOSCROLL
  353.     lStyleEx=WS_EX_CLIENTEDGE
  354.     cbBuf=Split(sData,"|")
  355.     fL=True
  356.     lSL=LB_ADDSTRING
  357.   Case "BUTTON"
  358.     sX=sClass
  359.     sD=sData
  360.     lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP
  361.     lStyleEx=0
  362.   Case "GROUPBOX"
  363.     sX="button"
  364.     sD=sData
  365.     lStyle=WS_CHILD+WS_VISIBLE+BS_GROUPBOX
  366.     lStyleEx=0
  367.   Case "CHECKBOX"
  368.     sX="button"
  369.     sD=sData
  370.     lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTOCHECKBOX
  371.     lStyleEx=0
  372.     fC=True
  373.   Case "RADIOBUTTON"
  374.     sX="button"
  375.     sD=sData
  376.     lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTORADIOBUTTON
  377.     lStyleEx=0
  378.     fC=True
  379.   Case Else
  380.     Err.raise 10000,"Method AddControl","The class " & sClass & " is not a global system class"
  381.     Exit Sub
  382.   End Select
  383.   hWn=oWGui.CreateWindowExA(lStyleEx,sX&"",sD&"",lStyle,lLeft,lTop,lWidth,lHeight,hWF,0,hIns,0) 'control creation
  384.   oWGui.SendMessageA hWn,WM_SETFONT,oWGui.GetStockObject(DEFAULT_GUI_FONT),-1             'default font
  385.   If fL Then 'feed the listbox/combobox
  386.     For n=0 to UBound(cbBuf)
  387.       oWsm.SendMessageA hWn,lSL,0,MSG.GetBSTRPtr(cbBuf(n))
  388.     Next
  389.   End If
  390.   If fC Then 'check control with end's name is letter k
  391.     If UCase(Right(sName,1))="K" Then oWGui.SendMessageA hWn,BM_SETCHECK,BST_CHECKED,0
  392.   End If
  393.   dFrmData.Add sName,hWn 'add control handle to dictionnary
  394. End Sub
  395. '************************************************************************************************************* IMPLEMENTATION
  396. Private oWGui   'object API GUI
  397. Private oWsm   'object SendMessage (syntax different)
  398. Private oWaw  'object ANSI -> UNICODE conversion
  399. Private MSG     'structure MSG from API
  400. Private hIns    'instance handle
  401. Private hWsh    'main window WScript handle (hidden)
  402. Private hWF      'form handle
  403. Private  Sub Class_Initialize 'Constructor
  404.   Const GWL_HINSTANCE=-6
  405.   Set oWGui=CreateObject("DynamicWrapper")
  406.   Set oWsm=CreateObject("DynamicWrapper")
  407.   Set oWaw=CreateObject("DynamicWrapper")
  408.   With oWGui
  409.     .Register "user32.dll","FindWindowA","f=s","i=ss","r=l"
  410.     .Register "user32.dll","CreateWindowExA","f=s","i=lsslllllllll","r=l"
  411.     .Register "user32.dll","SetWindowPos","f=s","i=lllllll","r=l"
  412.     .Register "user32.dll","GetMessageA","f=s","i=llll","r=l"
  413.     .Register "user32.dll","DispatchMessageA","f=s","i=l","r=l"
  414.     .Register "user32.dll","TranslateMessage","i=l","f=s","r=l"
  415.     .Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l"
  416.     .Register "user32.dll","SendMessageA","f=s","i=llll","r=l"
  417.     .Register "user32.dll","SetWindowLongA","f=s","i=lll","r=l"
  418.     .Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l"
  419.     .Register "user32.dll","IsDialogMessageA","f=s","i=ll","r=l"
  420.     .Register "user32.dll","DestroyWindow","f=s","i=l","r=l"
  421.     .Register "user32.dll","GetFocus","f=s","r=l"
  422.     .Register "user32.dll","GetWindowTextA","f=s","i=lll","r=l"
  423.     .Register "user32.dll","GetWindowTextLengthA","f=s","i=l","r=l"
  424.     .Register "user32.dll","GetClassLongA","f=s","i=ll","r=l"
  425.     .Register "gdi32.dll","GetStockObject","f=s","i=l","r=l"
  426.   End With
  427.   oWsm.Register "user32.dll","SendMessageA","f=s","i=llls","r=l" 'di
  428.   oWaw.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l"
  429.   Set MSG=New Struct
  430.   With MSG
  431.     .Add "hwnd","HWND",0
  432.      .Add "message","UINT",0
  433.      .Add "wParam","WPARAM",0
  434.      .Add "lParam","LPARAM",0
  435.      .Add "time","DWORD",0
  436.      .Add "ptx","POINTX",0
  437.      .Add "pty","POINTY",0
  438.   End With
  439.   Set dFrmData=CreateObject("Scripting.Dictionary")
  440.   hWsh=oWGui.FindWindowA("WSH-Timer",chr(0))
  441.   hIns=oWGui.GetWindowLongA(hWsh,GWL_HINSTANCE)  
  442. End Sub
  443. Private Function GetBSTRCtrl(hdW)
  444. ' Return handle hdW control content as string BSTR
  445.   Const CP_ACP=0
  446.   Dim sBuf,sBufW
  447.   sBuf=String(oWGui.GetWindowTextLengthA(hdW),Chr(0))  
  448.   sBufW=String(oWGui.GetWindowTextA(hdW,MSG.GetBSTRPtr(sBuf),oWGui.GetWindowTextLengthA(hdW)+1),Chr(0))
  449.   oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sBuf),-1,MSG.GetBSTRPtr(sBufW),LenB(sBufW)
  450.   GetBSTRCtrl=sBufW
  451. End Function
  452. End Class
  453. '************************************************************************* DialogBox SAMPLE
  454. Dim oFrm
  455. Set oFrm=New XGui
  456. oFrm.CreateForm "DialogBox by omen999",150,300,480,300,-1 ' modeless form
  457. oFrm.AddControl "label1","static","&Last Name :",10,8,60,16
  458. oFrm.AddControl "edit1","edit","",10,26,120,20
  459. oFrm.AddControl "label2","static","&First Name :",10,50,60,16
  460. oFrm.AddControl "edit2","edit","",10,68,120,20
  461. oFrm.AddControl "label3","static","A&ddress :",10,94,100,16
  462. oFrm.AddControl "edit3","edit","",10,112,150,20
  463. oFrm.AddControl "label4","static","&City :",10,136,100,20
  464. oFrm.AddControl "edit4","edit","",10,152,100,20
  465. oFrm.AddControl "gbox1","groupbox"," Sex ",6,178,84,72
  466. oFrm.AddControl "rdbox1","radiobutton","&Male",10,194,68,18
  467. oFrm.AddControl "rdbox2k","radiobutton","&Female",10,212,68,18   'this control will be checked
  468. oFrm.AddControl "rdbox3","radiobutton","&Don't know",10,230,74,18
  469. oFrm.AddControl "label5","static","&Status :",146,8,40,16
  470. oFrm.AddControl "cbox1","combobox","single|married|divorcee",146,26,150,80
  471. oFrm.AddControl "label6","static","&Type :",310,8,40,16
  472. oFrm.AddControl "lbox1","listbox","anorexic|very thin|thin|normal|fat|obese|dead",310,28,150,80
  473. oFrm.AddControl "ckbox1k","checkbox","Mem&ber",310,90,68,20      'this control will be checked
  474. oFrm.AddControl "button1","button","&OK",392,240,70,24
  475. oFrm.AddControl "button2","button","&Cancel",312,240,70,24
  476. oFrm.ShowForm False
  477. oFrm.RunForm 'messages pump
  478. 'display the dialogbox final content
  479. MsgBox oFrm.dFrmData.Item("label1") & vbLf &_
  480.      oFrm.dFrmData.Item("edit1") & vbLf &_
  481.      oFrm.dFrmData.Item("label2") & vbLf &_
  482.      oFrm.dFrmData.Item("edit2") & vbLf &_
  483.      oFrm.dFrmData.Item("label3") & vbLf &_
  484.      oFrm.dFrmData.Item("edit3") & vbLf &_
  485.      oFrm.dFrmData.Item("label4") & vbLf &_
  486.      oFrm.dFrmData.Item("edit4") & vbLf &_
  487.      oFrm.dFrmData.Item("gbox1") & vbLf &_
  488.      oFrm.dFrmData.Item("rdbox1") & vbLf &_
  489.      oFrm.dFrmData.Item("rdbox2k") & vbLf &_
  490.      oFrm.dFrmData.Item("rdbox3") & vbLf &_
  491.      oFrm.dFrmData.Item("label5") & vbLf &_
  492.      oFrm.dFrmData.Item("cbox1") & vbLf &_
  493.      oFrm.dFrmData.Item("label6") & vbLf &_
  494.      oFrm.dFrmData.Item("lbox1") & vbLf &_
  495.      oFrm.dFrmData.Item("ckbox1k") & vbLf &_
  496.      oFrm.dFrmData.Item("button1") & vbLf &_
  497.      oFrm.dFrmData.Item("button2")
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

返回列表