Small GUI Maker

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
gbos
Posts: 35
Joined: Feb 09, 2006 12:58

Small GUI Maker

Post by gbos »

A little program that takes as input code of this form - similar to rapidq :-)

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
and produces output that can be compiled with freebasic.

Image

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 *************************************
Don
Posts: 14
Joined: May 07, 2007 23:41
Location: USA

How to use?

Post by Don »

Looks very interesting.

Could you describe how to use GUI-maker, step-by-step?

I must be doing something wrong, because I can not seem to get the TEST example generated with GUI-maker.

Don
notthecheatr
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Post by notthecheatr »

While there are a lot of these, I gotta say it looks nice.
gbos
Posts: 35
Joined: Feb 09, 2006 12:58

Re: How to use?

Post by gbos »

Don wrote:Looks very interesting.

Could you describe how to use GUI-maker, step-by-step?

I must be doing something wrong, because I can not seem to get the TEST example generated with GUI-maker.

Don
Hi.

First you have to paste the test example form code (ctrl+v) into the first richedit window (make sure there is at least one empty line at the end of the code by hiting the enter key as else the program may ignore the last 'end create' line and the generated code may seem unfinished), then you hit the translate button and the freebasic code is generated into the second richedit window. You can copy the generated freebasic code to the clipboard by hitting the copy button.

The translated code is tested and compiled in both 0.18 and 0.17 versions of the compiler (althought it gives some Implicit conversion warnings).
Don
Posts: 14
Joined: May 07, 2007 23:41
Location: USA

GUI-maker

Post by Don »

gbos:

Thanks for the reply. GUI-maker is working fine for me now.

How closely does the syntax for GUI-maker source follow that of RapidQ, at least for the button controls it is capable of using?
gbos
Posts: 35
Joined: Feb 09, 2006 12:58

Post by gbos »

Unfortunately it is impossible for me to follow exactly the syntax of rapidq as the Qbutton control alone has dozens of properties, methods and events in rapidq that I can’t cover because as I said my knowledge of API is totally inadequate. My intension is to make something that creates working API code from “English type Language” and to use it as a head start if I wanted to create a simple window with some basic controls. From there I can alter and add the properties, events and methods manually. Yesterday I added some more controls and now the program can create menus, richedit,timer and open file dialogs. I will test the code for bugs and I will upload it probably next weekend (after adding some more controls also).

For example this code now

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
 
Create menu as QMenu
	Insert 0, "&File"
	Append 0,"mynew","&New"
	Append 0,"myopen","&Open..."
	Separator 0
	InsChild 0,2,"&Project"
	Append 2,"myPnew","&New"
	Append 2,"myPopen","&Open.."
	Append 0,"myexit","&Exit"
	Insert 2, "&Edit"
	Append 2,"mycopy","&Copy"
	Append 2,"mypaste","&Paste"
End Create

Create RichEdit1 as QRichEdit
	Text = "RichEdit Control"
	Top = 20
	left = 140
	width = 100
	Height = 100
End Create

Create Dialog as QOpenFile
	Title = "Open a File"
	Filter = "All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0"
End Create

Create mytimer as QTimer
	Interval = 10000
	OnTimer = TheTime
End Create
Is translated to this one with only the manuall addition of the contents of sub1 and sub thetime

Code: Select all

'' Made with GUI_Maker Version alpha 0.1


#define WIN_INCLUDEALL

'' Sub Declarations

Declare Sub Sub1()
Declare Sub S_mynew()
Declare Sub S_myopen()
Declare Sub S_mypnew()
Declare Sub S_mypopen()
Declare Sub S_myexit()
Declare Sub S_mycopy()
Declare Sub S_mypaste()

Declare Sub S_dialog(Byref filetoopen as string)

Declare Sub TheTime()

'' Include

#include once "windows.bi"
#include once "win/commctrl.bi"

'' Declare

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)

'' Names of Window Classes

Const WND_CLASS_NAME0 = "my_wnd_class_name_0"

'' Global Data

