$APPTYPE GUI
$TYPECHECK ON
$OPTION ICON "RapidFRM.ico"
$INCLUDE <RapidQ2.INC>
$INCLUDE "RapidFRM.inc"
$RESOURCE ObjData AS "component.data"
$RESOURCE HelpData AS "Help.data"
$RESOURCE ALLButtons AS "ToolBar.bmp"
$RESOURCE BlankIco AS "Blank.ico"
CONST VER="v1.43"
CONST CRLF=CHR$(13)+CHR$(10)
CONST QU=CHR$(34)
$DEFINE STAND_ALONE 0
$DEFINE INPUT_FILE 1
$DEFINE INPUT_CLIPBRD 2
$DEFINE MAX_OBJECTS 64
$DEFINE MAX_FORMS 8
$DEFINE MAX_MENUS 8
$DEFINE NON_VISIBLE 31
$DEFINE MAX_TOOLBTNS 45
$DEFINE MAINMENU 1
$DEFINE POPMENU 2
CONST SWP_NOSIZE=&H1
CONST SWP_NOMOVE=&H2
CONST SWP_NOZORDER=&H4
CONST SWP_DRAWFRAME=&H20
CONST FLAGS=(SWP_NOSIZE + SWP_NOMOVE)
CONST SW_FLAGS=(SWP_NOZORDER + SWP_DRAWFRAME)
CONST SWP_FLAGS=(SW_FLAGS + SWP_NOMOVE)
CONST GCL_HBRBACKGROUND = (-10)
DECLARE SUB Initialise
DECLARE SUB FormPopUp(X AS INTEGER, Y AS INTEGER)
DECLARE SUB ObjPopUp(X AS INTEGER, Y AS INTEGER)
DECLARE SUB DesignTabChange
DECLARE SUB SelectComboChange
DECLARE SUB ComponentTabChange
DECLARE SUB NoClose(Action AS INTEGER)
DECLARE SUB HelpBtnClick
DECLARE SUB ProgramEnd
DECLARE SUB LoadProject
DECLARE SUB ShowProject
DECLARE SUB BuildFormCode
DECLARE SUB LoadSingleButtons
DECLARE SUB LoadToolbar
DECLARE SUB DrawToolBar(Index AS INTEGER,Pressed AS INTEGER,Rect AS QRECT,Sender AS QHEADER)
DECLARE SUB ButnCmd(idx AS INTEGER, Sender AS QHEADER)
DECLARE SUB ShowToolbarHint(X AS INTEGER,Y AS INTEGER,Shift AS INTEGER,Sender AS QHEADER)
DECLARE SUB ToolTabChange
DECLARE SUB AboutClick
DECLARE SUB Deselect
DECLARE SUB AlignObject
DECLARE SUB MouseCopyObject
DECLARE SUB MousePasteObject
DECLARE SUB DeleteObject
DECLARE SUB CopyToClipBrd
DECLARE SUB SelectionToClipBrd
DECLARE SUB SaveFile
DECLARE SUB ExitNoUpdate
DECLARE SUB SaveAndExit
DECLARE SUB FormsMouseMove(X AS LONG, Y AS LONG, Shift AS LONG, Sender AS QFORM)
DECLARE SUB ReSizeForm(Sender AS QFORM)
DECLARE SUB PaintFormGrid(Sender AS QFORM)
DECLARE SUB CaretMseDown(MouseButton AS LONG, X AS LONG, Y AS LONG, Shift AS LONG, Sender AS QPANEL)
DECLARE SUB CaretMseUp(MouseButton AS LONG, X AS LONG, Y AS LONG, Shift AS LONG, Sender AS QPANEL)
DECLARE SUB DrawCarets(tgtRect AS QRECT)
DECLARE SUB CaretsOnTop
DECLARE SUB HideCarets
DECLARE SUB ScanMouse
DECLARE SUB MouseResizeObject(hWnd AS LONG)
DECLARE SUB MouseMoveObject(hWnd AS LONG)
DECLARE FUNCTION GetObjectFromHandle(hWnd AS LONG) AS INTEGER
DECLARE SUB UpdatePropGrid(idx AS INTEGER)
DECLARE SUB EditPropertyField(Col AS INTEGER, Row AS INTEGER, CanSelect AS INTEGER, Sender AS QSTRINGGRID)
DECLARE SUB EditMethodField(Col AS INTEGER, Row AS INTEGER, CanSelect AS INTEGER, Sender AS QSTRINGGRID)
DECLARE SUB EditEventField(Col AS INTEGER, Row AS INTEGER, CanSelect AS INTEGER, Sender AS QSTRINGGRID)
DECLARE SUB FieldUpdateCombo(Sender AS QCOMBOBOX)
DECLARE SUB FieldUpdateEdit(Key AS WORD, Shift AS INTEGER, Sender AS QEDIT)
DECLARE SUB ReDrawComponent
DECLARE SUB HideEditCtls(Col AS INTEGER, Row AS INTEGER, State AS INTEGER, Rect AS QRECT, Sender AS QSTRINGGRID)
DECLARE SUB MenuEditor
DECLARE SUB AddMainMenu
DECLARE SUB AddPopupMenu
DECLARE SUB UpdateProjectMenu
DECLARE SUB ParentChange
DECLARE SUB OptionChange
DECLARE SUB AddNewObject
DECLARE SUB AddNewForm
DECLARE FUNCTION GetDefaultProperties(ComponentID AS INTEGER) AS STRING
DEFINT ProjectMode
DEFINT ErrorCondition
DEFINT ComponentCount
DEFSTR ProjectFile
DIM ProjectStream AS QMEMORYSTREAM
DIM ComponentRef AS QMEMORYSTREAM
DIM HelpRef AS QMEMORYSTREAM
DEFINT StartOfBlocks, EndOfBlocks
DEFSTR FormsList
DEFSTR KnownsList
DEFSTR MainMenuList
DEFSTR PopMenuList
DEFSTR UnknownList
DEFSTR FwdDeclares
DEFSTR ExistDeclares
DEFSTR MenuUpdateStr
DIM ObjectList(0 TO MAX_OBJECTS) AS STRING
DIM Forms(1 TO MAX_FORMS) AS QFORM
DIM FormHandles(1 TO MAX_FORMS) AS LONG
DIM NonVisForm AS QFORM
DIM Buttons AS QBITMAP
DIM TBar(0 TO 2) AS QHEADER
DEFSTR ToolbarHint
DIM xtraBtns(0 TO 3) AS QCOOLBTN
DIM Carets(1 TO 8) AS QPANEL
DEFINT ActiveCaret, ReSizing
DIM CaretsTimer AS QTIMER
DIM Scan AS QTIMER
DIM DelayTimer AS QTIMER
DIM ColorPick AS QColorDlg
DEFINT MouseSaveX, MouseSaveY
DEFINT CurrentObject, CurrentForm
DEFINT ObjectIndex, FrmIndex, NonVIndex
DEFINT NewObjectID
DEFINT EdIndex, RichIndex, LabelIndex, ButnIndex, CoolIndex, OvalIndex
DEFINT CheckIndex, RadioIndex, ComboIndex, ListBIndex, PanIndex, GrpBoxIndex
DEFINT TabContIndex, ScrollBIndex, ScrllBarIndex, StringGIndex, ListVIndex
DEFINT HeadIndex, SplitIndex, StatIndex, GlassIndex, GaugeIndex, TrackBIndex
DEFINT OutLnIndex, DirTIndex, FileLIndex, TreeVIndex, OLEContIndex
DEFINT OpenDlgIndex, SaveDlgIndex, FontDlgIndex, ColorDlgIndex
DEFINT ImageIndex, ImgListIndex, CanvasIndex, OleObjIndex
DEFINT TimerIndex, SockIndex, FStreamIndex, MStreamIndex, FontIndex, SQLIndex
DEFINT BmpIndex, RegIndex, StrListIndex
DEFINT MainMenuIndex, PopUpIndex
CREATE designMenu AS QPOPUPMENU
CREATE mnuAlign AS QMENUITEM
CAPTION="Align to Grid"
OnClick=AlignObject
END CREATE
CREATE mnuCopy AS QMENUITEM
CAPTION="Copy Component"
OnClick=MouseCopyObject
END CREATE
CREATE mnuPaste AS QMENUITEM
CAPTION="Paste Component"
OnClick=MousePasteObject
END CREATE
CREATE mnuSep1 AS QMENUITEM
CAPTION="-"
END CREATE
CREATE mnuDelete AS QMENUITEM
CAPTION="Delete Component"
OnClick=DeleteObject
END CREATE
CREATE mnuSep2 AS QMENUITEM
CAPTION="-"
END CREATE
CREATE mnuQuit AS QMENUITEM
CAPTION="Exit Form Designer"
OnClick=ExitNoUpdate
END CREATE
END CREATE
CREATE codeMenu AS QPOPUPMENU
CREATE edCopy AS QMENUITEM
CAPTION="Copy all to clipboard"
OnClick=CopyToClipBrd
END CREATE
CREATE partCopy AS QMENUITEM
CAPTION="Copy selection to clipboard"
OnClick=SelectionToClipBrd
END CREATE
CREATE edSave AS QMENUITEM
CAPTION="Save to File"
OnClick=SaveFile
END CREATE
CREATE mnuSep3 AS QMENUITEM
CAPTION="-"
END CREATE
CREATE edPsave AS QMENUITEM
CAPTION="Save Project && Exit"
OnClick=SaveAndExit
END CREATE
CREATE mnuSep4 AS QMENUITEM
CAPTION="-"
END CREATE
CREATE edQuit AS QMENUITEM
CAPTION="Exit Form Designer"
OnClick=ExitNoUpdate
END CREATE
END CREATE
CREATE MainForm AS QFORM
Width=Screen.Width
Height=Screen.Height-28
Left=0
Top=0
CAPTION="RapidFRM "+VER
BorderStyle=bsSingle
DelBorderIcons(2)
OnShow=Initialise
OnClose=ExitNoUpdate
CREATE stat AS QSTATUSBAR
SizeGrip=False
AddPanels "", "", "", "", ""
Panel(0).Width=MainForm.ClientWidth\4
Panel(1).Width=MainForm.ClientWidth\4
Panel(2).Width=MainForm.ClientWidth\4-48
END CREATE
CREATE ToolBox AS QPANEL
Width=MainForm.ClientWidth
Height=60
Align=alTop
CAPTION=""
CREATE ToolBarTab AS QTABCONTROL
Width=15*26+9
Height=54
Left=10
Top=2
Tabheight=16
TabWidth=4*26
TabInactiveColor=&hbfbfbf
Font.Size=8
Font.COLOR=&h1f1fbf
Addtabs "Standard","Additional","Special"
OnChange=ToolTabChange
END CREATE
END CREATE
CREATE DesignPan AS QPANEL
Width=Screen.Width*3\4
Height=MainForm.ClientHeight-ToolBox.Height-stat.Height
Left=0
Top=ToolBox.Height
CREATE DesignTab AS QTABCONTROL
Width=DesignPan.ClientWidth
Height=DesignPan.ClientHeight
Align=alTop
TabHeight=24
TabWidth=100
TabInactiveColor=&hbfbfbf
Font.COLOR=&h7f7f00
AddTabs "Form Designer","Form Code","Menus","Help"
OnChange=DesignTabChange
CREATE FormsPanel AS QPANEL
Align=alClient
BevelWidth=2
BorderStyle=bvLowered
COLOR=&hdfdfdf
END CREATE
CREATE CodeText AS QRICHEDIT
Align=alClient
ScrollBars=ssBoth
COLOR=&hffffef
Font.Name="courier"
Font.Size=10
Font.COLOR=&hbf1f1f
PlainText=True
PopUpMenu=codeMenu
Visible=False
END CREATE
CREATE HelpText AS QRICHEDIT
Align=alClient
ScrollBars=ssVertical
COLOR=&hefffef
Font.Name="courier"
Font.Size=10
Font.COLOR=&h004f00
PlainText=True
ReadOnly=True
Visible=False
END CREATE
END CREATE
END CREATE
CREATE ComponentPan AS QPANEL
Left=DesignPan.Width
Top=DesignPan.Top
Width=Screen.Width-DesignPan.Width
Height=DesignPan.Height
CREATE SelectionCombo AS QCOMBOBOX
Align=alTop
Height=24
Width=ComponentPan.ClientWidth-4
Style=csDropDownList
OnChange=SelectComboChange
END CREATE
CREATE ComponentTab AS QTABCONTROL
Align=alClient
AddTabs "Properties","Methods","Events"
OnChange=ComponentTabChange
CREATE PropertyGrid AS QSTRINGGRID
Align=alClient
RowCount=100
DefaultRowHeight=16
FixedRows=1
FixedCols=1
ColCount=2
ColWidths(0)=100
ColWidths(1)=ComponentTab.ClientWidth-120
ColumnStyle(0)=gcsNone
ColumnStyle(1)=gcsNone
Cell(0,0)="PROPERTY"
Cell(1,0)="Value"
ScrollBars=ssVertical
OnSelectCell=EditPropertyField
OnDrawCell=HideEditCtls
END CREATE
CREATE MethodGrid AS QSTRINGGRID
Align=alClient
RowCount=100
DefaultRowHeight=16
FixedRows=1
FixedCols=1
ColCount=2
ColWidths(0)=100
ColWidths(1)=ComponentTab.ClientWidth-120
ColumnStyle(0)=gcsNone
ColumnStyle(1)=gcsNone
Cell(0,0)="METHOD"
Cell(1,0)="Assignment"
ScrollBars=ssVertical
OnSelectCell=EditMethodField
OnDrawCell=HideEditCtls
END CREATE
CREATE EventGrid AS QSTRINGGRID
Align=alClient
RowCount=100
DefaultRowHeight=16
FixedRows=1
FixedCols=1
ColCount=2
ColWidths(0)=100
ColWidths(1)=ComponentTab.ClientWidth-120
ColumnStyle(0)=gcsNone
ColumnStyle(1)=gcsNone
Cell(0,0)="EVENT"
Cell(1,0)="Subroutine"
ScrollBars=ssNone
Visible=False
OnSelectCell=EditEventField
OnDrawCell=HideEditCtls
END CREATE
CREATE FieldEdit AS QEDIT
Left=108
Width=PropertyGrid.ColWidths(1)-4
Height=PropertyGrid.DefaultRowHeight
OnKeyDown=FieldUpdateEdit
Visible=False
END CREATE
CREATE FieldBox AS QCOMBOBOX
Left=108
Width=PropertyGrid.ColWidths(1)-24
Height=PropertyGrid.DefaultRowHeight
DropDownCount=5
Style=csDropDownList
OnChange=FieldUpdateCombo
Visible=False
END CREATE
END CREATE
END CREATE
END CREATE
CREATE MenuPanel AS QPANEL
PARENT=DesignTab
Align=alClient
BevelWidth=2
BorderStyle=bvLowered
COLOR=&hdfffff
Visible=False
CREATE MenuText AS QRICHEDIT
Width=MenuPanel.ClientWidth\2
Height=MenuPanel.ClientHeight-150
Left=(MenuPanel.Width-MenuText.Width)\2
Top=MenuPanel.Top+100
ScrollBars=ssVertical
COLOR=&hcfefef
Font.Name="courier"
Font.Size=10
Font.COLOR=&h1f3f3f
PlainText=True
ReadOnly=True
END CREATE
CREATE btnMMenu AS QBUTTON
Width=145
Left=MenuText.Left
Top=20
CAPTION="Add QMainMenu"
Font.COLOR=&h009f00
Font.Bold=3
OnClick=AddMainMenu
END CREATE
CREATE cbMMenu AS QCOMBOBOX
Left=MenuText.Left
Top=50
Font.COLOR=0
OnChange=ParentChange
END CREATE
CREATE btnPMenu AS QBUTTON
Width=145
Left=MenuText.Left+MenuText.Width-145
Top=20
CAPTION="Add QPopupMenu"
Font.COLOR=&h009f00
Font.Bold=3
OnClick=AddPopupMenu
END CREATE
CREATE btnUpdate AS QBUTTON
Width=100
Height=60
Left=MenuText.Left+MenuText.Width\2 - 50
Top=20
CAPTION="Insert code"
Font.COLOR=&hbf
Font.Bold=3
Tag=0
OnClick=UpdateProjectMenu
END CREATE
CREATE chkMenu AS QCHECKBOX
Width=180
Left=MenuText.Left+MenuText.Width\2 - 90
Top=110
CAPTION="Add 'non-defaults' as comments"
Font.COLOR=0
Checked=True
OnClick=OptionChange
END CREATE
END CREATE
MainForm.SHOWMODAL
SUB UpdateStatus
DEFSTR tstr, strHandle
tstr=FIELD$(ObjectList(CurrentObject),"~",1)
strHandle=FIELD$(tstr,"|",3)
stat.Panel(0).CAPTION="Selection: Index="+STR$(CurrentObject)+" Object="+FIELD$(tstr,"|",5) _
+" [Handle="+strHandle+"]"
stat.Panel(1).CAPTION="Active Form = "+STR$(CurrentForm)
END SUB
SUB Deselect
DEFLNG hWnd
DEFINT i
DEFSTR tstr
HideCarets
FieldEdit.Visible=False
FieldBox.Visible=False
DesignTab.TabIndex=0
DesignTabChange
IF designMenu.Tag>0 THEN
designMenu.Tag=0
FOR i=1 TO MAX_FORMS
Forms(i).Cursor=crDefault
NEXT i
END IF
hWnd=FormHandles(CurrentForm)
FOR i=0 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF VAL(FIELD$(tstr,"|",3))=hWnd THEN
IF CurrentObject<>i THEN
CurrentObject=i
UpdatePropGrid(i)
UpdateStatus
END IF
EXIT FOR
END IF
NEXT i
NewObjectID=-1
END SUB
FUNCTION IsParentType(ThisIdx AS INTEGER) AS INTEGER
DEFSTR tstr
tstr=FIELD$(ObjectList(ThisIdx),"~",1)
SELECT CASE FIELD$(tstr,"|",2)
CASE "QPANEL","QTABCONTROL","QGROUPBOX","QSCROLLBOX"
Result=True
CASE ELSE
Result=False
END SELECT
END FUNCTION
FUNCTION FillSiblingList(StartIndex AS INTEGER) AS STRING
DEFINT i
DEFSTR tstr, strParent, sibResult
sibResult=""
tstr=FIELD$(ObjectList(StartIndex),"~",1)
strParent=FIELD$(tstr,"|",3)
FOR i=StartIndex+1 TO ObjectIndex-1
IF IsParentType(i)=False THEN
tstr=FIELD$(ObjectList(i),"~",1)
IF strParent=FIELD$(tstr,"|",6) THEN
sibResult=sibResult+STR$(i)+"|"
END IF
END IF
NEXT i
FOR i=StartIndex+1 TO ObjectIndex-1
IF IsParentType(i)=True THEN
tstr=FIELD$(ObjectList(i),"~",1)
IF strParent=FIELD$(tstr,"|",6) THEN
sibResult=sibResult+STR$(i)+"|"
END IF
END IF
NEXT i
Result=sibResult
END FUNCTION
SUB DeleteThisChain(StartIdx AS INTEGER)
DEFINT i, cnt, nxt
DEFSTR tstr, sibString
DEFLNG hWnd
sibString=FillSiblingList(StartIdx)
cnt=TALLY(sibString,"|")
IF cnt>0 THEN
FOR i=1 TO cnt
nxt=VAL(FIELD$(sibString,"|",i))
tstr=FIELD$(ObjectList(nxt),"~",1)
SELECT CASE FIELD$(tstr,"|",2)
CASE "QPANEL","QTABCONTROL","QGROUPBOX","QSCROLLBOX"
CASE ELSE
hWnd=VAL(FIELD$(tstr,"|",3))
ShowWindow(hWnd,0)
ObjectList(nxt)=""
END SELECT
NEXT i
FOR i=1 TO cnt
nxt=VAL(FIELD$(sibString,"|",i))
tstr=FIELD$(ObjectList(nxt),"~",1)
SELECT CASE FIELD$(tstr,"|",2)
CASE "QPANEL","QTABCONTROL","QGROUPBOX","QSCROLLBOX"
DeleteThisChain(nxt)
END SELECT
NEXT i
END IF
tstr=FIELD$(ObjectList(StartIdx),"~",1)
hWnd=VAL(FIELD$(tstr,"|",3))
ShowWindow(hWnd,0)
ObjectList(StartIdx)=""
END SUB
SUB PropertyFieldUpdate(pField AS STRING, vField AS STRING, position AS INTEGER)
DEFSTR propString, token, tstr, resString
DEFINT i, j, k, cnt
propString=ObjectList(CurrentObject)
cnt=TALLY(propString,"~"): resString=""
FOR i=1 TO cnt
token=FIELD$(propString,"~",i)
IF FIELD$(token,"|",1)=pField THEN
k=TALLY(token,"|")+1
tstr=""
FOR j=1 TO k
IF j=position THEN
tstr=tstr+vField+"|"
ELSE
tstr=tstr+FIELD$(token,"|",j)+"|"
END IF
NEXT j
token=LEFT$(tstr,LEN(tstr)-1)
END IF
resString=resString+token+"~"
NEXT i
ObjectList(CurrentObject)=resString
END SUB
SUB RefreshObject(hWnd AS LONG, nuRect AS QRECT)
DEFINT Width, Height
DEFLNG Parnt
DIM tPoint AS PointAPI
Width=nuRect.Right-nuRect.Left
Height=nuRect.Bottom-nuRect.Top
tPoint.x=nuRect.Left: tPoint.y=nuRect.Top
Parnt=GetParent(hWnd)
ScreenToClient(Parnt,tPoint)
PropertyFieldUpdate("Left", STR$(tPoint.x),4)
PropertyFieldUpdate("Top", STR$(tPoint.y),4)
PropertyFieldUpdate("Width", STR$(Width),4)
PropertyFieldUpdate("Height", STR$(Height),4)
UpdatePropGrid(CurrentObject)
ReDrawComponent
END SUB
SUB AlignObject
DEFINT i, Top, Left, deltaX, deltaY
DEFSTR tstr, propStr
HideCarets
tstr=ObjectList(CurrentObject)
FOR i=1 TO TALLY(tstr,"~")
propStr=FIELD$(tstr,"~",i)
SELECT CASE FIELD$(propStr,"|",1)
CASE "Left": Left=VAL(FIELD$(propStr,"|",4))
CASE "Top": Top=VAL(FIELD$(propStr,"|",4))
END SELECT
NEXT i
deltaX=(Left MOD 10): Left=Left-deltaX
IF deltaX>4 THEN Left=Left+10
deltaY=(Top MOD 10): Top=Top-deltaY
IF deltaY>4 THEN Top=Top+10
PropertyFieldUpdate("Left",STR$(Left),4)
PropertyFieldUpdate("Top",STR$(Top),4)
UpdatePropGrid(CurrentObject)
ReDrawComponent
END SUB
SUB MouseCopyObject
DEFINT i
DEFSTR tstr
tstr=FIELD$(ObjectList(CurrentObject),"~",1)
designMenu.Tag=VAL(FIELD$(tstr,"|",1))
IF designMenu.Tag>0 THEN
FOR i=1 TO MAX_FORMS
Forms(i).Cursor=crDrag
NEXT i
END IF
END SUB
SUB MousePasteObject
DEFINT i
FOR i=1 TO MAX_FORMS
Forms(i).Cursor=crDefault
NEXT i
IF designMenu.Tag>0 THEN
NewObjectID=designMenu.Tag
designMenu.Tag=0
SetCursorPos(MouseSaveX,MouseSaveY)
MouseSaveX=0: MouseSaveY=0
AddNewObject
END IF
END SUB
SUB DeleteObject
DEFINT i, j, cnt
DEFLNG hWnd
DEFSTR tstr
IF CurrentObject=0 THEN
MESSAGEBOX("You cannot delete this form!","Delete Component",&h10)
EXIT SUB
END IF
HideCarets
DeleteThisChain(CurrentObject)
i=CurrentObject
FOR j=i+1 TO ObjectIndex
IF ObjectList(j)<>"" THEN
ObjectList(i)=ObjectList(j)
ObjectList(j)=""
INC i
END IF
NEXT j
SelectionCombo.Clear
FOR i=0 TO MAX_OBJECTS
tstr=ObjectList(i)
IF tstr="" THEN EXIT FOR
tstr=FIELD$(tstr,"~",1)
SelectionCombo.AddItems FIELD$(tstr,"|",5)+" ["+FIELD$(tstr,"|",2)+"]"
NEXT i
ObjectIndex=i
hWnd=Forms(CurrentForm).Handle
FOR i=0 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF hWnd=VAL(FIELD$(tstr,"|",3)) THEN
CurrentObject=i
UpdatePropGrid(CurrentObject)
EXIT FOR
END IF
NEXT i
END SUB
SUB MouseResizeObject(hWnd)
DEFINT OldX, OldY, DeltaX, DeltaY
DIM ObjRect AS QRECT
OldX=screen.MOUSEX: OldY=screen.MOUSEY
GetWindowRect(hWnd,ObjRect)
DO
DeltaX=OldX-screen.MOUSEX: DeltaY=OldY-screen.MOUSEY
IF DeltaX<>0 OR DeltaY<>0 THEN
SELECT CASE ActiveCaret
CASE 1: ObjRect.Left=ObjRect.Left-DeltaX: ObjRect.Top=ObjRect.Top-DeltaY
CASE 2: ObjRect.Left=ObjRect.Left-DeltaX
CASE 3: ObjRect.Left=ObjRect.Left-DeltaX: ObjRect.Bottom=ObjRect.Bottom-DeltaY
CASE 4: ObjRect.Bottom=ObjRect.Bottom-DeltaY
CASE 5: ObjRect.Right=ObjRect.Right-DeltaX: ObjRect.Bottom=ObjRect.Bottom-DeltaY
CASE 6: ObjRect.Right=ObjRect.Right-DeltaX
CASE 7: ObjRect.Right=ObjRect.Right-DeltaX: ObjRect.Top=ObjRect.Top-DeltaY
CASE 8: ObjRect.Top=ObjRect.Top-DeltaY
END SELECT
DrawCarets(ObjRect)
OldX=screen.MOUSEX: OldY=screen.MOUSEY
END IF
DOEVENTS
LOOP UNTIL ReSizing=False
RefreshObject(hWnd,ObjRect)
END SUB
SUB MouseMoveObject(hWnd)
DEFINT OldX, OldY, DeltaX, DeltaY
DEFLNG parnt
DIM ObjRect AS QRECT
GetWindowRect(hWnd,ObjRect)
DrawCarets(ObjRect)
OldX=screen.MOUSEX: OldY=screen.MOUSEY
DO
DeltaX=OldX-screen.MOUSEX: DeltaY=OldY-screen.MOUSEY
IF DeltaX<>0 OR DeltaY<>0 THEN
ObjRect.Left=ObjRect.Left-DeltaX
ObjRect.Right=ObjRect.Right-DeltaX
ObjRect.Top=ObjRect.Top-DeltaY
ObjRect.Bottom=ObjRect.Bottom-DeltaY
DrawCarets(ObjRect)
OldX=screen.MOUSEX: OldY=screen.MOUSEY
END IF
DOEVENTS
LOOP UNTIL gMouseBtns=0
RefreshObject(hWnd,ObjRect)
END SUB
FUNCTION GetObjectFromHandle(hWnd AS LONG) AS INTEGER
DEFINT i
DEFSTR token
FOR i=0 TO MAX_OBJECTS
IF ObjectList(i)="" THEN EXIT FOR
token=FIELD$(ObjectList(i),"~",1)
IF VAL(FIELD$(token,"|",3))=hWnd THEN
Result=i
EXIT FUNCTION
END IF
NEXT i
Result=-1
END FUNCTION
FUNCTION WhichFormIsActive(hWnd AS LONG) AS INTEGER
DEFINT i
Result=0
FOR i=1 TO MAX_FORMS
IF hWnd=FormHandles(i) THEN
Result=i
EXIT FOR
END IF
NEXT i
END FUNCTION
FUNCTION IsObjectAForm(ObjIndex AS INTEGER) AS INTEGER
DEFSTR tstr
tstr=FIELD$(ObjectList(ObjIndex),"~",1)
IF VAL(FIELD$(tstr,"|",1))=0 THEN
Result=True
ELSE
Result=False
END IF
END FUNCTION
FUNCTION IsObjectMovable(ObjIndex AS INTEGER) AS INTEGER
DEFINT id
DEFSTR tstr
tstr=FIELD$(ObjectList(ObjIndex),"~",1)
id=VAL(FIELD$(tstr,"|",1))
IF (id=0) OR (id>=NON_VISIBLE) THEN
Result=False
ELSE
Result=True
END IF
END FUNCTION
SUB ResetComponentTab
FieldEdit.Visible=False: FieldBox.Visible=False
ComponentTab.TabIndex=0: ComponentTabChange
END SUB
SUB ScanMouse
DEFLNG hWnd
DEFINT ObjIndex
scan.Enabled=False
IF ReSizing THEN
stat.Panel(3).CAPTION="L"
stat.Panel(0).CAPTION="Resizing "+FIELD$(ObjectList(CurrentObject),"|",5)
hWnd=VAL(FIELD$(ObjectList(CurrentObject),"|",3))
MouseResizeObject(hWnd)
UpdateStatus
ELSEIF gMouseBtns=LMOUSE_BTN THEN
stat.Panel(3).CAPTION="L"
hWnd=WindowFromPoint(Screen.MOUSEX, Screen.MOUSEY)
ObjIndex=GetObjectFromHandle(hWnd)
IF (ObjIndex >= 0) AND (ObjIndex <= MAX_OBJECTS) THEN
BringWindowToTop(FormHandles(CurrentForm))
ResetComponentTab
IF NewObjectID>0 THEN
AddNewObject
ELSE
IF ObjIndex<>CurrentObject THEN
CurrentObject=ObjIndex
UpdatePropGrid(ObjIndex)
END IF
IF IsObjectMovable(CurrentObject) THEN
MouseMoveObject(hWnd)
ELSE
HideCarets
END IF
END IF
END IF
ELSEIF gMouseBtns=RMOUSE_BTN THEN
stat.Panel(3).CAPTION="R"
ResetComponentTab
hWnd=WindowFromPoint(Screen.MOUSEX, Screen.MOUSEY)
ObjIndex=GetObjectFromHandle(hWnd)
IF (ObjIndex >= 0) AND (ObjIndex <= MAX_OBJECTS) THEN
HideCarets
IF IsObjectAForm(ObjIndex) THEN
FormPopUp(Screen.MOUSEX, Screen.MOUSEY)
ELSE
ObjPopUp(Screen.MOUSEX, Screen.MOUSEY)
END IF
END IF
ELSEIF gMouseBtns=0 THEN
stat.Panel(3).CAPTION=""
END IF
DOEVENTS
scan.Enabled=True
END SUB
SUB CaretMseDown(MouseButton,X,Y,Shift,Sender)
ActiveCaret=Sender.Tag: ReSizing=True
END SUB
SUB CaretMseUp(MouseButton,X,Y,Shift,Sender)
ActiveCaret=0: ReSizing=False
END SUB
SUB DrawCarets(tgtRect)
DIM tPoint AS PointAPI
DEFINT i, Left, Top, Width, Height
DEFINT midX, midY
tPoint.x=tgtRect.Left: tPoint.y=tgtRect.Top
ScreenToClient(Forms(CurrentForm).Handle, tPoint)
Left=tPoint.x: Top=tPoint.y
Width=tgtRect.Right-tgtRect.Left
Height=tgtRect.Bottom-tgtRect.Top
midX=Width\2-3: midY=Height\2-3
Carets(1).Top=Top-6: Carets(1).Left=Left-6: Carets(1).Visible=True
Carets(2).Top=Top+midY: Carets(2).Left=Left-6: Carets(2).Visible=True
Carets(3).Top=Top+Height: Carets(3).Left=Left-6: Carets(3).Visible=True
Carets(4).Top=Top+Height: Carets(4).Left=Left+midX: Carets(4).Visible=True
Carets(5).Top=Top+Height: Carets(5).Left=Left+Width: Carets(5).Visible=True
Carets(6).Top=Top+midY: Carets(6).Left=Left+Width: Carets(6).Visible=True
Carets(7).Top=Top-6: Carets(7).Left=Left+Width: Carets(7).Visible=True
Carets(8).Top=Top-6: Carets(8).Left=Left+midX: Carets(8).Visible=True
CaretsTimer.Enabled=True
END SUB
SUB HideCarets
DEFINT i
CaretsTimer.Enabled=False
FOR i=1 TO 8
Carets(i).Visible=False
NEXT i
ActiveCaret=0
END SUB
SUB CaretsOnTop
DEFINT i
FOR i=1 TO 8
SetWindowPos(Carets(i).Handle,0,0,0,0,0,FLAGS)
NEXT i
END SUB
SUB ObjPopUp(X, Y)
mnuAlign.Enabled=True
mnuCopy.Enabled=True
IF designMenu.Tag>0 THEN
mnuPaste.Enabled=True
MouseSaveX=X: MouseSaveY=Y
ELSE
mnuPaste.Enabled=False
MouseSaveX=0: MouseSaveY=0
END IF
mnuDelete.Enabled=True
designMenu.Popup(X,Y)
END SUB
SUB FormPopUp(X, Y)
mnuAlign.Enabled=False
mnuCopy.Enabled=False
IF designMenu.Tag>0 THEN
mnuPaste.Enabled=True
MouseSaveX=X: MouseSaveY=Y
ELSE
mnuPaste.Enabled=False
MouseSaveX=0: MouseSaveY=0
END IF
mnuDelete.Enabled=False
designMenu.Popup(X,Y)
END SUB
SUB Initialise
DEFSTR tstr
DEFINT i, wStyle
DEFINT curs(1 TO 8)={-8, -9, -6, -7, -8, -9, -6, -7}
DIM mem AS QMEMORYSTREAM
SetWindowLong(MainForm.Handle, -8, 0)
SetWindowLong(Application.Handle, -8, MainForm.Handle)
lpHookProc=CODEPTR(MouseProc)
ThreadID=GetCurrentThreadId()
hHook=SetWindowsHookEx(7,CODEPTR(MouseProc),0,ThreadID)
ComponentRef.Position=0
ComponentRef.ExtractRes(Resource(0))
HelpRef.Position=0
HelpRef.ExtractRes(Resource(1))
Buttons.BMPHandle=ALLButtons
LoadSingleButtons
LoadToolBar
DesignTab.TabIndex=0
DesignTabChange
FOR i=1 TO 8
Carets(i).Tag=i
Carets(i).Height=6: Carets(i).Width=6
Carets(i).Cursor=curs(i): Carets(i).COLOR=&h3f7f00
Carets(i).Visible=False
Carets(i).OnMouseDown=CaretMseDown
Carets(i).OnMouseUp=CaretMseUp
NEXT i
ActiveCaret=0
CaretsTimer.Interval=250
CaretsTimer.Enabled=False
CaretsTimer.OnTimer=CaretsOnTop
Scan.Interval=50
Scan.Enabled=False
Scan.OnTimer=ScanMouse
NonVisForm.Left=Screen.Width\2: NonVisForm.Top=0
NonVisForm.Width=100
NonVisForm.Height=80
NonVisForm.DelBorderIcons 1,2
NonVisForm.CAPTION="Non-Visible Components"
NonVisForm.IcoHandle=BlankIco
NonVisForm.OnClose=NoClose
wStyle=GetWindowLong(NonVisForm.Handle, GWL_EXSTYLE)
SetWindowLong(NonVisForm.Handle, GWL_EXSTYLE, (wStyle OR WS_EX_LAYERED))
SetLayeredWindowAttributes(NonVisForm.Handle, 0, 127, 2)
SetWindowLong(NonVisForm.Handle, GWL_HWNDPARENT, MainForm.Handle)
FOR i=1 TO MAX_FORMS
wStyle=GetWindowLong(Forms(i).Handle, GWL_STYLE)
SetWindowLong(Forms(i).Handle, GWL_STYLE, (wStyle OR WS_CHILD))
SetParent(Forms(i).Handle, FormsPanel.Handle)
Forms(i).Left=0
Forms(i).Top=0
Forms(i).CAPTION="Form"+STR$(i)
Forms(i).Visible=False
Forms(i).AutoScroll=False
Forms(i).IcoHandle=BlankIco
Forms(i).OnPaint=PaintFormGrid
Forms(i).OnResize=ReSizeForm
Forms(i).OnMouseMove=FormsMouseMove
Forms(i).OnClose=NoClose
Forms(i).PopUpMenu=designMenu
FormHandles(i)=Forms(i).Handle
NEXT i
Forms(1).CAPTION="Main Form"
ColorPick.Style=cdFullOpen
ColorPick.Left=ComponentPan.Left-CHOOSER_FULL
ColorPick.Top=ComponentPan.Top+(ComponentPan.Height-CHOOSER_HEIGHT)\2
FwdDeclares=" ": FormsList=" ": KnownsList=" "
MainMenuList=" ": PopMenuList=" ": UnknownList=" "
FrmIndex=1: ObjectIndex=0: ComponentCount=0
IF COMMANDCOUNT=0 THEN
ProjectMode=STAND_ALONE
edPsave.Enabled=False
AddNewForm
INC ComponentCount
ELSE
ProjectFile=LTRIM$(RTRIM$(COMMAND$(1)))
IF UCASE$(ProjectFile)="CLIPBOARD" THEN
MainForm.CAPTION=MainForm.CAPTION+" [input from clipboard]"
ProjectMode=INPUT_CLIPBRD
ELSE
MainForm.CAPTION=MainForm.CAPTION+" ["+ProjectFile+"]"
ProjectMode=INPUT_FILE
END IF
edCopy.Enabled=False: partCopy.Enabled=False
edSave.Enabled=False
LoadProject
DelayTimer.Interval=200
DelayTimer.Enabled=True
DelayTimer.OnTimer=ShowProject
END IF
END SUB
SUB AboutClick
DEFSTR tstr
tstr="RapidFRM - Form Designer/Editor for RapidQ"+CRLF
tstr=tstr+"Copyright (c) 2010 D Homans"+CRLF
tstr=tstr+"Contact: d_homans@yahoo.com.au"+CRLF+CRLF
tstr=tstr+"Based on original code published by Jordi Ramos"+CRLF+CRLF
tstr=tstr+"You may freely copy/modify this code, for your own"+CRLF
tstr=tstr+"purposes, provided that you give recognition to the"+CRLF
tstr=tstr+"two persons mentioned above."+CRLF+CRLF
tstr=tstr+"As with all 'FREE' software, no warranties or guarantees,"+CRLF
tstr=tstr+"of any kind whatsoever, are offered with this distribution."+CRLF
tstr=tstr+"Use at your own risk!"
MESSAGEBOX(tstr,"RapidFRM "+VER,&h40)
END SUB
SUB HelpBtnClick
DesignTab.Tag=0
DesignTab.TabIndex=3
DesignTabChange
END SUB
SUB FillHelp(idx AS INTEGER)
DEFINT i
DEFSTR tstr, token
HelpText.Clear
token="#"+STR$(idx)
HelpRef.Position=0
FOR i=1 TO HelpRef.LineCount
tstr=HelpRef.ReadLine
IF FIELD$(tstr," ",1)=token THEN EXIT FOR
NEXT i
tstr=tstr-token
HelpText.AddStrings tstr
INC i
FOR i=i TO HelpRef.LineCount
tstr=HelpRef.ReadLine
IF LEFT$(tstr,1)="#" THEN EXIT FOR
HelpText.AddStrings tstr
NEXT i
END SUB
FUNCTION GetParentForm(objIndx AS INTEGER) AS INTEGER
DEFINT i, max=objIndx
DEFSTR tstr, parntStr, objStr=""
WHILE objStr<>"0"
tstr=FIELD$(ObjectList(max),"~",1)
parntStr=FIELD$(tstr,"|",6)
FOR i=0 TO max-1
tstr=FIELD$(ObjectList(i),"|",3)
IF tstr=parntStr THEN
objStr=FIELD$(ObjectList(i),"|",1)
max=i
EXIT FOR
END IF
NEXT i
WEND
Result=max
END FUNCTION
SUB SelectComboChange
DEFINT i, frmIdx
DEFLNG hWnd
DEFSTR tstr
DIM rect AS QRECT
IF SelectionCombo.ItemIndex=CurrentObject THEN EXIT SUB
HideCarets
CurrentObject=SelectionCombo.ItemIndex
tstr=FIELD$(ObjectList(CurrentObject),"~",1)
IF VAL(FIELD$(tstr,"|",1))<NON_VISIBLE THEN
IF FIELD$(tstr,"|",1)<>"0" THEN
frmIdx=GetParentForm(CurrentObject)
tstr=FIELD$(ObjectList(frmIdx),"~",1)
END IF
hWnd=VAL(FIELD$(tstr,"|",3))
FOR i=1 TO FrmIndex-1
IF hWnd=FormHandles(i) THEN
IF i<>CurrentForm THEN
CurrentForm=i
FOR i=1 TO 8
Carets(i).PARENT=Forms(CurrentForm)
NEXT i
END IF
EXIT FOR
END IF
NEXT i
tstr=FIELD$(ObjectList(CurrentObject),"~",1)
IF FIELD$(tstr,"|",1)<>"0" THEN
hWnd=VAL(FIELD$(tstr,"|",3))
GetWindowRect(hWnd,rect)
DrawCarets(rect)
END IF
END IF
UpdatePropGrid(CurrentObject)
END SUB
SUB ComponentTabChange
FieldEdit.Visible=False
FieldBox.Visible=False
SELECT CASE ComponentTab.TabIndex
CASE 0
PropertyGrid.Visible=True
MethodGrid.Visible=False
EventGrid.Visible=False
CASE 1
PropertyGrid.Visible=False
MethodGrid.Visible=True
EventGrid.Visible=False
CASE 2
PropertyGrid.Visible=False
MethodGrid.Visible=False
EventGrid.Visible=True
END SELECT
END SUB
SUB DesignTabChange
DEFINT i
ComponentTab.TabIndex=0
ComponentTabChange
NonVisForm.Visible=False
FOR i=1 TO FrmIndex-1
Forms(i).Visible=False
NEXT i
FormsPanel.Visible=False
MenuPanel.Visible=False
CodeText.Visible=False
HelpText.Visible=False
SELECT CASE DesignTab.TabIndex
CASE 0
DesignTab.Tag=1
FormsPanel.Visible=True
IF NonVIndex>0 THEN
NonVisForm.Visible=True
END IF
FOR i=1 TO FrmIndex-1
Forms(i).Visible=True
NEXT i
CASE 1
DesignTab.Tag=2
CodeText.Visible=True
BuildFormCode
CASE 2
DesignTab.Tag=3
MenuEditor
CASE 3
HelpText.Visible=True
FillHelp(DesignTab.Tag)
END SELECT
END SUB
SUB NoClose(Action)
Action=False
END SUB
SUB CleanUp
DEFINT i
DEFLNG hWnd
DEFSTR tstr
FOR i=1 TO ObjectIndex-1
tstr=ObjectList(i)
IF tstr<>"" THEN
tstr=FIELD$(tstr,"~",1)
IF FIELD$(tstr,"|",1)<>"0" THEN
hWnd=VAL(FIELD$(tstr,"|",3))
DestroyWindow(hWnd)
END IF
END IF
NEXT i
END SUB
SUB ProgramEnd
DEFSTR tstr
DEFLNG mask=&h100
IF ErrorCondition=False THEN
IF ObjectIndex>ComponentCount THEN
tstr="QUIT without saving changes?"
IF MESSAGEBOX(tstr,"Project updated...",mask+&h24)=mrNo THEN EXIT SUB
END IF
END IF
UnhookWindowsHookEx(hHook)
CleanUp
Application.Terminate
END SUB
SUB LoadSingleButtons
DEFINT i, ImgOffset
DIM tBmp AS QBITMAP
DIM src AS QRECT, dst AS QRECT
tBmp.Height=26: tBmp.Width=26
dst.Top=0: dst.Left=0: dst.Bottom=25: dst.Right=25
src.Top=0: src.Bottom=25
ImgOffset=MAX_TOOLBTNS*26
FOR i=0 TO 3
xtraBtns(i).PARENT=ToolBox
xtraBtns(i).Left=425+(i*30)
xtraBtns(i).Top=25
xtraBtns(i).Width=25
xtraBtns(i).Height=25
xtraBtns(i).Cursor=crHandPoint
xtraBtns(i).Flat=True
xtraBtns(i).ShowHint=True
SELECT CASE i
CASE 0
xtraBtns(i).Hint="ADD A FORM": xtraBtns(i).OnClick=AddNewForm
src.Left=ImgOffset: src.Right=ImgOffset+25
CASE 1
xtraBtns(i).Hint="ABOUT": xtraBtns(i).OnClick=AboutClick
src.Left=ImgOffset: src.Right=ImgOffset+25
CASE 2
xtraBtns(i).Hint="GENERAL HELP": xtraBtns(i).OnClick=HelpBtnClick
src.Left=ImgOffset: src.Right=ImgOffset+25
CASE 3
xtraBtns(i).Hint="EXIT": xtraBtns(i).OnClick=ExitNoUpdate
src.Left=ImgOffset: src.Right=ImgOffset+25
END SELECT
tBmp.CopyRect(dst,Buttons,src)
xtraBtns(i).BMP=tBmp.BMP
ImgOffset=ImgOffset+26
NEXT i
END SUB
SUB LoadToolbarHints
DEFINT i, cnt
DEFSTR tstr
ToolbarHint=""
ComponentRef.Position=0
cnt=ComponentRef.LineCount
tstr=ComponentRef.ReadLine
FOR i=2 TO cnt
tstr=ComponentRef.ReadLine
IF LEFT$(tstr,1)="#" THEN
ToolbarHint=ToolbarHint+FIELD$(tstr," ",3)+"~"
END IF
NEXT i
END SUB
SUB ShowToolbarHint(X, Y, Shift, Sender)
DEFINT i, butn
DEFSTR tstr
i=TBar(0).Width\15
butn=X\i: butn=butn+Sender.Tag+1
tstr=FIELD$(ToolbarHint,"~",butn)
i=Sender.Tag\15
TBar(i).Hint=tstr
END SUB
SUB LoadToolbar
DEFINT i,j
FOR j=0 TO 2
TBar(j).PARENT=ToolBarTab
TBar(j).Left=0: TBar(j).Top=32
TBar(j).Height=26: TBar(j).Width=ToolBarTab.ClientWidth
TBar(j).ShowHint=True: TBar(j).Cursor=crHandPoint
TBar(j).Tag=j*15
TBar(j).OnDrawSection=DrawToolBar
TBar(j).OnSectionClick=ButnCmd
TBar(j).OnMouseMove=ShowToolbarHint
FOR i=0 TO 14
TBar(j).AddSections " "
TBar(j).Sections(i).Width=26: TBar(j).Sections(i).maxWidth=26
TBar(j).Sections(i).minwidth=26: TBar(j).Sections(i).style=hsOwnerDraw
NEXT i
TBar(j).Visible=False
NEXT j
LoadToolbarHints
TBar(0).Visible=True
END SUB
SUB DrawToolBar(Index,Pressed,Rect,Sender)
DEFINT bmp_idx
DIM src AS QRECT, dst AS QRECT
bmp_idx=Sender.Tag+Index
src.Left=bmp_idx*26: src.Top=0
src.Right=src.Left+25: src.Bottom=25
dst.Left=Rect.Left: dst.Top=Rect.Top
dst.Right=Rect.Right: dst.Bottom=Rect.Bottom
Sender.CopyRect(dst,Buttons,src)
END SUB
SUB ButnCmd(idx, Sender)
Scan.Enabled=False
FieldEdit.Visible=False
FieldBox.Visible=False
DesignTab.TabIndex=0: DesignTabChange
ComponentTab.TabIndex=0: ComponentTabChange
HideCarets
NewObjectID=Sender.Tag+idx+1
IF NewObjectID >= NON_VISIBLE THEN
AddNewObject
END IF
Scan.Enabled=True
END SUB
SUB ToolTabChange
DEFINT i
DesignTab.TabIndex=0: DesignTabChange
ComponentTab.TabIndex=0: ComponentTabChange
FOR i=0 TO 2
TBar(i).Visible=False
NEXT i
TBar(ToolBarTab.TabIndex).Visible=True
Deselect
END SUB
FUNCTION UpdateDefProperties(defString AS STRING, X AS INTEGER, Y AS INTEGER, _
Width AS INTEGER, Height AS INTEGER, strText AS STRING) AS STRING
DEFINT i, cnt
DEFSTR token, resStr
cnt=TALLY(defString,"~")
resStr=" "
FOR i=1 TO cnt
token=FIELD$(defString,"~",i)
SELECT CASE UCASE$(FIELD$(token,"|",1))
CASE "LEFT": token=token-FIELD$(token,"|",4)+STR$(X)
CASE "TOP": token=token-FIELD$(token,"|",4)+STR$(Y)
CASE "WIDTH": token=token-FIELD$(token,"|",4)+STR$(Width)
CASE "HEIGHT": token=token-FIELD$(token,"|",4)+STR$(Height)
CASE "CAPTION": token=token-FIELD$(token,"|",4)+strText
CASE "PARENT"
IF INSTR(strText,"Form")=0 THEN
token=token-FIELD$(token,"|",4)
IF CurrentForm=0 THEN
token=token+"MainForm"
ELSE
token=token+"Form"+STR$(CurrentForm)
END IF
END IF
END SELECT
resStr=resStr+token+"~"
NEXT i
Result=LTRIM$(resStr)
END FUNCTION
SUB ReSizeForm(Sender)
DEFSTR tstr, saveStr
DEFINT idx
HideCarets
CurrentForm=WhichFormIsActive(Sender.Handle)
idx=GetObjectFromHandle(Sender.Handle)
IF (idx >= 0) AND (idx <= MAX_OBJECTS) THEN
CurrentObject=idx
tstr=ObjectList(idx)
saveStr=FIELD$(tstr,"~",1)+"~"
tstr=tstr-saveStr
tstr=UpdateDefProperties(tstr, Sender.Left, Sender.Top, _
Sender.Width, Sender.Height, Sender.CAPTION)
ObjectList(idx)=saveStr+tstr
UpdatePropGrid(idx)
END IF
END SUB
SUB FormsMouseMove(X, Y, Shift, Sender)
DEFINT i
i=WhichFormIsActive(Sender.Handle)
IF i<>CurrentForm THEN
CurrentForm=i
HideCarets
FOR i=1 TO 8
Carets(i).PARENT=Sender
NEXT i
END IF
stat.Panel(1).CAPTION="Active Form = "+STR$(CurrentForm)
stat.Panel(2).CAPTION="X="+STR$(X)+": Y="+STR$(Y)
END SUB
SUB PaintFormGrid(Sender)
DEFINT px, py
FOR py=10 TO Sender.Height STEP 10
FOR px=10 TO Sender.Width STEP 10
Sender.Pset(px, py, &h7f7f7f)
NEXT px
NEXT py
END SUB
SUB MethodUpdate(newStrings AS STRING)
DEFINT i, cnt
DEFLNG hWnd
DEFSTR tstr, token
IF LEN(newStrings)=0 THEN newStrings=" "
tstr=ObjectList(CurrentObject)
tstr=FIELD$(tstr,"~",1)
hWnd=VAL(FIELD$(tstr,"|",7))
DelAllTabs(hWnd)
SELECT CASE FIELD$(tstr,"|",2)
CASE "QTABCONTROL"
i=0: cnt=TALLY(newStrings,",")+1
DO
token=FIELD$(newStrings,",",i+1)
AddNewTab(hWnd,i,token)
INC i
LOOP UNTIL i=cnt
END SELECT
END SUB
SUB ReDrawComponent
DEFSTR propString, token, tstr
DEFINT i, X, Y, Height, Width, reposn, objType
DEFLNG hWnd
DIM rect AS QRECT
propString=ObjectList(CurrentObject)
tstr=FIELD$(propString,"~",1)
objType=VAL(FIELD$(tstr,"|",1))
IF objType>=NON_VISIBLE THEN EXIT SUB
reposn=False
hWnd=VAL(FIELD$(tstr,"|",3))
FOR i=2 TO TALLY(propString,"~")
tstr=FIELD$(propString,"~",i)
token=UCASE$(FIELD$(tstr,"|",1))
SELECT CASE token
CASE "LEFT": X=VAL(FIELD$(tstr,"|",4)): reposn=True
CASE "TOP": Y=VAL(FIELD$(tstr,"|",4)): reposn=True
CASE "WIDTH": Width=VAL(FIELD$(tstr,"|",4)): reposn=True
CASE "HEIGHT": Height=VAL(FIELD$(tstr,"|",4)): reposn=True
CASE "CAPTION"
token=FIELD$(tstr,"|",4)
SetWindowText(hWnd,token)
SetWindowPos(hWnd,0,0,0,0,0,SWP_FLAGS)
END SELECT
NEXT i
IF reposn THEN
HideCarets
SetWindowPos(hWnd, 0, X, Y, Width, Height, SW_FLAGS)
IF objType>0 THEN
GetWindowRect(hWnd,rect)
DrawCarets(rect)
END IF
END IF
END SUB
SUB SetPropertyColor(colorStr AS STRING)
DEFSTR propString
DEFLNG hWnd, hDC, hBrush, bkColor
DIM rct AS QRECT
propString=ObjectList(CurrentObject)
hWnd=VAL(FIELD$(propString,"|",3))
hDC=GetDC(hWnd)
bkColor=VAL(CONVBASE$(colorStr,16,10))
SetBKColor(hDC,bkColor)
ReleaseDC(hWnd,hDC)
END SUB
SUB UpdateColor
END SUB
SUB UpdateFont
END SUB
SUB FieldUpdateCombo(Sender)
DEFSTR tstr, tok
DEFINT i, Row, ColorChosen=False
Row=Sender.Tag
tstr=Sender.Item(Sender.ItemIndex)
IF UCASE$(tstr)="<CHOOSE>" THEN
tok=PropertyGrid.Cell(0,Row)+" ["
tok=tok+FIELD$(SelectionCombo.Item(SelectionCombo.ItemIndex),"[",1)+"]"
ColorPick.CAPTION=tok
IF ColorPick.EXECUTE THEN
tstr="&H"+RIGHT$(HEX$(ColorPick.COLOR),6)
ColorChosen=True
ELSE
tstr=PropertyGrid.Cell(1,Row)
END IF
END IF
IF tstr<>PropertyGrid.Cell(1,Row) THEN
PropertyGrid.Cell(1,Row)=tstr
PropertyFieldUpdate(PropertyGrid.Cell(0,Row),tstr,4)
IF ColorChosen THEN
PropertyFieldUpdate(PropertyGrid.Cell(0,Row),tstr,7)
SetPropertyColor(RIGHT$(tstr,LEN(tstr)-2))
END IF
END IF
Sender.Tag=-1
Sender.Visible=False
END SUB
FUNCTION GetSubParms(pField AS STRING) AS STRING
DEFSTR tstr, token
DEFINT i
Result=""
tstr=ObjectList(CurrentObject)
FOR i=1 TO TALLY(tstr,"~")
token=FIELD$(tstr,"~",i)
IF FIELD$(token,"|",1)=pField THEN
Result=FIELD$(token,"|",3)
EXIT FOR
END IF
NEXT i
END FUNCTION
SUB FieldUpdateEdit(Key,Shift,Sender)
DEFSTR oldStr, newStr, pField, token
DEFINT Row
IF Key=13 THEN
Row=Sender.Tag
Sender.Tag=-1
newStr=LTRIM$(RTRIM$(Sender.Text))
SELECT CASE ComponentTab.TabIndex
CASE 0: oldStr=PropertyGrid.Cell(1,Row)
CASE 1: oldStr=MethodGrid.Cell(1,Row)
CASE 2: oldStr=EventGrid.Cell(1,Row)
END SELECT
IF oldStr=newStr THEN
Sender.Visible=False
EXIT SUB
END IF
SELECT CASE ComponentTab.TabIndex
CASE 0
PropertyGrid.Cell(1,Row)=newStr
pField=PropertyGrid.Cell(0,Row)
PropertyFieldUpdate(pField,newStr,4)
SELECT CASE UCASE$(pField)
CASE "LEFT","TOP","WIDTH","HEIGHT","CAPTION"
ReDrawComponent
END SELECT
CASE 1
MethodGrid.Cell(1,Row)=newStr
pField=MethodGrid.Cell(0,Row)
PropertyFieldUpdate(pField,newStr,4)
MethodUpdate(newStr)
CASE 2
EventGrid.Cell(1,Row)=newStr
pField=EventGrid.Cell(0,Row)
PropertyFieldUpdate(pField,newStr,2)
IF newStr="" THEN
oldStr="SUB "+oldStr
IF INSTR(FwdDeclares,oldStr)<>0 THEN
oldStr=oldStr+GetSubParms(pField)+"~"
FwdDeclares=FwdDeclares-oldStr
END IF
ELSE
newStr="SUB "+newStr
IF INSTR(FwdDeclares,newStr)=0 THEN
newStr=newStr+GetSubParms(pField)+"~"
FwdDeclares=FwdDeclares+newStr
END IF
END IF
END SELECT
Sender.Visible=False
END IF
END SUB
SUB EditPropertyField(Col, Row, CanSelect, Sender)
DEFINT i, top, cnt
DEFSTR tstr
FieldEdit.Visible=False
FieldBox.Visible=False
tstr=ObjectList(CurrentObject)
tstr=FIELD$(tstr,"~",Row+1)
IF FIELD$(tstr,"|",3)="R" THEN EXIT SUB
i=Sender.DefaultRowHeight+1
top=i*(Row-Sender.TopRow+2)+(i\2)
cnt=TALLY(tstr,"|")+1
IF cnt>4 THEN
FieldBox.Top=top
FieldBox.Clear
FOR i=5 TO cnt
FieldBox.AddItems FIELD$(tstr,"|",i)
NEXT i
tstr=Sender.Cell(1,Row)
IF (LEFT$(tstr,1) <> "<") AND (LEFT$(FieldBox.Item(0),1)="<") THEN
FieldBox.AddItems tstr
FieldBox.ItemIndex=i-5
ELSE
FieldBox.ItemIndex=0
END IF
FieldBox.Tag=Row
FieldBox.Visible=True
ELSE
FieldEdit.Top=top
FieldEdit.Text=FIELD$(tstr,"|",4)
FieldEdit.Tag=Row
FieldEdit.Visible=True
END IF
END SUB
SUB EditMethodField(Col, Row, CanSelect, Sender)
DEFINT i, top, cnt
DEFSTR objString, tstr, token
HideCarets
FieldEdit.Visible=False
FieldBox.Visible=False
token=Sender.Cell(0,Row)
objString=ObjectList(CurrentObject)
cnt=TALLY(objString,"~")
FOR i=2 TO cnt
tstr=FIELD$(objString,"~",i)
IF LEFT$(tstr,1)="*" THEN EXIT FOR
NEXT i
FOR i=i TO cnt
tstr=FIELD$(objString,"~",i)
IF token=FIELD$(tstr,"|",1) THEN EXIT FOR
NEXT i
IF FIELD$(tstr,"|",3)<>"W" THEN EXIT SUB
token=FIELD$(tstr,"|",4)
i=Sender.DefaultRowHeight+1
top=i*(Row-Sender.TopRow+2)+(i\2)
FieldEdit.Top=top
FieldEdit.Text=token
FieldEdit.Tag=Row
FieldEdit.Visible=True
END SUB
SUB EditEventField(Col, Row, CanSelect, Sender)
DEFINT i, j, top, cnt
DEFSTR objString, tstr, token
HideCarets
FieldEdit.Visible=False
FieldBox.Visible=False
token=Sender.Cell(0,Row)
objString=ObjectList(CurrentObject)
cnt=TALLY(objString,"~")
j=0
FOR i=2 TO cnt
tstr=FIELD$(objString,"~",i)
IF LEFT$(tstr,1)="*" THEN INC j
IF j=2 THEN EXIT FOR
NEXT i
FOR i=i TO cnt
tstr=FIELD$(objString,"~",i)
IF token=FIELD$(tstr,"|",1) THEN EXIT FOR
NEXT i
token=FIELD$(tstr,"|",2)
i=Sender.DefaultRowHeight+1
top=i*(Row-Sender.TopRow+2)+(i\2)
FieldEdit.Top=top
FieldEdit.Text=token
FieldEdit.Tag=Row
FieldEdit.Visible=True
END SUB
SUB HideEditCtls(Col,Row,State,Rect,Sender)
IF Sender.Tag<>Sender.TopRow THEN
FieldEdit.Visible=False
FieldBox.Visible=False
Sender.Tag=Sender.TopRow
END IF
END SUB
SUB InsertCodeHeader
DEFINT i
DEFSTR tstr
CodeText.AddStrings "'", "' <Program Name>", "'"
CodeText.AddStrings "' Form code created by RapidFRM "+VER,"'",""
CodeText.AddStrings "$APPTYPE GUI", "$TYPECHECK ON",""
CodeText.AddStrings "$INCLUDE "+QU+"Rapidq2.inc"+QU, ""
FwdDeclares=LTRIM$(FwdDeclares)
IF FwdDeclares<>"" THEN
FOR i=1 TO TALLY(FwdDeclares,"~")
tstr=LTRIM$(RTRIM$(FIELD$(FwdDeclares,"~",i)))
CodeText.AddStrings "DECLARE "+tstr
NEXT i
CodeText.AddStrings ""
END IF
END SUB
SUB InsertCodeFooter
DEFINT i
DEFSTR tstr
tstr=FIELD$(ObjectList(0),"~",1)
tstr=FIELD$(tstr,"|",4)
CodeText.AddStrings "SetWindowLong("+tstr+".Handle, GWL_HWNDPARENT, 0)"
CodeText.AddStrings "SetWindowLong(Application.Handle, GWL_HWNDPARENT, "+tstr+".Handle)",""
CodeText.AddStrings tstr+".ShowModal",""
IF FwdDeclares<>"" THEN
FOR i=1 TO TALLY(FwdDeclares,"~")
tstr=LTRIM$(RTRIM$(FIELD$(FwdDeclares,"~",i)))
CodeText.AddStrings tstr,"END SUB",""
NEXT i
END IF
END SUB
SUB InsertNonVisible
DEFINT i, k, cnt, objID
DEFSTR defString, nuString, tstr, token
DEFSTR spacer=SPACE$(4)
FOR i=1 TO MAX_OBJECTS
nuString=ObjectList(i)
IF nuString="" THEN EXIT FOR
tstr=FIELD$(nuString,"~",1)
objID=VAL(FIELD$(tstr,"|",1))
IF objID >= NON_VISIBLE THEN
IF ProjectMode=STAND_ALONE THEN
token=FIELD$(tstr,"|",4)
ELSE
token=FIELD$(tstr,"|",5)
END IF
tstr="DIM "+token+" AS "+FIELD$(tstr,"|",2)
CodeText.AddStrings tstr
defString="Dummy align string~"
defString=defString+GetDefaultProperties(objID)
cnt=TALLY(defString,"~")
FOR k=2 TO cnt
tstr=FIELD$(nuString,"~",k)
IF FIELD$(defString,"~",k)<>tstr THEN
IF UCASE$(LEFT$(tstr,2))="ON" THEN
CodeText.AddStrings spacer+token+"."+FIELD$(tstr,"|",1) _
+" = "+FIELD$(tstr,"|",2)
ELSE
SELECT CASE FIELD$(tstr,"|",1)
CASE "Parent"
CASE ELSE
IF FIELD$(tstr,"|",2)="STRING" THEN
CodeText.AddStrings spacer+token+"."+FIELD$(tstr,"|",1) _
+" = "+QU+FIELD$(tstr,"|",4)+QU
ELSE
CodeText.AddStrings spacer+token+"."+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",4)
END IF
END SELECT
END IF
END IF
NEXT k
CodeText.AddStrings ""
END IF
NEXT i
END SUB
SUB InsertMenu(which AS INTEGER)
DEFINT i, j, cnt, lev
DEFSTR mnuString, tstr, token, spacer
IF which=MAINMENU THEN mnuString=LTRIM$(MainMenuList) ELSE mnuString=LTRIM$(PopMenuList)
mnuString=LTRIM$(mnuString)
cnt=TALLY(mnuString,"@")
FOR i=1 TO cnt
lev=0: spacer=""
tstr=FIELD$(mnuString,"@",i)+"~"
FOR j=1 TO TALLY(tstr,"~")
token=FIELD$(tstr,"~",j)
IF LEFT$(LTRIM$(token),1)="'" THEN
CodeText.AddStrings token
ELSE
IF INSTR(token,"=")>0 THEN
token=RTRIM$(FIELD$(token,"=",1))+" = "+LTRIM$(FIELD$(token,"=",2))
END IF
IF INSTR(UCASE$(token),"CAPTION")>0 THEN
token=FIELD$(token," ",1)+" = "+QU+LTRIM$(FIELD$(token,"=",2))+QU
END IF
IF UCASE$(FIELD$(token," ",1))="END" THEN
spacer=LEFT$(spacer,LEN(spacer)-4)
CodeText.AddStrings spacer+token
ELSEIF UCASE$(FIELD$(token," ",1))="CREATE" THEN
CodeText.AddStrings spacer+token
spacer=spacer+" "
ELSE
CodeText.AddStrings spacer+token
END IF
END IF
NEXT j
CodeText.AddStrings ""
NEXT i
END SUB
FUNCTION ObjectHasChildren(ThisIdx AS INTEGER) AS INTEGER
DEFINT i
DEFLNG hWnd
DEFSTR tstr
Result=False
tstr=FIELD$(ObjectList(ThisIdx),"~",1)
hWnd=VAL(FIELD$(tstr,"|",3))
FOR i=ThisIdx+1 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF hWnd=VAL(FIELD$(tstr,"|",6)) THEN
Result=True
EXIT FOR
END IF
NEXT i
END FUNCTION
SUB InsertObjectCode(ThisIdx AS INTEGER, lev AS INTEGER)
DEFINT i, j, cnt, aligned, addquotes
DEFSTR tstr, token, defString, nuString
DEFSTR spacer
spacer=SPACE$(lev*4)
nuString=ObjectList(ThisIdx)
IF ProjectMode=STAND_ALONE THEN
token=FIELD$(nuString,"|",4)
ELSE
token=FIELD$(nuString,"|",5)
END IF
CodeText.AddStrings spacer+"CREATE "+token+" AS "+FIELD$(nuString,"|",2)
spacer=spacer+" "
j=VAL(FIELD$(nuString,"|",1))
defString="Dummy align string~"
defString=defString+GetDefaultProperties(j)
aligned=False
cnt=TALLY(defString,"~")
FOR i=2 TO cnt
tstr=FIELD$(nuString,"~",i)
IF FIELD$(tstr,"|",1)="Align" THEN
IF FIELD$(tstr,"|",4)="alClient" THEN
aligned=True
END IF
EXIT FOR
END IF
NEXT i
addquotes=False
FOR i=2 TO cnt
tstr=FIELD$(nuString,"~",i)
IF FIELD$(defString,"~",i)<>tstr THEN
token=UCASE$(FIELD$(tstr,"|",1))
IF (LEFT$(token,2)="ON") OR (token="WNDPROC") THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",2)
ELSEIF LEFT$(token,3)="ADD" THEN
token=FIELD$(tstr,"|",4)
IF INSTR(token,QU)=0 THEN addquotes=True
tstr=spacer+FIELD$(tstr,"|",1)+" "
FOR j=1 TO TALLY(token,",")+1
IF addquotes THEN tstr=tstr+QU
tstr=tstr+LTRIM$(RTRIM$(FIELD$(token,",",j)))
IF addquotes THEN tstr=tstr+QU
tstr=tstr+","
NEXT j
CodeText.AddStrings LEFT$(tstr,LEN(tstr)-1)
ELSE
SELECT CASE FIELD$(tstr,"|",1)
CASE "Parent"
CASE "Height","Left","Top","Width"
IF aligned=False THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",4)
END IF
CASE ELSE
IF FIELD$(tstr,"|",2)="STRING" THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+QU+FIELD$(tstr,"|",4)+QU
ELSE
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",4)
END IF
END SELECT
END IF
END IF
NEXT i
END SUB
SUB InsertFormCode(idx AS INTEGER)
DEFINT i, cnt, Maxit
DEFSTR defString, nuString, tstr, token
DEFSTR spacer=SPACE$(4)
Maxit=False
nuString=ObjectList(idx)
tstr=FIELD$(nuString,"~",1)
IF ProjectMode=STAND_ALONE THEN
token=FIELD$(tstr,"|",4)
ELSE
token=FIELD$(tstr,"|",5)
END IF
CodeText.AddStrings "CREATE "+token+" AS QFORM"
defString="Dummy align string~"
defString=defString+GetDefaultProperties(0)
cnt=TALLY(defString,"~")
FOR i=2 TO cnt
tstr=FIELD$(nuString,"~",i)
IF FIELD$(tstr,"|",1)="WindowState" THEN
IF FIELD$(tstr,"|",4)="wsMaximized" THEN Maxit=True
EXIT FOR
END IF
NEXT i
FOR i=2 TO cnt
tstr=FIELD$(nuString,"~",i)
IF FIELD$(defString,"~",i)<>tstr THEN
token=UCASE$(FIELD$(tstr,"|",1))
IF (LEFT$(token,2)="ON") OR (token="WNDPROC") THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",2)
ELSE
SELECT CASE FIELD$(tstr,"|",1)
CASE "Left","Top"
CASE "Height","Width"
IF Maxit=False THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",4)
END IF
CASE ELSE
IF FIELD$(tstr,"|",2)="STRING" THEN
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+QU+FIELD$(tstr,"|",4)+QU
ELSE
CodeText.AddStrings spacer+FIELD$(tstr,"|",1)+" = "+FIELD$(tstr,"|",4)
END IF
END SELECT
END IF
END IF
NEXT i
IF Maxit=False THEN
CodeText.AddStrings spacer+"Center"
END IF
END SUB
SUB InsertThisChain(StartIdx AS INTEGER, lev AS INTEGER)
DEFINT i, cnt, nxt
DEFSTR sibString, spacer
spacer=SPACE$(lev*4)
sibString=FillSiblingList(StartIdx)
cnt=TALLY(sibString,"|")
IF cnt>0 THEN
FOR i=1 TO cnt
nxt=VAL(FIELD$(sibString,"|",i))
InsertObjectCode(nxt,lev)
IF IsParentType(nxt)=True THEN
INC lev
InsertThisChain(nxt,lev)
DEC lev
END IF
CodeText.AddStrings spacer+"END CREATE"
NEXT i
END IF
END SUB
SUB BuildFormCode
DEFINT i, j, lev=1
DEFSTR tstr
CodeText.Clear
IF ProjectMode=STAND_ALONE THEN
InsertCodeHeader
END IF
IF LTRIM$(PopMenuList)<>"" THEN
InsertMenu(POPMENU)
END IF
FOR i=0 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF FIELD$(tstr,"|",1)="0" THEN
InsertFormCode(i)
InsertThisChain(i,lev)
CodeText.AddStrings "END CREATE",""
END IF
NEXT i
IF LTRIM$(MainMenuList)<>"" THEN
InsertMenu(MAINMENU)
END IF
InsertNonVisible
IF ProjectMode=STAND_ALONE THEN
InsertCodeFooter
END IF
END SUB
SUB CopyToClipBrd
ClipBoard.OPEN
ClipBoard.Clear
CodeText.SelectAll
ClipBoard.Text=CodeText.Text
ClipBoard.CLOSE
CodeText.SelLength=0
ComponentCount=ObjectIndex
MESSAGEBOX("Your code has been placed on the clipboard","RapidFRM "+VER,&H40)
END SUB
SUB SelectionToClipBrd
IF CodeText.SelLength>0 THEN
ClipBoard.OPEN
ClipBoard.Clear
ClipBoard.Text=CodeText.SelText
ClipBoard.CLOSE
CodeText.SelLength=0
ComponentCount=ObjectIndex
MESSAGEBOX("Selected code has been placed on the clipboard","RapidFRM "+VER,&H40)
ELSE
MESSAGEBOX("No code has been selected","RapidFRM "+VER,&H30)
END IF
END SUB
SUB SaveFile
DIM SaveDialog AS QSAVEDIALOG
DEFSTR tstr
SaveDialog.Filter="BAS files|*.bas|INC files|*.inc|TEXT files|*.txt"
IF SaveDialog.EXECUTE THEN
IF INSTR(SaveDialog.FileName,".")=0 THEN
tstr=FIELD$(Savedialog.Filter,"*",Savedialog.FilterIndex+1)
SaveDialog.FileName=SaveDialog.FileName+LEFT$(tstr,4)
END IF
CodeText.SaveToFile SaveDialog.FileName
ComponentCount=ObjectIndex
END IF
END SUB
FUNCTION GetDefaultProperties(ComponentID)
DEFINT i, j
DEFSTR tstr, token
ComponentRef.Position=0
token="# "+STR$(ComponentID): j=LEN(token)
FOR i=1 TO ComponentRef.LineCount
tstr=ComponentRef.Readline
IF LEFT$(tstr,j)=token THEN
EXIT FOR
END IF
NEXT i
IF i>ComponentRef.LineCount THEN
tstr="GetDefaultProperties() - Component "+STR$(ComponentID)+" NOT found!"
MESSAGEBOX(tstr,"RapidFRM "+VER,&h30)
Result=""
EXIT FUNCTION
END IF
tstr=""
token=ComponentRef.Readline
WHILE LEFT$(token,1)<>"#"
tstr=tstr+token+"~"
token=ComponentRef.Readline
WEND
Result=tstr
END FUNCTION
SUB UpdatePropGrid(idx)
DEFINT i, propCount, methodCount, eventCount, maxStrings
DEFSTR propString, tstr, token
SelectionCombo.ItemIndex=idx
propString=ObjectList(idx)
tstr=FIELD$(propString,"~",1)
IF ProjectMode=STAND_ALONE THEN
token=FIELD$(tstr,"|",4)
ELSE
token=FIELD$(tstr,"|",5)
END IF
maxStrings=TALLY(propString,"~")
propCount=0: methodCount=0: eventCount=0
FOR i=2 TO maxStrings
tstr=FIELD$(propString,"~",i)
IF LEFT$(tstr,1)="*" THEN EXIT FOR
INC propCount
IF (propCount+1)=PropertyGrid.RowCount THEN PropertyGrid.InsertRow(propCount)
PropertyGrid.Cell(0,propCount)=FIELD$(tstr,"|",1)
PropertyGrid.Cell(1,propCount)=FIELD$(tstr,"|",4)
NEXT i
FOR i=i+1 TO maxStrings
tstr=FIELD$(propString,"~",i)
IF LEFT$(tstr,1)="*" THEN EXIT FOR
INC methodCount
IF (methodCount+1)=MethodGrid.RowCount THEN MethodGrid.InsertRow(methodCount)
MethodGrid.Cell(0,methodCount)=FIELD$(tstr,"|",1)
MethodGrid.Cell(1,methodCount)=FIELD$(tstr,"|",4)
NEXT i
FOR i=i+1 TO maxStrings
tstr=FIELD$(propString,"~",i)
INC eventCount
IF (eventCount+1)=EventGrid.RowCount THEN EventGrid.InsertRow(eventCount)
EventGrid.Cell(0,eventCount)=FIELD$(tstr,"|",1)
EventGrid.Cell(1,eventCount)=FIELD$(tstr,"|",2)
NEXT i
IF methodCount=0 THEN
methodCount=1
MethodGrid.Cell(0,1)="No design methods"
MethodGrid.Cell(1,1)=""
END IF
IF eventCount=0 THEN
eventCount=1
EventGrid.Cell(0,1)="No events"
EventGrid.Cell(1,1)=""
END IF
IF PropertyGrid.RowCount>(propCount+1) THEN
FOR i=(propCount+2) TO PropertyGrid.RowCount
PropertyGrid.DeleteRow(i)
NEXT i
END IF
IF MethodGrid.RowCount>(methodCount+1) THEN
FOR i=(methodCount+2) TO MethodGrid.RowCount
MethodGrid.DeleteRow(i)
NEXT i
END IF
IF EventGrid.RowCount>(eventCount+1) THEN
FOR i=(eventCount+2) TO EventGrid.RowCount
EventGrid.DeleteRow(i)
NEXT i
END IF
UpdateStatus
END SUB
SUB AddNewForm
DEFINT i
DEFSTR tstr, token
IF FrmIndex > MAX_FORMS THEN
MESSAGEBOX("Maximum forms ("+STR$(MAX_FORMS)+") has been reached","RapidFRM "+VER,&H30)
EXIT SUB
END IF
Scan.Enabled=False
DesignTab.TabIndex=0
DesignTabChange
CaretsTimer.Enabled=False
FOR i=1 TO 8
Carets(i).PARENT=Forms(FrmIndex)
Carets(i).Visible=False
NEXT i
CurrentForm=FrmIndex: CurrentObject=ObjectIndex
token="Form"+STR$(FrmIndex)
tstr=STR$(0)+"|QFORM|"+STR$(Forms(FrmIndex).Handle)+"|"+token+"|"+token+"|0~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(0)
SetWindowPos(Forms(FrmIndex).Handle,HWND_TOPMOST,0,0,0,0,FLAGS)
Forms(FrmIndex).Show
SelectionCombo.AddItems token+" [QFORM]"
SelectionCombo.ItemIndex=CurrentObject
INC ObjectIndex: INC FrmIndex: NewObjectID=-1
Scan.Enabled=True
END SUB
FUNCTION FormHasObject(ComponentID AS INTEGER) AS INTEGER
DEFINT i, j, cnt, thisObject
DEFSTR objStr, tstr
FOR i=1 TO MAX_OBJECTS
objStr=ObjectList(i)
IF objStr="" THEN EXIT FOR
tstr=FIELD$(objStr,"~",1)
thisObject=VAL(FIELD$(tstr,"|",1))
IF thisObject=ComponentID THEN
cnt=TALLY(objStr,"~")
FOR j=1 TO cnt
tstr=FIELD$(objStr,"~",j)
IF FIELD$(tstr,"|",1)="Parent" THEN
tstr=FIELD$(tstr,"|",4)
IF VAL(RIGHT$(tstr,1))=CurrentForm THEN
MESSAGEBOX("Only one instance per form allowed!","RapidFRM "+VER,&h30)
Result=True
EXIT FUNCTION
END IF
END IF
NEXT j
END IF
NEXT i
Result=False
END FUNCTION
FUNCTION ParentHasObject(Parnt AS LONG, ComponentID AS INTEGER) AS INTEGER
DEFINT i, parntIdx
DEFSTR tstr
FOR i=1 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF ComponentID=VAL(FIELD$(tstr,"|",1)) THEN
IF VAL(FIELD$(tstr,"|",6))=Parnt THEN
MESSAGEBOX("Only one instance per parent object allowed!","RapidFRM "+VER,&h30)
Result=True
EXIT FUNCTION
END IF
END IF
NEXT i
Result=False
END FUNCTION
FUNCTION WhichParent(hWnd AS LONG) AS STRING
DEFINT i
DEFSTR tstr
Result=""
FOR i=0 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF hWnd=VAL(FIELD$(tstr,"|",3)) THEN
Result=FIELD$(tstr,"|",5)
EXIT FOR
END IF
NEXT i
END FUNCTION
SUB AddQEDIT(hWnd AS LONG)
DIM BoxEdit(EdIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
BoxEdit(EdIndex).Width=121
BoxEdit(EdIndex).Height=21
BoxEdit(EdIndex).COLOR=&hffffff
BoxEdit(EdIndex).BevelOuter=2
BoxEdit(EdIndex).Alignment=taLeftJustify
token="Edit"+STR$(EdIndex+1)
BoxEdit(EdIndex).CAPTION="QEdit"
BoxEdit(EdIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxEdit(EdIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxEdit(EdIndex).Left=tPoint.x
BoxEdit(EdIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QEDIT|"+STR$(BoxEdit(EdIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QEDIT]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC EdIndex
END SUB
SUB AddQRICHEDIT(hWnd AS LONG)
DIM BoxRich(RichIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
BoxRich(RichIndex).Width=150
BoxRich(RichIndex).Height=100
BoxRich(RichIndex).COLOR=&hffffff
BoxRich(RichIndex).BevelOuter=2
BoxRich(RichIndex).Alignment=taLeftJustify
token="RichEd"+STR$(RichIndex+1)
BoxRich(RichIndex).CAPTION="QRichEdit"
BoxRich(RichIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxRich(RichIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxRich(RichIndex).Left=tPoint.x
BoxRich(RichIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QRICHEDIT|"+STR$(BoxRich(RichIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QRICHEDIT]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC RichIndex
END SUB
SUB AddQLABEL(hWnd AS LONG)
DIM BoxLabel(LabelIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
BoxLabel(LabelIndex).Width=75
BoxLabel(LabelIndex).Height=25
BoxLabel(LabelIndex).BevelOuter=2
BoxLabel(LabelIndex).Alignment=taLeftJustify
token="Label"+STR$(LabelIndex+1)
BoxLabel(LabelIndex).CAPTION=token
BoxLabel(LabelIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxLabel(LabelIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxLabel(LabelIndex).Left=tPoint.x
BoxLabel(LabelIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QLABEL|"+STR$(BoxLabel(LabelIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QLABEL]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC LabelIndex
END SUB
SUB AddQBUTTON(hWnd AS LONG)
DIM boxBut(ButnIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
boxBut(ButnIndex).Width=75
boxBut(ButnIndex).Height=25
boxBut(ButnIndex).BevelOuter=2
token="Butn"+STR$(ButnIndex+1)
boxBut(ButnIndex).CAPTION=token
boxBut(ButnIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(boxBut(ButnIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
boxBut(ButnIndex).Left=tPoint.x
boxBut(ButnIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QBUTTON|"+STR$(boxBut(ButnIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QBUTTON]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ButnIndex
END SUB
SUB AddQCOOLBTN(hWnd AS LONG)
DIM BoxCool(CoolIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
BoxCool(CoolIndex).Width=25
BoxCool(CoolIndex).Height=25
BoxCool(CoolIndex).BevelOuter=2
token="Cool"+STR$(CoolIndex+1)
BoxCool(CoolIndex).CAPTION=token
BoxCool(CoolIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxCool(CoolIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxCool(CoolIndex).Left=tPoint.x
BoxCool(CoolIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QCOOLBTN|"+STR$(BoxCool(CoolIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QCOOLBTN]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC CoolIndex
END SUB
SUB AddQOVALBTN(hWnd AS LONG)
DIM OvalBtn(OvalIndex+1) AS QOVALBTN
DIM BoxOval(OvalIndex+1) AS QPANEL
DEFSTR tstr, token
DEFLNG ovlHandle
DIM tPoint AS PointAPI
token="OvalBtn"+STR$(OvalIndex+1)
BoxOval(OvalIndex).Width=75
BoxOval(OvalIndex).Height=40
BoxOval(OvalIndex).BevelOuter=2
BoxOval(OvalIndex).BevelWidth=0
BoxOval(OvalIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxOval(OvalIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxOval(OvalIndex).Left=tPoint.x
BoxOval(OvalIndex).Top=tPoint.y
OvalBtn(OvalIndex).PARENT=BoxOval(OvalIndex)
OvalBtn(OvalIndex).Align=5
OvalBtn(OvalIndex).CAPTION=token
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QOVALBTN|"+STR$(BoxOval(OvalIndex).Handle)+"|"+token+ _
"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QOVALBTN]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC OvalIndex
END SUB
SUB AddQCHECKBOX(hWnd AS LONG)
DIM Check(CheckIndex+1) AS QCHECKBOX
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="ChkBox"+STR$(CheckIndex+1)
Check(CheckIndex).CAPTION=token
Check(CheckIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(Check(CheckIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
Check(CheckIndex).Left=tPoint.x
Check(CheckIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QCHECKBOX|"+STR$(Check(CheckIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QCHECKBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC CheckIndex
END SUB
SUB AddQRADIOBUTTON(hWnd AS LONG)
DIM Radio(RadioIndex+1) AS QRADIOBUTTON
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="RadioBtn"+STR$(RadioIndex+1)
Radio(RadioIndex).CAPTION=token
Radio(RadioIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(Radio(RadioIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
Radio(RadioIndex).Left=tPoint.x
Radio(RadioIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QRADIOBUTTON|"+STR$(Radio(RadioIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QRADIOBUTTON]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC RadioIndex
END SUB
SUB AddQPANEL(hWnd AS LONG)
DIM dPan(PanIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="Panel"+STR$(PanIndex+1)
dPan(PanIndex).CAPTION=token
dPan(PanIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(dPan(PanIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
dPan(PanIndex).Left=tPoint.x
dPan(PanIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QPANEL|"+STR$(dPan(PanIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QPANEL]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC PanIndex
END SUB
SUB AddQTABCONTROL(hWnd AS LONG)
DIM TabCtrl(TabContIndex+1) AS QTABCONTROL
DIM BoxTab(TabContIndex+1) AS QPANEL
DIM btn AS QBUTTON
DEFLNG TabHandle
DEFSTR tstr, token
DIM tPoint AS PointAPI
BoxTab(TabContIndex).Width=289
BoxTab(TabContIndex).Height=193
BoxTab(TabContIndex).Borderstyle=0
BoxTab(TabContIndex).BevelOuter=2
token="TabCtrl"+STR$(TabContIndex+1)
BoxTab(TabContIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxTab(TabContIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxTab(TabContIndex).Left=tPoint.x
BoxTab(TabContIndex).Top=tPoint.y
TabCtrl(TabContIndex).PARENT=BoxTab(TabContIndex)
TabCtrl(TabContIndex).Align=5
TabCtrl(TabContIndex).AddTabs("TAB 1","TAB 2","TAB 3")
btn.Visible=False: btn.PARENT=TabCtrl(TabContIndex)
TabHandle=GetParent(btn.Handle)
DestroyWindow(btn.Handle)
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QTABCONTROL|"+STR$(BoxTab(TabContIndex).Handle)+"|" _
+token+"|"+token+"|"+STR$(hWnd)+"|"+STR$(TabHandle)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QTABCONTROL]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC TabContIndex
END SUB
SUB AddQCOMBOBOX(hWnd AS LONG)
DIM Combo(ComboIndex+1) AS QCOMBOBOX
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="Combo"+STR$(ComboIndex+1)
Combo(ComboIndex).Text=token
Combo(ComboIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(Combo(ComboIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
Combo(ComboIndex).Left=tPoint.x
Combo(ComboIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QCOMBOBOX|"+STR$(Combo(ComboIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Text",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QCOMBOBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ComboIndex
END SUB
SUB AddQLISTBOX(hWnd AS LONG)
DIM ListB(ListBIndex+1) AS QLISTBOX
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="ListBox"+STR$(ListBIndex+1)
ListB(ListBIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(ListB(ListBIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
ListB(ListBIndex).Left=tPoint.x-2
ListB(ListBIndex).Top=tPoint.y-2
ListB(ListBIndex).AddItems token
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QLISTBOX|"+STR$(ListB(ListBIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QLISTBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ListBIndex
END SUB
SUB AddQGROUPBOX(hWnd AS LONG)
DIM GrpBox(GrpBoxIndex+1) AS QGROUPBOX
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="GrpBox"+STR$(GrpBoxIndex+1)
GrpBox(GrpBoxIndex).CAPTION=token
GrpBox(GrpBoxIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(GrpBox(GrpBoxIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
GrpBox(GrpBoxIndex).Left=tPoint.x
GrpBox(GrpBoxIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QGROUPBOX|"+STR$(GrpBox(GrpBoxIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QGROUPBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC GrpBoxIndex
END SUB
SUB AddQSCROLLBOX(hWnd AS LONG)
DIM ScrollB(ScrollBIndex+1) AS QSCROLLBOX
DIM BoxScroll(ScrollBIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="ScrlBox"+STR$(ScrollBIndex+1)
ScrollB(ScrollBIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(ScrollB(ScrollBIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
ScrollB(ScrollBIndex).Left=tPoint.x-2
ScrollB(ScrollBIndex).Top=tPoint.y-2
BoxScroll(ScrollBIndex).PARENT=ScrollB(ScrollBIndex)
BoxScroll(ScrollBIndex).Width=500: BoxScroll(ScrollBIndex).Height=500
BoxScroll(ScrollBIndex).Enabled=False
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QSCROLLBOX|"+STR$(ScrollB(ScrollBIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QSCROLLBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ScrollBIndex
END SUB
SUB AddQSCROLLBAR(hWnd AS LONG)
DIM ScrollBar(ScrllBarIndex+1) AS QSCROLLBAR
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="ScrlBar"+STR$(ScrllBarIndex+1)
ScrollBar(ScrllBarIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(ScrollBar(ScrllBarIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
ScrollBar(ScrllBarIndex).Left=tPoint.x
ScrollBar(ScrllBarIndex).Top=tPoint.y
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QSCROLLBAR|"+STR$(ScrollBar(ScrllBarIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QSCROLLBAR]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ScrllBarIndex
END SUB
SUB AddQSTRINGGRID(hWnd AS LONG)
DIM StrGrid(StringGIndex+1) AS QLISTVIEW
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="StringGrid"+STR$(StringGIndex+1)
StrGrid(StringGIndex).Width=150
StrGrid(StringGIndex).Height=100
StrGrid(StringGIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(StrGrid(StringGIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
StrGrid(StringGIndex).Left=tPoint.x-2
StrGrid(StringGIndex).Top=tPoint.y-2
StrGrid(StringGIndex).GridLines=True
StrGrid(StringGIndex).ViewStyle=vsReport
StrGrid(StringGIndex).AddColumns token,""
StrGrid(StringGIndex).Column(0).Width=74
StrGrid(StringGIndex).Column(1).Width=74
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QSTRINGGRID|"+STR$(StrGrid(StringGIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","150",4)
PropertyFieldUpdate("Height","100",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QSTRINGGRID]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC StringGIndex
END SUB
SUB AddQLISTVIEW(hWnd AS LONG)
DIM ListView(ListVIndex+1) AS QLISTVIEW
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="ListView"+STR$(ListVIndex+1)
ListView(ListVIndex).Width=150
ListView(ListVIndex).Height=75
ListView(ListVIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(ListView(ListVIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
ListView(ListVIndex).Left=tPoint.x-2
ListView(ListVIndex).Top=tPoint.y-2
ListView(ListVIndex).GridLines=True
ListView(ListVIndex).ViewStyle=vsReport
ListView(ListVIndex).AddColumns token,""
ListView(ListVIndex).Column(0).Width=74
ListView(ListVIndex).Column(1).Width=74
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QLISTVIEW|"+STR$(ListView(ListVIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","150",4)
PropertyFieldUpdate("Height","75",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QLISTVIEW]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ListVIndex
END SUB
SUB AddQHEADER(hWnd AS LONG)
DIM Headr(HeadIndex+1) AS QHEADER
DIM BoxHeadr(HeadIndex+1) AS QPANEL
DEFSTR tstr, token
DIM rect AS QRECT
DIM tPoint AS PointAPI
IF ParentHasObject(hWnd,NewObjectID) THEN
EXIT SUB
END IF
token="Header"+STR$(HeadIndex+1)
BoxHeadr(HeadIndex).Align=alTop
BoxHeadr(HeadIndex).Height=17
BoxHeadr(HeadIndex).BevelOuter=2
BoxHeadr(HeadIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxHeadr(HeadIndex).Handle,hWnd)
END IF
Headr(HeadIndex).PARENT=BoxHeadr(HeadIndex)
Headr(HeadIndex).Align=alClient
Headr(HeadIndex).AddSections "Hdr1","Hdr2","Hdr3"
Headr(HeadIndex).Enabled=False
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QHEADER|"+STR$(BoxHeadr(HeadIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QHEADER]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC HeadIndex
END SUB
SUB AddQSTATUSBAR(hWnd AS LONG)
DIM StatBar(StatIndex+1) AS QSTATUSBAR
DIM BoxStat(StatIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
IF ParentHasObject(hWnd,NewObjectID) THEN
EXIT SUB
END IF
token="Status"+STR$(StatIndex+1)
BoxStat(StatIndex).Align=alBottom
BoxStat(StatIndex).Height=19
BoxStat(StatIndex).BevelOuter=2
BoxStat(StatIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxStat(StatIndex).Handle,hWnd)
END IF
StatBar(StatIndex).PARENT=BoxStat(StatIndex)
StatBar(StatIndex).Align=alClient
StatBar(StatIndex).SimplePanel=True
StatBar(StatIndex).SimpleText=token
StatBar(StatIndex).Enabled=False
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QSTATUSBAR|"+STR$(BoxStat(StatIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QSTATUSBAR]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC StatIndex
END SUB
SUB AddQDIRTREE(hWnd AS LONG)
DIM DirTree AS QDIRTREE
DIM BoxDTree AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
IF DirTIndex>0 THEN
MESSAGEBOX("Only one instance allowed!","RapidFRM "+VER,&h30)
EXIT SUB
END IF
INC DirTIndex
token="DirTree"+STR$(DirTIndex)
BoxDTree.Width=200
BoxDTree.Height=160
BoxDTree.BevelOuter=2
BoxDTree.PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxDTree.Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxDTree.Left=tPoint.x: BoxDTree.Top=tPoint.y
DirTree.PARENT=BoxDTree: DirTree.Align=alClient: DirTree.Enabled=False
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QDIRTREE|"+STR$(BoxDTree.Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","200",4)
PropertyFieldUpdate("Height","160",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QDIRTREE]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex
END SUB
SUB AddQFILELISTBOX(hWnd AS LONG)
DIM dFileL(FileLindex+1) AS QFILELISTBOX
DIM BoxFile(FileLindex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="FileListBox"+ STR$(FileLindex+1)
BoxFile(FileLindex).Width=200
BoxFile(FileLindex).Height=160
BoxFile(FileLindex).BevelOuter=2
BoxFile(FileLindex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(BoxFile(FileLindex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
BoxFile(FileLindex).Left=tPoint.x
BoxFile(FileLindex).Top=tPoint.y
dFileL(FileLindex).PARENT=BoxFile(FileLindex)
dFileL(FileLindex).Align=alClient
dFileL(FileLindex).Enabled=False
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QFILELISTBOX|"+STR$(BoxFile(FileLindex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","200",4)
PropertyFieldUpdate("Height","160",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QFILELISTBOX]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC FileLindex
END SUB
SUB AddQGAUGE(hWnd AS LONG)
DIM dGauge(GaugeIndex+1) AS QGAUGE
DIM panGauge(GaugeIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="Gauge"+STR$(GaugeIndex+1)
panGauge(GaugeIndex).Width=100
panGauge(GaugeIndex).Height=25
panGauge(GaugeIndex).BevelOuter=2
panGauge(GaugeIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(panGauge(GaugeIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
panGauge(GaugeIndex).Left=tPoint.x
panGauge(GaugeIndex).Top=tPoint.y
dGauge(GaugeIndex).PARENT=panGauge(GaugeIndex)
dGauge(GaugeIndex).Align=alClient
dGauge(GaugeIndex).Position=75
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QGAUGE|"+STR$(panGauge(GaugeIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","100",4)
PropertyFieldUpdate("Height","25",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QGAUGE]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC GaugeIndex
END SUB
SUB AddQTRACKBAR(hWnd AS LONG)
DIM dTrackBar(TrackBIndex+1) AS QTRACKBAR
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="TrackBar"+STR$(TrackBIndex+1)
dTrackBar(TrackBIndex).Width=100
dTrackBar(TrackBIndex).Height=40
dTrackBar(TrackBIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(dTrackBar(TrackBIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
dTrackBar(TrackBIndex).Left=tPoint.x
dTrackBar(TrackBIndex).Top=tPoint.y
dTrackBar(TrackBIndex).Max=20
dTrackBar(TrackBIndex).Position=15
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QTRACKBAR|"+STR$(dTrackBar(TrackBIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","100",4)
PropertyFieldUpdate("Height","40",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QTRACKBAR]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC TrackBIndex
END SUB
SUB AddQSPLITTER(hWnd AS LONG)
DIM panSplit(SplitIndex+1) AS QPANEL
DEFSTR tstr, token
DIM rect AS QRECT
DIM tPoint AS PointAPI
IF ParentHasObject(hWnd,NewObjectID) THEN
EXIT SUB
END IF
GetWindowRect(hWnd,rect)
token="Split"+STR$(SplitIndex+1)
panSplit(SplitIndex).Width=6
panSplit(SplitIndex).Height=rect.Bottom-rect.Top-8
panSplit(SplitIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(panSplit(SplitIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
panSplit(SplitIndex).Left=tPoint.x
panSplit(SplitIndex).Top=0
panSplit(SplitIndex).COLOR=&h003f5f00
panSplit(SplitIndex).Cursor=crHSplit
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QSPLITTER|"+STR$(panSplit(SplitIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top","0",4)
PropertyFieldUpdate("Width","6",4)
PropertyFieldUpdate("Height",STR$(rect.Bottom-rect.Top-8),4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QSPLITTER]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC SplitIndex
END SUB
SUB AddQTREEVIEW(hWnd AS LONG)
DIM TreeView AS QTREEVIEW
DEFSTR tstr, token
DIM tPoint AS PointAPI
IF TreeVIndex>0 THEN
MESSAGEBOX("Only one instance allowed!","RapidFRM "+VER,&h30)
EXIT SUB
END IF
INC TreeVIndex
token="TreeView"+STR$(TreeVIndex)
TreeView.Width=120
TreeView.Height=100
TreeView.PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(TreeView.Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
TreeView.Left=tPoint.x-2
TreeView.Top=tPoint.y-2
TreeView.ReadOnly=True
TreeView.AddItems "1","2","3"
TreeView.AddChildItems 0, "Child A", "Child B", "Child C"
TreeView.AddChildItems 4, "Child X", "Child Y", "Child Z"
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QTREEVIEW|"+STR$(TreeView.Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","120",4)
PropertyFieldUpdate("Height","100",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QTREEVIEW]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex
END SUB
SUB AddQOUTLINE(hWnd AS LONG)
DIM frmOutLine AS QOUTLINE
DEFSTR tstr, token
DIM tPoint AS PointAPI
IF OutLnIndex>0 THEN
MESSAGEBOX("Only one instance allowed!","RapidFRM "+VER,&h30)
EXIT SUB
END IF
INC OutLnIndex
token="OutLine"+STR$(OutLnIndex)
frmOutLine.Width=120
frmOutLine.Height=100
frmOutLine.PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(frmOutLine.Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
frmOutLine.Left=tPoint.x-2
frmOutLine.Top=tPoint.y-2
frmOutLine.AddLines token,"Child1","Child2"
frmOutLine.AddLines "Parent2","Child1","Child2"
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QOUTLINE|"+STR$(frmOutLine.Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","120",4)
PropertyFieldUpdate("Height","100",4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QOUTLINE]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex
END SUB
SUB AddQOLECONTAINER(hWnd AS LONG)
DIM oleContainer(OLEContIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="OLEContainer"+STR$(OLEContIndex+1)
oleContainer(OLEContIndex).Width=100
oleContainer(OLEContIndex).Height=100
oleContainer(OLEContIndex).BevelOuter=2
oleContainer(OLEContIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(oleContainer(OLEContIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
oleContainer(OLEContIndex).Left=tPoint.x
oleContainer(OLEContIndex).Top=tPoint.y
oleContainer(OLEContIndex).CAPTION=token
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QOLECONTAINER|"+STR$(oleContainer(OLEContIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","100",4)
PropertyFieldUpdate("Height","100",4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QOLECONTAINER]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC OLEContIndex
END SUB
SUB AddQGLASSFRAME(hWnd AS LONG)
MESSAGEBOX("Not available ATT!","RapidFRM "+VER,&h10)
END SUB
SUB AddQCANVAS(hWnd AS LONG)
DIM panCanv(CanvasIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="Canvas"+STR$(CanvasIndex+1)
panCanv(CanvasIndex).Width=105
panCanv(CanvasIndex).Height=105
panCanv(CanvasIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(panCanv(CanvasIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
panCanv(CanvasIndex).Left=tPoint.x
panCanv(CanvasIndex).Top=tPoint.y
panCanv(CanvasIndex).CAPTION=token
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QCANVAS|"+STR$(panCanv(CanvasIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","105",4)
PropertyFieldUpdate("Height","105",4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QCANVAS]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC CanvasIndex
END SUB
SUB AddQIMAGE(hWnd AS LONG)
DIM panImage(ImageIndex+1) AS QPANEL
DEFSTR tstr, token
DIM tPoint AS PointAPI
token="Image"+STR$(ImageIndex+1)
panImage(ImageIndex).Width=105
panImage(ImageIndex).Height=105
panImage(ImageIndex).BevelOuter=2
panImage(ImageIndex).COLOR=&hffffff
panImage(ImageIndex).PARENT=Forms(CurrentForm)
IF hWnd<>Forms(CurrentForm).Handle THEN
SetParent(panImage(ImageIndex).Handle,hWnd)
END IF
tPoint.x=Screen.MOUSEX: tPoint.y=Screen.MOUSEY
ScreenToClient(hWnd,tPoint)
panImage(ImageIndex).Left=tPoint.x
panImage(ImageIndex).Top=tPoint.y
panImage(ImageIndex).CAPTION=token
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|QIMAGE|"+STR$(panImage(ImageIndex).Handle)+"|"+token+"|"+token+"|"+STR$(hWnd)+"~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
PropertyFieldUpdate("Left",STR$(tPoint.x),4)
PropertyFieldUpdate("Top",STR$(tPoint.y),4)
PropertyFieldUpdate("Width","105",4)
PropertyFieldUpdate("Height","105",4)
PropertyFieldUpdate("Caption",token,4)
PropertyFieldUpdate("Parent",WhichParent(hWnd),4)
SelectionCombo.AddItems token+" [QIMAGE]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC ImageIndex
END SUB
SUB AddNonVisible(hWnd AS LONG)
DIM dNonVis(NonVIndex+1) AS QBUTTON
DEFINT ObjIdx
DEFSTR tstr, ObjType, ObjName
DIM tPoint AS PointAPI
SELECT CASE NewObjectID
CASE 31
IF OpenDlgIndex>0 THEN EXIT SUB
INC OpenDlgIndex: ObjIdx=OpenDlgIndex
ObjName="OpenDialog": ObjType="QOPENDIALOG"
CASE 32
IF SaveDlgIndex>0 THEN EXIT SUB
INC SaveDlgIndex: ObjIdx=SaveDlgIndex
ObjName="SaveDialog": ObjType="QSAVEDIALOG"
CASE 33
IF FontDlgIndex>0 THEN EXIT SUB
INC FontDlgIndex: ObjIdx=FontDlgIndex
ObjName="FontDialog": ObjType="QFONTDIALOG"
CASE 34
IF ColorDlgIndex>0 THEN EXIT SUB
INC ColorDlgIndex: ObjIdx=ColorDlgIndex
ObjName="ColorDialog": ObjType="QCOLORDIALOG"
CASE 35
INC BmpIndex: ObjIdx=BmpIndex
ObjName="Bitmap"+STR$(ObjIdx): ObjType="QBITMAP"
CASE 36
INC ImgListIndex: ObjIdx=ImgListIndex
ObjName="ImageList"+STR$(ObjIdx): ObjType="QIMAGELIST"
CASE 37
INC TimerIndex: ObjIdx=TimerIndex
ObjName="Timer"+STR$(ObjIdx): ObjType="QTIMER"
CASE 38
INC SockIndex: ObjIdx=SockIndex
ObjName="Socket"+STR$(ObjIdx): ObjType="QSOCKET"
CASE 39
INC FStreamIndex: ObjIdx=FStreamIndex
ObjName="FileStream"+STR$(ObjIdx): ObjType="QFILESTREAM"
CASE 40
INC MStreamIndex: ObjIdx=MStreamIndex
ObjName="MemStream"+STR$(ObjIdx): ObjType="QMEMORYSTREAM"
CASE 41
INC FontIndex: ObjIdx=FontIndex
ObjName="Font"+STR$(ObjIdx): ObjType="QFONT"
CASE 42
INC SQLIndex: ObjIdx=SQLIndex
ObjName="MySQL"+STR$(ObjIdx): ObjType="QMYSQL"
CASE 43
INC OleObjIndex: ObjIdx=OleObjIndex
ObjName="OLEObject"+STR$(ObjIdx): ObjType="QOLEOBJECT"
CASE 44
INC RegIndex: ObjIdx=RegIndex
ObjName="Registry"+STR$(ObjIdx): ObjType="QREGISTRY"
CASE 45
INC StrListIndex: ObjIdx=StrListIndex
ObjName="StringList"+STR$(ObjIdx): ObjType="QSTRINGLIST"
CASE ELSE
EXIT SUB
END SELECT
IF NonVIndex=0 THEN
NonVisForm.Visible=True
ELSE
NonVisForm.Width=NonVisForm.Width+75
END IF
dNonVis(NonVIndex).PARENT=NonVisForm
dNonVis(NonVIndex).Left=NonVIndex*75+15
dNonVis(NonVIndex).Top=0
dNonVis(NonVIndex).Width=75
dNonVis(NonVIndex).Height=50
dNonVis(NonVIndex).CAPTION=ObjName
CurrentObject=ObjectIndex
tstr=STR$(NewObjectID)+"|"+ObjType+"|"+STR$(dNonVis(NonVIndex).Handle)+"|"+ObjName+"|"+ObjName+"|0~"
ObjectList(CurrentObject)=tstr+GetDefaultProperties(NewObjectID)
SelectionCombo.AddItems ObjName+" ["+ObjType+"]"
SelectionCombo.ItemIndex=CurrentObject
UpdatePropGrid(CurrentObject)
INC ObjectIndex: INC NonVIndex
END SUB
FUNCTION IsParentValid(hWnd AS LONG) AS INTEGER
DEFINT i
DEFSTR tstr
FOR i=0 TO ObjectIndex-1
tstr=ObjectList(i)
IF hWnd=VAL(FIELD$(tstr,"|",3)) THEN
tstr=FIELD$(tstr,"|",2)
SELECT CASE tstr
CASE "QFORM","QPANEL","QTABCONTROL","QGROUPBOX","QSCROLLBOX"
Result=True
CASE ELSE
Result=False
END SELECT
EXIT FOR
END IF
NEXT i
END FUNCTION
SUB AddNewObject
DEFLNG hWnd
IF ObjectIndex>MAX_OBJECTS THEN
MESSAGEBOX("Maximum components ("+STR$(MAX_OBJECTS)+") has been reached","RapidFRM "+VER,&H30)
NewObjectID=-1
EXIT SUB
END IF
IF NewObjectID < NON_VISIBLE THEN
hWnd=WindowFromPoint(Screen.MOUSEX,Screen.MOUSEY)
IF IsParentValid(hWnd)=False THEN
hWnd=GetParent(hWnd)
IF IsParentValid(hWnd)=False THEN
MESSAGEBOX("ERROR: Non-valid parent?","RapidFRM "+VER,&H30)
NewObjectID=-1
EXIT SUB
END IF
END IF
END IF
HideCarets
SELECT CASE NewObjectID
CASE 1: AddQEDIT(hWnd)
CASE 2: AddQRICHEDIT(hWnd)
CASE 3: AddQLABEL(hWnd)
CASE 4: AddQBUTTON(hWnd)
CASE 5: AddQCOOLBTN(hWnd)
CASE 6: AddQOVALBTN(hWnd)
CASE 7: AddQCHECKBOX(hWnd)
CASE 8: AddQRADIOBUTTON(hWnd)
CASE 9: AddQPANEL(hWnd)
CASE 10: AddQTABCONTROL(hWnd)
CASE 11: AddQCOMBOBOX(hWnd)
CASE 12: AddQLISTBOX(hWnd)
CASE 13: AddQGROUPBOX(hWnd)
CASE 14: AddQSCROLLBOX(hWnd)
CASE 15: AddQSCROLLBAR(hWnd)
CASE 16: AddQSTRINGGRID(hWnd)
CASE 17: AddQLISTVIEW(hWnd)
CASE 18: AddQDIRTREE(hWnd)
CASE 19: AddQFILELISTBOX(hWnd)
CASE 20: AddQTREEVIEW(hWnd)
CASE 21: AddQOUTLINE(hWnd)
CASE 22: AddQGAUGE(hWnd)
CASE 23: AddQTRACKBAR(hWnd)
CASE 24: AddQHEADER(hWnd)
CASE 25: AddQSTATUSBAR(hWnd)
CASE 26: AddQCANVAS(hWnd)
CASE 27: AddQIMAGE(hWnd)
CASE 28: AddQOLECONTAINER(hWnd)
CASE 29: AddQSPLITTER(hWnd)
CASE 30: AddQGLASSFRAME(hWnd)
CASE 31 TO 45: AddNonVisible(hWnd)
END SELECT
NewObjectID=-1
END SUB
SUB LoadMenu(which AS INTEGER, index AS INTEGER)
DEFINT i
DEFSTR tstr, token, ThisParent=""
MenuText.Clear
IF which=MAINMENU THEN
MenuUpdateStr=LTRIM$(MainMenuList)
token="#4"
ThisParent=LTRIM$(RTRIM$(cbMMenu.Item(cbMMenu.ItemIndex)))
ELSE
MenuUpdateStr=LTRIM$(PopMenuList)
token="#5"
END IF
HelpRef.Position=0
FOR i=1 TO HelpRef.LineCount
tstr=HelpRef.ReadLine
IF FIELD$(tstr," ",1)=token THEN EXIT FOR
NEXT i
token=STR$(index)
tstr="The following code will be added to your project:"
MenuText.AddStrings "", tstr, ""
FOR i=i+1 TO HelpRef.LineCount
tstr=HelpRef.ReadLine-CHR$(13)-CHR$(10)
IF LEFT$(tstr,1)="#" THEN EXIT FOR
IF INSTR(tstr,"##")>0 THEN tstr=REPLACESUBSTR$(tstr,"##",token)
IF INSTR(UCASE$(tstr),"PARENT")>0 THEN
IF ThisParent<>"" THEN tstr=" Parent = "+ThisParent
END IF
IF NOT ((chkMenu.Checked=False) AND (LEFT$(tstr,1)="'")) THEN
MenuUpdateStr=MenuUpdateStr+LTRIM$(tstr)+"~"
IF INSTR(UCASE$(tstr),"CAPTION")>0 THEN
tstr=RTRIM$(FIELD$(tstr,"=",1))+" = "+QU+LTRIM$(FIELD$(tstr,"=",2))+QU
END IF
MenuText.AddStrings tstr
END IF
NEXT i
MenuUpdateStr=LEFT$(MenuUpdateStr,LEN(MenuUpdateStr)-1)+"@"
END SUB
SUB OptionChange
SELECT CASE btnUpdate.Tag
CASE MAINMENU: LoadMenu(MAINMENU,MainMenuIndex)
CASE POPMENU: LoadMenu(POPMENU,PopUpIndex)
END SELECT
END SUB
SUB ParentChange
IF btnUpdate.Tag=MAINMENU THEN
btnUpdate.Enabled=True
LoadMenu(MAINMENU,MainMenuIndex)
END IF
END SUB
SUB AddMainMenu
btnUpdate.Tag=MAINMENU
btnUpdate.Enabled=True
LoadMenu(MAINMENU,MainMenuIndex)
END SUB
SUB AddPopupMenu
btnUpdate.Tag=POPMENU
btnUpdate.Enabled=True
LoadMenu(POPMENU,PopUpIndex)
END SUB
SUB UpdateFwdDeclares
DEFSTR tstr, token
DEFINT i
SELECT CASE btnUpdate.Tag
CASE MAINMENU: tstr=MenuUpdateStr-MainMenuList
CASE POPMENU: tstr=MenuUpdateStr-PopMenuList
END SELECT
FOR i=1 TO TALLY(tstr,"~")
token=FIELD$(tstr,"~",i)
IF RTRIM$(FIELD$(token,"=",1))="OnClick" THEN
FwdDeclares=FwdDeclares+"SUB "+LTRIM$(FIELD$(token,"=",2))+"~"
END IF
NEXT i
END SUB
SUB UpdateProjectMenu
DEFSTR tstr
UpdateFwdDeclares
SELECT CASE btnUpdate.Tag
CASE MAINMENU
MainMenuList=MenuUpdateStr
INC MainMenuIndex
tstr=RTRIM$(cbMMenu.Item(cbMMenu.ItemIndex))
IF tstr<>"" THEN
cbMMenu.DelItems(cbMMenu.ItemIndex)
END IF
CASE POPMENU
PopMenuList=MenuUpdateStr
INC PopUpIndex
END SELECT
btnUpdate.Tag=0
btnUpdate.Enabled=False
MenuText.Clear
END SUB
SUB MenuEditor
DEFINT i, j
DEFSTR tstr, token, frmNames=" "
cbMMenu.Clear
FOR i=0 TO ObjectIndex-1
tstr=FIELD$(ObjectList(i),"~",1)
IF FIELD$(tstr,"|",2)="QFORM" THEN
frmNames=frmNames+FIELD$(tstr,"|",5)+"~"
END IF
NEXT i
frmNames=LTRIM$(frmNames)
MainMenuIndex=TALLY(MainMenuList,"@")
IF MainMenuIndex>0 THEN
FOR i=1 TO MainMenuIndex
tstr=LTRIM$(FIELD$(MainMenuList,"@",i))+"~"
IF INSTR(UCASE$(tstr),"PARENT")>0 THEN
FOR j=1 TO TALLY(tstr,"~")
token=FIELD$(tstr,"~",j)
IF INSTR(UCASE$(token),"PARENT")>0 THEN
token=LTRIM$(FIELD$(token,"=",2))+"~"
frmNames=frmNames-token
END IF
NEXT j
END IF
NEXT i
END IF
cbMMenu.AddItems(" ")
FOR i=1 TO TALLY(frmNames,"~")
tstr=FIELD$(frmNames,"~",i)
cbMMenu.AddItems(tstr)
NEXT i
cbMMenu.Text="<Select a parent form>"
INC MainMenuIndex
PopUpIndex=TALLY(PopMenuList,"@")+1
MenuPanel.Visible=True
MenuPanel.Repaint
MenuText.Clear
btnUpdate.Enabled=False
chkMenu.Checked=True
END SUB
SUB UpdateObjList(objectName AS STRING)
DEFINT i, cnt
DEFSTR tstr, tok1, tok2
tstr=ObjectList(CurrentObject)
tok1=FIELD$(tstr,"~",1)
tstr=tstr-tok1
cnt=TALLY(tok1,"|")+1
tok2=""
FOR i=1 TO 4
tok2=tok2+FIELD$(tok1,"|",i)+"|"
NEXT i
tok2=tok2+objectName
FOR i=i+1 TO cnt
tok2=tok2+"|"+FIELD$(tok1,"|",i)
NEXT i
tstr=tok2+tstr
ObjectList(CurrentObject)=tstr
END SUB
SUB UpdateObjCombo(newObject AS STRING)
SelectionCombo.DelItems(ObjectIndex-1)
SelectionCombo.AddItems newObject
END SUB
SUB UpdateNewProperty(srcString AS STRING)
DEFINT i, offset
DEFSTR ObjString, tstr, token
ObjString=ObjectList(CurrentObject)
offset=4
token=UCASE$(RTRIM$(FIELD$(srcString,"=",1)))
IF (LEFT$(token,2)="ON") OR (token="WNDPROC") THEN offset=2
FOR i=1 TO TALLY(ObjString,"~")
tstr=FIELD$(ObjString,"~",i)
IF UCASE$(FIELD$(tstr,"|",1))=token THEN
token=LTRIM$(FIELD$(srcString,"=",2))
PropertyFieldUpdate(FIELD$(tstr,"|",1),token,offset)
EXIT FOR
END IF
NEXT i
END SUB
SUB UpdateObjGrid(Start AS INTEGER, blkString AS STRING)
DEFINT i, cnt, lev
DEFSTR tstr, token
lev=1
cnt=TALLY(blkString,"~")
FOR i=Start TO cnt
tstr=FIELD$(blkString,"~",i)
token=UCASE$(FIELD$(tstr," ",1))
SELECT CASE token
CASE "CREATE": INC lev
CASE "END": DEC lev: IF lev=0 THEN EXIT FOR
CASE ELSE
IF (lev=1) AND (INSTR(tstr,"=")>0) THEN
UpdateNewProperty(tstr)
END IF
END SELECT
NEXT i
UpdatePropGrid(CurrentObject)
END SUB
FUNCTION ExtractObjectID(objType AS STRING) AS INTEGER
DEFINT i
DEFSTR tstr
IF LEFT$(objType,5)="QFORM" THEN
Result=0
ELSE
FOR i=1 TO MAX_TOOLBTNS
tstr=UCASE$(FIELD$(ToolbarHint,"~",i))
IF objType=tstr THEN EXIT FOR
NEXT i
Result=i
END IF
END FUNCTION
SUB RepaintNewForm(frmString AS STRING)
DEFINT i, lev
DEFINT left, top, width, height, defWidth, defHeight
DEFSTR tstr, token, cap
left=0: top=0: width=0: height=0
defWidth=Forms(CurrentForm).Width: defHeight=Forms(CurrentForm).Height
cap="Form"+STR$(FrmIndex-1)
lev=1
FOR i=2 TO TALLY(frmString,"~")
tstr=LTRIM$(FIELD$(frmString,"~",i))
IF UCASE$(LEFT$(tstr,7))="CREATE " THEN
INC lev
ELSEIF UCASE$(LEFT$(tstr,7))="END CRE" THEN
DEC lev
IF lev=0 THEN EXIT FOR
ELSEIF (lev=1) AND (INSTR(tstr,"=")>0) THEN
token=UCASE$(RTRIM$(FIELD$(tstr,"=",1)))
SELECT CASE token
CASE "LEFT": left=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "TOP": top=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "WIDTH": width=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "HEIGHT": height=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "CAPTION": cap=LTRIM$(FIELD$(tstr,"=",2))
END SELECT
END IF
NEXT i
IF left<0 THEN left=0: IF top<0 THEN top=0
IF width<=0 THEN width=defWidth: IF height<=0 THEN height=defHeight
SetWindowPos(Forms(CurrentForm).Handle, 0, left, top, width, height, SW_FLAGS)
SetWindowText(Forms(CurrentForm).Handle,cap)
END SUB
SUB RepaintNewObject(Start AS INTEGER, frmString AS STRING)
DEFINT i, lev
DEFINT width, height, defWidth, defHeight
DEFLNG hWnd
DEFSTR tstr, token, cap
DIM tRect AS QRECT
DIM tPoint AS PointAPI
tstr=ObjectList(CurrentObject)
token=FIELD$(tstr,"~",1)
hWnd=VAL(FIELD$(token,"|",3))
FOR i=2 TO TALLY(tstr,"~")
token=UCASE$(FIELD$(tstr,"~",i))
SELECT CASE FIELD$(token,"|",1)
CASE "WIDTH": defWidth=VAL(FIELD$(token,"|",4))
CASE "HEIGHT": defHeight=VAL(FIELD$(token,"|",4))
END SELECT
NEXT i
width=0: height=0: tPoint.x=0: tPoint.y=0
lev=1: cap=""
FOR i=Start TO TALLY(frmString,"~")
tstr=LTRIM$(FIELD$(frmString,"~",i))
IF UCASE$(LEFT$(tstr,7))="CREATE " THEN
INC lev
ELSEIF UCASE$(LEFT$(tstr,7))="END CRE" THEN
DEC lev
IF lev=0 THEN EXIT FOR
ELSEIF (lev=1) AND (INSTR(tstr,"=")>0) THEN
token=UCASE$(RTRIM$(FIELD$(tstr,"=",1)))
SELECT CASE token
CASE "LEFT": tPoint.x=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "TOP": tPoint.y=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "WIDTH": width=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "HEIGHT": height=VAL(LTRIM$(FIELD$(tstr,"=",2)))
CASE "CAPTION": cap=LTRIM$(FIELD$(tstr,"=",2))
END SELECT
END IF
NEXT i
IF tPoint.x<0 THEN tPoint.x=0
IF tPoint.y<0 THEN tPoint.y=0
IF width<=0 THEN width=defWidth
IF height<=0 THEN height=defHeight
ClientToScreen(hWnd,tPoint)
tRect.Left=tPoint.x
tRect.Top=tPoint.y
tRect.Right=tRect.Left+width
tRect.Bottom=tRect.Top+height
RefreshObject(hWnd,tRect)
IF cap<>"" THEN
SetWindowText(hWnd,cap)
END IF
END SUB
FUNCTION SetCursorInParent(hWnd AS LONG, objType AS STRING) AS INTEGER
DEFINT px, py, y
DIM pRect AS QRECT
Result=True
GetWindowRect(hWnd,pRect)
SELECT CASE objType
CASE "QFORM"
px=pRect.Left+4: py=pRect.Top+23
CASE "QSCROLLBOX"
px=pRect.Left+2: py=pRect.Top+2
CASE "QPANEL","QGROUPBOX","QTABCONTROL"
px=pRect.Left: py=pRect.Top
CASE ELSE
px=pRect.Left: py=pRect.Top
SetCursorPos(px,py)
EXIT FUNCTION
END SELECT
FOR px=px TO pRect.Right STEP 5
FOR y=py TO pRect.Bottom STEP 5
IF WindowFromPoint(px,y)=hWnd THEN
SetCursorPos(px,y)
EXIT FUNCTION
END IF
NEXT y
NEXT px
Result=False
END FUNCTION
FUNCTION InsertObjBlock(Start AS INTEGER, frmString AS STRING) AS INTEGER
DEFSTR tstr, objType
DEFLNG hWnd
DEFINT i, cnt
tstr=FIELD$(frmString,"~",Start)
objType=UCASE$(FIELD$(tstr," ",4))
NewObjectID=ExtractObjectID(objType)
IF objType="QFORM" THEN
AddNewForm
RepaintNewForm(frmString)
ELSE
AddNewObject
RepaintNewObject(Start+1,frmString)
END IF
scan.Enabled=False
tstr=FIELD$(tstr," ",2)
UpdateObjList(tstr)
UpdateObjCombo(tstr+" ["+objType+"]")
UpdateObjGrid(Start+1,frmString)
tstr=ObjectList(ObjectIndex-1)
hWnd=VAL(FIELD$(tstr,"|",3))
cnt=TALLY(frmString,"~")
FOR i=Start+1 TO cnt
tstr=LTRIM$(FIELD$(frmString,"~",i))
SELECT CASE UCASE$(LEFT$(tstr,6))
CASE "END CR"
Result=i
EXIT FUNCTION
CASE "CREATE"
IF SetCursorInParent(hWnd,objType) THEN
i=InsertObjBlock(i,frmString)
IF i = -1 THEN
Result = -1
EXIT FUNCTION
END IF
ELSE
SHOWMESSAGE "SetCursorInParent() failed for parent "+objType
Result = -1
EXIT FUNCTION
END IF
END SELECT
NEXT i
END FUNCTION
SUB InsertThisForm(frmString AS STRING)
InsertObjBlock(1,frmString)
END SUB
SUB BuildFwdDeclarations
DEFINT i, j
DEFSTR tstr, tok1, tok2
FwdDeclares=" "
FOR i=0 TO MAX_OBJECTS
tstr=ObjectList(i)
IF tstr="" THEN EXIT FOR
FOR j=1 TO TALLY(tstr,"~")
tok1=FIELD$(tstr,"~",j)
tok2=UCASE$(FIELD$(tok1,"|",1))
IF (LEFT$(tok2,2)="ON") OR (tok2="WNDPROC") THEN
tok2=FIELD$(tok1,"|",2)
IF (tok2<>"") AND (INSTR(FwdDeclares,tok2)=0) THEN
tok2=tok2+FIELD$(tok1,"|",3)
FwdDeclares=FwdDeclares+"SUB "+tok2+"~"
END IF
END IF
NEXT j
NEXT i
FwdDeclares=LTRIM$(FwdDeclares)
END SUB
SUB ShowProject
DEFINT i, cnt
DEFSTR tstr, exForms
DelayTimer.Enabled=False
scan.Enabled=False
ExistDeclares=" ": UnknownList=" ": exForms=" "
cnt=TALLY(FormsList,"@")
IF cnt>MAX_FORMS THEN
tstr="The maximum number of forms has been exceeded!"+CRLF
tstr=tstr+"Only the FIRST "+STR$(MAX_FORMS)+" forms can be edited!"
MESSAGEBOX(tstr,"RapidFRM "+VER,&h30)
END IF
i=1
DO
tstr=LTRIM$(FIELD$(FormsList,"@",i))
IF i>MAX_FORMS THEN
exForms=exForms+tstr+"@"
ELSE
InsertThisForm(tstr+"~")
END IF
INC i
LOOP UNTIL i>cnt
exForms=LTRIM$(exForms)
UnknownList=exForms+LTRIM$(UnknownList)
BuildFwdDeclarations
FOR i=1 TO TALLY(FwdDeclares,"~")
tstr=FIELD$(FwdDeclares,"~",i)
IF INSTR(tstr,"(")>0 THEN tstr=RTRIM$(FIELD$(tstr,"(",1))
ExistDeclares=ExistDeclares+tstr+"~"
NEXT i
ExistDeclares=LTRIM$(ExistDeclares)
FwdDeclares=" "
scan.Enabled=True
END SUB
FUNCTION ReformatLine(inpStr AS STRING) AS STRING
DEFSTR tstr, tok1, tok2, resString
tstr=REPLACESUBSTR$(inpStr,CHR$(9)," ")
IF (UCASE$(LEFT$(tstr,4))="REM ") OR (LEFT$(tstr,1)="'") OR _
(LTRIM$(tstr)="") THEN
Result=""
EXIT FUNCTION
END IF
IF INSTR(tstr,"'")>0 THEN
tstr=RTRIM$(FIELD$(tstr,"'",1))
END IF
tstr=REPLACESUBSTR$(tstr,QU," ")
tstr=RTRIM$(LTRIM$(tstr))
resString=" "
IF INSTR(tstr,"=")>0 THEN
tok1=RTRIM$(FIELD$(tstr,"=",1))+" = "
tok2=LTRIM$(FIELD$(tstr,"=",2))
resString=tok1+tok2
ELSE
WHILE tstr<>""
tok1=FIELD$(tstr," ",1)
resString=resString+tok1+" "
tstr=LTRIM$(RIGHT$(tstr,LEN(tstr)-LEN(tok1)))
WEND
END IF
Result=RTRIM$(LTRIM$(resString))
END FUNCTION
FUNCTION ExtractOther(StartIdx AS INTEGER, inpString AS STRING) AS INTEGER
DEFSTR tstr, token, ParentName, objString
DEFINT i, cnt, lev
ParentName=FIELD$(inpString," ",2)
objString=FIELD$(inpString,"~",StartIdx)+"~"
IF UCASE$(FIELD$(objString," ",4))<>"QPOPUPMENU~" THEN
tstr="Parent = "+ParentName+"~"
objString=objString+tstr
END IF
lev=1: cnt=TALLY(inpString,"~")+1
FOR i=StartIdx+1 TO cnt
tstr=FIELD$(inpString,"~",i)
token=UCASE$(FIELD$(tstr," ",1))
IF token="CREATE" THEN
INC lev
ELSEIF token="END" THEN
DEC lev
END IF
objString=objString+tstr+"~"
IF lev=0 THEN EXIT FOR
NEXT i
objString=LEFT$(objString,LEN(objString)-1)
tstr=FIELD$(inpString,"~",StartIdx)
token=UCASE$(FIELD$(tstr," ",4))
SELECT CASE token
CASE "QMAINMENU": MainMenuList=MainMenuList+objString+"@"
CASE "QPOPUPMENU": PopMenuList=PopMenuList+objString+"@"
CASE ELSE
UnknownList=UnknownList+objString+"@"
END SELECT
Result=i
END FUNCTION
SUB ParseForm(inpString AS STRING)
DEFINT i, cnt, objType
DEFSTR tstr, token, frmString
frmString=FIELD$(inpString,"~",1)+"~"
cnt=TALLY(inpString,"~")
FOR i=2 TO cnt
tstr=FIELD$(inpString,"~",i)
token=UCASE$(FIELD$(tstr," ",1))
IF token="CREATE" THEN
token=UCASE$(FIELD$(tstr," ",4))
objType=ExtractObjectID(token)
IF (objType > 0) AND (objType < NON_VISIBLE) THEN
frmString=frmString+tstr+"~"
ELSE
i=ExtractOther(i,inpString)
END IF
ELSE
frmString=frmString+tstr+"~"
END IF
NEXT i
frmString=LEFT$(frmString,LEN(frmString)-1)
FormsList=FormsList+frmString+"@"
END SUB
FUNCTION IsParentKnown(inpString AS STRING) AS INTEGER
DEFINT i, cnt
DEFSTR tstr, FormName=""
Result=False
cnt=TALLY(inpString,"~")+1
FOR i=2 TO cnt
tstr=FIELD$(inpString,"~",i)
IF UCASE$(RTRIM$(FIELD$(tstr,"=",1)))="PARENT" THEN
FormName=UCASE$(LTRIM$(FIELD$(tstr,"=",2)))
EXIT FOR
END IF
NEXT i
IF FormName<>"" THEN
cnt=TALLY(FormsList,"@")
FOR i=1 TO cnt
tstr=FIELD$(FormsList,"@",i)
tstr=UCASE$(FIELD$(tstr," ",2))
IF tstr=FormName THEN
Result=True
EXIT FOR
END IF
NEXT i
END IF
END FUNCTION
SUB CreateDebugFile
DIM oFile AS QFILESTREAM
DEFINT i
DEFSTR tstr
oFile.OPEN("DebugMap.txt", fmCreate)
FOR i=1 TO TALLY(FormsList,"@")
tstr=FIELD$(FormsList,"@",i)
oFile.WriteLine(tstr)
NEXT i
FOR i=1 TO TALLY(MainMenuList,"@")
tstr=FIELD$(MainMenuList,"@",i)
oFile.WriteLine(tstr)
NEXT i
FOR i=1 TO TALLY(PopMenuList,"@")
tstr=FIELD$(PopMenuList,"@",i)
oFile.WriteLine(tstr)
NEXT i
FOR i=1 TO TALLY(KnownsList,"@")
tstr=FIELD$(KnownsList,"@",i)
oFile.WriteLine(tstr)
NEXT i
FOR i=1 TO TALLY(UnknownList,"@")
tstr=FIELD$(UnknownList,"@",i)
oFile.WriteLine(tstr)
NEXT i
oFile.CLOSE
END SUB
SUB ParseInputStream
DEFINT i, lev, cnt, objType
DEFSTR tstr, blkString
DEFSTR CreateBlocks(1 TO MAX_OBJECTS)
FOR cnt=1 TO MAX_OBJECTS
CreateBlocks(cnt)=""
NEXT cnt
blkString=" ": lev=0: cnt=0
ProjectStream.Position=0
FOR i=1 TO ProjectStream.LineCount
tstr=ProjectStream.ReadLine
tstr=ReformatLine(tstr)
IF tstr="" THEN
ELSEIF UCASE$(FIELD$(tstr," ",1))="CREATE" THEN
IF (cnt=0) AND (lev=0) THEN StartOfBlocks=i
INC lev
blkString=blkString+tstr+"~"
ELSEIF lev>0 THEN
blkString=blkString+tstr+"~"
IF (UCASE$(FIELD$(tstr," ",1))="END") THEN
DEC lev
IF lev=0 THEN
EndOfBlocks=i
INC cnt
blkString=LEFT$(blkString,LEN(blkString)-1)+"@"
CreateBlocks(cnt)=LTRIM$(blkString)
blkString=" "
END IF
END IF
END IF
NEXT i
FOR i=1 TO cnt
blkString=CreateBlocks(i)
tstr=FIELD$(blkString,"~",1)
tstr=UCASE$(FIELD$(tstr," ",4))
IF LEFT$(tstr,5)="QFORM" THEN
tstr=LEFT$(blkString,LEN(blkString)-1)+"~"
ParseForm(tstr)
ELSEIF tstr="QMAINMENU" THEN
MainMenuList=LTRIM$(MainMenuList)+blkString
ELSEIF tstr="QPOPUPMENU" THEN
PopMenuList=LTRIM$(PopMenuList)+blkString
ELSE
objType=ExtractObjectID(tstr)
IF (objType > 0) AND (objType <= MAX_TOOLBTNS) THEN
IF IsParentKnown(blkString) THEN
KnownsList=LTRIM$(KnownsList)+blkString
ELSE
UnknownList=LTRIM$(UnknownList)+blkString
END IF
ELSE
UnknownList=LTRIM$(UnknownList)+blkString
END IF
END IF
NEXT i
END SUB
SUB LoadClipboardText
DEFSTR tstr
ClipBoard.OPEN
tstr=ClipBoard.Text
ClipBoard.Clear
ClipBoard.CLOSE
DOEVENTS
IF tstr="" THEN
MESSAGEBOX("The clipboard is empty - terminating!","RapidFRM "+VER,&h30)
ErrorCondition=True
ProgramEnd
ELSE
ProjectStream.CLOSE
ProjectStream.WriteStr(tstr,LEN(tstr))
ProjectStream.Position=0
END IF
END SUB
SUB LoadProjectFile
DIM file AS QFILESTREAM
DEFSTR tstr
IF FILEEXISTS(ProjectFile)=0 THEN
MESSAGEBOX("File "+ProjectFile+" does not exist - terminating!","RapidFRM "+VER,&h30)
ErrorCondition=True
ProgramEnd
END IF
tstr=UCASE$(RIGHT$(ProjectFile,4))
SELECT CASE tstr
CASE ".BAS",".RQB",".INC",".FRM"
CASE ELSE
tstr="Usage:"+CRLF+"RapidFRM.exe [<source file>]"+CRLF
tstr=tstr+"Optional source file to be of type BAS, RQB, INC or FRM"
MESSAGEBOX(tstr,"RapidFRM "+VER,&h40)
ErrorCondition=True
ProgramEnd
END SELECT
ProjectStream.CLOSE
file.OPEN(ProjectFile,fmOpenRead)
ProjectStream.CopyFrom(file,0)
file.CLOSE
DOEVENTS
ProjectStream.Position=0
END SUB
SUB LoadProject
IF ProjectMode=INPUT_CLIPBRD THEN
LoadClipboardText
ELSE
LoadProjectFile
END IF
ParseInputStream
END SUB
FUNCTION FmtOtherBlocks(inpStr AS STRING) AS STRING
DEFINT i, cnt
DEFSTR tstr, token, spacer=" "
DEFSTR blkString
cnt=TALLY(inpStr,"~")-1
blkString=FIELD$(inpStr,"~",1)+CRLF
FOR i=2 TO cnt
tstr=FIELD$(inpStr,"~",i)
token=FIELD$(tstr," ",1)
SELECT CASE UCASE$(token)
CASE "CAPTION", "TEXT", "HINT"
token=LTRIM$(FIELD$(tstr,"=",2))
token=QU+token+QU
tstr=RTRIM$(FIELD$(tstr,"=",1))
tstr=tstr+" = "+token
END SELECT
tstr=spacer+tstr+CRLF
blkString=blkString+tstr
NEXT i
tstr=FIELD$(inpStr,"~",i)
blkString=blkString+tstr+CRLF
Result=blkString
END FUNCTION
SUB SaveAndExit
DIM newStream AS QMEMORYSTREAM
DIM NewFile AS QFILESTREAM
DEFINT i, lev
DEFSTR tstr, token
IF ProjectMode=INPUT_FILE THEN
tstr=LEFT$(ProjectFile, RINSTR(ProjectFile,"."))+"bup"
IF FILEEXISTS(tstr) THEN
KILL tstr
DOEVENTS
END IF
RENAME(ProjectFile,tstr)
DOEVENTS
END IF
ProjectStream.Position=0
newStream.CLOSE
FOR i=1 TO StartOfBlocks-1
tstr=ProjectStream.ReadLine
newStream.WriteLine(tstr)
NEXT i
FOR i=i TO EndOfBlocks
tstr=ProjectStream.ReadLine
NEXT i
IF LTRIM$(FwdDeclares)<>"" THEN
IF ProjectMode=INPUT_CLIPBRD THEN
newStream.WriteLine("'FWD_DECL")
ELSE
newStream.WriteLine("' Forward declarations")
END IF
FOR i=1 TO TALLY(FwdDeclares,"~")
tstr=LTRIM$(RTRIM$(FIELD$(FwdDeclares,"~",i)))
newStream.WriteLine("DECLARE "+tstr)
NEXT i
newStream.WriteLine("")
END IF
IF ProjectMode=INPUT_CLIPBRD THEN
newStream.WriteLine("'FRM_CODE")
newStream.WriteLine("' Code generated by RapidFRM "+VER)
END IF
FOR i=0 TO CodeText.LineCount-1
tstr=CodeText.Line(i)
newStream.WriteLine(tstr)
NEXT i
IF UnknownList<>"" THEN
FOR i=1 TO TALLY(UnknownList,"@")
tstr=FIELD$(UnknownList,"@",i)+"~"
tstr=FmtOtherBlocks(tstr)
newStream.WriteLine(tstr)
NEXT i
END IF
i=EndOfBlocks+1
FOR i=i TO ProjectStream.LineCount
tstr=ProjectStream.ReadLine
newStream.WriteLine(tstr)
NEXT i
IF LTRIM$(FwdDeclares)<>"" THEN
newStream.WriteLine("")
IF ProjectMode=INPUT_CLIPBRD THEN
newStream.WriteLine("'FRM_STUBS")
END IF
FOR i=1 TO TALLY(FwdDeclares,"~")
tstr=FIELD$(FwdDeclares,"~",i)
newStream.WriteLine(LTRIM$(tstr))
newStream.WriteLine("END SUB")
newStream.WriteLine("")
NEXT i
END IF
IF ProjectMode=INPUT_FILE THEN
NewFile.OPEN(ProjectFile, fmCreate)
NewFile.CopyFrom(newStream,0)
NewFile.CLOSE
tstr="Your project file has been saved."+CRLF+"Your original file was archived"
MESSAGEBOX(tstr,"RapidFRM "+VER,&h40)
ELSE
newStream.Position=0: tstr=""
FOR i=1 TO newStream.LineCount
tstr=tstr+newStream.ReadLine+CRLF
NEXT i
ClipBoard.OPEN
ClipBoard.Clear
ClipBoard.Text=tstr
ClipBoard.CLOSE
END IF
ErrorCondition=False: ObjectIndex=ComponentCount
ProgramEnd
END SUB
SUB ExitNoUpdate
DEFINT i
DEFSTR tstr=""
SELECT CASE ProjectMode
CASE STAND_ALONE, INPUT_FILE
ProgramEnd
CASE ELSE
ProjectStream.Position=0
FOR i=1 TO ProjectStream.LineCount
tstr=tstr+ProjectStream.ReadLine+CRLF
NEXT i
ClipBoard.OPEN: ClipBoard.Clear
ClipBoard.Text=tstr
ClipBoard.CLOSE
DOEVENTS
ErrorCondition=False: ObjectIndex=ComponentCount
ProgramEnd
END SELECT
END SUB
|
|