Multi-document Main Window File

Unit umainform;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, comctrls, toolwin, menus, imglist, stdctrls, uchildform;

Type
Tmainform1 = Class (tform)
Mainmenu1: tmainmenu;
Nfile: tmenuitem;
NNew: tmenuitem;
Nopen: tmenuitem;
Nclose: tmenuitem;
N1: tmenuitem;
Nsave: tmenuitem;
Nsaveas: tmenuitem;
N2: tmenuitem;
Npageset: tmenuitem;
Nprintview: tmenuitem;
Nprint: tmenuitem;
N3: tmenuitem;
Nexit: tmenuitem;
Nwindow: tmenuitem;
Ntile: tmenuitem;
Ncascade: tmenuitem;
Nhelp: tmenuitem;
Nabout: tmenuitem;
Coolbar1: tcoolbar;
Toolbar1: ttoolbar;
Toolbar2: ttoolbar;
Tbnew: ttoolbutton;
Tbopen: ttoolbutton;
Tbsave: ttoolbutton;
Tbcut: ttoolbutton;
Tbcopy: ttoolbutton;
Tbpaste: ttoolbutton;
Tbundo: ttoolbutton;
Cbfont: tcombobox;
Cbfontsize: tcombobox;
Toolbutton14: ttoolbutton;
Tbbold: ttoolbutton;
Tbitalic: ttoolbutton;
Tbunderline: ttoolbutton;
Toolbutton18: ttoolbutton;
Toolbutton20: ttoolbutton;
Tbleft: ttoolbutton;
Tbcenter: ttoolbutton;
Tbright: ttoolbutton;
Imagelist1: timagelist;
Statusbar1: tstatusbar;
Savedialog1: tsavedialog;
Opendialog1: topendialog;
Narrangeall: tmenuitem;
Fontdialog1: tfontdialog;
Colordialog1: tcolordialog;
Popupmenu1: tpopupmenu;
N4: tmenuitem;
N5: tmenuitem;
N6: tmenuitem;
N7: tmenuitem;
Procedure nnewclick (Sender: tobject );
Procedure ncloseclick (Sender: tobject );
Procedure nopenclick (Sender: tobject );
Procedure nsaveclick (Sender: tobject );
Procedure ncascadeclick (Sender: tobject );
Procedure narrangeallclick (Sender: tobject );
Procedure ntileclick (Sender: tobject );
Procedure tbcutclick (Sender: tobject );
Procedure tbcopyclick (Sender: tobject );
Procedure tbpasteclick (Sender: tobject );
Procedure tbundoclick (Sender: tobject );
Procedure cbfontchange (Sender: tobject );
Procedure cbfontsizechange (Sender: tobject );
Procedure tbboldclick (Sender: tobject );
Procedure tbitalicclick (Sender: tobject );
Procedure tbunderlineclick (Sender: tobject );
Procedure tbleftclick (Sender: tobject );
Procedure nsaveasclick (Sender: tobject );
Procedure tbfontcolorclick (Sender: tobject );
Procedure nprintclick (Sender: tobject );
Procedure nexitclick (Sender: tobject );
Private
{Private Declarations}
Public
{Public declarations}
End;

VaR
Mainform1: tmainform1;
Achild: tchildform;
Fname: string;

Implementation

{$ R *. DFM}

Procedure tmainform1.nnewclick (Sender: tobject );
Begin
Achild: = tchildform. Create (application );
Achild. richedit1.clear;
Getdir (0, fname );
Fname: = fname + '\ '+ inttostr (mdichildcount );
Achild. Caption: = fname;
End;

Procedure tmainform1.ncloseclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild. activemdichild. close;
End;

Procedure tmainform1.nopenclick (Sender: tobject );
VaR
I: integer;
Curchild: tchildform;
Find: Boolean;
Begin
If opendialog1.execute and fileexists (opendialog1.filename) then
Begin
I: = mdichildcount;
Find: = false;

While not find and (I> = 0) Do
If mdichil1_[ I]. Caption = opendialog1.filename then
Begin
Mdichildren [I]. show;
Find: = true;
End
Else
I: = I-1;

If not find then
Begin
Achild: = tchildform. Create (application );
Achild. richedit1.lines. loadfromfile (opendialog1.filename );
Achild. Caption: = opendialog1.filename;
Fname: = opendialog1.filename;
End;
End;
Curchild: = self. activemdichild as tchildform;
Curchild. richedit1.modified: = false;
End;

Procedure tmainform1.nsaveclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If pos ('document', fname) <> 0 then
Begin
If savedialog1.execute then
Begin
Fname: = savedialog1.filename;
Curchild. richedit1.lines. savetofile (fname );
Curchild. Caption: = fname;
End;
End
Else
Begin
Fname: = self. activemdichild. Caption;
Curchild. richedit1.lines. savetofile (fname );
Curchild. Caption: = fname;
End;
Mainform1.tbsave. Enabled: = false;
Mainform1.tbundo. Enabled: = false;
Curchild. richedit1.modified: = false;
End;

Procedure tmainform1.ncascadeclick (Sender: tobject );
Begin
Mainform1.cascade;
End;

Procedure tmainform1.narrangeallclick (Sender: tobject );
Begin
Mainform1.arrangeicons;
End;

Procedure tmainform1.ntileclick (Sender: tobject );
Begin
Mainform1.tile;
End;

Procedure tmainform1.tbcutclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
Curchild. richedit1.cuttoclipboard;
End;

Procedure tmainform1.tbcopyclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
Curchild. richedit1.copytoclipboard;
End;

Procedure tmainform1.tbpasteclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
Curchild. richedit1.pastefromclipboard;
End;

Procedure tmainform1.tbundoclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
Curchild. richedit1.undo;
End;

Procedure tmainform1.cbfontchange (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If cbfont. Text <> ''then
Curchild. richedit1.selattributes. Name: = cbfont. text;
End;

Procedure tmainform1.cbfontsizechange (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If cbfontsize. Text <> ''then
Curchild. richedit1.selattributes. Size: = strtoint (cbfontsize. Text );
End;

Procedure tmainform1.tbboldclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If tbbold. down then
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style + [fsbold]
Else
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style-[fsbold]
End;

Procedure tmainform1.tbitalicclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If tbitalic. down then
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style + [fsitalic]
Else
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style-[fsitalic];
End;

Procedure tmainform1.tbunderlineclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If tbunderline. down then
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style + [fsunderline]
Else
Curchild. richedit1.selattributes. Style: = curchild. richedit1.selattributes. Style-[fsunderline];
End;

Procedure tmainform1.tbleftclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If sender = tbleft then
Curchild. richedit1.paragraph. Alignment: = taleftjustify
Else If sender = tbcenter then
Curchild. richedit1.paragraph. Alignment: = tacenter
Else
Curchild. richedit1.paragraph. Alignment: = tarightjustify;
End;

Procedure tmainform1.nsaveasclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If savedialog1.execute then
Curchild. richedit1.lines. savetofile (savedialog1.filename)
End;

Procedure tmainform1.tbfontcolorclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If colordialog1.execute then
Curchild. richedit1.selattributes. Color: = colordialog1.color;
End;

Procedure tmainform1.nprintclick (Sender: tobject );
VaR
Curchild: tchildform;
Begin
Curchild: = self. activemdichild as tchildform;
If printdialog1.execute then
Curchild. richedit1.print (printdialog1.name)
End;

Procedure tmainform1.nexitclick (Sender: tobject );
Begin
Mainform1.close;
End;

End.