Code: Select all
Create form As QForm 'This is the basic Form
Caption = "Hello World"
Width = 300
Height = 200
End Create
Create edit1 As QEdit
Top = 20
Left = 20
Height = 25
Width = 100
Text = "Test"
End Create
Create button1 As QButton
Caption = "Click Me"
Width = 100
Height = 30
Top = 100
Left = 20
OnClick = Sub1()
End Create
Create label1 As QLabel
Caption = "Welcome!!"
Width = 100
Height = 25
Top = 70
Left = 20
End Create
It only produces edit controls, buttons and labels as my knowledge of api is totally limited and I had to study the output of other visual gui editors posted in the projects forum (visg etc.) just to make the code for this one. Its easy though to add other controls if you have better knowledge of the api than me :-).
http://www.savefile.com/files/1146798
GUI_Maker.bas
Code: Select all
'' Main Program
'' Subs and Functions
Declare Function Clipboard_SetText(BYVAL Text AS STRING) as Integer
Declare Sub BUTTON0_Click()
Declare Sub BUTTON1_Click()
#Include "string.bas"
#Include "modules.bas"
#include once "windows.bi"
#include once "win/commctrl.bi"
'' Handles
Dim Shared hwndWindow0 As Long
DIM SHARED hwndButton0 AS Long
DIM SHARED hwndButton1 AS Long
'DIM SHARED hwndEdit0 AS Long
DIM SHARED hwndRichEdit0 AS Long
DIM SHARED hwndRichEdit1 AS Long
'' names of window classes.
const WND_CLASS_NAME0 = "my_wnd_class_name_0"
'' identifiers.
const IDC_BUTTON1 = 2004
const IDC_RICHEDIT1 = 2003
const IDC_RICHEDIT0 = 2002
const IDC_BUTTON0 = 2001
'' function prototypes.
declare sub register_classes
declare function message_loop as integer
declare function wnd_proc0(byval thiswnd as hwnd, byval message as uinteger, byval w_param as wparam, byval l_param as lparam) as lresult
declare function create_wnd0 as hwnd
declare sub create_wnd_content0(byval parent as hwnd)
'' global data.
dim shared instance as hmodule
dim shared h_font as HFONT
'' main code.
instance = GetModuleHandle(null)
InitCommonControls
LoadLibrary "RICHED32.DLL"
register_classes
h_font = CreateFont(-13, 0, 0, 0, FW_NORMAL, 0, _
0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, "Times New Roman")
create_wnd0
end message_loop
'' window procedure #0 [window].
function wnd_proc0(byval thiswnd as hwnd, byval message as uinteger, byval w_param as wparam, byval l_param as lparam) as lresult
select case message
case WM_CREATE
create_wnd_content0 thiswnd
case WM_CLOSE
if IDYES = MessageBox(thiswnd, "Quit?", "Exit Program...", MB_YESNO or MB_ICONQUESTION) then
DestroyWindow thiswnd
end if
case WM_DESTROY:
PostQuitMessage 0 '' PostQuitMessage(return_code) quits the message loop.
Case WM_COMMAND
select case loword(w_param)
case IDC_BUTTON0 '' button: "button"
BUTTON0_Click()
case IDC_BUTTON1 '' button: "button"
BUTTON1_Click()
case else
end select
case else
return DefWindowProc(thiswnd, message, w_param, l_param)
end select
return 0
end function
'' create window #0 [window].
function create_wnd0 as hwnd
dim wnd as hwnd
Dim mydummy As ULong
mydummy = &h14CF0000 - WS_MAXIMIZEBOX '' I don't want an active maximize button
wnd = CreateWindowEx(&h00000100, WND_CLASS_NAME0, "GUI Maker", mydummy, CW_USEDEFAULT, CW_USEDEFAULT, 400, 600, null, null, instance, null)
hwndWindow0 = wnd
ShowWindow wnd, SW_SHOWNORMAL
UpdateWindow wnd
return wnd
end function
'' create window content #0 [window].
sub create_wnd_content0(byval parent as hwnd)
dim wnd as hwnd
wnd = CreateWindowEx(&h00000200, "RICHEDIT", "", &h500110C4, 10, 10, 370, 240, parent, cast(hmenu, IDC_RICHEDIT0), instance, null)
hwndRichEdit0 = wnd
SendMessage wnd, WM_SETFONT, cast(wparam, h_font), TRUE
wnd = CreateWindowEx(&h00000200, "RICHEDIT", "", &h500110C4, 10, 270, 370, 240, parent, cast(hmenu, IDC_RICHEDIT1), instance, null)
hwndRichEdit1 = wnd
SendMessage wnd, WM_SETFONT, cast(wparam, h_font), TRUE
wnd = CreateWindowEx(&h00000000, "Button", "Translate", &h50010001, 80, 520, 100, 30, parent, cast(hmenu, IDC_BUTTON0), instance, null)
hwndButton0 = wnd
SendMessage wnd, WM_SETFONT, cast(wparam, h_font), TRUE
wnd = CreateWindowEx(&h00000000, "Button", "Copy", &h50010001, 220, 520, 100, 30, parent, cast(hmenu, IDC_BUTTON1), instance, null)
hwndButton1 = wnd
SendMessage wnd, WM_SETFONT, cast(wparam, h_font), TRUE
End sub
'' register all the window classes.
sub register_classes
dim wc as WNDCLASS
with wc
.cbClsExtra = 0
.cbWndExtra = 0
.hbrBackground = cast(hbrush, COLOR_3DFACE + 1)
.hCursor = LoadCursor(null, byval IDC_ARROW)
.hIcon = LoadIcon(null, byval IDI_APPLICATION)
.hInstance = instance
.lpszMenuName = null
.style = CS_PARENTDC or CS_DBLCLKS
end with
wc.lpfnWndProc = @wnd_proc0
wc.lpszClassName = strptr(WND_CLASS_NAME0)
RegisterClass @wc
end sub
'' message loop.
function message_loop as integer
dim message as MSG
while (GetMessage(@message, null, 0, 0) <> false)
TranslateMessage @message
DispatchMessage @message
wend
DeleteObject h_font
return message.wParam
end function
'' End of file.
'' Subs and Functions Code
Function Clipboard_SetText(BYVAL Text AS STRING) as integer
Dim as Zstring Ptr lpMem
Dim as Handle hMem
' Allocate global memory block
hMem = GlobalAlloc(null, LEN(Text) + 1)
' lock it and get pointer to memory location
lpMem = GlobalLock(hMem)
' copy text into memory object
*lpMem = Text
' unlock the memory object
GlobalUnlock hMem
' add text to the clipboard
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_TEXT, hMem
CloseClipboard
Clipboard_SetText=1
END Function
Sub BUTTON0_Click()
Dim newline As String
newline = Chr(13,10)
Dim ProgTitle As String
ProgTitle = "'' Made with GUI_Maker Version alpha 0.1" + newline + newline
Initial()
'' Input Code
Dim ins As String*10000 '' The Input Code
Dim len_ins As Long
len_ins = GetWindowText(hwndRichEdit0,ins,10000)
'' Take The Input Code
InterPr(ins)
'' Output Code
Dim ans As String '' The Final Translated Code
'' Make The Header
Code_Header()
'' Make The Main Code
MainCode()
'' Make The Form Function Code
MakeForm()
'' Make Controls
MakeControls()
'' Make Events
MakeEvents()
'' Cumulative Code
ans = ProgTitle + SubDecl + newline + h_ans + idvariables + newline + handlevariables + newline
ans = ans + m_ans + newline + f_ans + newline + windowcontrols + newline + windowevents + newline + SubCodes
SetWindowText(hwndRichEdit1,ans)
End Sub
Sub BUTTON1_Click()
'' Input Code
Dim ins As String*10000 '' The Input Code
Dim len_ins As Long
len_ins = GetWindowText(hwndRichEdit1,ins,10000)
Dim i As Integer
i = Clipboard_SetText(ins)
End Sub
modules.bas
Code: Select all
'' Modules
Declare Sub Initial()
Declare Sub InterPr(ByRef ans As String)
Declare Sub Code_Header()
Declare Sub MainCode()
Declare Sub MakeForm()
Declare Sub MakeControls()
Declare Sub MakeEvents()
Declare Sub MakeButton(startline As Integer, endline As Integer)
Declare Sub MakeEdit(startline As Integer, endline As Integer)
Declare Sub MakeLabel(startline As Integer, endline As Integer)
Declare Sub MakeOneControl(qc As String, sl As Integer, el As Integer)
Dim Shared codelines(1000) As String*100 '' The Forms Code
Dim Shared h_ans As String '' The Header
Dim Shared m_ans As String '' Main Code
Dim Shared f_ans As String '' The Form
Dim Shared idnumbers As Integer '' The cumulative ID nbrs
Dim Shared windowcontrols As String '' The Controls
Dim Shared windowevents As String '' Windows Events
Dim Shared windowclickevents As String '' Button Clicks Events
Dim Shared handlevariables As String '' The Handles
Dim Shared idvariables As String '' The IDs
Dim Shared SubDecl As String '' The Sub Declarations
Dim Shared SubCodes As String '' The Sub Codes
Sub Initial()
Dim newline As String
newline = Chr(13,10)
Dim i As Integer
idnumbers = 1000
h_ans = ""
f_ans = ""
m_ans = ""
windowcontrols = ""
handlevariables = ""
idvariables = ""
windowevents = ""
windowclickevents = ""
SubDecl = "'' Sub Declarations" + newline + newline
SubCodes = "'' Sub Codes" + newline + newline
For i = 1 To 1000
codelines(i) = ""
Next
End Sub
Sub InterPr(ByRef ans As String)
Dim i As Integer
Dim j As Integer
Dim newline As String
newline = Chr(13,10)
j = TallyStr(ans, newline)
For i = 1 To j
codelines(i) = FieldStr(FieldStr(ans, newline, i),"'",1)
Next
codelines(j+1) = "endoffile"
End Sub
Sub Code_Header()
Dim newline As String
newline = Chr(13,10)
Dim ans As String
ans = ans + "'' Include" + newline
ans = ans + newline
ans = ans + "#include once " + Chr(34) + "windows.bi" + Chr(34) + newline
ans = ans + "#include once " + Chr(34) + "win/commctrl.bi" + Chr(34) + newline
ans = ans + newline
ans = ans + "'' Declare" + newline
ans = ans + newline
ans = ans + "Declare Sub register_classes" + newline
ans = ans + "Declare Function message_loop As integer" + newline
ans = ans + "Declare Function wnd_proc0(Byval thiswnd As hwnd, Byval message As uinteger, Byval w_param As wparam, Byval l_param As lparam) As lresult" + newline
ans = ans + "Declare Function create_wnd0 As hwnd" + newline
ans = ans + "Declare Sub create_wnd_content0(byval parent as hwnd)" + newline
ans = ans + newline
ans = ans + "'' Names of Window Classes" + newline
ans = ans + newline
ans = ans + "Const WND_CLASS_NAME0 = " + Chr(34) + "my_wnd_class_name_0" + Chr(34) + newline
ans = ans + newline
ans = ans + "'' Global Data" + newline
ans = ans + newline
ans = ans + "Dim Shared instance as hmodule" + newline
ans = ans + "Dim Shared h_font as HFONT" + newline
ans = ans + newline
h_ans = ans
End Sub
Sub MainCode()
Dim newline As String
newline = Chr(13,10)
m_ans = m_ans + "'' Main Code" + newline + newline
m_ans = m_ans + "instance = GetModuleHandle(null)" + newline
m_ans = m_ans + "InitCommonControls" + newline
m_ans = m_ans + "LoadLibrary " + Chr(34) + "RICHED32.DLL" + Chr(34) + newline
m_ans = m_ans + "register_classes" + newline
m_ans = m_ans + "h_font = CreateFont(-13, 0, 0, 0, FW_NORMAL, 0, _" + newline
m_ans = m_ans + "0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _" + newline
m_ans = m_ans + "DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, " + Chr(34) + "Times New Roman" + Chr(34) +")" + newline
m_ans = m_ans + "create_wnd0" + newline
m_ans = m_ans + "End message_loop" + newline
m_ans = m_ans + newline
m_ans = m_ans + "'' Register Windows Classes" + newline + newline
m_ans = m_ans + "Sub register_classes" + newline
m_ans = m_ans + " Dim wc As WNDCLASS" + newline
m_ans = m_ans + " With wc" + newline
m_ans = m_ans + " .cbClsExtra = 0" + newline
m_ans = m_ans + " .cbWndExtra = 0" + newline
m_ans = m_ans + " .hbrBackground = cast(hbrush, COLOR_3DFACE + 1)" + newline
m_ans = m_ans + " .hCursor = LoadCursor(null, byval IDC_ARROW)" + newline
m_ans = m_ans + " .hIcon = LoadIcon(null, byval IDI_APPLICATION)" + newline
m_ans = m_ans + " .hInstance = instance" + newline
m_ans = m_ans + " .lpszMenuName = null" + newline
m_ans = m_ans + " .style = CS_PARENTDC or CS_DBLCLKS" + newline
m_ans = m_ans + " End with" + newline
m_ans = m_ans + " wc.lpfnWndProc = @wnd_proc0" + newline
m_ans = m_ans + " wc.lpszClassName = strptr(WND_CLASS_NAME0)" + newline
m_ans = m_ans + " RegisterClass @wc" + newline
m_ans = m_ans + "End Sub" + newline
m_ans = m_ans + newline
m_ans = m_ans + "'' Message Loop" + newline + newline
m_ans = m_ans + "Function message_loop As Integer" + newline
m_ans = m_ans + " Dim message As MSG" + newline
m_ans = m_ans + " While (GetMessage(@message, null, 0, 0) <> false)" + newline
m_ans = m_ans + " TranslateMessage @message" + newline
m_ans = m_ans + " DispatchMessage @message" + newline
m_ans = m_ans + " Wend" + newline
m_ans = m_ans + " DeleteObject h_font" + newline
m_ans = m_ans + " Return message.wParam" + newline
m_ans = m_ans + "End Function" + newline
End Sub
Sub MakeForm()
Dim ans As String
Dim exitflag As Byte
Dim Form_Name As String
Dim Form_Caption As String
Dim Form_Width As Integer
Dim Form_Height As Integer
Dim startline As Integer
Dim endline As Integer
Dim temp As String
Dim temp2 As String
Dim i As Integer
For i = 1 To 1000
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If TallyStr(temp2, "qform") = 1 Then
startline = i
exitflag = 1
EndIf
If (TallyStr(temp2, "end") = 1 And TallyStr(temp2, "create") = 1) Then
If exitflag = 1 Then
endline = i
Exit For
EndIf
EndIf
Next
For i = startline To endline
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If TallyStr(temp2, "width") = 1 Then
Form_Width = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "height") = 1 Then
Form_Height = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "caption") = 1 Then
Form_Caption = FieldStr(codelines(i), Chr(34), 2)
EndIf
If TallyStr(temp2, "qform") = 1 Then
temp2 = ReplaceStr(temp2, " ", " ")
Form_Name = ReplaceStr(FieldStr(FieldStr(temp2, "create", 2)," as qform",1)," ","")
EndIf
Next
Dim newline As String
newline = Chr(13,10)
handlevariables = handlevariables + "Dim Shared hwnd" + Form_Name + " As Long '' Form Handle" + newline
handlevariables = handlevariables + newline
ans = ans + "'' Create Window #0" + newline
ans = ans + newline
ans = ans + "Function create_wnd0 As hwnd" + newline
ans = ans + " Dim wnd As hwnd" + newline
ans = ans + " wnd = CreateWindowEx(&h00000100, WND_CLASS_NAME0, " + Chr(34) + Form_Caption + Chr(34) + ", &h14CF0000, CW_USEDEFAULT, CW_USEDEFAULT, " + Str$(Form_Width) + ", " + Str$(Form_Height) + ", null, null, instance, null)" + newline
ans = ans + " hwnd" + Form_Name + " = wnd" + newline
ans = ans + " ShowWindow wnd, SW_SHOWNORMAL" + newline
ans = ans + " UpdateWindow wnd" + newline
ans = ans + " Return wnd" + newline
ans = ans + "End Function" + newline
ans = ans + newline
f_ans = ans
End Sub
Sub MakeEvents()
Dim newline As String
newline = Chr(13,10)
Dim ans As String
ans = ans + "'' window procedure #0" + newline
ans = ans + newline
ans = ans + "Function wnd_proc0(byval thiswnd as hwnd, byval message as uinteger, byval w_param as wparam, byval l_param as lparam) as lresult" + newline
ans = ans + " Select Case message" + newline
ans = ans + " Case WM_CREATE" + newline
ans = ans + " create_wnd_content0 thiswnd" + newline
ans = ans + " Case WM_CLOSE" + newline
ans = ans + " If IDYES = MessageBox(thiswnd, " + Chr(34) + "Quit?" + Chr(34) + ", " + Chr(34) + "Exit Program..." + Chr(34) + ", MB_YESNO or MB_ICONQUESTION) Then" + newline
ans = ans + " DestroyWindow thiswnd" + newline
ans = ans + " End If" + newline
ans = ans + " Case WM_DESTROY" + newline
ans = ans + " PostQuitMessage 0" + newline
ans = ans + " Case WM_COMMAND" + newline
ans = ans + " Select Case loword(w_param)" + newline
ans = ans + windowclickevents
ans = ans + " Case Else" + newline
ans = ans + " End Select" + newline
ans = ans + " Case Else" + newline
ans = ans + " Return DefWindowProc(thiswnd, message, w_param, l_param)" + newline
ans = ans + " End Select" + newline
ans = ans + " Return 0" + newline
ans = ans + "End Function" + newline
windowevents = ans
End Sub
Sub MakeButton(startline As Integer, endline As Integer)
Dim newline As String
newline = Chr(13,10)
Dim Button_Name As String
Dim Button_Caption As String
Dim Button_Top As Integer
Dim Button_Left As Integer
Dim Button_Width As Integer
Dim Button_Height As Integer
Dim Button_OnClick As String
Dim IdVar As String
' Initial Values
Button_Caption = "Button"
Button_Top = 10
Button_Left = 10
Button_Width = 100
Button_Height = 40
' Main Routine
Dim i As Integer
Dim temp As String
Dim temp2 As String
For i = startline To endline
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If TallyStr(temp2, "width") = 1 Then
Button_Width = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "height") = 1 Then
Button_Height = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "top") = 1 Then
Button_Top = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "left") = 1 Then
Button_Left = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "caption") = 1 Then
Button_Caption = FieldStr(codelines(i), Chr(34), 2)
EndIf
If TallyStr(temp2, "onclick") = 1 Then
Button_OnClick = FieldStr(codelines(i), "=", 2)
EndIf
If TallyStr(temp2, "qbutton") = 1 Then
temp2 = ReplaceStr(temp2, " ", " ")
Button_Name = ReplaceStr(FieldStr(FieldStr(temp2, "create", 2)," as qbutton",1)," ","")
EndIf
Next
' Make ID and Handle
handlevariables = handlevariables + "Dim Shared hwnd" + Button_Name + " As Long" + newline
IdVar = "IDC_" + Button_Name
idvariables = idvariables + "Const " + IdVar + " = " + Str$(idnumbers) + newline
idnumbers = idnumbers + 1
If Button_OnClick <> "" Then
' Make Click Events
windowclickevents = windowclickevents + " Case " + IdVar + newline
windowclickevents = windowclickevents + " " + Button_OnClick + newline
' Make Subs
SubDecl = SubDecl + "Declare Sub " + Button_OnClick + newline
SubCodes = SubCodes + "Sub " + Button_OnClick + newline
SubCodes = SubCodes + " MessageBox(NULL, " + Chr(34) + Button_OnClick + " Sub Executed!" + Chr(34) + ", " + Chr(34) + "Event!" + Chr(34) + ",MB_ICONEXCLAMATION Or MB_OK)" + newline
SubCodes = SubCodes + "End Sub" + newline
SubCodes = SubCodes + newline
End If
' Make Control
windowcontrols = windowcontrols + " " + "hwnd" + Button_Name + " = CreateWindowEx(&h00000000, " + Chr(34) + "Button" + Chr(34) + ", " + Chr(34) + Button_Caption + Chr(34) + ", &h50010001, "
windowcontrols = windowcontrols + Str$(Button_Left) + ", " + Str$(Button_Top) + ", " + Str$(Button_Width) + ", " + Str$(Button_Height) + ", parent, cast(hmenu, " + IdVar +") , instance, null)" + newline
windowcontrols = windowcontrols + " " + "SendMessage " + "hwnd" + Button_Name +", WM_SETFONT, cast(wparam, h_font), TRUE" + newline
End Sub
Sub MakeEdit(startline As Integer, endline As Integer)
Dim newline As String
newline = Chr(13,10)
Dim Edit_Name As String
Dim Edit_Text As String
Dim Edit_Top As Integer
Dim Edit_Left As Integer
Dim Edit_Width As Integer
Dim Edit_Height As Integer
Dim Edit_OnClick As String
Dim IdVar As String
' Initial Values
Edit_Text = "Text"
Edit_Top = 10
Edit_Left = 10
Edit_Width = 100
Edit_Height = 40
' Main Routine
Dim i As Integer
Dim temp As String
Dim temp2 As String
For i = startline To endline
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If TallyStr(temp2, "width") = 1 Then
Edit_Width = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "height") = 1 Then
Edit_Height = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "top") = 1 Then
Edit_Top = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "left") = 1 Then
Edit_Left = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "text") = 1 Then
Edit_Text = FieldStr(codelines(i), Chr(34), 2)
EndIf
If TallyStr(temp2, "qedit") = 1 Then
temp2 = ReplaceStr(temp2, " ", " ")
Edit_Name = ReplaceStr(FieldStr(FieldStr(temp2, "create", 2)," as qedit",1)," ","")
EndIf
Next
' Make ID and Handle
handlevariables = handlevariables + "Dim Shared hwnd" + Edit_Name + " As Long" + newline
IdVar = "IDC_" + Edit_Name
idvariables = idvariables + "Const " + IdVar + " = " + Str$(idnumbers) + newline
idnumbers = idnumbers + 1
' Make Control
windowcontrols = windowcontrols + " " + "hwnd" + Edit_Name + " = CreateWindowEx(&h00000200, " + Chr(34) + "Edit" + Chr(34) + ", " + Chr(34) + Edit_Text + Chr(34) + ", &h50010080, "
windowcontrols = windowcontrols + Str$(Edit_Left) + ", " + Str$(Edit_Top) + ", " + Str$(Edit_Width) + ", " + Str$(Edit_Height) + ", parent, cast(hmenu, " + IdVar +") , instance, null)" + newline
windowcontrols = windowcontrols + " " + "SendMessage " + "hwnd" + Edit_Name +", WM_SETFONT, cast(wparam, h_font), TRUE" + newline
End Sub
Sub MakeLabel(startline As Integer, endline As Integer)
Dim newline As String
newline = Chr(13,10)
Dim Label_Name As String
Dim Label_Caption As String
Dim Label_Top As Integer
Dim Label_Left As Integer
Dim Label_Width As Integer
Dim Label_Height As Integer
Dim Label_OnClick As String
Dim IdVar As String
' Initial Values
Label_Caption = "Text"
Label_Top = 10
Label_Left = 10
Label_Width = 100
Label_Height = 40
' Main Routine
Dim i As Integer
Dim temp As String
Dim temp2 As String
For i = startline To endline
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If TallyStr(temp2, "width") = 1 Then
Label_Width = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "height") = 1 Then
Label_Height = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "top") = 1 Then
Label_Top = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "left") = 1 Then
Label_Left = Val(FieldStr(temp2, "=", 2))
EndIf
If TallyStr(temp2, "caption") = 1 Then
Label_Caption = FieldStr(codelines(i), Chr(34), 2)
EndIf
If TallyStr(temp2, "qlabel") = 1 Then
temp2 = ReplaceStr(temp2, " ", " ")
Label_Name = ReplaceStr(FieldStr(FieldStr(temp2, "create", 2)," as qlabel",1)," ","")
EndIf
Next
' Make ID and Handle
handlevariables = handlevariables + "Dim Shared hwnd" + Label_Name + " As Long" + newline
IdVar = "IDC_" + Label_Name
idvariables = idvariables + "Const " + IdVar + " = " + Str$(idnumbers) + newline
idnumbers = idnumbers + 1
' Make Control
windowcontrols = windowcontrols + " " + "hwnd" + Label_Name + " = CreateWindowEx(&h00000000, " + Chr(34) + "Static" + Chr(34) + ", " + Chr(34) + Label_Caption + Chr(34) + ", &h50000300, "
windowcontrols = windowcontrols + Str$(Label_Left) + ", " + Str$(Label_Top) + ", " + Str$(Label_Width) + ", " + Str$(Label_Height) + ", parent, cast(hmenu, " + IdVar +") , instance, null)" + newline
windowcontrols = windowcontrols + " " + "SendMessage " + "hwnd" + Label_Name +", WM_SETFONT, cast(wparam, h_font), TRUE" + newline
End Sub
Sub MakeControls
Dim newline As String
newline = Chr(13,10)
Dim i As Integer
Dim temp As String
Dim temp2 As String
Dim controltype As String
Dim startline As Integer
Dim endline As Integer
windowcontrols = windowcontrols + "Sub create_wnd_content0(byval parent as hwnd)" + newline
For i = 1 To 1000
temp = LCase(codelines(i))
temp2 = FieldStr(temp, Chr(34), 1)
If temp2 = "endoffile" Then
Exit For
EndIf
If TallyStr(temp2, "qform") = 1 Then
startline = i
controltype = "qform"
EndIf
If TallyStr(temp2, "qedit") = 1 Then
startline = i
controltype = "qedit"
EndIf
If TallyStr(temp2, "qbutton") = 1 Then
startline = i
controltype = "qbutton"
EndIf
If TallyStr(temp2, "qlabel") = 1 Then
startline = i
controltype = "qlabel"
EndIf
If (TallyStr(temp2, "end") = 1 And TallyStr(temp2, "create") = 1) Then
endline = i
MakeOneControl(controltype,startline,endline)
EndIf
Next
windowcontrols = windowcontrols + "End Sub" + newline
End Sub
Sub MakeOneControl(qc As String, sl As Integer, el As Integer)
If qc = "qbutton" Then MakeButton(sl,el)
If qc = "qedit" Then MakeEdit(sl,el)
If qc = "qlabel" Then MakeLabel(sl,el)
End Sub
string.bas
Code: Select all
' ********************************** Module 1 - String Functions *************************************
Function ReplaceStr(TheString as string, RWhat as string, RWith as string) as string
Dim tempv as string
tempv=""
Dim lw as integer
lw=Len(RWhat)
Dim i as integer
for i=1 to Len(TheString)
if mid$(TheString,i,lw)=RWhat then
tempv=tempv+RWith
i=i+lw-1
else
tempv=tempv+mid$(TheString,i,1)
end if
Next i
ReplaceStr=tempv
End Function
Function TallyStr(TheString as string, RWhat as string) as integer
Dim As Integer i,j
j=0
Dim lw as integer
lw=Len(RWhat)
for i=1 to Len(TheString)
if mid$(TheString,i,lw)=RWhat then
j=j+1
i=i+lw-1
else
end if
Next i
TallyStr=j
End Function
Function FieldStr(TheString as string, RWhat as String, index as integer) as string
Dim jindex as integer
jindex=TallyStr(TheString,RWhat)
If jindex+1< index then
FieldStr=""
Exit Function
end if
Dim a(jindex+1) as integer
Dim As integer i,j
j=1
Dim lw as integer
lw=Len(RWhat)
for i=1 to Len(TheString)
if mid$(TheString,i,lw)=RWhat then
a(j)=i
j=j+1
i=i+lw-1
else
end if
Next i
If index=0 then
FieldStr=""
Exit Function
End if
If Index=jindex+1 then
FieldStr=mid$(TheString,a(index-1)+lw,len(TheString)-a(index-1)-lw+1)
Exit Function
End if
If index=1 then
FieldStr=mid$(TheString,1,a(1)-1)
Exit Function
End if
FieldStr=mid$(TheString,a(index-1)+lw,a(index)-a(index-1)-lw)
End Function
' ****************************** end of module 1 *************************************