March 29, 2024, 12:11:06 AM

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


Visual Designer

Started by WayneA, June 14, 2010, 02:15:08 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

WayneA

June 14, 2010, 02:15:08 PM Last Edit: March 04, 2011, 04:37:45 PM by WayneA
/* Proof of concept for a multi-language visual IDE with configurable code generation.. This demonstrates how code generation and
the visual designer aspect could function... I've taken what I believe to be a novel approach to code generation here.
Basically instead of maintaining in a struct/type various aspects of the window/controls I grab them dynamically using API
This allows a unique feature of being able to grab the handle of any window currently open and generate code for that window
even if its not in the visual designer application.
Not at all ready for primetime, but the basics are here. From my research and testing I believe grabbing the font from a control/window
using the same approach as grabbing other properties may not work. I have not found any method that provides usable info.. Though there
is one last promising lead that I am following.
I didn't initially plan to release this code this early, so its not too readable.. Unfortunately I don't have the time to continue on this
project while I look for work.. There may be some functions that are not used.. I had to entirely restructure it one point and I did it
without cleaning up entirely..
There is one known bug with the following code, if a control with child controls (like listview with a header) is added, the child controls
will be generated as top-level control. This is simple to fix (confirm the parent of the control is the correct hwnd) I just haven't done it
yet as the fix is simple i've been focused on other issues.
Not sure how I will ensure a consistent Z-order yet. Not too concerned with this issue, I can thinking several possible solutions.
*/

$Include "windows.inc"
AutoDefine "Off"
Enum MenuIDs
mnuFileNew=101
mnuFileImpWin
mnuFileExWin
mnuFileExit
mnuSrcGen
EndEnum
Enum ControlIDs
mnuNewBtn=101
mnuNewEdit
mnuNewListBox
mnuNewMonthCal
EndEnum
Const MAX_WINS=10
Const CID_WIDTH=1
Const CID_HEIGHT=2
Const GWL_USERDATA=-21
Const GWL_WNDPROC=-4
Const WM_DESTROY=2
Const WM_LBUTTONDOWN=0x201
Const WM_LBUTTONUP=0x202
Const WM_NCLBUTTONDOWN=0xA1
Const WM_CONTEXTMENU=0x7B
Const WM_NCHITTEST=0x84
Const WM_SETCURSOR=0x20
Const WM_SIZING=0x214
Const WM_EXITSIZEMOVE=0x232
Const WM_KILLFOCUS=8
Const WM_PAINT=0xF
Const TPM_RETURNCMD=0x100
Const HTCaption=2
Declare Import,GetSysColor(nIndex As Int),Int
Declare Import,GetWindowLongA(hWnd As UInt,nIndex As UInt),UInt
Declare Import,SetWindowLongA(hWnd As UInt,nIndex As UInt,dwNewLong As UInt),UInt
Declare Import,EnumChildWindows(hWndParent As UInt,lpEnumProc As UInt,lParam As UInt),Int
Declare Import,EnableWindow(hWnd As UInt,bEnable As Int),Int
Declare Import,CallWindowProcA(lpPrevWndFunc As Int,hWnd As UInt,Msg As UInt,wParam As UInt,lParam As UInt),Int
Declare Import,DefWindowProcA(hWnd As UInt,Msg As UInt,wParam As UInt,lParam As UInt),Int
Declare Import,TrackPopupMenu(hMenu As UInt,uFlags As UInt,x As Int,y As Int,nReserved As Int,hWnd As UInt,lpRC As UInt)
Declare Import,DestroyMenu(hMenu As UInt),Int
Declare Import,LoadCursorA(hInstance As Int,lpCursorName As Int),Int
Declare Import,InvalidateRect(hwnd As Int,lpRect As UInt,bErase As UInt),Int
Declare Import,EnumChildWindowsA Alias EnumChildWindows(hWndParent As UInt,lpEnumProc As UInt,lParam[] As String),Int
Dim wndMain,wndEdit[10] As Window
Dim dlgSource As Dialog
Dim globalX,globalY As Int
Dim _Shared_Counter=0 As UInt
Dim globePtr As Pointer
OpenWindow wndMain,0,0,650,650,@MDIFrame|@Size|@MinBox|@MaxBox,null,"Visual Designer",&wndMainProc
CreateDialog dlgSource,0,0,300,202,0x80C80080,0,"Source",&dlgSourceProc
Control dlgSource,@Edit,"",0,0,300,179,0x50B110C4,1
Control dlgSource,@Button,"Okay",107,182,70,20,0x50010001,2
AttachMainMenu(wndMain)
ShowWindow wndMain,@SWMaximized
WaitUntil wndMain=0
End

