Small GUI Maker

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

Small GUI Maker

Postby gbos » Oct 25, 2007 9:16

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?

Postby Don » Oct 25, 2007 19:00

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:

Postby notthecheatr » Oct 25, 2007 22:35

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?

Postby gbos » Oct 26, 2007 6:03

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

Postby Don » Oct 26, 2007 14:41

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

Postby gbos » Oct 27, 2007 7:56

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:

Postby JohnK » Nov 02, 2007 3:39

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

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests