From 8aa1bb16011e625e672ff832b4c3456fa68049e9 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 15 May 2010 12:08:46 +0200 Subject: Splashscreen Demo: Updated the demo. * Using new coding standards * New Commands implemented * Showing Splashscreen and Borderless Forms in action. --- examples/gui/splashscreen/commands.pas | 32 ++++- examples/gui/splashscreen/frm_main.pas | 155 +++++++++++++++++++++---- examples/gui/splashscreen/frm_splashscreen.pas | 43 +++---- examples/gui/splashscreen/test.lpi | 5 +- 4 files changed, 174 insertions(+), 61 deletions(-) (limited to 'examples') diff --git a/examples/gui/splashscreen/commands.pas b/examples/gui/splashscreen/commands.pas index c487b0b1..e9adf75d 100644 --- a/examples/gui/splashscreen/commands.pas +++ b/examples/gui/splashscreen/commands.pas @@ -37,10 +37,22 @@ type end; + TShowSplashCommand = class(TInterfacedObject, ICommand) + public + procedure Execute; + end; + + + TShowBorderlessForm = class(TInterfacedObject, ICommand) + public + procedure Execute; + end; + + implementation uses - fpg_main, SysUtils; + SysUtils, fpg_main, frm_main, frm_splashscreen; { TNullInterfacedObject } @@ -72,18 +84,30 @@ end; procedure TAddCommand.Execute; begin - Writeln('>> TAddComand.Execute'); FMemo.Lines.Add('Hello ' + IntToStr(Random(500))); - FMemo.Invalidate; end; { TExitCommand } procedure TExitCommand.Execute; begin - Writeln('>> TExitComand.Execute'); fpgApplication.Terminated := True; end; +{ TShowSplashCommand } + +procedure TShowSplashCommand.Execute; +begin + frmSplash := TSplashForm.Create(nil); + frmSplash.Show; +end; + +{ TShowBorderlessForm } + +procedure TShowBorderlessForm.Execute; +begin + TBorderLessForm.Execute; +end; + end. diff --git a/examples/gui/splashscreen/frm_main.pas b/examples/gui/splashscreen/frm_main.pas index 6835b98a..bc367e8e 100644 --- a/examples/gui/splashscreen/frm_main.pas +++ b/examples/gui/splashscreen/frm_main.pas @@ -9,27 +9,38 @@ unit frm_main; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel; + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_button, + fpg_memo, fpg_menu, fpg_label, fpg_trackbar; type TMainForm = class(TfpgForm) private - procedure CommandHandler(Sender: TObject); - public {@VFD_HEAD_BEGIN: MainForm} btnAdd: TfpgButton; memName1: TfpgMemo; btnQuit: TfpgButton; MainMenu: TfpgMenuBar; mnuFile: TfpgPopupMenu; + btnShowBorderless: TfpgButton; + btnShowSplash: TfpgButton; {@VFD_HEAD_END: MainForm} - procedure AfterCreate; override; + public + procedure AfterCreate; override; + end; + + + TBorderLessForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: BorderLessForm} + btnClose: TfpgButton; + Label1: TfpgLabel; + TrackBar1: TfpgTrackBar; + {@VFD_HEAD_END: BorderLessForm} + public + constructor Create(AOwner: TComponent); override; + procedure AfterCreate; override; + class procedure Execute; end; {@VFD_NEWFORM_DECL} @@ -42,45 +53,109 @@ uses {@VFD_NEWFORM_IMPL} -{ A single event handler that handles all Command based events. } -procedure TMainForm.CommandHandler(Sender: TObject); -var - cmd: ICommand; - holder: ICommandHolder; +{ TBorderLessForm } + +constructor TBorderLessForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +// WindowType := wtPopup; // removes borders and title bar + Include(FWindowAttributes, waBorderLess) +// WindowAttributes := WindowAttributes + [waStayOnTop]; // well, it lets the window stay on top. :) +end; + +procedure TBorderLessForm.AfterCreate; begin - if Supports(Sender, ICommandHolder, holder) then + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: BorderLessForm} + Name := 'BorderLessForm'; + SetPosition(321, 549, 323, 133); + WindowTitle := 'BorderLessForm'; + Hint := ''; + WindowPosition := wpOneThirdDown; + + btnClose := TfpgButton.Create(self); + with btnClose do + begin + Name := 'btnClose'; + SetPosition(232, 100, 80, 24); + Text := 'Close'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrOK; + TabOrder := 1; + end; + + Label1 := TfpgLabel.Create(self); + with Label1 do + begin + Name := 'Label1'; + SetPosition(8, 32, 304, 16); + FontDesc := '#Label2'; + Hint := ''; + Layout := tlCenter; + Text := 'Look Mom, no borders!'; + end; + + TrackBar1 := TfpgTrackBar.Create(self); + with TrackBar1 do begin - cmd := holder.GetCommand; - cmd.Execute; + Name := 'TrackBar1'; + SetPosition(72, 60, 148, 30); + Hint := ''; + TabOrder := 3; + end; + + {@VFD_BODY_END: BorderLessForm} + {%endregion} +end; + +class procedure TBorderLessForm.Execute; +var + frm: TBorderLessForm; +begin + frm := TBorderLessForm.Create(nil); + try + frm.ShowModal; + finally + frm.Free; end; end; + +{ TMainForm } + procedure TMainForm.AfterCreate; begin + {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: MainForm} Name := 'MainForm'; SetPosition(293, 236, 416, 273); WindowTitle := 'Command Interface Test'; + Hint := ''; WindowPosition := wpScreenCenter; btnAdd := TfpgButton.Create(self); with btnAdd do begin Name := 'btnAdd'; - SetPosition(332, 36, 75, 24); - Text := 'Add'; + SetPosition(260, 36, 148, 24); + Text := 'Add Text to Memo'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; - OnClick := @CommandHandler; + TabOrder := 1; end; memName1 := TfpgMemo.Create(self); with memName1 do begin Name := 'memName1'; - SetPosition(8, 36, 316, 228); + SetPosition(8, 36, 236, 228); + Hint := ''; Lines.Add(''); FontDesc := '#Edit1'; + TabOrder := 2; end; btnQuit := TfpgButton.Create(self); @@ -90,8 +165,9 @@ begin SetPosition(332, 240, 75, 24); Text := 'Quit'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; - OnClick := @CommandHandler; + TabOrder := 3; end; MainMenu := TfpgMenuBar.Create(self); @@ -107,16 +183,45 @@ begin begin Name := 'mnuFile'; SetPosition(44, 72, 120, 20); - AddMenuItem('Quit', '', @CommandHandler); + AddMenuItem('Quit', '', nil); + end; + + btnShowBorderless := TfpgButton.Create(self); + with btnShowBorderless do + begin + Name := 'btnShowBorderless'; + SetPosition(260, 68, 148, 24); + Text := 'Show Borderless Form'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 6; + end; + + btnShowSplash := TfpgButton.Create(self); + with btnShowSplash do + begin + Name := 'btnShowSplash'; + SetPosition(260, 100, 148, 24); + Text := 'Show Splash Screen'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 7; end; {@VFD_BODY_END: MainForm} - + {%endregion} + MainMenu.AddMenuItem('File', nil).SubMenu := mnuFile; - // instantiate the Command classes + { Instantiate the Command classes. By setting a Command it + take preference over OnClick event handlers and is handled + automatically for you. No need to declare a OnClick event handler. } btnAdd.SetCommand(TAddCommand.Create(memName1)); btnQuit.SetCommand(TExitCommand.Create); + btnShowBorderless.SetCommand(TShowBorderlessForm.Create); + btnShowSplash.SetCommand(TShowSplashCommand.Create); // The menu item File|Quit shares the command of btnQuit mnuFile.MenuItemByName('Quit').SetCommand(btnQuit.GetCommand); end; diff --git a/examples/gui/splashscreen/frm_splashscreen.pas b/examples/gui/splashscreen/frm_splashscreen.pas index 46433ab0..ccb432cc 100644 --- a/examples/gui/splashscreen/frm_splashscreen.pas +++ b/examples/gui/splashscreen/frm_splashscreen.pas @@ -5,33 +5,24 @@ unit frm_splashscreen; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge; + SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_panel, + fpg_label; type - - { TSplashForm } - TSplashForm = class(TfpgForm) - procedure SplashFormShow(Sender: TObject); - procedure TimerFired(Sender: TObject); private - tmr: TfpgTimer; - protected - procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; - procedure AdjustWindowStyle; override; - public {@VFD_HEAD_BEGIN: SplashForm} pnlName1: TfpgBevel; lblName2: TfpgLabel; lblName1: TfpgLabel; {@VFD_HEAD_END: SplashForm} + tmr: TfpgTimer; + procedure SplashFormShow(Sender: TObject); + procedure TimerFired(Sender: TObject); + procedure SplashFormClick(Sender: TObject); + public constructor Create(AOwner: TComponent); override; - procedure AfterCreate; override; + procedure AfterCreate; override; end; {@VFD_NEWFORM_DECL} @@ -43,6 +34,11 @@ implementation {@VFD_NEWFORM_IMPL} +procedure TSplashForm.SplashFormClick(Sender: TObject); +begin + TimerFired(nil); +end; + procedure TSplashForm.SplashFormShow(Sender: TObject); begin tmr.Enabled := True; @@ -56,18 +52,6 @@ begin Hide; end; -procedure TSplashForm.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); -begin - inherited HandleLMouseUp(x, y, shiftstate); - TimerFired(nil); -end; - -procedure TSplashForm.AdjustWindowStyle; -begin - inherited AdjustWindowStyle; - -end; - constructor TSplashForm.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -78,6 +62,7 @@ begin tmr.OnTimer := @TimerFired; OnShow := @SplashFormShow; + OnClick := @SplashFormClick; end; procedure TSplashForm.AfterCreate; diff --git a/examples/gui/splashscreen/test.lpi b/examples/gui/splashscreen/test.lpi index d347a75a..9ff31725 100644 --- a/examples/gui/splashscreen/test.lpi +++ b/examples/gui/splashscreen/test.lpi @@ -1,15 +1,14 @@ - - + + - -- cgit v1.2.3-70-g09d2