summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--prototypes/mdi/fpg_mdi.pas441
-rw-r--r--prototypes/mdi/frm_child.pas170
-rw-r--r--prototypes/mdi/project1.lpi82
-rw-r--r--prototypes/mdi/project1.lpr113
-rw-r--r--src/gui/fpg_panel.pas2
5 files changed, 808 insertions, 0 deletions
diff --git a/prototypes/mdi/fpg_mdi.pas b/prototypes/mdi/fpg_mdi.pas
new file mode 100644
index 00000000..2de4b642
--- /dev/null
+++ b/prototypes/mdi/fpg_mdi.pas
@@ -0,0 +1,441 @@
+unit fpg_mdi;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpg_base, fpg_main, fpg_widget, fpg_scrollbar, fpg_panel,
+ fpg_button;
+
+type
+ // forward declarations
+ TfpgMDIChildForm = class;
+
+
+ TfpgMDIWorkArea = class(TfpgWidget)
+ private
+ FHorBar: TfpgScrollbar;
+ FVerBar: TfpgScrollbar;
+ FList: TList;
+ FActiveWindow: TfpgMDIChildForm;
+ procedure InternalMsgFreeMe(var msg: TfpgMessageRec); message FPGM_FREEME;
+ procedure SetActiveWindow(AValue: TfpgMDIChildForm);
+ function GetChildWindowCount: integer;
+ protected
+ procedure HandlePaint; override;
+ procedure PositionScrollBars;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function AddWindow(AWindowClass: TfpgFrameClass): TfpgFrame;
+ property ActiveWindow: TfpgMDIChildForm read FActiveWindow write SetActiveWindow;
+ property ChildWindowCount: integer read GetChildWindowCount;
+ end;
+
+
+ TfpgMDIChildForm = class(TfpgWidget)
+ private
+ {@VFD_HEAD_BEGIN: MDIChildForm}
+ Panel1: TfpgPanel;
+ bevLeft: TfpgBevel;
+ Bevel2: TfpgBevel;
+ bevBottom: TfpgBevel;
+ Bevel4: TfpgBevel;
+ bevRight: TfpgBevel;
+ Button1: TfpgButton;
+ Button2: TfpgButton;
+ Button3: TfpgButton;
+ Button4: TfpgButton;
+ bvlClientArea: TfpgBevel;
+ {@VFD_HEAD_END: MDIChildForm}
+ FMDIWorkArea: TfpgMDIWorkArea;
+ FWindowTitle: TfpgString;
+ FIsMouseDown: boolean;
+ FLastPos: TPoint;
+ FActive: boolean;
+ procedure SetWindowTitle(AValue: TfpgString);
+ procedure TitleMouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint);
+ procedure TitleMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure TitleMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure TitleMouseExit(Sender: TObject);
+ procedure CloseMDIWindowClicked(Sender: TObject);
+ procedure SetActive(AValue: boolean);
+ protected
+ property Active: boolean read FActive write SetActive;
+ public
+ constructor Create(AOwner: TfpgMDIWorkArea); reintroduce;
+ property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle;
+ procedure SetClientFrame(AFrame: TfpgFrame);
+ procedure UpdateWindowTitle;
+ procedure Close;
+ end;
+
+implementation
+
+uses
+ dbugintf;
+
+{ TfpgMDIChildForm }
+
+procedure TfpgMDIChildForm.TitleMouseMove(Sender: TObject; AShift: TShiftState;
+ const AMousePos: TPoint);
+var
+ dx, dy: integer;
+ pt: TPoint;
+begin
+ pt := WindowToScreen(self, AMousePos);
+ if not FIsMouseDown then
+ begin
+ FLastPos := pt;
+ Exit;
+ end;
+
+ dx := pt.X - FLastPos.X;
+ dy := pt.Y - FLastPos.Y;
+ Left := Left + dx;
+ Top := Top + dy;
+ FLastPos := pt;
+ UpdateWindowPosition;
+end;
+
+procedure TfpgMDIChildForm.TitleMouseUp(Sender: TObject; AButton: TMouseButton;
+ AShift: TShiftState; const AMousePos: TPoint);
+begin
+ FIsMouseDown := False;
+ {$IFDEF MSWINDOWS}
+ ReleaseMouse;
+ {$ENDIF}
+end;
+
+procedure TfpgMDIChildForm.TitleMouseDown(Sender: TObject; AButton: TMouseButton;
+ AShift: TShiftState; const AMousePos: TPoint);
+begin
+ FMDIWorkArea.ActiveWindow := self;
+ FIsMouseDown := True;
+ FLastPos := Panel1.WindowToScreen(self, AMousePos);
+ {$IFDEF MSWINDOWS}
+ CaptureMouse;
+ {$ENDIF}
+end;
+
+procedure TfpgMDIChildForm.TitleMouseExit(Sender: TObject);
+begin
+// FIsMouseDown := False;
+end;
+
+procedure TfpgMDIChildForm.CloseMDIWindowClicked(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfpgMDIChildForm.SetActive(AValue: boolean);
+begin
+ if FActive = AValue then
+ Exit;
+ FActive := AValue;
+ if FActive then
+ begin
+ Panel1.BackgroundColor := clNavy;
+ bevLeft.BackgroundColor := clNavy;
+ bevBottom.BackgroundColor := clNavy;
+ bevRight.BackgroundColor := clNavy;
+ Bevel2.BackgroundColor := clNavy;
+ Bevel4.BackgroundColor := clNavy;
+ end
+ else
+ begin
+ Panel1.BackgroundColor := clMedGray;
+ bevLeft.BackgroundColor := clMedGray;
+ bevBottom.BackgroundColor := clMedGray;
+ bevRight.BackgroundColor := clMedGray;
+ Bevel2.BackgroundColor := clMedGray;
+ Bevel4.BackgroundColor := clMedGray;
+ end;
+end;
+
+procedure TfpgMDIChildForm.SetWindowTitle(AValue: TfpgString);
+begin
+ if FWindowTitle = AValue then
+ Exit;
+ FWindowTitle := AValue;
+ if not (csLoading in ComponentState) then
+ Panel1.Text := FWindowTitle;
+end;
+
+constructor TfpgMDIChildForm.Create(AOwner: TfpgMDIWorkArea);
+begin
+ inherited Create(AOwner);
+ FMDIWorkArea := AOwner;
+ FIsMouseDown := False;
+ FLastPos := Point(0,0);
+ {@VFD_BODY_BEGIN: MDIChildForm}
+ Name := 'MDIChildForm';
+ SetPosition(369, 166, 300, 250);
+ WindowTitle := 'ChildForm1';
+ Hint := '';
+
+ Panel1 := TfpgPanel.Create(self);
+ with Panel1 do
+ begin
+ Name := 'Panel1';
+ SetPosition(0, 0, 301, 24);
+ Anchors := [anLeft,anRight,anTop];
+ BackgroundColor := TfpgColor($0A0081);
+ FontDesc := '#Label2';
+ Hint := '';
+ Text := 'Window Title';
+ TextColor := TfpgColor($FFFFFF);
+ OnMouseDown := @TitleMouseDown;
+ OnMouseUp := @TitleMouseUp;
+ OnMouseMove := @TitleMouseMove;
+ OnMouseExit := @TitleMouseExit;
+ end;
+
+ bevLeft := TfpgBevel.Create(self);
+ with bevLeft do
+ begin
+ Name := 'bevLeft';
+ SetPosition(0, 24, 3, 211);
+ Anchors := [anLeft,anTop,anBottom];
+ BackgroundColor := TfpgColor($000080);
+ Hint := '';
+ Shape := bsSpacer;
+ end;
+
+ Bevel2 := TfpgBevel.Create(self);
+ with Bevel2 do
+ begin
+ Name := 'Bevel2';
+ SetPosition(0, 235, 16, 16);
+ Anchors := [anLeft,anBottom];
+ BackgroundColor := TfpgColor($000080);
+ Hint := '';
+ end;
+
+ bevBottom := TfpgBevel.Create(self);
+ with bevBottom do
+ begin
+ Name := 'bevBottom';
+ SetPosition(16, 248, 269, 3);
+ Anchors := [anLeft,anRight,anBottom];
+ BackgroundColor := TfpgColor($000080);
+ Hint := '';
+ Shape := bsSpacer;
+ end;
+
+ Bevel4 := TfpgBevel.Create(self);
+ with Bevel4 do
+ begin
+ Name := 'Bevel4';
+ SetPosition(285, 235, 16, 16);
+ Anchors := [anRight,anBottom];
+ BackgroundColor := TfpgColor($000080);
+ Hint := '';
+ end;
+
+ bevRight := TfpgBevel.Create(self);
+ with bevRight do
+ begin
+ Name := 'bevRight';
+ SetPosition(297, 24, 3, 211);
+ Anchors := [anRight,anTop,anBottom];
+ BackgroundColor := TfpgColor($000080);
+ Hint := '';
+ Shape := bsSpacer;
+ end;
+
+ Button1 := TfpgButton.Create(Panel1);
+ with Button1 do
+ begin
+ Name := 'Button1';
+ SetPosition(3, 4, 16, 16);
+ Text := '-';
+ Embedded := True;
+ FontDesc := '#Grid';
+ Hint := '';
+ ImageName := '';
+ TabOrder := 1;
+ TextColor := TfpgColor($000000);
+ end;
+
+ Button2 := TfpgButton.Create(Panel1);
+ with Button2 do
+ begin
+ Name := 'Button2';
+ SetPosition(251, 4, 16, 16);
+ Anchors := [anRight,anTop];
+ Text := '_';
+ Embedded := True;
+ FontDesc := '#Grid';
+ Hint := '';
+ ImageName := '';
+ TabOrder := 1;
+ TextColor := TfpgColor($000000);
+ end;
+
+ Button3 := TfpgButton.Create(Panel1);
+ with Button3 do
+ begin
+ Name := 'Button3';
+ SetPosition(267, 4, 16, 16);
+ Anchors := [anRight,anTop];
+ Text := 'o';
+ Embedded := True;
+ FontDesc := '#Grid';
+ Hint := '';
+ ImageName := '';
+ TabOrder := 1;
+ TextColor := TfpgColor($000000);
+ end;
+
+ Button4 := TfpgButton.Create(Panel1);
+ with Button4 do
+ begin
+ Name := 'Button4';
+ SetPosition(283, 4, 16, 16);
+ Anchors := [anRight,anTop];
+ Text := 'X';
+ Embedded := True;
+ FontDesc := '#Grid';
+ Hint := '';
+ ImageName := '';
+ TabOrder := 1;
+ TextColor := TfpgColor($000000);
+ OnClick := @CloseMDIWindowClicked;
+ end;
+
+ bvlClientArea := TfpgBevel.Create(self);
+ with bvlClientArea do
+ begin
+ Name := 'bvlClientArea';
+ SetPosition(2, 24, 296, 224);
+ Anchors := [anLeft,anRight,anTop,anBottom];
+ Hint := '';
+ Shape := bsSpacer;
+ end;
+
+ {@VFD_BODY_END: MDIChildForm}
+ Name := 'MDIChildForm' + IntToStr(Random(MaxInt));
+end;
+
+procedure TfpgMDIChildForm.SetClientFrame(AFrame: TfpgFrame);
+begin
+// AFrame.Owner := bvlClientArea;
+ AFrame.Align := alClient;
+ AFrame.Visible := True;
+ UpdateWindowTitle;
+end;
+
+procedure TfpgMDIChildForm.UpdateWindowTitle;
+begin
+ Panel1.Text := FWindowTitle;
+end;
+
+procedure TfpgMDIChildForm.Close;
+begin
+ // We can't free ourselves, somebody else needs to do it
+ fpgPostMessage(Self, FMDIWorkArea, FPGM_FREEME);
+end;
+
+{ TfpgMDIWorkArea }
+
+procedure TfpgMDIWorkArea.InternalMsgFreeMe(var msg: TfpgMessageRec);
+var
+ i: integer;
+begin
+ if Assigned(msg.Sender) then
+ begin
+ if csDestroying in TComponent(msg.Sender).ComponentState then
+ Exit;
+ RemoveComponent(TfpgMDIChildForm(msg.Sender));
+ i := FList.IndexOf(TfpgMDIChildForm(msg.Sender));
+ if i = -1 then
+ raise Exception.Create('Could not find MDI Child Form');
+ FList.Delete(i);
+ if FList.Count >= i+1 then
+ { set focus to next child window after the one just deleted }
+ ActiveWidget := TfpgMDIChildForm(FList.Items[i])
+ else if FList.Count > 0 then
+ { fallback to the first child window we created }
+ ActiveWidget := TfpgMDIChildForm(FList.Items[0])
+ else
+ { there simply isn't any more child windows }
+ ActiveWidget := nil;
+ TfpgMDIChildForm(msg.Sender).Free;
+ end;
+end;
+
+procedure TfpgMDIWorkArea.SetActiveWindow(AValue: TfpgMDIChildForm);
+var
+ i: integer;
+ w: TfpgMDIChildForm;
+begin
+ if FActiveWindow = AValue then
+ Exit;
+ FActiveWindow := AValue;
+ ActiveWidget := FActiveWindow;
+ for i := 0 to FList.Count-1 do
+ begin
+ w := TfpgMDIChildForm(FList[i]);
+ w.Active := (w = AValue);
+ end;
+end;
+
+function TfpgMDIWorkArea.GetChildWindowCount: integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TfpgMDIWorkArea.HandlePaint;
+begin
+ inherited HandlePaint;
+ Canvas.Clear(clLtGray);
+end;
+
+procedure TfpgMDIWorkArea.PositionScrollBars;
+begin
+ FHorBar.Left := Left;
+ FHorBar.Top := Height - FHorBar.Height;
+ FHorBar.Width := Width;
+ FHorBar.Anchors := [anLeft, anBottom, anRight];
+ FVerBar.Left := Width - FVerBar.Width;
+ FVerBar.Top := 0;
+ FVerBar.Height := Height;
+ FVerBar.Anchors := [anRight, anTop, anBottom];
+end;
+
+constructor TfpgMDIWorkArea.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FIsContainer := True;
+ FHorBar := TfpgScrollbar.Create(self);
+ FHorBar.Visible := False;
+ FHorBar.Orientation := orHorizontal;
+ FVerBar := TfpgScrollbar.Create(self);
+ FVerBar.Visible := False;
+ FVerBar.Orientation := orVertical;
+ PositionScrollBars;
+ FList := TList.Create;
+ FActiveWindow := nil;
+end;
+
+destructor TfpgMDIWorkArea.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TfpgMDIWorkArea.AddWindow(AWindowClass: TfpgFrameClass): TfpgFrame;
+var
+ frm: TfpgMDIChildForm;
+begin
+ frm := TfpgMDIChildForm.Create(self);
+ Result := AWindowClass.Create(frm.bvlClientArea);
+ frm.SetClientFrame(Result);
+ FList.Add(frm);
+ ActiveWindow := frm;
+end;
+
+end.
+
diff --git a/prototypes/mdi/frm_child.pas b/prototypes/mdi/frm_child.pas
new file mode 100644
index 00000000..a9890a3c
--- /dev/null
+++ b/prototypes/mdi/frm_child.pas
@@ -0,0 +1,170 @@
+unit frm_child;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_button, fpg_edit,
+ fpg_checkbox, fpg_radiobutton, fpg_gauge, fpg_mdi, fpg_panel, fpg_trackbar;
+
+type
+
+ TChildForm = class(TfpgFrame)
+ private
+ {@VFD_HEAD_BEGIN: ChildForm}
+ btnClose: TfpgButton;
+ CheckBox1: TfpgCheckBox;
+ CheckBox2: TfpgCheckBox;
+ RadioButton1: TfpgRadioButton;
+ RadioButton2: TfpgRadioButton;
+ Edit1: TfpgEdit;
+ Gauge1: TfpgGauge;
+ TrackBar1: TfpgTrackBar;
+ {@VFD_HEAD_END: ChildForm}
+ FWindowTitle: TfpgString;
+ procedure btnCloseClicked(Sender: TObject);
+ procedure TrackBarChanged(Sender: TObject; APosition: integer);
+ procedure SetWindowTitle(AValue: TfpgString);
+ public
+ procedure AfterCreate; override;
+ property WindowTitle: TfpgString read FWindowTitle write SetWindowTitle;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+var
+ ChildForm: TChildForm;
+
+implementation
+
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TChildForm.TrackBarChanged(Sender: TObject; APosition: integer);
+begin
+ Gauge1.Progress := APosition;
+end;
+
+procedure TChildForm.SetWindowTitle(AValue: TfpgString);
+begin
+ if FWindowTitle = AValue then
+ Exit;
+ FWindowTitle := AValue;
+ TfpgMDIChildForm(Owner.Owner).WindowTitle := FWindowTitle;
+end;
+
+procedure TChildForm.btnCloseClicked(Sender: TObject);
+begin
+ TfpgMDIChildForm(Owner).Close;
+end;
+
+procedure TChildForm.AfterCreate;
+begin
+ {%region 'Auto-generated GUI code' -fold}
+ {@VFD_BODY_BEGIN: ChildForm}
+ Name := 'ChildForm';
+ SetPosition(391, 210, 271, 150);
+// WindowTitle := 'ChildForm';
+ Hint := '';
+
+ btnClose := TfpgButton.Create(self);
+ with btnClose do
+ begin
+ Name := 'btnClose';
+ SetPosition(180, 116, 80, 24);
+ Text := 'Close';
+ FontDesc := '#Label1';
+ Hint := '';
+ ImageName := '';
+ TabOrder := 1;
+ OnClick := @btnCloseClicked;
+ end;
+
+ CheckBox1 := TfpgCheckBox.Create(self);
+ with CheckBox1 do
+ begin
+ Name := 'CheckBox1';
+ SetPosition(164, 16, 120, 20);
+ FontDesc := '#Label1';
+ Hint := '';
+ TabOrder := 2;
+ Text := 'CheckBox';
+ end;
+
+ CheckBox2 := TfpgCheckBox.Create(self);
+ with CheckBox2 do
+ begin
+ Name := 'CheckBox2';
+ SetPosition(164, 36, 120, 20);
+ FontDesc := '#Label1';
+ Hint := '';
+ TabOrder := 3;
+ Text := 'CheckBox';
+ end;
+
+ RadioButton1 := TfpgRadioButton.Create(self);
+ with RadioButton1 do
+ begin
+ Name := 'RadioButton1';
+ SetPosition(164, 60, 120, 20);
+ FontDesc := '#Label1';
+ GroupIndex := 0;
+ Hint := '';
+ TabOrder := 4;
+ Text := 'RadioButton';
+ end;
+
+ RadioButton2 := TfpgRadioButton.Create(self);
+ with RadioButton2 do
+ begin
+ Name := 'RadioButton2';
+ SetPosition(164, 80, 120, 20);
+ FontDesc := '#Label1';
+ GroupIndex := 0;
+ Hint := '';
+ TabOrder := 5;
+ Text := 'RadioButton';
+ end;
+
+ Edit1 := TfpgEdit.Create(self);
+ with Edit1 do
+ begin
+ Name := 'Edit1';
+ SetPosition(8, 8, 120, 24);
+ ExtraHint := '';
+ FontDesc := '#Edit1';
+ Hint := '';
+ TabOrder := 6;
+ Text := '';
+ end;
+
+ Gauge1 := TfpgGauge.Create(self);
+ with Gauge1 do
+ begin
+ Name := 'Gauge1';
+ SetPosition(12, 44, 116, 25);
+ Color := TfpgColor($C4C4C4);
+ Hint := '';
+ Progress := 65;
+ end;
+
+ TrackBar1 := TfpgTrackBar.Create(self);
+ with TrackBar1 do
+ begin
+ Name := 'TrackBar1';
+ SetPosition(12, 84, 116, 30);
+ Hint := '';
+ TabOrder := 8;
+ Position := 65;
+ OnChange := @TrackBarChanged;
+ end;
+
+ {@VFD_BODY_END: ChildForm}
+ {%endregion}
+ Name := 'ChildForm' + IntToStr(Random(MaxInt));
+
+end;
+
+
+end.
diff --git a/prototypes/mdi/project1.lpi b/prototypes/mdi/project1.lpi
new file mode 100644
index 00000000..5252f0c7
--- /dev/null
+++ b/prototypes/mdi/project1.lpi
@@ -0,0 +1,82 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <UseAppBundle Value="False"/>
+ <ResourceType Value="res"/>
+ </General>
+ <i18n>
+ <EnableI18N LFM="False"/>
+ </i18n>
+ <VersionInfo>
+ <StringTable ProductVersion=""/>
+ </VersionInfo>
+ <BuildModes Count="1">
+ <Item1 Name="Default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_toolkit"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="3">
+ <Unit0>
+ <Filename Value="project1.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="project1"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="fpg_mdi.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="fpg_mdi"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="frm_child.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frm_child"/>
+ </Unit2>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ </SearchPaths>
+ <Other>
+ <CompilerMessages>
+ <UseMsgFile Value="True"/>
+ </CompilerMessages>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+ <Debugging>
+ <Exceptions Count="3">
+ <Item1>
+ <Name Value="EAbort"/>
+ </Item1>
+ <Item2>
+ <Name Value="ECodetoolError"/>
+ </Item2>
+ <Item3>
+ <Name Value="EFOpenError"/>
+ </Item3>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
diff --git a/prototypes/mdi/project1.lpr b/prototypes/mdi/project1.lpr
new file mode 100644
index 00000000..fa8a1850
--- /dev/null
+++ b/prototypes/mdi/project1.lpr
@@ -0,0 +1,113 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, fpg_base, fpg_main, fpg_form, fpg_mdi, frm_child,
+ fpg_menu, fpg_panel;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ {@VFD_HEAD_BEGIN: MainForm}
+ MainBar: TfpgMenuBar;
+ MDIWorkArea: TfpgMDIWorkArea;
+ Bevel1: TfpgBevel;
+ pmChildren: TfpgPopupMenu;
+ {@VFD_HEAD_END: MainForm}
+ procedure NewFormClicked(Sender: TObject);
+ procedure miQuitClicked(Sender: TObject);
+ public
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.NewFormClicked(Sender: TObject);
+begin
+ ChildForm := MDIWorkArea.AddWindow(TChildForm) as TChildForm;
+ ChildForm.WindowTitle := Format('Child %d', [MDIWorkArea.ChildWindowCount]);
+end;
+
+procedure TMainForm.miQuitClicked(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {%region 'Auto-generated GUI code' -fold}
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(351, 159, 555, 321);
+ WindowTitle := 'fpGUI''s MDI Demo';
+ Hint := '';
+
+ MainBar := TfpgMenuBar.Create(self);
+ with MainBar do
+ begin
+ Name := 'MainBar';
+ SetPosition(0, 0, 555, 24);
+ Anchors := [anLeft,anRight,anTop];
+ end;
+
+ MDIWorkArea := TfpgMDIWorkArea.Create(self);
+ with MDIWorkArea do
+ begin
+ Name := 'MDIWorkArea';
+ SetPosition(3, 32, 548, 264);
+ Anchors := [anLeft,anRight,anTop,anBottom];
+ end;
+
+ Bevel1 := TfpgBevel.Create(self);
+ with Bevel1 do
+ begin
+ Name := 'Bevel1';
+ SetPosition(0, 300, 555, 20);
+ Anchors := [anLeft,anRight,anBottom];
+ Hint := '';
+ Style := bsLowered;
+ end;
+
+ pmChildren := TfpgPopupMenu.Create(self);
+ with pmChildren do
+ begin
+ Name := 'pmChildren';
+ SetPosition(336, 88, 120, 20);
+ AddMenuItem('Add child', '', @NewFormClicked);
+ AddMenuItem('-', '', nil);
+ AddMenuItem('Quit', '', @miQuitClicked);
+ end;
+
+ {@VFD_BODY_END: MainForm}
+ {%endregion}
+ MainBar.AddMenuItem('Children', nil).SubMenu := pmChildren;
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/src/gui/fpg_panel.pas b/src/gui/fpg_panel.pas
index 700844dd..2d09a6a9 100644
--- a/src/gui/fpg_panel.pas
+++ b/src/gui/fpg_panel.pas
@@ -269,6 +269,8 @@ type
property OnShowHint;
end;
+ TfpgFrameClass = class of TfpgFrame;
+
function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AShape: TPanelShape;
AStyle: TPanelStyle): TfpgBevel;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 14:41:13 +0000