xGUICOM : composant COM (GUI) portable pour langage Active Scripting (VBScript/JScript)Date de publication : 4 avril 2011. Date de mise à jour : 19 mai 2011.
8. Le script VBS
8. Le script VBS
 |
Les composants WSC ne supportent pas les caractères accentués lorsqu'ils ne sont pas sauvegardés en Unicode. Les commentaires
sont donc volontairement dépourvus de toute accentuation.
|
< ?xml version= " 1.0 " ?>
< component>
< ?component error = " true " debug= " false " ?>
< registration
description= " xGuiCom "
progid= " xGuiCom.WSC "
version= " 1.10 "
classid= " {e3ba4a33-2e7e-4539-badb-0a141ad397ff} "
>
< / registration>
< comment>
composant GUI ecrit en VBScript par omen999 - http:/ / omen999. developpez . com /
la boite de dialogue est creee avec l
si cette dll n
dans le meme repertoire que le composant avec l
ce composant n
< / comment>
< public >
< method name= " CreateForm " >
< parameter name= " sCaption " / >
< parameter name= " lLeft " / >
< parameter name= " lTop " / >
< parameter name= " lWidth " / >
< parameter name= " lHeight " / >
< / method>
< method name= " AddControl " >
< parameter name= " iID " / >
< parameter name= " sClass " / >
< parameter name= " lLeft " / >
< parameter name= " lTop " / >
< parameter name= " lWidth " / >
< parameter name= " lHeight " / >
< parameter name= " sData " / >
< parameter name= " iStyle " / >
< / method>
< method name= " LoadLayoutFromRes " >
< parameter name= " sData " / >
< / method>
< method name= " LoadDialogFromRes " >
< parameter name= " sData " / >
< parameter name= " iIndex " / >
< / method>
< method name= " Show " >
< parameter name= " iIDD " / >
< parameter name= " bOnTaskBar " / >
< / method>
< method name= " GetValueFromID " >
< parameter name= " iID " / >
< parameter name= " hWndDlg " / >
< / method>
< method name= " SetValueFromID " >
< parameter name= " iID " / >
< parameter name= " hWndDlg " / >
< parameter name= " vData " / >
< / method>
< method name= " AddItem " >
< parameter name= " iID " / >
< parameter name= " hWndDlg " / >
< parameter name= " sData " / >
< parameter name= " iIndex " / >
< / method>
< method name= " RemoveItem " >
< parameter name= " iID " / >
< parameter name= " hWndDlg " / >
< parameter name= " iIndex " / >
< / method>
< method name= " BinToB64 " >
< parameter name= " sFileName " / >
< / method>
< event name= " Launch " / >
< event name= " Create " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< / event>
< event name= " Close " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< parameter name= " iID " / >
< / event>
< event name= " Click " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< parameter name= " iID " / >
< / event>
< event name= " Change " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< parameter name= " iID " / >
< / event>
< event name= " Open " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< parameter name= " iID " / >
< parameter name= " sFileName " / >
< / event>
< event name= " Save " >
< parameter name= " iIDD " / >
< parameter name= " hWndDlg " / >
< parameter name= " iID " / >
< parameter name= " sFileName " / >
< / event>
< / public >
< script language= " VBScript " >
< ![CDATA[
Option Explicit
Const _
WS_CHILD = & H40000000, _
WS_VISIBLE = & H10000000, _
WS_TABSTOP = & H10000, _
WS_GROUP = & H20000, _
BM_SETCHECK = & HF1, _
HKM_SETHOTKEY = & H401, _
GWL_USERDATA = (- 21 ), _
SS_BITMAP = & HE, _
STM_SETIMAGE = & H172, _
LR_LOADFROMFILE = & H10, _
IMAGE_BITMAP = 0 , _
IPM_SETADDRESS = & H465, _
DTM_SETSYSTEMTIME = & H1002, _
GDT_VALID = 0 , _
MCM_SETCURSEL = & H1002
Dim bInit
Dim oWrap
Dim oStream
Dim oFso
Dim hIns
Dim hWsh
Dim pAdr
Dim pIDisp
Dim iC
Dim DLGTEMPLATEEX
DLGTEMPLATEEX = Array ()
Dim aDataDlg ()
Dim OPENFILENAME
Dim sStrFile
Dim sStrFileTitle
Dim SYSTEMTIME
Function Initialize ()
Const _
GWL_HINSTANCE = - 6 , _
adTypeBinary = 1 , _
adTypeText = 2
Dim oXml
Dim oElm
On Error Resume Next
For iC = 0 To 0
Set oWrap = CreateObject (" DynamicWrapperX " )
Set oStream = CreateObject (" ADODB.Stream " )
If oStream Is Nothing Then
Set oFso= CreateObject (" Scripting.FileSystemObject " )
If oFso Is Nothing Then
MsgBox " Le composant DynamicWrapperX indispensable au bon fonctionnement de xGuiCOM est absent. " & Chr (13 ) & _
" Veuillez proc " & Chr (233 ) & " der " & Chr (224 ) & " son enregistrement avant d'utiliser xGuiCOM. " , _
vbCritical ," Erreur xGuiCOM v1.0 "
Exit Function
Else
If IsObject (oWrap) Then Exit For
If Not oFso. FileExists (" dynwrapx.dll " ) Then
Set oStream = oFso. CreateTextFile (" dynwrapx.dll " )
B64ToBin imgDynWrapX,oStream,0
oStream. Close
End If
If Not oFso. FileExists (" wscript.exe " ) Then
Set oStream = oFso. CreateTextFile (" wscript.exe " ,True )
B64ToBin imgWScript,oStream,0
End If
End If
Else
If IsObject (oWrap) Then Exit For
Set oXml = CreateObject (" Microsoft.XMLDOM " )
If oXml Is Nothing Then
oStream. Type = adTypeText
oStream. CharSet = " Windows-1252 "
Else
oStream. Type = adTypeBinary
Set oElm = oXml. createElement (" tmp " )
oElm. DataType = " bin.base64 "
bXml = True
End If
oStream. Open
oStream. LoadFromFile " dynwrapx.dll "
If oStream. Size = 0 Then
If oXml Is Nothing Then
B64ToBin imgDynWrapX,oStream,1
Else
oElm. Text = imgDynWrapX
oStream. Write oElm. NodeTypedValue
End If
oStream. SaveToFile " dynwrapx.dll " ,2
End If
oStream. Position = 0
oStream. LoadFromFile " wscript.exe "
If oStream. Size < 100000 Then
If oXml Is Nothing Then
B64ToBin imgWScript,oStream,1
Else
oElm. Text = imgWScript
oStream. Write oElm. NodeTypedValue
End If
oStream. SaveToFile " wscript.exe " ,2
End If
End If
oStream. Close
fireEvent " Launch "
Initialize = False
Exit Function
Next
On Error GoTo 0
With oWrap
. Register " user32 " ," DialogBoxIndirectParamW " ," i=hphpp " ," r=l "
. Register " user32 " ," EndDialog " ," i=hl " ," r=l "
. Register " user32 " ," GetNextDlgTabItem " ," i=hhl " ," r=h "
. Register " user32 " ," GetDlgItem " ," i=hl " ," r=h "
. Register " user32 " ," GetClassNameA " ," i=hSl " ," r=l "
. Register " user32 " ," GetWindowTextA " ," i=hSl " ," r=l "
. Register " user32 " ," SetWindowTextA " ," i=hS " ," r=l "
. Register " user32 " ," FindWindowA " , " i=SS " ," r=l "
. Register " user32 " ," GetWindowLongA " ," i=ll " ," r=l "
. Register " user32 " ," SendMessageW " ," i=hulW " ," r=l "
. Register " user32 " ," SendMessage " ," i=hupp " ," r=l "
. Register " user32 " ," SendMessageA " ," i=hupl " ," r=l "
. Register " user32 " ," SetWindowLongW " ," i=hlp " ," r=l "
. Register " user32 " ," GetWindowLongW " ," i=hl " ," r=l "
. Register " user32 " ," LoadImageW " ," i=hwullu " ," r=h "
. Register " comdlg32 " ," GetOpenFileNameW " ," i=p " ," r=l "
. Register " comdlg32 " ," GetSaveFileNameW " ," i=p " ," r=l "
hWsh = . FindWindowA (" WSH-Timer " ," " )
hIns = . GetWindowLongA (hWsh,GWL_HINSTANCE)
Set pIDisp = GetRef (" DialogProc " )
pAdr = . RegisterCallback (pIDisp," i=huul " ," r=l " )
End With
Initialize = True
End Function
Sub B64ToBin (ByRef sB64, ByRef Strm, ByVal iType)
Const cB64Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ "
Dim iPointer
Dim iGSize
Dim iOffset
Dim cChar
Dim cBin
Dim iGBuffer
Dim hGBuffer
Dim cGBuffer
Dim iPVar
iGSize = 3
iPVar = 3
For iPointer = 1 To Len (sB64) Step 4
iGBuffer = 0
For iOffset = 0 To 3
cChar = Mid (sB64,iPointer + iOffset,1 )
If cChar = " = " Then
iGSize = iGSize - 1
cBin = 0
Else
cBin = InStr (1 ,cB64Charset,cChar,vbBinaryCompare) - 1
End If
iGBuffer = 64 * iGBuffer + cBin
Next
hGBuffer = Hex (iGBuffer)
hGBuffer = String (6 - Len (hGBuffer), " 0 " ) & hGBuffer
cGBuffer = Chr (CByte (" &h " & Mid (hGBuffer, 1 , 2 ))) + _
Chr (CByte (" &h " & Mid (hGBuffer, 3 , 2 ))) + _
Chr (CByte (" &h " & Mid (hGBuffer, 5 , 2 )))
Select Case iType
Case 0 Strm. Write Left (cGBuffer,iGSize)
Case 1 Strm. WriteText Left (cGBuffer,iGSize)
Case 2 For iC = 1 to 3
oWrap. NumPut Asc (Mid (cGBuffer,iC,1 )),Strm,iC + iPVar," b "
Next
iPVar = iPVar + 3
End Select
Next
If iType = 2 Then oWrap. NumPut iPVar,Strm
End Sub
Function MyASC (sChar)
If sChar = " " Then MyASC = 0 Else MyASC = AscB (sChar)
End Function
Function BinToB64 (sFile)
Const cB64Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ " , _
adTypeBinary = 1 , _
adTypeText = 2
Dim sBinBuffer
Dim oFile
Dim aB64 ()
Dim s24
Dim iPointer
BinToB64 = " "
If Not bInit Then Exit Function
If IsObject (oStream) Then
With oStream
. Type = adTypeBinary
. Open
. LoadFromFile sFileName
. Type = adTypeText
If . Size = 0 Then Exit Function
sBinBuffer = . ReadText
. Close
End With
Else
If IsObject (oFso) Then
If oFso. FileExists (sFileName) Then
Set oFile = oFso. GetFile (sFileName)
Set oStream = oFile. OpenAsTextStream (1 )
For iC = 0 to oFile. Size - 1
oWrap. NumPut Asc (oStream. Read (1 )),sBinBuffer,iC," t "
Next
End If
Else
Exit Function
End If
End If
ReDim aB64 (Int (LenB (sBinBuffer)/ 3 ) + 1 )
For iPointer = 0 To LenB (sBinBuffer) - 1 Step 3
s24 = Oct (& H10000 * AscB (MidB (sBinBuffer,iPointer + 1 , 1 )) + & H100 * _
MyASC (MidB (sBinBuffer,iPointer + 2 , 1 )) + _
MyASC (MidB (sBinBuffer,iPointer + 3 , 1 )))
s24 = Right (" 00000000 " & s24, 8 )
For iC = 0 To 3
aB64 (iPointer/ 3 ) = aB64 (iPointer/ 3 ) & Mid (cB64CharSet,CLng (" &o " & Mid (s24,iC* 2 + 1 ,2 )) + 1 ,1 )
Next
Next
BinToB64 = Join (aB64," " )
Select Case LenB (sBinBuffer) Mod 3
Case 1
BinToB64 = Left (BinToB64,Len (BinToB64) - 2 ) & " == "
Case 2
BinToB64 = Left (BinToB64,Len (BinToB64) - 1 ) & " = "
End Select
End Function
Function ParseHotKey (ByRef sHK)
Const _
HOTKEYF_ALT = & H4, _
HOTKEYF_CONTROL = & H2, _
HOTKEYF_SHIFT = & H1
Dim sFNum
ParseHotKey = 0
If Left (sHK,1 ) = " { " And Right (sHK,1 ) = " } " And Len (sHK) < 9 Then
sHK = Mid (sHK,2 ,Len (sHK) - 2 )
If InStr (sHK," % " ) > 0 Then ParseHotKey = HOTKEYF_ALT
If InStr (sHK," ^ " ) > 0 Then ParseHotKey = ParseHotKey + HOTKEYF_CONTROL
If InStr (sHK," + " ) > 0 Then ParseHotKey = ParseHotKey + HOTKEYF_SHIFT
If InStr (UCase (sHK)," F " ) > 0 And InStr (UCase (sHK)," F " ) < Len (sHK) Then
sFNum = Mid (sHK,InStr (UCase (sHK)," F " )+ 1 )
On Error Resume Next
ParseHotKey = CInt (sFNum) + 111 + ParseHotKey * 256
On Error GoTo 0
Else
ParseHotKey = Asc (UCase (Right (sHK,1 ))) + ParseHotKey * 256
End If
End If
End Function
Function ParseIPStr (ByRef sIP)
Dim aVal
ParseIPStr = 0
aVal = Split (sIP," . " )
If UBound (aVal) = 3 Then
On Error Resume Next
ParseIPStr = oWrap. Space (2 ," " )
oWrap. NumPut CByte (aVal (1 )) * 65536 + CByte (aVal (2 )) * 256 + CByte (aVal (3 )),ParseIPStr,0 ," u "
oWrap. NumPut CByte (aVal (0 )),ParseIPStr,3 ," b "
ParseIPStr = oWrap. NumGet (ParseIPStr,0 ," u " )
On Error GoTo 0
End If
End Function
Function ParseDateTime (ByRef sDateTime)
Dim aDateTime
ParseDateTime = 0
aDateTime = Split (sDateTime," / " )
If UBound (aDateTime) = 2 Then
If IsDate (sDateTime) Then
With oWrap
SYSTEMTIME = . Space (8 ," " )
. NumPut CInt (aDateTime (2 )),SYSTEMTIME,0 ," t "
. NumPut CInt (aDateTime (1 )),SYSTEMTIME,2 ," t "
. NumPut Weekday (sDateTime) - 1 ,SYSTEMTIME,4 ," t "
. NumPut CInt (aDateTime (0 )),SYSTEMTIME,6 ," t "
ParseDateTime = . StrPtr (SYSTEMTIME)
End With
End If
End If
End Function
Sub BuildOpenFileName (ByRef pOPENFILENAME,ByRef aBoxData,hWnd)
Const OFN_OVERWRITEPROMPT = & H2
Dim aFilter (5 )
Dim sFilters
Dim sExt
Dim iUBound
Dim hCtrl
Dim sValue
With oWrap
aFilter (0 ) = " Tous fichiers (*.*) "
aFilter (1 ) = " *.* "
aFilter (2 ) = " Fichiers script (*.wsf | *.vbs) "
aFilter (3 ) = " *.wsf;*.vbs "
aFilter (4 ) = " Fichiers texte (*.txt) "
aFilter (5 ) = " *.txt "
sFilters = Join (aFilter,vbNullChar ) & vbNullChar & vbNullChar
sExt = " vbs "
iUBound = UBound (aBoxData)
If iUBound < 4 Then ReDim Preserve aBoxData (4 )
For iC = iUBound + 1 to 4
aBoxData (iC) = " "
Next
. NumPut 76 ,pOPENFILENAME,0 ," u "
. NumPut hWnd,pOPENFILENAME,4 ," h "
. NumPut sFilters,pOPENFILENAME,12 ," p "
. NumPut 2 ,pOPENFILENAME,24 ," u "
On Error Resume Next
hCtrl = . GetDlgItem (hWnd,CLng (aBoxData (1 )))
If (Err . Number = 0 ) And (hCtrl > 0 ) Then
sValue = GetValueFromID (CLng (aBoxData (1 )),hWnd)
If Right (sValue,1 ) < > " \ " And Right (sValue,1 ) < > " " Then sStrFile = sValue & . Space (130 - Len (sValue)," " )
. NumPut sStrFile,pOPENFILENAME,28 ," p "
. NumPut 260 ,pOPENFILENAME,32 ," u "
. NumPut sStrFileTitle,pOPENFILENAME,36 ," p "
. NumPut 128 ,pOPENFILENAME,40 ," u "
. NumPut Left (sValue,InStrRev (sValue," \ " )),pOPENFILENAME,44 ," p "
Else
If (Len (aBoxData (3 )) > 0 ) And (Right (aBoxData (3 ),1 ) < > " \ " ) Then aBoxData (3 ) = aBoxData (3 ) & " \ "
If (Len (aBoxData (2 )) > 0 ) And (aBoxData (2 ) < > " " ) Then _
sStrFile = aBoxData (3 ) & aBoxData (2 ) & . Space (130 - Len (aBoxData (3 )) - Len (aBoxData (2 ))," " )
. NumPut sStrFile,pOPENFILENAME,28 ," p "
. NumPut 260 ,pOPENFILENAME,32 ," u "
. NumPut sStrFileTitle,pOPENFILENAME,36 ," p "
. NumPut 128 ,pOPENFILENAME,40 ," u "
. NumPut aBoxData (3 ),pOPENFILENAME,44 ," p "
End If
. NumPut aBoxData (4 ),pOPENFILENAME,48 ," p "
. NumPut OFN_OVERWRITEPROMPT,pOPENFILENAME,52 ," u "
. NumPut sExt,pOPENFILENAME,60 ," p "
On Error GoTo 0
End With
End Sub
Function DialogProc (hWndDlg,uMsg,wParam,lParam)
Const _
WM_CLOSE = & H10, _
WM_COMMAND = & H111, _
WM_INITDIALOG = & H110, _
LB_ADDSTRING = & H180, _
CB_ADDSTRING = & H143, _
CB_SETCURSEL = & H14E, _
WM_USER = & H400, _
BST_CHECKED = & H1, _
GWL_STYLE = (- 16 ), _
GWL_EXSTYLE = (- 20 ), _
EN_CHANGE = & H300, _
BN_CLICKED = 0 , _
LBN_SELCHANGE = 1
Dim iIDD
Dim iID
Dim hPWnd
Dim hNWnd
Dim iCC
Dim sClsName
Dim sWinTxt
Dim aList
Dim pCur
Dim pEoDD
Dim aBoxData
Dim OPENFILENAME
iIDD = oWrap. GetWindowLongW (hWndDlg,GWL_USERDATA)
Select Case uMsg
Case WM_CLOSE
fireEvent " Close " ,iIDD,hWndDlg,0
oWrap. EndDialog hWndDlg,0
DialogProc = True
Case WM_COMMAND
iID = wParam mod 65536
DialogProc = True
Select Case Fix (wParam/ 65536 )
Case BN_CLICKED
If (iID < 8 And iID > 0 ) Then
fireEvent " Close " , iIDD, hWndDlg,iID
oWrap. EndDialog hWndDlg,iID
Else
If oWrap. GetWindowLongW (lParam,GWL_USERDATA) > 0 Then
aBoxData = Split (oWrap. StrGet (oWrap. GetWindowLongW (lParam,GWL_USERDATA))," | " )
OPENFILENAME = oWrap. Space (38 ," " )
sStrFile = oWrap. Space (130 ," " )
sStrFileTitle = oWrap. Space (64 ," " )
BuildOpenFileName oWrap. StrPtr (OPENFILENAME),aBoxData,hWndDlg
Select Case aBoxData (0 )
Case 0
If oWrap. GetOpenFileNameW (oWrap. StrPtr (OPENFILENAME)) < > 0 Then
fireEvent " Open " ,iIDD,hWndDlg,iID,sStrFile
End If
Case 1
If oWrap. GetSaveFileNameW (oWrap. StrPtr (OPENFILENAME)) < > 0 Then
fireEvent " Save " ,iIDD,hWndDlg,iID,sStrFile
End If
Case Else
MsgBox " Contr " & Chr (244 ) & " le inconnu " ,vbCritical ," Erreur xGuiCOM v1.0 "
End Select
Else
fireEvent " Click " ,iIDD,hWndDlg,iID
End If
End If
Case EN_CHANGE,LBN_SELCHANGE
fireEvent " Change " ,iIDD,hWndDlg,iID
Case Else
DialogProc= False
End Select
Case WM_INITDIALOG
hPWnd= 0
With oWrap
sClsName = . Space (16 ," " )
sWinTxt = . Space (4096 ," " )
iIDD = . NumGet (lParam,4 ," t " )
For iC = 1 to . NumGet (DLGTEMPLATEEX (iIDD),20 ," t " )
hNWnd = . GetNextDlgTabItem (hWndDlg,hPWnd,0 )
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " ListBox "
. GetWindowTextA hNWnd,sWinTxt,8192
aList = Split (sWinTxt," | " )
For iCC = 0 to UBound (aList)
. SendMessageW hNWnd,LB_ADDSTRING,0 ,aList (iCC)
Next
Case " Button "
If . GetWindowLongA (hNWnd,GWL_EXSTYLE) = 6 Then _
. SendMessageA hNWnd,BM_SETCHECK,BST_CHECKED,0
Case " Static "
. GetWindowTextA hNWnd,sWinTxt,8192
. SendMessageA hNWnd,STM_SETIMAGE,IMAGE_BITMAP,. LoadImageW (0 ,sWinTxt,IMAGE_BITMAP,0 ,0 ,LR_LOADFROMFILE)
. SetWindowLongW hNWnd,GWL_STYLE,SS_BITMAP + WS_CHILD + WS_VISIBLE + WS_GROUP
End Select
hPWnd = hNWnd
Next
. SetWindowLongW hWndDlg,GWL_USERDATA,iIDD
pEoDD = . NumGet (lParam)
If pEoDD > 6 Then
pCur = lParam + 6
Do
iID = . NumGet (pCur,0 ," t " )
sWinTxt = . StrGet (pCur + 2 )
hNWnd = . GetDlgItem (hWndDlg,iID)
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " Button "
aBoxData = Split (sWinTxt," | " )
If (UBound (aBoxData) > 0 ) Then
If IsNumeric (aBoxData (1 )) Then
. SetWindowTextA hNWnd,aBoxData (0 )
. SetWindowLongW hNWnd,GWL_USERDATA,pCur + LenB (aBoxData (0 )) + 4
End If
End If
Case " ComboBox "
aList = Split (sWinTxt," | " )
For iCC = 0 to UBound (aList)
. SendMessageW hNWnd,CB_ADDSTRING,0 ,aList (iCC)
Next
. SendMessageA hNWnd,CB_SETCURSEL,0 ,0
Case " msctls_hotkey32 "
. SendMessageA hNWnd,HKM_SETHOTKEY,ParseHotKey (sWinTxt),0
Case " SysIPAddress32 "
. SendMessage hNWnd,IPM_SETADDRESS,0 ,ParseIPStr (sWinTxt)
Case " SysDateTimePick32 "
. SendMessage hNWnd,DTM_SETSYSTEMTIME,GDT_VALID,ParseDateTime (sWinTxt)
Case " SysMonthCal32 "
. SendMessage hNWnd,MCM_SETCURSEL,0 ,ParseDateTime (sWinTxt)
End Select
pCur = pCur + 4 + LenB (sWinTxt)
Loop Until pCur >= lParam + pEoDD - 6
End If
fireEvent " Create " ,iIDD,hWndDlg
DialogProc= True
End With
Case Else
DialogProc= False
End Select
End Function
Function CreateForm (sCaption,lLeft,lTop,lWidth,lHeight)
Const _
WS_CAPTION = & HC00000, _
WS_SYSMENU = & H80000, _
DS_MODALFRAME = & H80, _
DS_SETFONT = & H40, _
sFont = " MS Shell Dlg 2 "
Dim iUp
Dim pEoDT
If not bInit Then
If not Initialize Then
CreateForm = - 1
Exit Function
End if
bInit = True
End If
iUp = UBound (DLGTEMPLATEEX) + 1
ReDim Preserve DLGTEMPLATEEX (iUp)
ReDim Preserve aDataDlg (iUp)
With oWrap
aDataDlg (iUp) = . Space (4096 ," " )
. NumPut iUp,aDataDlg (iUp),4 ," t "
. NumPut 6 ,aDataDlg (iUp)
DLGTEMPLATEEX (iUp) = . Space (4096 ," " )
pEoDT = . NumPut (4 ,DLGTEMPLATEEX (iUp))
pEoDT = . NumPut (4294901761 ,pEoDT,0 ," u " )
If (lLeft < 0 ) OR (lTop < 0 ) Then
pEoDT = . NumPut (WS_SYSMENU + WS_CAPTION + DS_MODALFRAME + DS_SETFONT + DS_CENTER,pEoDT,8 ," u " )
Else
pEoDT = . NumPut (WS_SYSMENU + WS_CAPTION + DS_MODALFRAME + DS_SETFONT,pEoDT,8 ," u " )
End If
pEoDT = . NumPut (0 ,pEoDT,0 ," t " )
pEoDT = . NumPut (lLeft,pEoDT,0 ," n " )
pEoDT = . NumPut (lTop,pEoDT,0 ," n " )
pEoDT = . NumPut (lWidth,pEoDT,0 ," n " )
pEoDT = . NumPut (lHeight,pEoDT,0 ," n " )
pEoDT = pEoDT + 4
For iC= 1 to Len (sCaption)
pEoDT = . NumPut (Asc (Mid (sCaption,iC,1 )),pEoDT,0 ," t " )
Next
pEoDT = . NumPut (0 ,pEoDT,0 ," t " )
pEoDT = . NumPut (8 ,pEoDT,0 ," t " )
pEoDT = . NumPut (0 ,pEoDT,0 ," t " )
pEoDT = . NumPut (0 ,pEoDT,0 ," b " )
pEoDT = . NumPut (1 ,pEoDT,0 ," b " )
For iC= 1 to Len (sFont)
pEoDT = . NumPut (Asc (Mid (sFont,iC,1 )),pEoDT,0 ," t " )
Next
pEoDT = . NumPut (0 ,pEoDT,0 ," t " )
. NumPut pEoDT - . StrPtr (DLGTEMPLATEEX (iUp)),DLGTEMPLATEEX (iUp)
End With
CreateForm = iUp
End Function
Sub BuildDataDlg (iID,ByRef aData, ByRef sData, pCur)
If Len (sData) > 0 Then
With oWrap
pCur = . NumPut (iID And 65535 ,aData,pCur," t " )
For iC= 1 to Len (sData)
pCur = . NumPut (Asc (Mid (sData,iC,1 )),pCur,0 ," t " )
Next
pCur = . NumPut (0 ,pCur,0 ," t " )
. NumPut pCur - . StrPtr (aData),aData
End With
End If
End Sub
Function AddControl (iID,sClass,lLeft,lTop,lWidth,lHeight,sData,iStyle)
Const _
WS_VSCROLL = & H200000, _
WS_HSCROLL = & H100000, _
WS_BORDER = & H800000, _
BS_PUSHBUTTON = & H0, _
BS_DEFPUSHBUTTON = & H1, _
BS_AUTOCHECKBOX = & H3, _
BS_GROUPBOX = & H7, _
BS_AUTORADIOBUTTON = & H9, _
BS_FLAT = & H8000, _
CBS_SIMPLE = & H1, _
CBS_DROPDOWN = & H2, _
CBS_DROPDOWNLIST = & H3, _
CBS_AUTOHSCROLL = & H40, _
ES_AUTOHSCROLL = & H80, _
ES_AUTOVSCROLL = & H40, _
ES_PASSWORD = & H20, _
ES_MULTILINE = & H4, _
ES_WANTRETURN = & H1000, _
ES_LOWERCASE = & H10, _
SS_ICON = & H3, _
LBS_NOTIFY = & H1, _
LBS_SORT = & H2, _
PBS_SMOOTH = & H1, _
SBS_HORZ = & H0, _
SBS_VERT = & H1, _
WS_CTRLSTD = & H50010000
Dim iUp
Dim pEoDT
Dim pEoDD
Dim aData
Dim iClass
Dim bChk
AddControl = False
If Not bInit Then Exit Function
If iID < 1 Then
Err . Raise 10000 ," Fonction AddControl " ," L'identifiant du contr " & Chr (244 ) & " le doit " & Chr (234 ) & _
" tre sup " & Chr (233 ) & " rieur ou " & Chr (233 ) & " gal " & Chr (224 ) & " un "
Exit Function
End If
iUp = UBound (DLGTEMPLATEEX)
pEoDD = oWrap. NumGet (aDataDlg (iUp))
Select Case LCase (sClass)
Case " commandbutton "
iClass = 8454143
If iStyle < 2 Then iStyle = iStyle + WS_CTRLSTD
Case " optionbutton "
iClass = 8454143
If iStyle = 1 Then bChk = True
If iStyle < 2 Then iStyle = BS_AUTORADIOBUTTON + WS_CTRLSTD
Case " checkbox "
iClass = 8454143
If iStyle = 1 Then bChk = True
If iStyle < 2 Then iStyle = BS_AUTOCHECKBOX + WS_CTRLSTD
Case " frame "
iClass = 8454143
If iStyle = 0 Then iStyle = BS_GROUPBOX + WS_CTRLSTD + WS_GROUP
Case " edit "
iClass = 8519679
If iStyle = 0 Then iStyle = ES_AUTOHSCROLL + WS_BORDER + WS_CTRLSTD
Case " edpswd "
iClass = 8519679
If iStyle = 0 Then iStyle = ES_PASSWORD + ES_AUTOHSCROLL + WS_BORDER + WS_CTRLSTD
Case " memo "
iClass = 8519679
If iStyle = 0 Then iStyle = ES_MULTILINE + ES_WANTRETURN + WS_BORDER + ES_AUTOHSCROLL + ES_AUTOVSCROLL + WS_CTRLSTD
Case " label "
iClass = 8585215
If iStyle = 0 Then iStyle = WS_CHILD + WS_VISIBLE + WS_GROUP
Case " image "
iClass = 8585215
If iStyle = 0 Then iStyle = SS_BITMAP + WS_CHILD + WS_VISIBLE + WS_GROUP + WS_TABSTOP
Case " icon "
iClass = 8585215
If iStyle = 0 Then iStyle = SS_ICON + WS_CHILD + WS_VISIBLE + WS_GROUP
Case " listbox "
iClass = 8650751
If iStyle = 0 Then iStyle = LBS_NOTIFY + LBS_SORT + WS_VSCROLL + WS_BORDER + WS_CTRLSTD
Case " scrollbar "
iClass = 8716287
If iStyle < 2 Then iStyle = WS_CHILD + WS_VISIBLE + iStyle
Case " filedlgbox "
iClass = 8454143
If iStyle < 2 Then iStyle = iStyle + WS_CTRLSTD
aData = Split (sData," | " )
If (UBound (aData) > 1 ) And IsNumeric (aData (1 )) Then
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Else
Err . Raise 10001 ," Fonction AddControl " ," Erreur de syntaxe : le contr " & Chr (244 ) & " le filedlgbox n'est pas cr " & Chr (233 ) & Chr (233 )
Exit Function
End If
Case " combobox "
iClass = 8781823
If iStyle = 0 Then iStyle = CBS_DROPDOWNLIST + CBS_AUTOHSCROLL + WS_VSCROLL + WS_CTRLSTD
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Case " hotkey "
iClass = " msctls_hotkey32 "
If iStyle = 0 Then iStyle = WS_BORDER + WS_CTRLSTD
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Case " ipcontrol "
iClass = " SysIPAddress32 "
If iStyle = 0 Then iStyle = WS_CTRLSTD
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Case " datetimepick "
iClass = " SysDateTimePick32 "
If iStyle = 0 Then iStyle = WS_CTRLSTD
If iStyle = 1 Then iStyle = WS_CTRLSTD + DTS_UPDOWN
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Case " monthcalendar "
iClass = " SysMonthCal32 "
If iStyle = 0 Then iStyle = WS_CTRLSTD
BuildDataDlg iID,aDataDlg (iUp),sData,pEoDD
Case " progressbar "
iClass = " msctls_progress32 "
If iStyle = 0 Then iStyle = WS_CHILD + WS_VISIBLE + PBS_SMOOTH
Case Else
Err . Raise 10002 ," Fonction AddControl " ," La classe " & LCase (sClass) & " n'est pas une classe support " & Chr (233 ) & " e "
Exit Function
End Select
With oWrap
pEoDT = oWrap. NumGet (DLGTEMPLATEEX (iUp))
pEoDT = pEoDT + pEoDT Mod 4
If bChk Then
pEoDT = . NumPut (2 ,. StrPtr (DLGTEMPLATEEX (iUp)) + pEoDT,4 ," u " )
Else
pEoDT = . NumPut (0 ,. StrPtr (DLGTEMPLATEEX (iUp)) + pEoDT,4 ," u " )
End If
pEoDT = . NumPut (iStyle,pEoDT,0 ," u " )
pEoDT = . NumPut (lLeft,pEoDT,0 ," n " )
pEoDT = . NumPut (lTop,pEoDT,0 ," n " )
pEoDT = . NumPut (lWidth,pEoDT,0 ," n " )
pEoDT = . NumPut (lHeight,pEoDT,0 ," n " )
pEoDT = . NumPut (iID,pEoDT,0 ," u " )
If VarType (iClass) = 3 Then
pEoDT = . NumPut (iClass,pEoDT,0 ," u " )
Else
For iC= 1 to Len (iClass)
pEoDT = . NumPut (Asc (Mid (iClass,iC,1 )),pEoDT,0 ," t " )
Next
pEoDT = . NumPut (0 ,pEoDT,0 ," t " )
End If
If Len (sData) > 0 Then
For iC= 1 to Len (sData)
pEoDT = . NumPut (Asc (Mid (sData,iC,1 )),pEoDT,0 ," t " )
Next
End If
pEoDT = . NumPut (0 ,pEoDT,0 ," u " )
. NumPut . NumGet (DLGTEMPLATEEX (iUp),20 ," t " ) + 1 ,DLGTEMPLATEEX (iUp),20 ," t "
. NumPut pEoDT - . StrPtr (DLGTEMPLATEEX (iUp)),DLGTEMPLATEEX (iUp)
End With
AddControl = True
End Function
Sub ParseBinRes (ByRef sData)
Dim sBuf
Dim sCaption
Dim sFont
Dim pBase
Dim iDTE
Dim iOffset
Dim cClass
Dim sClass
Dim sInit
Dim iID
Dim pEoDD
Dim iUp
iUp = UBound (aDataDlg)
sBuf = sData
pBase = oWrap. StrPtr (sBuf) + 4
sCaption = oWrap. StrGet (pBase + 30 )
sFont = oWrap. StrGet (pBase + 38 + LenB (sCaption))
iDTE = 40 + LenB (sCaption) + LenB (sFont)
pBase = pBase + iDTE + iDTE mod 4
iOffset = 24
Do
pEoDD = oWrap. NumGet (oWrap. StrPtr (aDataDlg (iUp)))
cClass = oWrap. NumGet (pBase,iOffset," t " )
If cClass = 65535 Then
sInit = oWrap. StrGet (pBase + iOffset + 4 )
cClass = oWrap. NumGet (pBase,iOffset + 2 ," t " )
If (cClass = 133 ) or (cClass = 128 ) Then
iID = oWrap. NumGet (pBase,iOffset - 4 )
BuildDataDlg iID,aDataDlg (iUp),sInit,pEoDD
End If
iOffset = iOffset + LenB (sInit) + 32
iOffset = iOffset + iOffset mod 4
Else
sClass = oWrap. StrGet (pBase + iOffset)
sInit = oWrap. StrGet (pBase + iOffset + LenB (sClass) + 2 )
Select Case sClass
Case " SysIPAddress32 "
iID = oWrap. NumGet (pBase,iOffset - 4 )
BuildDataDlg iID,aDataDlg (iUp),sInit,pEoDD
Case " msctls_hotkey32 "
iID = oWrap. NumGet (pBase,iOffset - 4 )
BuildDataDlg iID,aDataDlg (iUp),sInit,pEoDD
End Select
iOffset = iOffset + LenB (sInit) + LenB (sClass) + 30
iOffset = iOffset + iOffset mod 4
End If
Loop Until iOffset >= LenB (sBuf) - iDTE
End Sub
Function DataExist (ByRef sData)
Const _
adTypeBinary = 1 , _
adTypeText = 2
Dim oFile
If not bInit Then
If Not Initialize Then
DataExist = - 4
Exit Function
End if
bInit = True
End If
On Error Resume Next
If oStream Is Nothing Then
If oFso Is Nothing Then
If VarType (sData) = 8 Then
DataExist = 0
Else
DataExist = - 1
Exit Function
End If
Else
If oFso. FileExists (sData) Then
DataExist = 2
Else
If VarType (sData) = 8 Then
DataExist = 0
Else
DataExist = - 2
Exit Function
End If
End If
End If
Else
With oStream
. Type = adTypeBinary
. Open
. LoadFromFile sData
. Type = adTypeText
If . Size = 0 Then
If VarType (sData) = 8 Then
DataExist = 0
Else
DataExist = - 2
Exit Function
End If
Else
DataExist = 1
End If
End With
End If
On Error GoTo 0
End Function
Function GetDlgTemplate (ByRef sBuffer, iIndex)
Dim iOffset
Dim iDSize
Dim iHSize
With oWrap
iOffset = 32
iDSize = 0
iHSize = 0
iC = - 1
Do
iDSize = . NumGet (sBuffer,iOffset)
iHSize = . NumGet (sBuffer,iOffset + 4 )
If . NumGet (sBuffer,iOffset + 8 ) = & H5FFFF Then iC = iC + 1
iOffset = iOffset + iDSize + iHSize
If iOffset > (Len (sBuffer) * 2 ) Then
GetDlgTemplate = " "
Exit Function
End If
Loop Until iC = iIndex
GetDlgTemplate = . Space (iDSize/ 2 + 2 ," " )
For iC = 1 to iDSize
. NumPut AscB (MidB (sBuffer,iOffset - iDSize + iC,1 )),GetDlgTemplate,iC + 3 ," t "
Next
. NumPut iDSize + 4 ,GetDlgTemplate
End With
End Function
Function LoadDialogFromRes (ByRef sData, iIndex)
Dim iUp
Dim sDataBuffer
LoadDialogFromRes = DataExist (sData)
If LoadDialogFromRes < 0 Then Exit Function
sDataBuffer = oWrap. Space (32768 ," " )
Select Case LoadDialogFromRes
Case 0
B64ToBin sData,sDataBuffer,2
Case 1
sDataBuffer = oStream. ReadText
Case 2
Set oFile = oFso. GetFile (sData)
Set oStream = oFile. OpenAsTextStream (1 )
For iC = 0 to oFile. Size - 1
oWrap. NumPut Asc (oStream. Read (1 )),sDataBuffer,iC," t "
Next
End Select
If VarType (oStream) = 9 Then oStream. Close
iUp = UBound (DLGTEMPLATEEX) + 1
ReDim Preserve DLGTEMPLATEEX (iUp)
ReDim Preserve aDataDlg (iUp)
DLGTEMPLATEEX (iUp) = GetDlgTemplate (sDataBuffer,iIndex)
If DLGTEMPLATEEX (iUp) = " " Then
LoadDialogFromRes = - 5
Exit Function
End If
With oWrap
If . NumGet (DLGTEMPLATEEX (iUp),4 ) < > - 65535 Then
LoadDialogFromRes = - 3
Exit Function
End If
aDataDlg (iUp) = . Space (4096 ," " )
. NumPut iUp,aDataDlg (iUp),4 ," t "
. NumPut 6 ,aDataDlg (iUp)
End With
ParseBinRes DLGTEMPLATEEX (iUp)
LoadDialogFromRes = iUp
End Function
Function LoadLayoutFromRes (ByRef sData)
Dim oFile
Dim iUp
LoadLayoutFromRes = DataExist (sData)
If LoadLayoutFromRes < 0 Then Exit Function
iUp = UBound (DLGTEMPLATEEX) + 1
ReDim Preserve DLGTEMPLATEEX (iUp)
DLGTEMPLATEEX (iUp) = oWrap. Space (4096 ," " )
ReDim Preserve aDataDlg (iUp)
With oWrap
Select Case LoadLayoutFromRes
Case 0
B64ToBin sData,DLGTEMPLATEEX (iUp),2
Case 1
DLGTEMPLATEEX (iUp) = . Space (2 ," " ) & oStream. ReadText
. NumPut oStream. Size + 4 ,DLGTEMPLATEEX (iUp)
Case 2
Set oFile = oFso. GetFile (sData)
Set oStream = oFile. OpenAsTextStream (1 )
For iC = 0 to oFile. Size - 1
. NumPut Asc (oStream. Read (1 )),DLGTEMPLATEEX (iUp),iC + 4 ," t "
Next
. NumPut oFile. Size + 4 ,DLGTEMPLATEEX (iUp)
End Select
If VarType (oStream) = 9 Then oStream. Close
If . NumGet (DLGTEMPLATEEX (iUp),4 ) < > - 65535 Then
LoadLayoutFromRes = - 3
Exit Function
End If
aDataDlg (iUp) = . Space (4096 ," " )
. NumPut iUp,aDataDlg (iUp),4 ," t "
. NumPut 6 ,aDataDlg (iUp)
End With
ParseBinRes DLGTEMPLATEEX (iUp)
LoadLayoutFromRes = iUp
End Function
Function Show (iIDD,bOnTaskBar)
Dim hParent
Show = - 1
If Not bInit Then Exit Function
If (iIDD < 0 ) Or (iIDD > UBound (DLGTEMPLATEEX)) Then Exit Function
If bOnTaskBar Then hParent = 0 Else hParent = hWsh
Show = oWrap. DialogBoxIndirectParamW (hIns,oWrap. StrPtr (DLGTEMPLATEEX (iIDD)) + 4 ,hParent,pAdr,aDataDlg (iIDD))
End Function
Function GetValueFromID (iID,hWndDlg)
Const _
EM_GETLINE = & HC4, _
EM_LINELENGTH = & HC1, _
LB_GETCURSEL = & H188, _
LB_GETTEXT = & H189, _
LB_GETTEXTLEN = & H18A, _
CB_GETCURSEL = & H147, _
CB_GETLBTEXT = & H148, _
CB_GETLBTEXTLEN = & H149, _
BM_GETCHECK = & HF0, _
HKM_GETHOTKEY = & H402, _
IPM_GETADDRESS = & H466, _
DTM_GETSYSTEMTIME = & H1001, _
MCM_GETCURSEL = & H1001
Dim hNWnd
Dim sClsName
Dim iLen,iIndex
GetValueFromID = " "
If Not bInit Then Exit Function
With oWrap
sClsName = . Space (16 ," " )
hNWnd = . GetDlgItem (hWndDlg,iID)
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " Edit "
iLen = . SendMessageA (hNWnd,EM_LINELENGTH,0 ,0 )
GetValueFromID = . Space (iLen," " )
. NumPut iLen,GetValueFromID,0 ," t "
. SendMessageW hNWnd,EM_GETLINE,0 ,GetValueFromID
Case " ListBox "
iIndex = . SendMessageA (hNWnd,LB_GETCURSEL,0 ,0 )
iLen = . SendMessageA (hNWnd,LB_GETTEXTLEN,iIndex,0 )
GetValueFromID = . Space (iLen + 1 ," " )
. SendMessageW hNWnd,LB_GETTEXT,iIndex,GetValueFromID
Case " ComboBox "
iIndex = . SendMessageA (hNWnd,CB_GETCURSEL,0 ,0 )
iLen = . SendMessageA (hNWnd,CB_GETLBTEXTLEN,iIndex,0 )
GetValueFromID = . Space (iLen + 1 ," " )
. SendMessageW hNWnd,CB_GETLBTEXT,iIndex,GetValueFromID
Case " Button "
GetValueFromID = . SendMessageA (hNWnd,BM_GETCHECK,0 ,0 )
Case " Static "
GetValueFromID = . Space (128 ," " )
. GetWindowTextA hNWnd,GetValueFromID,256
Case " msctls_hotkey32 "
GetValueFromID = . SendMessageA (hNWnd,HKM_GETHOTKEY,0 ,0 )
Case " SysIPAddress32 "
. SendMessageW hNWnd,IPM_GETADDRESS,0 ,GetValueFromID
GetValueFromID = CStr (. NumGet (GetValueFromID,3 ," b " )) & " . " & CStr (. NumGet (GetValueFromID,2 ," b " )) & _
" . " & CStr (. NumGet (GetValueFromID,1 ," b " )) & " . " & CStr (. NumGet (GetValueFromID,0 ," b " ))
Case " SysDateTimePick32 "
. SendMessageW hNWnd,DTM_GETSYSTEMTIME,0 ,GetValueFromID
GetValueFromID = CStr (. NumGet (GetValueFromID,6 ," t " )) & " / " & CStr (. NumGet (GetValueFromID,2 ," t " )) & " / " & _
CStr (. NumGet (GetValueFromID,0 ," t " ))
Case " SysMonthCal32 "
. SendMessageW hNWnd,MCM_GETCURSEL,0 ,GetValueFromID
GetValueFromID = CStr (. NumGet (GetValueFromID,6 ," t " )) & " / " & CStr (. NumGet (GetValueFromID,2 ," t " )) & " / " & _
CStr (. NumGet (GetValueFromID,0 ," t " ))
End Select
End With
End Function
Function SetValueFromID (iID,hWndDlg,vData)
Const _
WM_SETTEXT = & HC, _
LB_SETCURSEL = & H186, _
CB_SETCURSEL = & H14E
Dim hNWnd
Dim sClsName
Dim iLen,iIndex
Dim pData
SetValueFromID = False
If Not bInit Then Exit Function
With oWrap
sClsName = . Space (16 ," " )
hNWnd = . GetDlgItem (hWndDlg,iID)
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " Edit "
SetValueFromID = . SendMessageW (hNWnd,WM_SETTEXT,0 ,vData)
Case " ListBox "
SetValueFromID = . SendMessageA (hNWnd,LB_SETCURSEL,vData,0 )
Case " ComboBox "
SetValueFromID = . SendMessageA (hNWnd,CB_SETCURSEL,vData,0 )
Case " Button "
pData = . GetWindowLongW (hNWnd,GWL_USERDATA)
If pData > 0 Then
Else
SetValueFromID = . SendMessageA (hNWnd,BM_SETCHECK,0 ,0 )
End If
Case " Static "
SetValueFromID = . SendMessageA (hNWnd,STM_SETIMAGE,IMAGE_BITMAP,. LoadImageW (0 ,vData,IMAGE_BITMAP,0 ,0 ,LR_LOADFROMFILE))
Case " msctls_hotkey32 "
SetValueFromID = . SendMessageA (hNWnd,HKM_SETHOTKEY,ParseHotKey (vData),0 )
Case " SysIPAddress32 "
SetValueFromID = . SendMessage (hNWnd,IPM_SETADDRESS,0 ,ParseIPStr (vData))
Case " SysDateTimePick32 "
SetValueFromID = . SendMessage (hNWnd,DTM_SETSYSTEMTIME,GDT_VALID,ParseDateTime (vData))
Case " SysMonthCal32 "
SetValueFromID = . SendMessage (hNWnd,MCM_SETCURSEL,0 ,ParseDateTime (vData))
End Select
End With
End Function
Function AddItem (iID,hWndDlg,sData,iIndex)
Const LB_INSERTSTRING = & H181, _
CB_INSERTSTRING = & H14A
Dim hNWnd
Dim sClsName
AddItem = - 1
If Not bInit Then Exit Function
With oWrap
sClsName = . Space (16 ," " )
hNWnd = . GetDlgItem (hWndDlg,iID)
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " ListBox "
AddItem = . SendMessageW (hNWnd,LB_INSERTSTRING,iIndex,sData)
Case " ComboBox "
AddItem = . SendMessageW (hNWnd,CB_INSERTSTRING,iIndex,sData)
End Select
End With
End Function
Function RemoveItem (iID,hWndDlg,iIndex)
Const LB_DELETESTRING = & H182, _
CB_DELETESTRING = & H144, _
CB_RESETCONTENT = & H14B, _
LB_RESETCONTENT = & H184
Dim hNWnd
Dim sClsName
RemoveItem = - 1
If Not bInit Then Exit Function
With oWrap
sClsName = . Space (16 ," " )
hNWnd = . GetDlgItem (hWndDlg,iID)
. GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case " ListBox "
If iIndex < 0 Then
. SendMessageA hNWnd,LB_RESETCONTENT,0 ,0
RemoveItem = 0
Else
RemoveItem = . SendMessageA (hNWnd,LB_DELETESTRING,iIndex,0 )
End If
Case " ComboBox "
If iIndex < 0 Then
. SendMessageA hNWnd,CB_RESETCONTENT,0 ,0
RemoveItem = 0
Else
RemoveItem = . SendMessageA (hNWnd,CB_DELETESTRING,iIndex,0 )
End If
End Select
End With
End Function
Const imgWScript = < code disponible dans le script à télécharger dans la page précédente>
Const imgDynWrapX = < code disponible dans le script à télécharger dans la page précédente>
]]>
< / script>
< / component>
|
Les sources présentés sur cette page sont libres de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2011 omen999.
Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu :
textes, documents, images, etc sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à 3 ans de prison et jusqu'à 300 000 E de dommages et intérêts.
Cette page est déposée à la SACD.
|