Dim Shared instance as hmodule
Dim Shared h_font as HFONT


'' Menu Module Header

Type TMENU
	hnd as HMENU
End Type

Type TMENUITEM
	title as string
	id as integer
End Type

Const MENUID_BASE = 100
Const MAXMENUS = 10
Const MAXMENUITEMS = 50

Declare Sub init_menus(byval hWnd as HWND)
Declare Sub menu_insert(byval hmenu as HMENU, byval submenu as integer, title as string, byval flags as integer = 0)
Declare Sub menu_append(byval submenu as integer, byval id as integer, title as string, byval flags as integer = 0)
Declare Sub menu_separator(byval submenu as integer)

Dim Shared submenuTB(0 to MAXMENUS) as TMENU
Dim Shared menuitemTB(0 to MAXMENUITEMS-1) as TMENUITEM


Declare Function file_getname( byval hWnd as HWND ) as string

Const IDC_edit1 = 1000
Const IDC_button1 = 1001
Const IDC_label1 = 1002

Const mynew = 100
Const myopen = 101
Const mypnew = 102
Const mypopen = 103
Const myexit = 104
Const mycopy = 105
Const mypaste = 106
Const IDC_richedit1 = 1003
Const IDC_mytimer = 1004

Dim Shared hwndform As hwnd  '' Form Handle

Dim Shared hwndedit1  As hwnd
Dim Shared hwndbutton1  As hwnd
Dim Shared hwndlabel1  As hwnd
Dim Shared hwndrichedit1  As hwnd
Dim Shared hwndmytimer  As hwnd


'' Menu Module Subs

Sub menu_insert(byval hmenu as HMENU, byval submenu as integer, title as string, byval flags as integer = 0)
	With submenuTB(submenu)
		.hnd = CreatePopupMenu( )
		InsertMenu(hmenu, submenu, MF_BYPOSITION Or MF_POPUP Or MF_STRING or flags, cuint( .hnd ), title)
	End With
End Sub

Sub menu_append(byval submenu as integer, byval id as integer, title as string, byval flags as integer = 0)
	With menuitemTB(id-MENUID_BASE)
		.id = id
		.title = title
		AppendMenu(submenuTB(submenu).hnd, MF_STRING or flags, id, title)
	End With
End Sub

Sub menu_separator(byval submenu as integer)
	AppendMenu(submenuTB(submenu).hnd, MF_SEPARATOR, 0, NULL)
End Sub


Sub init_menus(byval hWnd as HWND)
	Dim menu as HMENU
	menu = CreateMenu( )
	menu_insert(menu, 0,"&file")
	menu_append( 0,mynew,"&new")
	menu_append( 0,myopen,"&open...")
	menu_separator(  0 )
	menu_insert(submenuTB( 0 ).hnd,2,"&project")
	menu_append( 2,mypnew,"&new")
	menu_append( 2,mypopen,"&open..")
	menu_append( 0,myexit,"&exit")
	menu_insert(menu, 2,"&edit")
	menu_append( 2,mycopy,"&copy")
	menu_append( 2,mypaste,"&paste")
	SetMenu(hWnd, menu)
	DrawMenuBar(hWnd)
End Sub


Function file_getname( byval hWnd as HWND ) as string
	Dim ofn as OPENFILENAME
	Dim filename as zstring * MAX_PATH+1
	With ofn
	.lStructSize 		= sizeof( OPENFILENAME )
	.hwndOwner	 		= hWnd
	.hInstance	 		= GetModuleHandle( NULL )
	.lpstrFilter 		= strptr( !"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0" )
	.lpstrCustomFilter 	= NULL
	.nMaxCustFilter 	= 0
	.nFilterIndex 		= 1
	.lpstrFile			= @filename
	.nMaxFile			= sizeof( filename )
	.lpstrFileTitle		= NULL
	.nMaxFileTitle		= 0
	.lpstrInitialDir	= NULL
	.lpstrTitle			= @"Open a File"
	.Flags				= OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
	.nFileOffset		= 0
	.nFileExtension		= 0
	.lpstrDefExt		= NULL
	.lCustData			= 0
	.lpfnHook			= NULL
	.lpTemplateName		= NULL
	End With
	If( GetOpenFileName( @ofn ) = FALSE ) Then
	Return ""
	Else
	Return filename
	End If
