[求助]請(qǐng)問(wèn)這兩個(gè)API的DynamicWrapper輸入?yún)?shù)數(shù)量和類(lèi)型該怎么寫(xiě) [金字塔]
- 咨詢內(nèi)容：
在VB是這么寫(xiě)的：
Private Declare Sub CopyMemory Lib "ntdll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function StrCSpn Lib "shlwapi.dll" Alias "StrCSpnW" (ByVal lpStr&, ByVal lpCharacters&) As Long
謝謝！！
- 金字塔客服：
建議看看金字塔編程幫助中對(duì)DynamicWrapper的參數(shù)描述吧，此外DynamicWrapper是公用的控件，你可以到GOOGLE上搜索一下看看有沒(méi)有能幫助到你的信息
- 用戶回復(fù)：
我看過(guò)幫助了
主要是Any類(lèi)型不知道怎么轉(zhuǎn)換
查了一下，是變體
- 網(wǎng)友回復(fù)：
到網(wǎng)上一艘一大把
給你找了一篇 VBS調(diào)用Win32API示例：對(duì)話框
里面有相關(guān)累死的代碼調(diào)用Option Explicit
'************************************
'* Sample GUI only with API calls *
'* Need DynaWrap component *
'* Use Struct v1.1 Class *
'* syntax Win NT et > *
'* omen999 february 2007 *
'************************************
Class Struct ' v1.1 allow typedef with dynawrap calls
Public Property Get Ptr '******************************* Property Ptr
Ptr=GetBSTRPtr(sBuf)
End Property
Public Sub Add(sItem,sType,Data) '********************** Method Add
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)'************************************************* COMPLETE WITH OTHERS WIN32 TYPES
'OS 32bits...
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) '********************************************** Méthode GetItem
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)
'retun the TRUE address (variant long) of the sData string BSTR
Dim pSource
Dim pDest
If VarType(sData)<>vbString Then 'little check
GetBSTRPtr=0
err.raise 10000, "GetBSTRPtr", "The variable is not a string"
Exit Function
End If
pSource=oSCat.lstrcat(sData,"") 'trick to return sData pointer
pDest=oSCat.lstrcat(GetBSTRPtr,"") 'idem
GetBSTRPtr=CLng(0) 'cast function variable
'l'adresse du contenu réel de sBuf (4octets) écrase le contenu de la variable GetBSTPtr
'les valeurs sont incrémentées de 8 octets pour tenir compte du Type Descriptor
oMM.RtlMovememory pDest+8,pSource+8,4
End Function
'**************************************************************************** IMPLEMENTATION
Private oMM,oSCat,oAnWi 'objets wrapper API
Private dBuf,sBuf,iOffset
Private Sub Class_Initialize 'Constructeur
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)
'Place une valeur Data de taille iSize à l'adresse lpData+iOfs
Dim lW,hW,xBuf
Select Case iSize 'on commence par formater les valeurs numériques
Case 1
lW=Data mod 256 'formatage 8 bits
xBuf=ChrB(lW)
Case 2 'if any
lW=Data mod 65536 'formatage 16 bits
xBuf=ChrW(lW) 'formatage little-endian
Case 4
hW=Fix(Data/65536)'high word
lW=Data mod 65536 'low word
xBuf=ChrW(lW) & ChrW(hW) 'formatage little-endian
Case Else 'bytes array, size iSize
xBuf=Data
End Select
oMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSize
iOfs=iOfs+iSize 'maj l'offset
End Sub
Private Function GetDataBSTR(lpData,iSize,iOffset)
'Read an iSize data to lpData+iOffset address
Const CP_ACP=0 'code ANSI
Dim pDest,tdOffset
'valeurs pour les données numériques
pDest=oSCat.lstrcat(GetDataBSTR,"")
tdOffset=8
Select Case iSize ' cast de la variable fonction
Case 1
GetDataBSTR=CByte(0)
Case 2
GetDataBSTR=CInt(0)
Case 4
GetDataBSTR=CLng(0)
Case Else 'a little bit more complicated with string data...
GetDataBSTR=String(iSize/2,Chr(0))
'la chaine variant BSTR stocke ses données ailleurs
pDest=GetBSTRPtr(GetDataBSTR)
tdOffset=0
End Select
'le contenu de la structure à l'offset iOffset écrase le contenu de la variable GetDataBSTR (tenir compte du TD)
oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize
if tdOffset=0 Then
oAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize 'don't forget conversion Ansi->Wide
GetDataBSTR=Replace(GetDataBSTR,Chr(0),"") 'clean the trailer
End If
End Function
End Class - 網(wǎng)友回復(fù)：
Class XGui 'v1.0
' this class create a dialogbox only by api calls
' it uses automation component DynaWrap and the struct class upper to allow typedef with dynawrap calls
' 4 public methods: CreateForm, ShowForm, RunForm et AddControl
' 1 public object dictionnary dFrmData which keys are name controls and stores data controls
' edit, static et button controls return content, listbox/combobox the selected item if exists, or empty string
' radiobutton and checkbox return true if checked or false
' groupbox control always return false
' each control must have unique name
' if the last letter of a checkbox ou radiobutton control name is "k", the control wil be checked
' close form without dictionnary data with esc key, Alt+F4, close button and system menu
' button controls haven't default behavior et must be manage by RunForm method
' this release 1.0 manages only "&ok" et "&cancel" buttons
' button ok closes the form and set data dictionnary, button cancel acts like esc key
Public dFrmData ' object dictionnary
Public Sub CreateForm(sCaption,lLeft,lTop,lWidth,lHeight,bOnTaskBar)
'Create a modeless invisible form
'sCaption: form caption
'lLeft,lTop: coordinates form
'lWidth, lHeight: form dimensions
'bOnTaskBar: if true (-1) form is display on taskbar
'no return value
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)
'display the form created by CreateForm
'bAlwaysOnTop: if true (-1) form always on top
'no return value
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()
'form messages pump and dictionnary gestion
'no return value
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 'control content ansi/wide
Dim aKData,aHData 'dictionnary contents keys/datas
Dim lGetI 'index selected item (listbox)
Dim lStyle 'button style
Dim lKCode 'param message
Dim n 'compteur
- 上一篇：[求助]REF(H,1)如何寫(xiě)成VBA語(yǔ)句
- 下一篇：沒(méi)有了！
相關(guān)文章
-
沒(méi)有相關(guān)內(nèi)容
會(huì)員登錄/注冊(cè)