The main form of the basic architecture is mdiform.
Form Display Mode
Procedure tfmmain. mmcascadeclick (Sender: tobject); // stacked display form
Begin
Cascade;
End;
Procedure tfmmain. mmarrangeiconsclick (Sender: tobject); // arrange the form
Begin
Arrangeicons;
End;
Procedure tfmmain. mmhtitleclick (Sender: tobject); // display all forms horizontally
Begin
Tilemode: = tbhorizontal;
Tile;
End;
Procedure tfmmain. mmhtitleclick (Sender: tobject); // vertically display all forms
Begin
Tilemode: = tbvertical;
Tile;
End;
Main form custom functions and message processing:
Const
Wmcust = wm_user + $100;
Wmclose = wm_user ++ $110;
Wmfmactive = wm_user + $120;
Type
Pamodule = ^ tamodule;
Tamodule = record
Amenuitem: tmenuitem;
Classname: string;
Caption: string;
Form: tform;
Bloadok: Boolean;
End;
Procedure domenuitem (menuitem: tmenuitem );
Procedure wmcustdo (VAR wmmsg: tmessage); message wmcust;
Procedure wmclosedo (VAR wmmsg: tmessage); message wmclose;
Procedure wmactive (VAR wmmsg: tmessage); message wmfmactive;
Procedure wm_close (VAR wmmsg: twmclose); message wm_close;
Procedure tfmmain. wm_close (VAR wmmsg: twmclose );
VaR
Pmodule: pamodule;
Amodule: tamodule;
Begin
If custtabset. Tabs. Count = 0 then
Begin
Close;
Exit;
End;
Pmodule: = pamodule (custtabset. Tabs. objects [custtabset. tabindex]);
Amodule. Form: = pmodule ^. form;
(Amodule. Form as tform). close;
End;
Procedure tfmmain. wmactive (VAR wmmsg: tmessage );
VaR
Pmodule: pamodule;
Amodule: tamodule;
I: integer;
Begin
If wmmsg. MSG = wmfmactive then
Begin
If custtabset. Tabs. Count = 0 Then exit;
Custtabset. onclick: = nil;
For I: = 0 to custtabset. Tabs. Count-1 do
Begin
Pmodule: = pamodule (custtabset. Tabs. objects [I]);
Amodule. Form: = pmodule ^. form;
If amodule. Form. Name = activemdichild. name then
Begin
Custtabset. tabindex: = I;
Break;
End;
End;
Custtabset. onclick: = custtabsetclick;
End;
End;
Procedure tfmmain. wmcustdo (VAR wmmsg: tmessage );
VaR
Pmodule: pamodule;
Amodule: tamodule;
Begin
If wmmsg. MSG = wmcust then
Begin
If custtabset. Tabs. Count = 0 Then exit;
Lockwindowupdate (getmediatopwindow );
Pmodule: = pamodule (custtabset. Tabs. objects [custtabset. tabindex]);
Amodule. Form: = pmodule ^. form;
Amodule. amenuitem: = pmodule ^. amenuitem;
(Amodule. amenuitem as tmenuitem). Tag: = 0;
Custtabset. Tabs. Delete (custtabset. tabindex );
Dispose (pmodule );
Lockwindowupdate (0 );
End;
End;
Procedure tfmmain. wmclosedo (VAR wmmsg: tmessage );
Begin
If wmmsg. MSG = wmclose then
Begin
Custtabsetdblclick (NiL );
End;
End;
Procedure tfmmain. mmstockadjustclick (Sender: tobject );
Begin
Domenuitem (sender as tmenuitem );
End;
Procedure tfmmain. domenuitem (menuitem: tmenuitem );
VaR
Pmodule: pamodule;
Amodule: tamodule;
Begin
If menuitem. Tag = 0 then
Begin
New (pmodule );
Lockwindowupdate (getmediatopwindow );
If menuitem. Name = 'mmstockadjust 'then
Amodule: = dostock (dmdata. dbconn, userinfo );
//... Call each module
Lockwindowupdate (0 );
If amodule. bloadok then
Begin
Menuitem. Tag: = 1;
Pmodule ^. amenuitem: = menuitem;
Pmodule ^. classname: = amodule. classname;
Pmodule ^. Caption: = amodule. Caption;
Pmodule ^. Form: = amodule. form;
Pmodule ^. bloadok: = amodule. bloadok;
Custtabset. Tabs. addobject (amodule. Caption, tobject (pmodule ));
Custtabset. tabindex: = custtabset. Tabs. Count-1;
(Amodule. Form) as tform). windowstate: = wsmaximized;
End else
Begin
// Error
End;
End;
End;
// The custom control custtabset is added with dbclick
Procedure tfmmain. custtabsetdblclick (Sender: tobject );
VaR
Pmodule: pamodule;
Amodule: tamodule;
Begin
If custtabset. Tabs. Count = 0 Then exit;
Pmodule: = pamodule (custtabset. Tabs. objects [custtabset. tabindex]);
Amodule. Form: = pmodule ^. form;
(Amodule. Form as tform). close;
End;
Procedure tfmmain. custtabsetclick (Sender: tobject );
VaR
Pmodule: pamodule;
Amodule: tamodule;
Begin
If custtabset. Tabs. Count = 0 Then exit;
Pmodule: = pamodule (custtabset. Tabs. objects [custtabset. tabindex]);
Amodule. Form: = pmodule ^. form;
Lockwindowupdate (getmediatopwindow );
Showwindow (amodule. Form as tform). Handle, sw_restore );
Showwindow (amodule. Form as tform). Handle, sw_showmaximized );
Lockwindowupdate (0 );
End;
Subform formchild interface and message:
Function dostock (dbconn: tadoconnection; userinfo: tuserinfo): tamodule;
Begin
Fmstock: = tfmstock. Create (application );
Fmstock. dbconn: = dbconn;
Fmstock. curuserinfo: = userinfo;
Fmstock. formshow (NiL );
Fmstock. show;
Result. Caption: = fmstock. Caption;
Result. Form: = fmstock;
Result. classname: = fmstock. Name;
Result. bloadok: = true;
End;
Procedure tfmstock. formactivate (Sender: tobject );
Begin
Sendmessage (application. mainform. Handle, wmfmactive, 0, 0 );
End;
Procedure tfmstock. formclosequery (Sender: tobject;
VaR canclose: Boolean );
Begin
Canclose: = Showbox ('exit ['+ caption +? ') = Idyes;
If canclose then
Begin
Sendmessage (application. mainform. Handle, wmcust, 0, 0 );
End;
End;
Procedure tfmstock. btnclose (Sender: tobject );
Begin
Sendmessage (application. mainform. Handle, wmclose, 0, 0 );
End;
Procedure tfmstock. formclose (Sender: tobject;
VaR action: tcloseaction );
Begin
Action: = cafree;
End;