End Function

'' 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
SetTimer(hwndform,IDC_mytimer,5000,@TheTime())

End message_loop

'' Register Windows 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

'' Create Window #0

Function create_wnd0 As hwnd
	Dim wnd As hwnd
	wnd = CreateWindowEx(&h00000100, WND_CLASS_NAME0, "Hello World", &h14CF0000, CW_USEDEFAULT, CW_USEDEFAULT, 300, 200, null, null, instance, null)
	hwndform = wnd
	ShowWindow wnd, SW_SHOWNORMAL
	UpdateWindow wnd
	Return wnd
End Function


Sub create_wnd_content0(byval parent as hwnd)
	hwndedit1 = CreateWindowEx(&h00000200, "Edit", "Test", &h50010080, 20, 20, 100, 25, parent, cast(hmenu, IDC_edit1) , instance, null)
	SendMessage hwndedit1, WM_SETFONT, cast(wparam, h_font), TRUE
	hwndbutton1 = CreateWindowEx(&h00000000, "Button", "Click Me", &h50010001, 20, 100, 100, 30, parent, cast(hmenu, IDC_button1) , instance, null)
	SendMessage hwndbutton1, WM_SETFONT, cast(wparam, h_font), TRUE
	hwndlabel1 = CreateWindowEx(&h00000000, "Static", "Welcome!!", &h50000300, 20, 70, 100, 25, parent, cast(hmenu, IDC_label1) , instance, null)
	SendMessage hwndlabel1, WM_SETFONT, cast(wparam, h_font), TRUE
	hwndrichedit1 = CreateWindowEx(&h00000200, "RichEdit", "RichEdit Control", &h500110C4, 140, 20, 100, 100, parent, cast(hmenu, IDC_richedit1) , instance, null)
	SendMessage hwndrichedit1, WM_SETFONT, cast(wparam, h_font), TRUE
End Sub

'' window procedure #0

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
			init_menus(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
		Case WM_COMMAND
			Select Case loword(w_param)
			Case IDC_button1
			Sub1()
			Case mynew
			S_mynew()
			Case myopen
			S_myopen()
			Case mypnew
			S_mypnew()
			Case mypopen
			S_mypopen()
			Case myexit
			S_myexit()
			Case mycopy
			S_mycopy()
			Case mypaste
			S_mypaste()
			Case Else
			End Select
	Case Else
		Return DefWindowProc(thiswnd, message, w_param, l_param)
	End Select
	Return 0
End Function

'' Sub Codes

Sub Sub1()
	Dim a As String
	S_dialog(a)
	MessageBox(NULL, a, "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_mynew()
	MessageBox(NULL, "mynew Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_myopen()
	MessageBox(NULL, "myopen Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_mypnew()
	MessageBox(NULL, "mypnew Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_mypopen()
	MessageBox(NULL, "mypopen Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_myexit()
	MessageBox(NULL, "myexit Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_mycopy()
	MessageBox(NULL, "mycopy Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub

Sub S_mypaste()
	MessageBox(NULL, "mypaste Sub Executed!", "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub


Sub S_dialog(Byref filetoopen as string)
	filetoopen = file_getname(hwndform)
End Sub

Sub TheTime()
	SetWindowText(hwndEdit1,str$(rnd()))
	' KillTimer(hwndform, IDC_mytimer)
End Sub

JohnK
Posts: 279
Joined: Sep 01, 2005 5:20
Location: Earth, usually
Contact:

Post by JohnK »

I just noticed this post. Very interesting because you are making a RapidQ to FB converter. I admire your motivation here, but that will be no simple task! Maybe you know about Eodor's GUI library, which is also pretty close to RapidQ syntax. I would really like to contribute to these projects, ohhhh, but the time....


-JK
Post Reply