Sub wndMainProc
Select @Message
Case @IDCreate
CenterWindow wndMain
Case @IDMenuPick
Select @MenuNum
Case mnuFileNew
If NewMDIChild(wndMain,wndEdit)=-1 Then
MessageBox wndMain,"Unable to open a new window.","Error"
EndIf
Case mnuSrcGen
DoModal dlgSource,wndMain
EndSelect
Case @IDCloseWindow
CloseWindow wndMain
EndSelect
EndSub

Sub dlgSourceProc
Select @Message
Case @IDInitDialog
SetControlText dlgSource,1,GetWinOutline(_GetFocus(),"wndMain")
Case @IDControl
If @ControlID=2 Then CloseDialog dlgSource
Case @IDCloseWindow
CloseDialog dlgSource
EndSelect
EndSub

Sub NewMDIChild(parent As Window,win[] As Window,Opt maxChildren=MAX_WINS As Int),Int
Dim i,index=-1 As Int
For i=0 to maxChildren-1
If win[i].hWnd=0 Then
OpenWindow win[i],@UseDefault,0,0,0,@Size|@MinBox|@MaxBox,parent,Using("Window 0##",i+1),&MDIChildProc
SetWindowColor win[i],GetSysColor(15)
SetClientSize(win[i].hWnd,400,400)
index=i
BreakFor
EndIf
Next i
If index>=0 Then
'OnMessage win[index],@IDCloseWindow,&OnChildClose
'OnMenuPick win[index],mnuNewBtn,&OnNewControl
'OnMenuPick win[index],mnuNewEdit,&OnNewControl
'OnMenuPick win[index],mnuNewListBox,&OnNewControl
'OnMessage win[index],@IDRButtonUp,&OnRButtonUp
SetUserData(win[index],null)
EndIf
Return index
EndSub

