From 8c893507f77978c2e08f5589d3adb1edc2cb3bd5 Mon Sep 17 00:00:00 2001 From: graemeg Date: Fri, 13 Jul 2007 09:13:27 +0000 Subject: fpgui2: refactored the SetWindowTitle method. * Reworked the BitmapTest not to rely on GUI classes. --- .../fpgui2/examples/core/eventtest/eventtest.lpr | 6 +- .../fpgui2/examples/core/helloworld/helloworld.pas | 2 +- .../fpgui2/examples/core/imgtest/bitmaptest.dpr | 102 ++++++++++++--------- prototypes/fpgui2/source/core/gdi/gfx_gdi.pas | 2 +- prototypes/fpgui2/source/core/gfxbase.pas | 7 ++ prototypes/fpgui2/source/core/x11/gfx_x11.pas | 2 +- prototypes/fpgui2/source/gui/gui_form.pas | 8 +- 7 files changed, 77 insertions(+), 52 deletions(-) diff --git a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr index 30ed822e..e4cc9c3b 100644 --- a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr +++ b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr @@ -35,7 +35,7 @@ type procedure MsgScroll(var msg: TfpgMessageRec); message FPGM_SCROLL; protected public - constructor Create(aowner: TComponent); override; + constructor Create(AOwner: TComponent); override; procedure Show; end; @@ -174,7 +174,7 @@ begin Writeln('Mouse scroll delta=' + IntToStr(delta) + ' button=' + IntToStr(msg.Params.mouse.Buttons)); end; -constructor TMainForm.Create(aowner: TComponent); +constructor TMainForm.Create(AOwner: TComponent); begin inherited Create(aowner); FMoveEventCount := 0; @@ -188,7 +188,7 @@ begin AllocateWindowHandle; // We can't set a title if we don't have a window handle. So we do that here // and not in the constructor. - DoSetWindowTitle('fpGFX event test'); + SetWindowTitle('fpGFX event test'); end; diff --git a/prototypes/fpgui2/examples/core/helloworld/helloworld.pas b/prototypes/fpgui2/examples/core/helloworld/helloworld.pas index 85591532..52e56158 100644 --- a/prototypes/fpgui2/examples/core/helloworld/helloworld.pas +++ b/prototypes/fpgui2/examples/core/helloworld/helloworld.pas @@ -54,7 +54,7 @@ begin AllocateWindowHandle; // We can't set a title if we don't have a window handle. So we do that here // and not in the constructor. - DoSetWindowTitle('fpGFX Hello World'); + SetWindowTitle('fpGFX Hello World'); end; procedure TMainWindow.MsgPaint(var msg: TfpgMessageRec); diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr index b0dd8098..8ab86361 100644 --- a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr +++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr @@ -7,60 +7,78 @@ uses SysUtils, gfxbase, fpgfx, - gfx_imgfmt_bmp, - gui_form; + gfx_imgfmt_bmp; type - { TMainForm } - - TMainForm = class(TfpgForm) - protected - procedure HandlePaint; override; + TMainForm = class(TfpgWindow) + private + img: TfpgImage; + procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT; + procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; public - procedure AfterCreate; override; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Show; end; - { TMainForm } +{ TMainForm } - procedure TMainForm.AfterCreate; - begin - SetPosition(100, 100, 256, 256); - WindowTitle := 'fpGUI Bitmap Test'; - end; +procedure TMainForm.MsgPaint(var msg: TfpgMessageRec); +begin + Canvas.BeginDraw; + Canvas.DrawImage(0, 0, img); + Canvas.EndDraw; +end; - procedure TMainForm.HandlePaint; - var - img: TfpgImage; - i, j: integer; - begin - Canvas.BeginDraw; // activate double buffering in time. - inherited HandlePaint; - - img := TfpgImage.Create; - img.AllocateImage(32, 256, 256); - img.UpdateImage; - // populate the bitmap with pretty colors :-) - for j := 0 to 255 do - for i := 0 to 255 do - PLongWord(img.ImageData)[j * 256 + i] := (i shl 16) or (j shl 8); +procedure TMainForm.MsgClose(var msg: TfpgMessageRec); +begin + ReleaseWindowHandle; + Halt(0); +end; - Canvas.DrawImage(0, 0, img); - img.Free; - Canvas.EndDraw; - end; +constructor TMainForm.Create(AOwner: TComponent); +var + i, j: integer; +begin + inherited Create(AOwner); + FWidth := 256; + FHeight := 256; + WindowAttributes := [waScreenCenterPos]; + + img := TfpgImage.Create; + img.AllocateImage(32, 256, 256); + img.UpdateImage; + // populate the bitmap with pretty colors :-) + for j := 0 to 255 do + for i := 0 to 255 do + PLongWord(img.ImageData)[j * 256 + i] := (i shl 16) or (j shl 8); +end; - procedure MainProc; - var - frm: TMainForm; - begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - frm.Show; - fpgApplication.Run; - end; +destructor TMainForm.Destroy; +begin + img.Free; + inherited Destroy; +end; +procedure TMainForm.Show; +begin + AllocateWindowHandle; + // We can only set the title once we have a window handle. + SetWindowTitle('fpGUI Bitmap Test'); +end; + + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + frm.Show; + fpgApplication.Run; +end; begin MainProc; diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas index c155dff9..12599e11 100644 --- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas +++ b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas @@ -130,7 +130,7 @@ type procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override; function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override; //procedure MoveToScreenCenter; override; - procedure DoSetWindowTitle(const atitle: string); + procedure DoSetWindowTitle(const ATitle: string); override; property WinHandle: TfpgWinHandle read FWinHandle; public constructor Create(AOwner: TComponent); override; diff --git a/prototypes/fpgui2/source/core/gfxbase.pas b/prototypes/fpgui2/source/core/gfxbase.pas index 6d11808d..7725be6c 100644 --- a/prototypes/fpgui2/source/core/gfxbase.pas +++ b/prototypes/fpgui2/source/core/gfxbase.pas @@ -286,11 +286,13 @@ type procedure DoReleaseWindowHandle; virtual; abstract; procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); virtual; abstract; function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; virtual; abstract; + procedure DoSetWindowTitle(const ATitle: string); virtual; abstract; procedure SetParent(const AValue: TfpgWindowBase); virtual; function GetParent: TfpgWindowBase; virtual; function GetCanvas: TfpgCanvasBase; virtual; procedure AllocateWindowHandle; procedure ReleaseWindowHandle; + procedure SetWindowTitle(const ATitle: string); virtual; public // make some setup before the window shows procedure AdjustWindowStyle; virtual; // forms modify the window creation parameters @@ -422,6 +424,11 @@ begin end; end; +procedure TfpgWindowBase.SetWindowTitle(const ATitle: string); +begin + DoSetWindowTitle(ATitle); +end; + procedure TfpgWindowBase.AdjustWindowStyle; begin // does nothing here diff --git a/prototypes/fpgui2/source/core/x11/gfx_x11.pas b/prototypes/fpgui2/source/core/x11/gfx_x11.pas index fe58da64..d40b7a2d 100644 --- a/prototypes/fpgui2/source/core/x11/gfx_x11.pas +++ b/prototypes/fpgui2/source/core/x11/gfx_x11.pas @@ -124,7 +124,7 @@ type procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; procedure DoReleaseWindowHandle; override; function HandleIsValid: boolean; override; - procedure DoSetWindowTitle(const atitle: string); + procedure DoSetWindowTitle(const ATitle: string); override; procedure DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override; function DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override; procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; diff --git a/prototypes/fpgui2/source/gui/gui_form.pas b/prototypes/fpgui2/source/gui/gui_form.pas index 3b7cbf65..c839492b 100644 --- a/prototypes/fpgui2/source/gui/gui_form.pas +++ b/prototypes/fpgui2/source/gui/gui_form.pas @@ -33,7 +33,7 @@ type FBackgroundColor: TfpgColor; procedure AdjustWindowStyle; override; procedure SetWindowParameters; override; - procedure SetWindowTitle(const AValue: string); + procedure SetWindowTitle(const ATitle: string); override; procedure MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE; procedure MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE; procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; @@ -99,10 +99,10 @@ end; { TfpgForm } -procedure TfpgForm.SetWindowTitle(const AValue: string); +procedure TfpgForm.SetWindowTitle(const ATitle: string); begin - FWindowTitle := avalue; - inherited DoSetWindowTitle(FWindowTitle); + FWindowTitle := ATitle; + inherited SetWindowTitle(ATitle); end; procedure TfpgForm.MsgActivate(var msg: TfpgMessageRec); -- cgit v1.2.3-70-g09d2