Tweet
Been working long and hard at this, so much so that I havn't kept up with messages sent to me (banjo picking) or much of anything else. So I want to present what I have, and I guarantee it will take some time to get through it, as it tries to tackle some of the really nasty issues of converting OOP code to procedure calls.
What stopped me on the original conversion of last week was the following…
TxtText1.Text = “You Clicked cmdButton Whatever…”
Following are my thoughts on a general solution. Every line of code the VB Converter looks at is going to have to be examined to determine what general category of code line it is. Some possibilities are assignment statements such as…
I=1
Or perhaps the txtText1.text = “…..” above. Both are assignment statements. But what about…
Select Case iNumber
Or
For I=1 To 100000
These I would catagorize as ‘Block’ statements. Or what about this…
Erase iArr
Or
Dim iNumber As Long
Or
Kill strFileName
Or
Call ClearArrays()
These are procedure calls or calls using reserved words. So what I’m saying is that I believe we need some kind of data structure to describe a vb code line in preparation for its eventual parsing into some kind of PB statement or procedure call.
By the way, I’ve never done anything like this before, so the only real qualifications I have for it are enthusiasm and the ability to write reams of code!
So anyway, I agonized over this issue of a data structure to describe a line of code quite a bit; creating types, erasing types, etc. The problem is that the fields of a structure (TYPE) to describe a code line pretty much depend on the above catagorization of what general type of line it is. For example, if a code line is an assignment statement it will have an equal sign in it and a left and right term. These fields would be meaningless if it is just a subroutine call such as ‘Call MyProc()’. So to make a long story short I decided to use a UNION to describe a code line. A structure (TYPE) will be included in the UNION for all the general types of statements that exist. Here is the general idea…
This way, a parsing routine, on a first cut through, can figure out what a line ‘is’, then pass its handling off to the next routine in sequence. Note that in forming a UNION to be used in this way one places some kind of integer class variable as the 1st member of every TYPE that will be contained in the UNION.
The next concept necessary to a solution of the problem I believe is the creation of a symbol table that contains information on every symbol defined by the programmer of the VB program to be converted. In general, the symbol table will contain the names of all controls on a Form such as textboxes, the names of all variables, and the names of all sub routines, event procedures, etc. The idea being that at some point terms are going to have to be taken apart, i.e., parsed, and the SymbolTable is where the program will have to look to determine if it is dealing with an integer variable such as ‘i’, or an object such as a listbox, button, or textbox.
In working with the code I posted last week I found the Windows GUI environment to be too awkward for me to agonize through these concepts and difficulties, and I wanted the familiarity of a plain old console screen. So I tore a lot of the code out of that earlier example and set it up to run with the Console Compiler. There were some GDI calls to complicate things (converting twips to pixels), so I ended up copying a few equates and declares out of Win32Api.inc so that my Console program would run. These and a few other items I didn’t want to spend much time scrolling through all the time I stuck in an include file. So below is a console program I call CCParse.bas. You'll want to set your console screen to fit it as on the first pass through you'll probably get gibberish. Note that it reads frmVBConvert.frm, so look down in PBMain() at the bottom and change this line to wherever you have frmVBConvert.frm
szFileToConvert="frmVBConvert.frm"
As you can see, I just put it with the program itself. Perhaps I ought to repost the frmVBConvert.frm file I'm using, then the program
'frmVBConvert
and here's a real whopper! (Console Compiler Program!) Note I added voluminous comments to many of the critical conversion procedures to explain what they are doing. I hope it helps!
Jeeze! I don't want to forget the include file needed by the above. Here it is...
Note that if you want to take the time to figure it out the trail of comments starts down in PBMain() then moves up through the translation procedures as they are called.
What stopped me on the original conversion of last week was the following…
TxtText1.Text = “You Clicked cmdButton Whatever…”
Following are my thoughts on a general solution. Every line of code the VB Converter looks at is going to have to be examined to determine what general category of code line it is. Some possibilities are assignment statements such as…
I=1
Or perhaps the txtText1.text = “…..” above. Both are assignment statements. But what about…
Select Case iNumber
Or
For I=1 To 100000
These I would catagorize as ‘Block’ statements. Or what about this…
Erase iArr
Or
Dim iNumber As Long
Or
Kill strFileName
Or
Call ClearArrays()
These are procedure calls or calls using reserved words. So what I’m saying is that I believe we need some kind of data structure to describe a vb code line in preparation for its eventual parsing into some kind of PB statement or procedure call.
By the way, I’ve never done anything like this before, so the only real qualifications I have for it are enthusiasm and the ability to write reams of code!
So anyway, I agonized over this issue of a data structure to describe a line of code quite a bit; creating types, erasing types, etc. The problem is that the fields of a structure (TYPE) to describe a code line pretty much depend on the above catagorization of what general type of line it is. For example, if a code line is an assignment statement it will have an equal sign in it and a left and right term. These fields would be meaningless if it is just a subroutine call such as ‘Call MyProc()’. So to make a long story short I decided to use a UNION to describe a code line. A structure (TYPE) will be included in the UNION for all the general types of statements that exist. Here is the general idea…
Code:
Type Term szTerm As Asciiz*256 '256 End Type Type vbAssignmentStatement iType As Long LeftTerm As Term '256 RightTerm As Term '256 LeftTermIdentity As Long ' 4 1=%NumericConstant, 2=%StringConstant, 3=vbObject…. RightTermIdentity As Long ' 4 ditto End Type Type vbStatement iType As Long szReservedWord As Asciiz*16 '16 szArguements As Asciiz*48 '48 End Type Type vbBlockStatement iType As Long szStatement As Asciiz*32 End Type Union vbCodeLine iType As Long vbAssignment As vbAssignmentStatement vbVerb As vbStatement vbBlock As vbBlockStatement End Union
The next concept necessary to a solution of the problem I believe is the creation of a symbol table that contains information on every symbol defined by the programmer of the VB program to be converted. In general, the symbol table will contain the names of all controls on a Form such as textboxes, the names of all variables, and the names of all sub routines, event procedures, etc. The idea being that at some point terms are going to have to be taken apart, i.e., parsed, and the SymbolTable is where the program will have to look to determine if it is dealing with an integer variable such as ‘i’, or an object such as a listbox, button, or textbox.
In working with the code I posted last week I found the Windows GUI environment to be too awkward for me to agonize through these concepts and difficulties, and I wanted the familiarity of a plain old console screen. So I tore a lot of the code out of that earlier example and set it up to run with the Console Compiler. There were some GDI calls to complicate things (converting twips to pixels), so I ended up copying a few equates and declares out of Win32Api.inc so that my Console program would run. These and a few other items I didn’t want to spend much time scrolling through all the time I stuck in an include file. So below is a console program I call CCParse.bas. You'll want to set your console screen to fit it as on the first pass through you'll probably get gibberish. Note that it reads frmVBConvert.frm, so look down in PBMain() at the bottom and change this line to wherever you have frmVBConvert.frm
szFileToConvert="frmVBConvert.frm"
As you can see, I just put it with the program itself. Perhaps I ought to repost the frmVBConvert.frm file I'm using, then the program
'frmVBConvert
Code:
VERSION 5.00
Begin VB.Form frmVBConvert
Caption = "This Is A Visual Basic Form"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox txtText1
Height = 435
Left = 630
TabIndex = 3
Top = 2160
Width = 3285
End
Begin VB.CommandButton cmdButton3
Caption = "cmdButton3"
Height = 495
Left = 1440
TabIndex = 2
Top = 1470
Width = 1695
End
Begin VB.CommandButton cmdButton2
Caption = "cmdButton2"
Height = 495
Left = 1440
TabIndex = 1
Top = 840
Width = 1695
End
Begin VB.CommandButton cmdButton1
Caption = "cmdButton1"
Height = 495
Left = 1440
TabIndex = 0
Top = 210
Width = 1695
End
End
Attribute VB_Name = "frmVBConvert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdButton1_Click()
txtText1.Text = "You Clicked cmdButton1 (the top button)!"
End Sub
Private Sub cmdButton2_Click()
txtText1.Text = "You Clicked cmdButton2 (the middle button)!"
End Sub
Private Sub cmdButton3_Click()
txtText1.Text = "You Clicked cmdButton3 (the bottom button)!"
End Sub
Code:
#Compile Exe
#Dim All
#Include "CCParse.inc"
'Enumeration vbSymbolTable.iGeneralType
%SCALER_VARIABLE = 0
%COMPLEX_VARIABLE = 1
%OBJECT_VARIABLE = 2
%PROCEDURE = 3
'Enumeration Union vbCodeLine.iType
%Assignment = 0
%vbStatement = 1
%vbBlockStatement = 2
%CallProcedure = 3
'Enumeration Term (for iIdentifyTerm() Function
' and vbAssignmentStatement.LeftTermIdentity
' and vbAssignmentStatement.RightTermIdentity
%iIdentify_Term_Error = 0
%NumericConstant = 1
%StringConstant = 2
%vbObject = 3
%Integer = 4
%Long = 5
%Single = 6
%Double = 7
%Currency = 8
%Variant = 9
Type vbObject
szObject As Asciiz*24
szName As Asciiz*32
szCaption As Asciiz*64
szSdkControl As Asciiz*16
szEquate As Asciiz*64
iBegin As Long
iEnd As Long
Width As Long
Height As Long
X As Long
Y As Long
TabIndex As Long
iCountEvents As Long
dwExStyle As Dword
dwStyle As Dword
End Type
Type vbProcedure
szType As Asciiz*16 'Can be Sub or Function
iType As Long '0=Sub / 1=Function
iBegin As Long 'What line in frm file?
iEnd As Long 'Line # of End Sub or End Function
blnContainsObject As Long '%TRUE / %FALSE Does the string contain a control in the *.frm file
blnContainsUnderscore As Long 'Is there an underscore in the name?
blnContainsEventName As Long 'Event name found in string?
szObjectName As Asciiz*16 'Name of control if event procedure for control
szSdkObjectType As Asciiz*16 'button, edit, static, listbox, etc
szEventName As Asciiz*16 'Click, Keypress, Change, etc
szOriginalSymbol As Asciiz*64
szNewSymbol As Asciiz*64
blnRequiresWMCommand As Long 'Will this procedure be routed from WM_COMMAND message?
blnEventProcedure As Long 'Using the above gleaned info, is it an Event Procedure (%TRUE / %FALSE)?
End Type
Type vbSymbolTable
szSymbol As Asciiz*64 'e.g, txtFirstName, iNumber, strDate, etc.
iGeneralType As Long 'enumeration, i.e., simple scaler variable=0, complex variable=1, object variable=2, procedure=3
szSpecificType As Asciiz*24 '"TextBox", "CommonDialog", "Database", "Integer", "String", "Variant", "Sub", "Function", etc.
blnArray As Long 'TRUE/FALSE. Could be an array of almost anything, e.g., textboxes, databases, integers, blnSymbolTables, whatever.
szSdkType As Asciiz*16 'edit,button, etc.
Scope As Long '0=Local, 1=Form, 2=Public, 3=Static
szEquate As Asciiz*64 'Put equate here if its an object
End Type
Type Term
szTerm As Asciiz*256 '256
End Type
Type vbAssignmentStatement
iType As Long
LeftTerm As Term '256
RightTerm As Term '256
LeftTermIdentity As Long ' 4 1=%NumericConstant, 2=%StringConstant, 3=vbObject, 4=%Integer, 5=%Long, 6=%Single, 7=%Double, etc
RightTermIdentity As Long ' 4 ditto
End Type
Type vbStatement
iType As Long
szReservedWord As Asciiz*16 '16
szArguements As Asciiz*48 '48
End Type
Type vbBlockStatement
iType As Long
szStatement As Asciiz*32
End Type
Union vbCodeLine
iType As Long
vbAssignment As vbAssignmentStatement
vbVerb As vbStatement
vbBlock As vbBlockStatement
End Union
Function TwipsPerPixelX() As Single
Dim lngDC As Long
lngDC = GetDC(%HWND_DESKTOP)
TwipsPerPixelX=1440&/GetDeviceCaps(lngDC,%LOGPIXELSX)
Call ReleaseDC(%HWND_DESKTOP,lngDC)
End Function
Function TwipsPerPixelY() As Single 'blasted vb dimensions
Dim lngDC As Long 'are in Twips!!!!!!!!!
lngDC=GetDC(%HWND_DESKTOP)
TwipsPerPixelY=1440&/GetDeviceCaps(lngDC,%LOGPIXELSY)
Call ReleaseDC(%HWND_DESKTOP,lngDC)
End Function
Function strGetObjName(strArr() As String, iRec As Long) As String
Local iSpace,iLenStr,iNum As Long
Register i As Long
iLenStr=Len(strArr(iRec))
For i=iLenStr -2 To 1 Step -1
If Mid$(strArr(iRec),i,1)=" " Then
iSpace=i
Exit For
End If
Next i
strGetObjName=Trim$(Right$(strArr(iRec),iLenStr-iSpace))
End Function
Function strGetVariableType(strDeclaration As String) As String
Local iLenStr,iSpace As Long
Register i As Long
iLenStr=Len(strDeclaration)
For i=iLenStr To 1 Step -1
If Mid$(strDeclaration,i,1)=" " Then
iSpace=i
Exit For
End If
Next i
strGetVariableType=Trim$(Right$(strDeclaration,iLenStr-iSpace))
End Function
Function blnLoadObjProperties(strArr() As String, vbObj() As vbObject) As Long
Local blnFound,iCtr,iStart,i,iPos As Long
Register j As Long, k As Long
'Print
'Print "Entering blnLoadObjProperties()"
'Find beginning and end of Form properties
For i=0 To Ubound(strArr,1)
If Instr(strArr(i),"Begin VB.Form") Then
vbObj(0).iBegin=i
blnFound=%TRUE
Iterate For
End If
If blnFound Then
If Instr(strArr(i),"Begin ") Then
vbObj(0).iEnd=i-1
Exit For
End If
End If
Next i
iStart=i
Incr iCtr 'vbObj(0) Already Found
'Print "vbObj(0).iBegin = "vbObj(0).iBegin
'Print "vbObj(0).iEnd = "vbObj(0).iEnd
'Find Beginning and End Of Other Object Properties
iCtr=1
For i=iStart To UBound(strArr,1)
If Instr(strArr(i),"Begin ") Then
If InStr(strArr(i),vbObj(iCtr).szObject) Then
vbObj(iCtr).iBegin=i
End If
For j=i To UBound(strArr,1)
If InStr(strArr(j),"End") Then
vbObj(iCtr).iEnd=j-1
Incr iCtr
Exit For
End If
Next j
End If
Next i
For i=0 To UBound(vbObj,1)
vbObj(i).szName=strGetObjName(strArr(),vbObj(i).iBegin)
iStart=vbObj(i).iBegin+1
Select Case vbObj(i).szObject
Case "VB.Form"
If i=0 Then
vbObj(0).szSdkControl=vbObj(0).szName
End If
For j=iStart To vbObj(i).iEnd
If InStr(strArr(j),"Caption") Then
iPos=InStr(strArr(j),Chr$(34))
vbObj(i).szCaption=Remove$(Right$(strArr(j),Len(strArr(j))-iPos),Chr$(34))
End If
If InStr(strArr(j),"ScaleHeight") Then
vbObj(i).Height=Val(Right$(strArr(j),6))/TwipsPerPixelY()
End If
If InStr(strArr(j),"ScaleWidth") Then
vbObj(i).Width=Val(Right$(strArr(j),6))/TwipsPerPixelX()
End If
If InStr(strArr(j),"StartUpPosition") Then
vbObj(i).X=400
vbObj(i).Y=300
End If
vbObj(i).dwStyle=%WS_OVERLAPPEDWINDOW
vbObj(i).dwExStyle=0
Next j
Case "VB.TextBox"
For j=iStart To vbObj(i).iEnd
If InStr(strArr(j),"Height") Then
vbObj(i).Height=Val(Right$(strArr(j),6))/TwipsPerPixelY()
End If
If InStr(strArr(j),"Width") Then
vbObj(i).Width=Val(Right$(strArr(j),6))/TwipsPerPixelX()
End If
If InStr(strArr(j),"Left") Then
vbObj(i).X=Val(Right$(strArr(j),6))/TwipsPerPixelX()
End If
If InStr(strArr(j),"Top") Then
vbObj(i).Y=Val(Right$(strArr(j),6))/TwipsPerPixelY()
End If
vbObj(i).dwStyle=%WS_CHILD Or %WS_VISIBLE
vbObj(i).dwExStyle=%WS_EX_CLIENTEDGE
Next j
Case "VB.CommandButton"
For j=iStart To vbObj(i).iEnd
If InStr(strArr(j),"Caption") Then
iPos=InStr(strArr(j),Chr$(34))
vbObj(i).szCaption=Remove$(Right$(strArr(j),Len(strArr(j))-iPos),Chr$(34))
End If
If InStr(strArr(j),"Height") Then
vbObj(i).Height=Val(Right$(strArr(j),6))/TwipsPerPixelY()
End If
If InStr(strArr(j),"Width") Then
vbObj(i).Width=Val(Right$(strArr(j),6))/TwipsPerPixelX()
End If
If InStr(strArr(j),"Left") Then
vbObj(i).X=Val(Right$(strArr(j),6))/TwipsPerPixelX()
End If
If InStr(strArr(j),"Top") Then
vbObj(i).Y=Val(Right$(strArr(j),6))/TwipsPerPixelY()
End If
vbObj(i).dwStyle=%WS_CHILD Or %WS_VISIBLE Or %BS_NOTIFY
vbObj(i).dwExStyle=0
Next j
End Select
If i Then 'Form Equate By Concatenating Form Name (szObj(0)) To Control Name With Underscore In Middle
vbObj(i).szEquate="%" & vbObj(0).szName & "_" & vbObj(i).szName
Else 'Its the Main Form
vbObj(i).szEquate="%" & vbObj(0).szName
End If
Next i
'Print
'Print " i vbObj(i).szObject Sdk Begin End vbObj(i).szName Ht Wd X Y Caption szEquate"
'Print "======================================================================================================================================"
'For i=0 To UBound(vbObj,1)
' Print i Tab(4) vbObj(i).szObject Tab(25) vbObj(i).szSdkControl Tab(40) vbObj(i).iBegin Tab(45) vbObj(i).iEnd _
' Tab(50) vbObj(i).szName Tab(70) vbObj(i).Height Tab(75) vbObj(i).Width Tab(80) vbObj(i).X Tab(85) vbObj(i).Y _
' Tab(90) vbObj(i).szCaption Tab(120) vbObj(i).szEquate
'Next i
'Print
'Print "Leaving blnLoadObjProperties()"
'Print
blnLoadObjProperties=%TRUE
End Function
Function blnLoadVbObjs(strArr() As String, vbObj() As vbObject) As Long
Register i As Long, j As Long
Local blnFound As Long
Local iCtr As Long
For i=1 To UBound(strArr,1)
If InStr(strArr(i),"Begin") Then
blnFound=%FALSE
For j=0 To UBound(g_strObjects,1)
If InStr(strArr(i),g_strObjects(j)) Then
blnFound=%True
vbObj(iCtr).szObject=g_strObjects(j)
vbObj(iCtr).szSdkControl=g_strSdkObjects(j)
Incr iCtr
Exit For
End If
Next j
If blnFound=%FALSE Then
Print "Unidentified VB Object!"
blnLoadVbObjs=%FALSE
Exit Function
End If
End If
Next i
blnLoadVbObjs=%TRUE
End Function
Function blnLoadVbProcs(strArr() As String, vbObj() As vbObject, vbProc() As vbProcedure) As Long
Register i As Long, j As Long
Local iCtr As Long
Print
Print"Entering blnLoadVbProcs()"
Print
Print " iCtr szType vbProc(iCtr).szNewSymbol iType iBegin iEnd blnContainsObject blnContainsUnderscore szObjectName szEventName szOriginalName"
Print "==================================================================================================================================================================="
For i=0 To Ubound(strArr,1)
If Instr(strArr(i),"Private Sub") Then
vbProc(iCtr).szType="Sub"
vbProc(iCtr).iType=0
vbProc(iCtr).iBegin=i 'This is the line number where a Sub begins
For j=i To UBound(strArr,1) 'Find out line number where Sub Ends
If InStr(strArr(j),"End Sub") Then
vbProc(iCtr).iEnd=j
Exit For
End If
Next j
For j=0 To UBound(vbObj,1) 'Now find out if a control name stored in vbObj()
If InStr(strArr(i),vbObj(j).szName) Then 'is in procedure name, i.e., cmdButton1
vbProc(iCtr).blnContainsObject=%TRUE
vbProc(iCtr).szObjectName=vbObj(j).szName
vbProc(iCtr).szSdkObjectType=vbObj(j).szSdkControl
Exit For
End If
Next j
For j=i To UBound(strArr,1) 'Find out if procedure line contains underscore
If InStr(strArr(j),"_") Then
vbProc(iCtr).blnContainsUnderscore=%TRUE
Exit For
End If
Next j
For j=1 To UBound(g_strEventNames,1)
If InStr(strArr(i),g_strEventNames(j)) Then
vbProc(iCtr).blnContainsEventName=%TRUE
vbProc(iCtr).szEventName=g_strEventNames(j)
Exit For
End If
Next j
If vbProc(iCtr).blnContainsObject Then
If vbProc(iCtr).blnContainsUnderscore Then
If vbProc(iCtr).blnContainsEventName Then
vbProc(iCtr).blnEventProcedure=%TRUE
End If
End If
End If
If vbProc(iCtr).blnEventProcedure Then
vbProc(iCtr).szOriginalSymbol=vbProc(iCtr).szObjectName & "_" & vbProc(iCtr).szEventName
vbProc(iCtr).szNewSymbol=vbObj(0).szName & "_" & vbProc(iCtr).szObjectName & "_" & vbProc(iCtr).szEventName
End If
Print iCtr Tab(8) vbProc(iCtr).szType Tab(18) vbProc(iCtr).szNewSymbol Tab(53) vbProc(iCtr).iType Tab(60) vbProc(iCtr).iBegin Tab(70) vbProc(iCtr).iEnd _
Tab(77) vbProc(iCtr).blnContainsObject Tab(95) vbProc(iCtr).blnContainsUnderscore Tab(120) vbProc(iCtr).szObjectName _
Tab(135) vbProc(iCtr).szEventName Tab(150) vbProc(iCtr).szOriginalSymbol
Incr iCtr
End If
If InStr(strArr(i),"Public Sub") Then
Print iCtr Tab(8) vbProc(iCtr).szType Tab(23) vbProc(iCtr).iType Tab(30) vbProc(iCtr).iBegin Tab(40) vbProc(iCtr).iEnd
Incr iCtr
End If
If InStr(strArr(i),"Private Function") Then
Print iCtr Tab(8) vbProc(iCtr).szType Tab(23) vbProc(iCtr).iType Tab(30) vbProc(iCtr).iBegin Tab(40) vbProc(iCtr).iEnd
Incr iCtr
End If
If InStr(strArr(i),"Public Function") Then
Print iCtr Tab(8) vbProc(iCtr).szType Tab(23) vbProc(iCtr).iType Tab(30) vbProc(iCtr).iBegin Tab(40) vbProc(iCtr).iEnd
Incr iCtr
End If
Next i
'Count Event Procedures For Each Object And Store In vbObj(). This Will Be Useful To Know Later.
Print : Print
For i=0 To UBound(vbObj,1)
iCtr=0
For j=0 To UBound(vbProc,1)
If vbObj(i).szName=vbProc(j).szObjectName Then
Incr iCtr
End If
Next j
vbObj(i).iCountEvents=iCtr
Next i
Print " i vbObj(i).szName vbObj(i).iCountEvents"
Print "========================================================"
For i=0 To UBound(vbObj,1)
Print i,vbObj(i).szName,,vbObj(i).iCountEvents
Next i
Print
Print "Leaving blnLoadVbProcs()"
Print
blnLoadVbProcs=%TRUE
End Function
Function iCountVariables(strArr() As String) As Long
Register i As Long
Local iCtr As Long
For i=0 To UBound(strArr,1)
If InStr(strArr(i),"Dim") Then
Incr iCtr
End If
Next i
iCountVariables=iCtr
End Function
Sub LoadFormSymbolTable(strArr() As String, vbObj() As vbObject, vbProc() As vbProcedure, vbSym() As vbSymbolTable)
Local strTmp,strVarType As String
Register i As Long, j As Long
j=UBound(vbObj,1)
Incr j
For i=0 To UBound(strArr,1)
If InStr(strArr(i),"Private Sub") Or InStr(strArr(i),"Private Function") Then
Exit For
End If
If InStr(strArr(i),"Dim") Then 'You need to add functionality here to determine if its
strTmp=Remove$(strArr(i),"Dim ") 'an array or a type/structure or not
strVarType=strGetVariableType(strTmp)
vbSym(j).szSpecificType=strVarType
'vbSym(j).szSpecificType=
vbSym(j).szSymbol=Left$(strTmp,Instr(strTmp," ")-1)
vbSym(j).Scope=1
'Print #fp,"strTmp="strTmp
Incr j
End If
Next i
For i=0 To UBound(vbProc,1)
vbSym(j).szSymbol=vbProc(i).szOriginalSymbol
vbSym(j).iGeneralType=3
vbSym(j).szSpecificType=vbProc(i).szType
Incr j
Next i
End Sub
Function iIdentifyTerm(szTerm As Asciiz*256, vbSym() As vbSymbolTable, iGenType As Long, szSpecType As Asciiz*24, iSymbol As Long) As Long
Register i As Long, j As Long
Print
Print "Entering blnIdentifyTerm()"
If Left$(szTerm,1)=Chr$(34) And Right$(szTerm,1)=Chr$(34) And Tally(szTerm,Chr$(34))=2 Then 'Its a simple string constant
Print "It Looks A Lot Like A String Constant!"
iIdentifyTerm=2 'We're obviously going to need to handle situations such as...
Exit Function '"His Last Name Is " & txtLastName.Text & " And He Lives At "
End If
'We'll need code to recognize numeric constants!!! But will get to that later!!!
For i=0 To UBound(vbSym) 'See if one of the symbols in the Symbol Table can be
If Instr(szTerm,vbSym(i).szSymbol) Then 'found in the Term passed to this function.
'blnFound=%TRUE
Print "We Found Something!!!!!!"
Print "We Found Something!!!!!!"
iGenType=vbSym(i).iGeneralType
szSpecType=vbSym(i).szSpecificType
iIdentifyTerm=3
iSymbol=i
Exit Function
Exit For
End If
Next i
Print "Leaving blnIdentifyTerm()"
iIdentifyTerm=0
End Function
Function blnDoTextBoxCode(vbSym() As vbSymbolTable, iSymbol As Long, vbLn As vbCodeLine, strWorkBuffer() As String) As Long
Local strObjectCall As String
Register i As Long, j As Long
'If you check the include file of this console app you'll see there a bunch of global arrays holding all sorts of
'VB specific objects, properties, methods, and event names. Of particular importance here is the global array
'g_strTextBoxProps(), which I'll reproduce here...
''Initial string array to hold respective property names of global VB objects. Below is TextBox
'g_strTextBoxProps(1)="Height"
'g_strTextBoxProps(2)="Left"
'g_strTextBoxProps(3)="TabIndex"
'g_strTextBoxProps(4)="Top"
'g_strTextBoxProps(5)="Width"
'g_strTextBoxProps(6)="Text"
'
'What we must now do is determine which object property/method call is being requested on behalf of the txtText1 object.
'In procedural programming languages this will translate to a function call where the first parameter of the call will
'probably be the left operand of the object.property pair. We check to find if a '.' is in the string (it had better be!),
'and we parse out the property name and find out (surprise!, Surprise!) it is 'Text'. In the loop below we iterate through
'all the property names in g_strTextBoxProps() and find indeed that a text box has a property named 'Text'. So in that
'code we finally piece together a Api function call where the first parameter is indeed the handle of the object whose
'Text is being set. It could just as well have been a DDT Dialog Set Text or whatever that syntax is. Not exactly trivial!
'However, I think what I have done here, while only capable really of translating this one ridiculously simple program, does
'provide an extensible framework where hopefully all VB Object / PB Function Call translations can be made.
Print "Entering blnDoTextBoxCode()"
Print "vbLn.vbAssignment.LeftTerm = " vbLn.vbAssignment.LeftTerm.szTerm
Print "vbLn.vbAssignment.LeftTermIdentity = " vbLn.vbAssignment.LeftTermIdentity
Print "vbLn.vbAssignment.RightTerm = " vbLn.vbAssignment.RightTerm.szTerm
Print "vbLn.vbAssignment.RightTermIdentity = " vbLn.vbAssignment.RightTermIdentity
Select Case As Long vbLn.vbAssignment.LeftTermIdentity
Case %vbObject
Print "The Left Term Is An Object Of Type VB.TextBox"
Case %Integer
Print "The Left Term Is An Integer"
End Select
Select Case As Long vbLn.vbAssignment.RightTermIdentity
Case %StringConstant
Print "The Right Term Is A String Constant"
Case %vbObject
Print "The Right Term Is An Object Of Type VB.TextBox"
Case %Integer
Print "The Right Term Is An Integer"
End Select
Print
If InStr(vbLn.vbAssignment.LeftTerm.szTerm,".") Then
strObjectCall= _
Right$(vbLn.vbAssignment.LeftTerm.szTerm,Len(vbLn.vbAssignment.LeftTerm.szTerm)-Instr(vbLn.vbAssignment.LeftTerm.szTerm,"."))
Print "strObjectCall = " strObjectCall
Print "Len(strObjectCall) = " Len(strObjectCall)
For i=1 To UBound(g_strTextBoxProps)
If strObjectCall=g_strTextBoxProps(i) Then
Select Case g_strTextBoxProps(i)
Case "Height"
Case "Left"
Case "Text"
strWorkBuffer(j)= " Call SetWindowText(GetDlgItem(Wea.hWnd," & Trim$(vbSym(iSymbol).szEquate) & ")," & _
vbLn.vbAssignment.RightTerm.szTerm & ")"
End Select
Exit For
End If
Next i
Else
Print "Something's Badly Wrong! I'm Outta Here!"
Function=%FALSE
Exit Function
End If
Print "Leaving blnDoTextBoxCode()"
Function=%TRUE
End Function
Function blnExamineLine(vbPrc As vbProcedure, vbSym() As vbSymbolTable, vbLn As vbCodeLine, strLine As String, strWorkBuffer() As String) As Long
Local szSpecTypeReturn As Asciiz*24
Local iVarReturn As Long
Local iSymbol As Long
Print
Print "Entering blnExamineLine()"
Print "strLine = "strLine
'Note it isn't September yet and this isn't quite a beta yet, so the code for converting anything other that this one
'assignment statement isn't in place below in the Select Case. However, what this procedure will first look at is the
'type of code line passed to it from blnConvertProc(). In our case here its an assignment statement, so that is where
'code starts running. You can see right away the first thing blnExamineLine tries to do. It knows it has an assignmnt
'statement so it wants to parse out a left term and a right term. Then, after having those two strings in its clutches,
'it needs to figure out what each is. In our case here the left string is txtText1.Text and the right string is "You
'clicked cmdButtonX or whatever". Here is what's in the console output...
'
' vbLn.vbAssignment.RightTerm.szTerm = "You Clicked cmdButton2 (the middle button)!"
' Entering blnIdentifyTerm()
' It Looks A Lot Like A String Constant!
'
'Look at the call to the Function iIdentifyTerm() invoked by the Select Case statement. The enum discussed back in
'blnConvertProc() is once again used, and iIdentifyTerm() tells us that the term passed to it looks like a literal
'string constant. Then the LeftTerm is parsed out and that is passed also to iIdentifyTerm() to see if it can figure
'out what it is. Below is the console output from this call...
'
' vbLn.vbAssignment.LeftTerm.szTerm=txtText1.Text
' Entering blnIdentifyTerm()
' We Found Something!!!!!!
' We Found Something!!!!!!
' Ascertained Identity of Left Term To Be vbObject txtText1.Text
' iVarReturn = 2
' szSpecTypeReturn = VB.TextBox
'
'You'll want to look at iIdentifyTerm(). I won't discuss it in any detail, but it isn't really rocket science. It
'gets access to the SymbolTable, and is able to figure out what the object is. Lets summarize where we are at this point.
'We know that the code line we want to convert is an assignment statement in which a string constant is in some way
'going to be assigned to some textbox property of txtText1. But we're not exactly sure of the relationship. Don't jump
'to the conclusion that the Text property is going to be set because we havn't yet looked at the object function that will
'be called on behalf of the text box object. For all we know, the literal string constant could be the name of a new
'Font that is going to be assigned to the textbox. It is to that issue we must now turn. So below you'll see that
'program execution eventually branches to blnDoTextBoxCode() after some preliminary tests. So now lets jump with this
'discussion to blnDoTextBoxCode().....
Select Case vbLn.iType
Case %Assignment
vbLn.vbAssignment.RightTerm.szTerm=Right$(strLine,Len(strLine)-Instr(strLine,"="))
vbLn.vbAssignment.RightTerm.szTerm=Trim$(vbLn.vbAssignment.RightTerm.szTerm)
Print "vbLn.vbAssignment.RightTerm.szTerm = "vbLn.vbAssignment.RightTerm.szTerm
Select Case As Long iIdentifyTerm(vbLn.vbAssignment.RightTerm.szTerm, vbSym(),iVarReturn,szSpecTypeReturn,iSymbol)
Case %iIdentify_Term_Error
blnExamineLine=%FALSE
Exit Function
Case %NumericConstant
Case %StringConstant
vbLn.vbAssignment.RightTermIdentity=%StringConstant
End Select
vbLn.vbAssignment.LeftTerm.szTerm=Trim$(Left$(strLine,Instr(strLine,"=")-1))
Print "vbLn.vbAssignment.LeftTerm.szTerm="vbLn.vbAssignment.LeftTerm.szTerm
Select Case As Long iIdentifyTerm(vbLn.vbAssignment.LeftTerm.szTerm, vbSym(),iVarReturn,szSpecTypeReturn,iSymbol)
Case %iIdentify_Term_Error
blnExamineLine=%FALSE
Exit Function
Case %NumericConstant
Case %StringConstant
vbLn.vbAssignment.RightTermIdentity=%StringConstant
Case %vbObject
vbLn.vbAssignment.LeftTermIdentity=%vbObject
Print "Ascertained Identity of Left Term To Be vbObject " vbLn.vbAssignment.LeftTerm.szTerm
Print "iVarReturn = "iVarReturn
Print "szSpecTypeReturn = "szSpecTypeReturn
End Select
If vbLn.vbAssignment.LeftTermIdentity=%vbObject Or vbLn.vbAssignment.RightTermIdentity=%vbObject Then
Select Case szSpecTypeReturn
Case "VB.Form"
Case "VB.CommandButton"
Case "VB.TextBox"
If blnDoTextBoxCode(vbSym(),iSymbol,vbLn,strWorkBuffer()) Then
Print "Succeeded In Writing TextBox Code!"
Print strWorkBuffer(0)
Else
Print "Failed To Write TextBox Code!"
End If
Case "VB.ListBox"
End Select
End If
Case %vbStatement
Case %vbBlockStatement
Case %CallProcedure
End Select
Print "Leaving blnExamineLine()"
blnExamineLine=%TRUE
End Function
Function blnConvertProc(iProcNum As Long, iCtr As Long, strConvertedVBProc() As String, vbProc() As vbProcedure, vbSym() As vbSymbolTable) As Long
Local strWorkBuffer() As String
Register i As Long, j As Long
Local vbLn As vbCodeLine
Local iEndSub As Long
Local iLastCodeLine As Long
Local iFinish As Long
Local iStart As Long
Local iLineCtr As Long
Print
Print "Entering blnConvertProc()"
iEndSub=iCtr-1
iLastCodeLine=iEndSub-1
Print "iProcNum = " iProcNum 'The procedure number in vbProc() we're working on now
Print "iCtr = " iCtr 'One more than the number of lines written into strConvertedVBProc()
Print "iLastCodeLine = " iLastCodeLine
Print "iEndSub = " iEndSub
Print "vbProc(iProcNum).szNewSymbol = " vbProc(iProcNum).szNewSymbol
If vbProc(iProcNum).blnEventProcedure Then
Print
strConvertedVBProc(0)="Sub " & vbProc(iProcNum).szNewSymbol & "(Wea As WndEventArgs)" 'This just converts the proc declaration to PB
iLineCtr=1 'equivalent. Note subscript 0.
For i=1 To iLastCodeLine 'We'll iterate through all the code lines passed to us
Select Case Tally(strConvertedVBProc(i),"=") 'As previously discussed, the first thing that needs to be done is to figure out what
Case 0 'in the devil the code line is. At this point we don't know a thing about it other
Print "No Occurances of '=' Sign" 'than that it is a string of characters. If there are no equal signs in it at this
Case 1 'early point of just writting trial apps we'll assume it isn't an assignment statement.
Print "One Occurance of '=' Sign" 'If its got one equal sign in it we'll assume it is an assignment statement.
vbLn.vbAssignment.iType=0
'vbLn.iType=0 'Its an assignment statement!
Case >1
Print "Multiple Occurances of '=' Sign. Will Have To Examine This Line In Greater Detail To See What The Deal Is"
Print "It May, For Example, Be An Assignment Statement Involving A String Where There Is An '=' Sign Embedded In The"
Print "String To Be Assigned To Something, For Example A Textbox."
End Select
'At this point we've determined what the code line is. In our case here its an assignment statement. Note that vbLn is a UNION of
'type vbCodeLine, which, if determined above we're dealing with an assignment statement, will be loaded with a TYPE vbAssignmentStatement
'variable. Note that vbAssignment.iType is an enumeration like so...
''Enumeration Union vbCodeLine.iType
'%Assignment = 0
'%vbStatement = 1
'%vbBlockStatement = 2
'%CallProcedure = 3
'So that is what is going on with the term - vbLn.vbAssignment.iType = 0. Next, we need to work ourselves a little bit closer to
'converting the line. Lets dimension another string variable of some arbitrary size ( strWorkBuffer(10) ) and pass everything we
'have so far to that function to learn more about the code line. Further note that we are now in a procedure ( blnConvertProc() )
'whose mission in life is to convert a whole procedure. But within this procedure we are now in we are presently in a For Loop
'calling another procedure to move us closer to converting a single line of VB code. So the discussion now moves to blnExamineLine().
Redim strWorkBuffer(10) As String 'Make it arbitrarily large because we don't know how many lines of PowerBASIC code it will take to convert a VB line.
If blnExamineLine(vbProc(iProcNum), vbSym(), vbLn, strConvertedVBProc(i), strWorkBuffer()) Then
j=0
Do While strWorkBuffer(j)<>""
strConvertedVBProc(iLineCtr)=strWorkBuffer(j)
Incr j : Incr iLineCtr
Loop
Erase strWorkBuffer
Else
Print "blnExamineLine() Returned %FALSE"
blnConvertProc=%FALSE
Exit Function
End If
Next i
Print iEndSub,strConvertedVBProc(iEndSub)
Print
End If
Print "Leaving blnConvertProc()"
Print
blnConvertProc=%TRUE
End Function
Function PBMain() As Long
Local strConvertedVBProc() As String
Local szFileToConvert As Asciiz*256
Local vbSym() As vbSymbolTable
Local vbProc() As vbProcedure
Register i As Long, j As Long
Local strArray() As String
Local vbLine As vbCodeLine
Local iSizeOfProc As Long
Local vbObj() As vbObject
Local iFinish As Long
Local strLn As String
Local iRecCnt As Long
Local iStart As Long
Local iCtr As Long
Local fp1 As Long
Call Initializations()
'Change this line to reflect where you have frmVBConvert on your computer, or just put it in the same dir as the program.
'szFileToConvert="C:\Program Files\Microsoft Visual Studio\VB98\Projects\vbConvert\frmVBConvert.frm"
szFileToConvert="frmVBConvert.frm"
fp1=Freefile
Open szFileToConvert For Input As #fp1
FileScan #fp1, Records To iRecCnt
Redim strArray(iRecCnt) As String
Line Input #fp1, strArray() To iRecCnt
Close #fp1
For i=0 To iRecCnt
Print strArray(i)
Next i
Print "Everything Above This Line Is Simply The Contents of the frmVBConvert.frm File Being Output To The Screen."
Print "It s Stored in strArray(), Which Was Dimensioned To Hold Its Contents. Everything Below Is What This Program"
Print "Is Doing With strArray()."
Print
For i=1 To iRecCnt ' This block of code loads vbObj() with objects found in *.frm file
If InStr(strArray(i),"Begin ") Then ' "Begin " seems to be how all objects are started in the *.frm file
Incr iCtr ' so we can find out how many there are this ay.
End If
Next i
Decr iCtr
Redim vbObj(iCtr) As vbObject
If blnLoadVbObjs(strArray(),vbObj()) Then 'This proc loads the just dimensioned vbObj() array with
Print "blnLoadVbObjs() Succeeded!" 'info on the vb objects found in frmVBConvert.frm. Note
End If 'we're storing the file in strArray().
Print : Print
For i=0 To UBound(vbObj,1)
Print i,vbObj(i).szObject
Next i
Print
If blnLoadObjProperties(strArray(),vbObj()) Then 'This proc gets the rest of the info into vbObj()
Print "blnLoadObjProperties() Succeeded!" 'for example converting twips to pixels and so on
End If 'Lot of stuff set in the properties pane in VB IDE
Print : Print
Print " i vbObj(i).szObject vbObj(i).szName vbObj(i).szSdkControl vbObj(i).szEquate" 'Just display
Print "==========================================================================================" 'what we got so far
For i=0 To Ubound(vbObj)
Print i Tab(5) vbObj(i).szObject Tab(30) vbObj(i).szName Tab(50) vbObj(i).szSdkControl Tab(74) vbObj(i).szEquate
Next i
'Find out how many procedures are in *.frm file 'Now lets start working on the procedures. In this little
iCtr=0 'VB program there are only three of them
For i=0 To UBound(strArray,1)
If InStr(strArray(i),"End Sub") Or InStr(strArray(i),"End Function") Then
Incr iCtr
End If
Next i
Print
Print "There Are "iCtr" Procedures In The File."
Decr iCtr
Redim vbProc(iCtr) As vbProcedure
If blnLoadVbProcs(strArray(),vbObj(),vbProc()) Then
Print "blnLoadVbProcs() Succeeded!"
Else
Erase strArray,vbObj,vbProc
Exit Function
End If
Print : Print
Print " i szType iType iBegin iEnd blnContainsObject blnContainsUnderscore szObjectName szEventName szOriginalSymbol szNewSymbol"
Print "=============================================================================================================================================================="
For i=0 To UBound(vbProc)
Print i Tab(6) vbProc(i).szType Tab(15) vbProc(i).iType Tab(22) vbProc(i).iBegin Tab(29) vbProc(i).iEnd Tab(34) vbProc(i).blnContainsObject _
Tab(52) vbProc(i).blnContainsUnderscore Tab(75) vbProc(i).szObjectName Tab(89) vbProc(i).szEventName Tab(103) vbProc(i).szOriginalSymbol Tab(128) vbProc(i).szNewSymbol
Next i
Print
'Find variables and fill symbol table
iCtr=iCountVariables(strArray()) 'at this point can't have multiple variables on one line 'Now things are starting to get interesting! It looks like
Print "iCountVariables="iCtr 'the concept of a 'symbol table' is something we're going to
Redim vbSym(iCtr+UBound(vbObj,1)+UBound(vbProc,1)+1) 'need.
Print "Ubound(vbSym,1) = "Ubound(vbSym,1)
Print
For i=0 To UBound(vbObj,1)
vbSym(i).szSymbol=vbObj(i).szName 'e.g., txtFirstName, iCtr, strLastName, etc.
vbSym(i).iGeneralType=2
vbSym(i).szSpecificType=vbObj(i).szObject 'Object
vbSym(i).szSdkType=vbObj(i).szSdkControl 'edit, button, static, listbox, etc.
vbSym(i).Scope=2
If i Then
vbSym(i).szEquate="%" & vbObj(0).szName & "_" & vbObj(i).szName
Else
vbSym(i).szEquate="%" & vbObj(0).szName
End If
Next i
Call LoadFormSymbolTable(strArray(),vbObj(),vbProc(),vbSym()) 'only used i believe if form variables are in the frm file. here there aren't any
Print
Print " i vb.Sym(i).szSymbol vbSym(i).iGeneralType vbSym(i).szSpecificType vbSym(i).szSdkType vbSym(i).Scope vbSym(i).szEquate"
Print "====================================================================================================================================="
For i=0 To UBound(vbSym,1)
Print i Tab(9)vbSym(i).szSymbol Tab(30)vbSym(i).iGeneralType Tab(55) vbSym(i).szSpecificType Tab(80) vbSym(i).szSdkType _
Tab(100) vbSym(i).Scope Tab(115) vbSym(i).szEquate
Next i
Print
'The below code will iterate through the three event procedures in vbProc(). It won't modify strArray() in any way, but will
'dynamically dimension a new string array strConvertedVBProc() with four times the number of lines in the original proc. This
'is just an arbitrary number and is based on the idea that the converted procedure may contain more lines than the original.
'Finally, blnConvertProc() is called to convert the procedure. A lot of data is passed to blnConvertProc(), as you can see.
'Essentially, all the data gleaned so far by examining the whole of the frm file with a fine tooth comb. The symbol table will
'be passed, the vbProc() array, the code lines of the proc, as well as the index within vbProc() of the Proc being converted.
'When blnConvertProc() returns strConvertedVBProc() will contain the new code lines - not the lines of VB code passed in. A
'whole string of further procedures are called in blnConvertProc(), and it is to there you should next look.
For i=0 To UBound(vbProc) 'Loop through vbProc() array
iSizeOfProc=vbProc(i).iEnd - vbProc(i).iBegin 'How many lines? ( this info is in vbProc() )
Redim strConvertedVBProc(iSizeOfProc*4) As String 'Make sure it is way big enough. The original procedure will be read into this and
iCtr=0 'and passed to blnConvertProc(). Within that procedure the lines will be converted
For j=vbProc(i).iBegin To vbProc(i).iEnd 'and more than likely moved around some from the original. strConvertedVBProc() is
strConvertedVBProc(iCtr)=strArray(j) 'loaded here with original lines of the procedure held in strArray(), then this new
Incr iCtr 'at least 3 lines unless empty proc 'string array is passed to blnConvertProc().
Next j
If blnConvertProc(i,iCtr,strConvertedVBProc(),vbProc(),vbSym()) Then
Print "blnConvertProc() Returned %TRUE"
Print: Print
j=0
Do While strConvertedVBProc(j)<>""
Print j, strConvertedVBProc(j)
Incr j
Loop
Print : Print
Else
Print "blnConvertProc() Returned %FALSE"
End If
Print : Print : Print : Print
Erase strConvertedVBProc
Next i
Erase strArray, vbObj, vbProc, vbSym
Waitkey$
PBMain=0
End Function
Code:
'CCParse.inc %LOGPIXELSX = 88& %LOGPIXELSY = 90& %HWND_DESKTOP = 0 %FALSE = 0 %TRUE = 1 ' Window Styles %WS_OVERLAPPED = &H0 %WS_POPUP = &H80000000 %WS_CHILD = &H40000000 %WS_MINIMIZE = &H20000000 %WS_VISIBLE = &H10000000 %WS_DISABLED = &H08000000 %WS_CLIPSIBLINGS = &H04000000 %WS_CLIPCHILDREN = &H02000000 %WS_MAXIMIZE = &H01000000 %WS_CAPTION = &H00C00000 ' WS_BORDER OR WS_DLGFRAME %WS_BORDER = &H00800000 %WS_DLGFRAME = &H00400000 %WS_VSCROLL = &H00200000 %WS_HSCROLL = &H00100000 %WS_SYSMENU = &H00080000 %WS_THICKFRAME = &H00040000 %WS_GROUP = &H00020000 %WS_TABSTOP = &H00010000 %WS_MINIMIZEBOX = &H00020000 %WS_MAXIMIZEBOX = &H00010000 %WS_TILED = %WS_OVERLAPPED %WS_ICONIC = %WS_MINIMIZE %WS_SIZEBOX = %WS_THICKFRAME %WS_OVERLAPPEDWIN = %WS_OVERLAPPED OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME %WS_OVERLAPPEDWINDOW= %WS_OVERLAPPED OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX %WS_EX_CLIENTEDGE = &H00000200 ' Button Control Styles %BS_TEXT = &H0& %BS_PUSHBUTTON = &H0& %BS_DEFPUSHBUTTON = &H1& %BS_DEFAULT = %BS_DEFPUSHBUTTON %BS_CHECKBOX = &H2& %BS_AUTOCHECKBOX = &H3& %BS_RADIOBUTTON = &H4& %BS_3STATE = &H5& %BS_AUTO3STATE = &H6& %BS_GROUPBOX = &H7& %BS_USERBUTTON = &H8& %BS_AUTORADIOBUTTON = &H9& %BS_OWNERDRAW = &HB& %BS_LEFTTEXT = &H20& %BS_ICON = &H40& %BS_BITMAP = &H80& %BS_LEFT = &H100& %BS_RIGHT = &H200& %BS_CENTER = &H300& %BS_TOP = &H400& %BS_BOTTOM = &H800& %BS_VCENTER = &HC00& %BS_PUSHLIKE = &H00001000& %BS_MULTILINE = &H00002000& %BS_NOTIFY = &H00004000& %BS_FLAT = &H00008000& %BS_RIGHTBUTTON = %BS_LEFTTEXT DECLARE FUNCTION GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS DWORD) AS DWORD DECLARE FUNCTION GetDeviceCaps LIB "GDI32.DLL" ALIAS "GetDeviceCaps" (BYVAL hdc AS DWORD, BYVAL nIndex AS LONG) AS LONG DECLARE FUNCTION ReleaseDC LIB "USER32.DLL" ALIAS "ReleaseDC" (BYVAL hWnd AS DWORD, BYVAL hDC AS DWORD) AS LONG Global g_strObjects() As String 'This woud be the names of controls encountered in the *.frm file, i.e., "VB.TextBox". Global g_strSdkObjects() As String 'Corresponding Sdk name for a control, i.e., 'edit" Global g_strFormProps() As String 'Caption, StartUpPosition, etc Global g_strTextBoxProps() As String Global g_strCmdButtonProps() As String Global g_strEventNames() As String Global g_strButtonMessages() As String Sub Initializations() Redim g_strObjects(2) As String 'This woud be the names of controls encountered in the *.frm file, i.e., "VB.TextBox". Redim g_strSdkObjects(2) As String 'Corresponding Sdk name for a control, i.e., 'edit" Redim g_strFormProps(9) As String 'Caption, StartUpPosition, etc Redim g_strTextBoxProps(6) As String 'MultiLine, scroll bars, etc. Redim g_strCmdButtonProps(6) As String 'Visible, Height, etc. Redim g_strEventNames(7) As String 'Event names encountered in actual procedures, e.g., cmdButton_Click(). 'Click' would be event name Redim g_strButtonMessages(8) As String 'strName of button message, i.e., what is in the Hiwrd(wParam) - notification messages 'Initialize string array to hold names of global VB Objects as in *.frm file, i.e., Forms, Command Buttons, Text Boxes, etc g_strObjects(0)="VB.Form" g_strObjects(1)="VB.TextBox" : g_strSdkObjects(1)="edit" g_strObjects(2)="VB.CommandButton" : g_strSdkObjects(2)="button" 'Initial string array to hold respective property names of global VB objects. Below is Form g_strFormProps(1)="Caption" g_strFormProps(2)="ClientHeight" g_strFormProps(3)="ClientLeft" g_strFormProps(4)="ClientTop" g_strFormProps(5)="ClientWidth" g_strFormProps(6)="LinkTopic" g_strFormProps(7)="ScaleHeight" g_strFormProps(8)="ScaleWidth" g_strFormProps(9)="StartUpPosition" 'Initial string array to hold respective property names of global VB objects. Below is TextBox g_strTextBoxProps(1)="Height" g_strTextBoxProps(2)="Left" g_strTextBoxProps(3)="TabIndex" g_strTextBoxProps(4)="Top" g_strTextBoxProps(5)="Width" g_strTextBoxProps(6)="Text" 'Initial string array to hold respective property names of global VB objects. Below is Push Button g_strCmdButtonProps(1)="Caption" g_strCmdButtonProps(2)="Height" g_strCmdButtonProps(3)="Left" g_strCmdButtonProps(4)="TabIndex" g_strCmdButtonProps(5)="Top" g_strCmdButtonProps(6)="Width" 'Load A Few VB Event Names g_strEventNames(1)="Load" g_strEventNames(2)="Click" g_strEventNames(3)="GotFocus" g_strEventNames(4)="KeyDown" g_strEventNames(5)="KeyPress" g_strEventNames(6)="Change" g_strEventNames(7)="Validate" g_strButtonMessages(1)="BN_CLICKED" 'I don't think I even used any of these!!! g_strButtonMessages(2)="BN_DBLCLK" ' g_strButtonMessages(3)="BN_DISABLE" ' g_strButtonMessages(4)="BN_PUSHED" g_strButtonMessages(5)="BN_KILLFOCUS" g_strButtonMessages(6)="BN_PAINT" g_strButtonMessages(7)="BN_SETFOCUS" g_strButtonMessages(8)="BN_UNPUSHED" End Sub
Comment