Sub MDIChildProc
Select @Message
Case @IDMenuPick
CreateControl(#<Window>globePtr,@MenuNum,globalX,globalY)
Case @IDRButtonUp
globalX=@MouseX
globalY=@MouseY
globePtr=@HitWindow
ContextMenu #<Window>@HitWindow,@MouseX,@MouseY
MenuItem "New &Button",0,mnuNewBtn
MenuItem "New &Edit",0,mnuNewEdit
MenuItem "New &ListBox",0,mnuNewListBox
MenuItem "New &Calendar",0,mnuNewMonthCal
EndMenu
Case @IDCloseWindow
CloseWindow #<Window>@HitWindow
EndSelect
EndSub

Sub OnNewControl(),Int
'MessageBox 0,Str$(@MenuNum),Using("x # y #",globalX,globalY)
'If CreateControl(#<Window>@HitWindow,@MenuNum,globalX,globalY)=-1 Then
'There was an error!?
'EndIf
'At this point all the windows messages are no longer reliable.
CreateControl(#<Window>@HitWindow,@MenuNum,globalX,globalY)
Return null
EndSub

Sub CreateControl(win As Window,cType As Int,Opt left=0 As Int,Opt top=0 As Int,Opt width=-1 As Int,Opt height=-1 As Int),Int
Dim w,h,cCount=0,ret As Int
Dim ClassName="" As String
'If width and height aren't specified, a default for each control type will be used.
If win.hWnd=0 Then Return 0
ClassName=GetControlType(cType)
If width=-1 Then w=GetDefSize(cType,CID_WIDTH) Else w=width
If height=-1 Then h=GetDefSize(cType,CID_HEIGHT) Else h=height
cCount=GetUserData(win)+1
SetUserData(win,GetUserData(win)+1)
ret=ControlExEx(win,ClassName,ClassName,left,top,w,h,GetDefStyle(cType,False),GetDefStyle(cType,True),cCount)
Return ret
EndSub

Sub OnRButtonUp(),Int
globalX=@MouseX
globalY=@MouseY
DebugPrint "OnRButtonUp hwnd "+Hex$(#<Window>@HitWindow.hWnd)
ContextMenu #<Window>@HitWindow,@MouseX,@MouseY
MenuItem "New &Button",0,mnuNewBtn
MenuItem "New &Edit",0,mnuNewEdit
MenuItem "New &ListBox",0,mnuNewListBox
EndMenu
Return null
EndSub

Sub OnChildClose(),Int
CloseWindow #<Window>@HitWindow
Return null
EndSub

Sub GetControlType(cIndex As Int),String
Select cIndex
Case mnuNewBtn
Return "Button"
Case mnuNewEdit
Return "Edit"
Case mnuNewListBox
Return "ListBox"
Case mnuNewMonthCal
Return "SysMonthCal32"
Default
Return ""
EndSelect
EndSub

Sub GetDefSize(cIndex As Int,Dimension As Int),Int
Select cIndex
Case mnuNewBtn
If Dimension=CID_WIDTH Then Return 50
If Dimension=CID_HEIGHT Then Return 25
Case mnuNewEdit
If Dimension=CID_WIDTH Then Return 100
If Dimension=CID_HEIGHT Then Return 25
Case mnuNewListBox
Return 100
Case mnuNewMonthCal
Return 200
EndSelect
Return 50
EndSub

Sub GetDefStyle(cIndex As Int,bExStyle As Int),UInt
Select cIndex
Case mnuNewBtn
Return null
Case mnuNewEdit
If bExStyle Then
Return null
EndIf
Return @Border
Case mnuNewListBox
If bExStyle Then
Return null
EndIf
Return @CTListTabs|@CTListNotify|@Border
EndSelect
Return null
EndSub

Sub AttachMainMenu(win As Window)
BeginInsertMenu win,0
MenuTitle "&File"
MenuItem "&New Window\tCtrl+N",0,mnuFileNew
Separator
BeginPopup "&Import..."
MenuItem "*.win",0,mnuFileImpWin
EndPopup
BeginPopup "Export..."
MenuItem "*.win",0,mnuFileExWin
EndPopup
Separator
MenuItem "E&xit\tAlt+F4",0,mnuFileExit
MenuTitle "&Source"
MenuItem "Generate &Source",0,mnuSrcGen
EndMenu
EndSub

Sub ControlProc(hWnd As UInt,uMsg As UInt,wParam As UInt,lParam As UInt),Int
Dim proc=GetUserDataA(hWnd) As UInt
Select uMsg
Case WM_DESTROY
SetWindowLongA(hWnd,GWL_WNDPROC,proc)
Case WM_NCRBUTTONUP
'Context menu
Case WM_NCHITTEST
Return HitTest(hWnd,lParam)
EndSelect
Return CallWindowProcA(proc,hWnd,uMsg,wParam,lParam)
EndSub

Sub HitTest(hWnd As UInt,lParam As UInt),UInt
Dim rc As WINRECT
Dim pt As Point
pt.x=LOWORD(lParam)
pt.y=HIWORD(lParam)
_ScreenToClient(hWnd,pt)
_GetWindowRect(hWnd,rc)
_MapWindowPoints(HWND_DESKTOP,__GetParent(hWnd),&rc,2)
If pt.y<4 And pt.x<4 Then
Return HTTOPLEFT
ElseIf pt.y<4 And pt.x>=(rc.right-rc.left-4) Then
Return HTTOPRIGHT
ElseIf pt.y >=(rc.bottom-rc.top-4) And pt.x>=(rc.right-rc.left-4) Then
Return HTBOTTOMRIGHT
ElseIf pt.x<4 And pt.y>=(rc.bottom -rc.top-4) Then
Return HTBOTTOMLEFT
ElseIf pt.y<4
Return HTTOP
ElseIf pt.x>=(rc.right-rc.left-4) Then
Return HTRIGHT
ElseIf pt.y>=(rc.bottom-rc.top-4) Then
Return HTBOTTOM
EndIf
Return HTCAPTION
EndSub

Sub __GetParent(hWnd As UInt),UInt
Return GetWindowLongA(hWnd,GWL_HWNDPARENT)
EndSub

Sub GetUserData(win As Window,Opt cid=0 As Int),UInt
If cid Then
' Return GetWindowLongA(GetControlHandle(win,cid),GWL_USERDATA)
Return _GetProp(GetControlHandle(win,cid),"GWL_USERDATA")
EndIf
Return GetWindowLongA(win.hWnd,GWL_USERDATA)
'Return _GetProp(win.hWnd,"GWL_USERDATA")
EndSub

Sub GetUserDataA(hWnd As UInt),UInt
Return GetWindowLongA(hWnd,GWL_USERDATA)
'Return _GetProp(hWnd,"GWL_USERDATA")
EndSub

Sub SetUserData(win As Window,dat As UInt,Opt cid=0 As Int),UInt
If cid Then
Return SetWindowLongA(GetControlHandle(win,cid),GWL_USERDATA,dat)
'Return _SetProp(GetControlHandle(win,cid),"GWL_USERDATA",dat)
EndIf
Return SetWindowLongA(win.hWnd,GWL_USERDATA,dat)
'Return _SetProp(win.hWnd,"GWL_USERDATA",dat)
EndSub

Sub ControlExEx(parent As Window,ClassName As String,Title As String,left As Int,top As Int,width As Int,height As Int,style As Int,exStyle As Int,id As UInt),UInt
Dim handle As UInt
handle=ControlEx(parent,ClassName,Title,left,top,width,height,style,exStyle,id)
If handle Then
SetUserData(parent,SetWindowLongA(handle,GWL_WNDPROC,&ControlProc),id)
EnumChildWindows(handle,&DisableChildEnumProc,null)
Return handle
EndIf
Return null
EndSub

Sub DisableChildEnumProc(hWnd As UInt,lParam As UInt),Int
EnableWindow(hWnd,False)
Return True
EndSub

Sub LOWORD(in As UInt),Word
Return in & 0xFFFF
EndSub

Sub HIWORD(in As UInt),Word
Return (in >> 16) & 0xFFFF
EndSub

Sub GetWinOutline(hWnd As UInt,WindowName As String,Opt ParentName="null" As String),String
Dim ctrls[62] As String
Dim WinOutline[63*255+(63*2)] As IString
Dim i As Int
'By default subs can have 32768 bytes in local vars, this totals to 32005. We can handle 62 controls without any problems.
'As a rule I try not to rely on altering this build option. When this function is finished it will no longer rely
'on a static string array.
WinOutline=GenWindowCode(hWnd,WindowName,ParentName)+"\n"
EnumChildWindowsA(hWnd,&EnumChildProc,ctrls)
For i=0 to _Shared_Counter-1
WinOutline+=ctrls[i]+"\n"
Next i
_Shared_Counter=0
Return WinOutline
EndSub

Sub GenControlCode(hWnd As UInt,cid As Int,Parent As String),String
Dim Style,ExStyle,hWndParent As UInt
Dim Text,ClassName As String
Dim WndRect,ParentRect As WINRECT
Dim FrameSize As Int
Style=GetWindowLongA(hWnd,GWL_STYLE)
ExStyle=GetWindowLongA(hWnd,GWL_EXSTYLE)
hWndParent=GetWindowLongA(hWnd,GWL_HWNDPARENT)
_GetWindowText(hWnd,Text,254)
_GetClassName(hWnd,ClassName,254)
_GetWindowRect(hWnd,WndRect)
_GetWindowRect(hWndParent,ParentRect)
FrameSize=_GetSystemMetrics(SM_CXFRAME)

'This caused problems when there was line breaks in the edit control. Just easier this way.
If InStr(UCase$(ClassName),"EDIT") Then Text=""

'This removes the "ownerdrawn" style from all controls.. This was mainly an issue with @Button controls but in general it
'would mean that any control with this flag just wouldn't be drawn in the generated program.
If (Style & 0xB) Then Style=Style||0xB
Return "ControlEx("+Parent+",\""+ClassName+"\",\""+Text+"\","+LTrim$(Str$(WndRect.left-ParentRect.left-FrameSize))+_
","+LTrim$(Str$(WndRect.top-ParentRect.top-_GetSystemMetrics(SM_CYCAPTION)-FrameSize))+_
","+LTrim$(Str$(WndRect.right-WndRect.left))+","+LTrim$(Str$(WndRect.bottom-WndRect.top))+_
",0x"+Hex$(Style)+",0x"+Hex$(ExStyle)+","+LTrim$(Str$(cid))+")"
EndSub

Sub GenWindowCode(hWnd As UInt,Name As String,Opt Parent="null" As String),String
Dim Style,hWndParent As UInt
Dim Text As String
Dim WndRect,ParentRect As WINRECT
Style=GetWindowLongA(hWnd,GWL_STYLE)
hWndParent=GetWindowLongA(hWnd,GWL_HWNDPARENT)
_GetWindowText(hWnd,Text,254)
_GetWindowRect(hWnd,WndRect)
_GetWindowRect(hWndParent,ParentRect)
Return "OpenWindow("+Name+",0,0,"+LTrim$(Str$(WndRect.right-WndRect.left))+","+LTrim$(Str$(WndRect.bottom-WndRect.top))+",0x"+_
Hex$(Style)+","+Parent+",\""+Text+"\",&"+Name+"Proc)"
EndSub

Sub EnumChildProc(hWnd As UInt,lParam[] As String)
lParam[_Shared_Counter]=GenControlCode(hWnd,_Shared_Counter+1,"wndMain")
_Shared_Counter++
'This condition will prevent overwriting memory until the WinOutliner is updated
If _Shared_Counter>61 Then Return False
Return True
EndSub

Sub SetClientSize(win As Int,w As Int,h As Int,Opt fmenu=0 As Int),Int
WINRECT rec
Int style,exstyle,err
style=0:exstyle=0:err=0
style=GetWindowLongA(win,GWL_STYLE)
If style
style=style & not(WS_OVERLAPPED)
exstyle=GetWindowLongA(win,GWL_EXSTYLE)
If style=0 | exstyle=0 Then Return 0
EndIf
err=_SetRect(rec,0,0,w,h)
If err
err=_AdjustWindowRectEx(rec,style,fmenu,exstyle)
If err
err=_SetWindowPos(win,0,0,0,rec.right+Int(ABS(rec.left)),rec.bottom+Int(ABS(rec.top)),SWP_NOMOVE)
EndIf
EndIf
Return err
EndSub

Sub WinErrMsg(x As Int),String
Dim buffer[640] As IString
_FormatMessage(0x1000,0,x,0,buffer,639,0)
If Len(buffer) Then
Return "Error"+Str$(x)+" = "+buffer
Else
Return "Unknown error code:"+Str$(x)
EndIf
EndSub

99 little bugs in the code,
99 bugs in the code,
Fix one bug,
Compile again,
104 little bugs in the code...

All code I post is in the public domain.

Guilect

Thanks for sharing WayneA.

Techno

Wayne,

Can not Build or Compiled with IWBasic v2.0 and IWBasic 3.0. Can you please send here an worked version that can compiled with the new compilers.

Thanks

Compiling Resources...
No Errors

Compiling...
iwb_visual_designer_v0.5.iwb
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (106) Error: syntax error - Window
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (68) Warning: Argument 9 (wndMainProc) does not match the declaration of IWBWNDPROC
Different return type: none, should be int
File: C:\IWBDev3\bin\iwbstd.incc (10) Warning: See previous declaration of IWBWNDPROC
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (77) Warning: See previous declaration of wndMainProc
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (69) Warning: Argument 9 (dlgSourceProc) does not match the declaration of IWBDLGPROC
Different return type: none, should be int
File: C:\IWBDev3\bin\iwbstd.incc (9) Warning: See previous declaration of IWBDLGPROC
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (95) Warning: See previous declaration of dlgSourceProc
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (84) Error: Undefined function NewMDIChild
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (106) Error: syntax error - Window
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (108) Error: Undefined variable maxChildren
File: C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb (109) Error: Undefined variable win
Error(s) in compiling "C:\Users\Public\Documents\Development\IWBasic\Projects\roundtable\Visual Designer\v0.5\iwb_visual_designer_v0.5.iwb"
Build Failed

LarryMc

You tell me what you think is wrong first. ;D
LarryMc
Larry McCaughn :)
Author of IWB+, Custom Button Designer library, Custom Chart Designer library, Snippet Manager, IWGrid control library, LM_Image control library

Techno

Quote from: LarryMc on May 27, 2015, 07:57:10 AM
You tell me what you think is wrong first. ;D

I don't understand this errors Larry.
I want to see how it works in runtime and study.
Great compiler and IDE the IWBasic v3.0 nice features !

h3kt0r

Just remove the [] after the "win" in the "Sub NewMDIChild(parent As Window,win As Window,Opt maxChildren=MAX_WINS As Int),Int".
Should compile afterward. Well, it worked for me.
Nice code. Thank you for sharing this !