From b4450ba52960d6859cac021b27d0d3e13c5c7571 Mon Sep 17 00:00:00 2001 From: graemeg Date: Sat, 7 Jul 2007 09:47:08 +0000 Subject: * Refactored the Window class. * Added some basic predefined colors to gfxbase. * Some more code cleanup in the test projects. * Fixed a dependency issue with the core/imgtest example project. --- .../fpgui2/examples/core/helloworld/helloworld.pas | 12 +-- .../fpgui2/examples/core/imgtest/bitmaptest.dpr | 2 +- .../fpgui2/examples/core/imgtest/bitmaptest.lpi | 7 +- prototypes/fpgui2/source/core/fpgfx.pas | 43 +++----- prototypes/fpgui2/source/core/gdi/gfx_gdi.pas | 10 +- prototypes/fpgui2/source/core/gfxbase.pas | 114 +++++++++++++-------- prototypes/fpgui2/source/core/predefinedcolors.inc | 66 ++++++++++++ prototypes/fpgui2/source/core/x11/gfx_x11.pas | 15 +-- prototypes/fpgui2/tests/bitmaptest.dpr | 2 +- prototypes/fpgui2/tests/fpgcanvas.lpr | 7 -- 10 files changed, 170 insertions(+), 108 deletions(-) create mode 100644 prototypes/fpgui2/source/core/predefinedcolors.inc (limited to 'prototypes') diff --git a/prototypes/fpgui2/examples/core/helloworld/helloworld.pas b/prototypes/fpgui2/examples/core/helloworld/helloworld.pas index 7c7b60f5..85591532 100644 --- a/prototypes/fpgui2/examples/core/helloworld/helloworld.pas +++ b/prototypes/fpgui2/examples/core/helloworld/helloworld.pas @@ -27,11 +27,7 @@ uses const HelloWorldString: String = 'Hello, world!'; -const - // predefined colors RRGGBB format - colWhite = $FFFFFF; - colBlack = $000000; - + type TMainWindow = class(TfpgWindow) @@ -74,7 +70,7 @@ begin r.Width := FWidth; for i := 0 to FHeight-1 do begin - Color := $ff - (i * $ff) div FHeight; + Color := $ff - (i * $ff) div FHeight; // shades of Blue Canvas.SetColor(Color); r.Top := i; r.Height := i + 1; @@ -83,11 +79,11 @@ begin Canvas.Font := fpgGetFont('Arial-30'); - Canvas.SetTextColor(colBlack); + Canvas.SetTextColor(clBlack); Canvas.DrawString((Width - Canvas.Font.TextWidth(HelloWorldString)) div 2 + 1, (Height - Canvas.Font.Height) div 2 + 1, HelloWorldString); - Canvas.SetTextColor(colWhite); + Canvas.SetTextColor(clWhite); Canvas.DrawString((Width - Canvas.Font.TextWidth(HelloWorldString)) div 2 - 1, (Height - Canvas.Font.Height) div 2 - 1, HelloWorldString); diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr index 969cb09f..b0dd8098 100644 --- a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr +++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr @@ -27,7 +27,7 @@ type procedure TMainForm.AfterCreate; begin SetPosition(100, 100, 256, 256); - WindowTitle := 'fpGUI2 Bitmap Test'; + WindowTitle := 'fpGUI Bitmap Test'; end; procedure TMainForm.HandlePaint; diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi index 844bcc82..7fefd31c 100644 --- a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi +++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi @@ -32,17 +32,12 @@ - + - - - - - diff --git a/prototypes/fpgui2/source/core/fpgfx.pas b/prototypes/fpgui2/source/core/fpgfx.pas index e1754515..3468e65c 100644 --- a/prototypes/fpgui2/source/core/fpgfx.pas +++ b/prototypes/fpgui2/source/core/fpgfx.pas @@ -78,19 +78,15 @@ type TfpgWindow = class(TfpgWindowImpl) protected - FParentWindow: TfpgWindow; - FCanvas: TfpgCanvas; - procedure AllocateWindowHandle; - procedure ReleaseWindowHandle; + procedure SetParentWindow(const AValue: TfpgWindow); reintroduce; + function GetParentWindow: TfpgWindow; reintroduce; + function GetCanvas: TfpgCanvas; reintroduce; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure UpdateWindowPosition; - function Right: TfpgCoord; - function Bottom: TfpgCoord; - property ParentWindow: TfpgWindow read FParentWindow write FParentWindow; - property Canvas: TfpgCanvas read FCanvas; - property WinHandle; // surface this property from TfpgXXXImpl class + property ParentWindow: TfpgWindow read GetParentWindow write SetParentWindow; + property Canvas: TfpgCanvas read GetCanvas; + property WinHandle; // surface this property from TfpgXXXImpl class in it's native format end; @@ -674,34 +670,19 @@ begin inherited Destroy; end; -procedure TfpgWindow.AllocateWindowHandle; -begin - DoAllocateWindowHandle(FParentWindow); -end; - -procedure TfpgWindow.ReleaseWindowHandle; -begin - if HasHandle then - begin - Canvas.FreeResources; - DoReleaseWindowHandle; - end; -end; - -function TfpgWindow.Right: TfpgCoord; +procedure TfpgWindow.SetParentWindow(const AValue: TfpgWindow); begin - Result := FLeft + FWidth - 1; + inherited SetParentWindow(AValue); end; -function TfpgWindow.Bottom: TfpgCoord; +function TfpgWindow.GetParentWindow: TfpgWindow; begin - Result := FTop + FHeight - 1; + result := TfpgWindow(inherited GetParentWindow); end; -procedure TfpgWindow.UpdateWindowPosition; +function TfpgWindow.GetCanvas: TfpgCanvas; begin - if HasHandle then - DoUpdateWindowPosition(FLeft, FTop, FWidth, FHeight); + Result := TfpgCanvas(inherited GetCanvas); end; { TfpgImage } diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas index 95f2ea5e..9d989c7d 100644 --- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas +++ b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas @@ -116,10 +116,10 @@ type FWinStyle: longword; FWinStyleEx: longword; FParentWinHandle: TfpgWinHandle; - procedure DoAllocateWindowHandle(aparent: TfpgWindowImpl); - procedure DoReleaseWindowHandle; + procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; + procedure DoReleaseWindowHandle; override; function HandleIsValid: boolean; override; - procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); + procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; procedure DoMoveWindow(x, y: TfpgCoord); //procedure MoveToScreenCenter; override; procedure DoSetWindowTitle(const atitle: string); @@ -678,7 +678,7 @@ end; { TfpgWindowImpl } -procedure TfpgWindowImpl.DoAllocateWindowHandle(aparent: TfpgWindowImpl); +procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); var wcname: string; wname: string; @@ -696,7 +696,7 @@ begin wcname := 'FPGWIN'; if aparent <> nil then - FParentWinHandle := aparent.WinHandle + FParentWinHandle := TfpgWindowImpl(AParent).WinHandle else FParentWinHandle := 0; diff --git a/prototypes/fpgui2/source/core/gfxbase.pas b/prototypes/fpgui2/source/core/gfxbase.pas index 62a7864f..a245a033 100644 --- a/prototypes/fpgui2/source/core/gfxbase.pas +++ b/prototypes/fpgui2/source/core/gfxbase.pas @@ -10,7 +10,7 @@ uses type TfpgCoord = integer; // we might use floating point coordinates in the future... - TfpgColor = longword; + TfpgColor = longword; // Always in RRGGBB (Red, Green, Blue) format!! type TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup); @@ -90,6 +90,12 @@ const KEYSC_ENTER = $1C; KEYSC_SPACE = $39; + + FPG_DEFAULT_FONT_DESC = 'Arial-10'; + UserNamedColorStart = 128; + + {$I predefinedcolors.inc} + type TfpgRect = object // not class for static allocations Top: TfpgCoord; @@ -103,7 +109,7 @@ type procedure SetRight(Value: TfpgCoord); end; -type + TfpgMsgParmMouse = record x: TfpgCoord; y: TfpgCoord; @@ -111,10 +117,12 @@ type shiftstate: word; end; + TfpgMsgParmKeyboard = record keycode: word; shiftstate: word; end; + TfpgMessageParams = record case integer of @@ -122,6 +130,7 @@ type 1: (keyboard: TfpgMsgParmKeyboard); 2: (rect: TfpgRect); end; + TfpgMessageRec = record MsgCode: integer; @@ -131,42 +140,7 @@ type end; PfpgMessageRec = ^TfpgMessageRec; -const - FPG_DEFAULT_FONT_DESC = 'Arial-10'; - -const - UserNamedColorStart = 128; - -// named color identifiers -const - clWindowBackground = $80000001; - clBoxColor = $80000002; - clButtonFace = $80000003; - clShadow1 = $80000004; - clShadow2 = $80000005; - clHilite1 = $80000006; - clHilite2 = $80000007; - clText1 = $80000008; - clText2 = $80000009; - clText3 = $8000000A; - clText4 = $8000000B; - clSelection = $8000000C; - clSelectionText = $8000000D; - clInactiveSel = $8000000E; - clInactiveSelText = $8000000F; - clScrollBar = $80000010; - clListBox = $80000011; - clGridLines = $80000012; - clGridHeader = $80000013; - clWidgetFrame = $80000014; - clInactiveWgFrame = $80000015; - clTextCursor = $80000016; - clChoiceListBox = $80000017; - clUnset = $80000018; - clMenuText = $80000019; - clMenuDisabled = $8000001A; -type TfpgLineStyle = (lsSolid, lsDash, lsDot); @@ -201,8 +175,6 @@ type end; - { TfpgFontBase } - TfpgFontBase = class(TObject) protected FFontDesc: string; @@ -222,8 +194,6 @@ type TfpgWindowBase = class; - { TfpgCanvasBase } - TfpgCanvasBase = class(TObject) protected FBufferedDraw: boolean; @@ -297,12 +267,25 @@ type FHeight: TfpgCoord; FMinWidth: TfpgCoord; FMinHeight: TfpgCoord; + FCanvas: TfpgCanvasBase; + FParentWindow: TfpgWindowBase; function HandleIsValid: boolean; virtual; abstract; + procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual; abstract; + procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); virtual; abstract; + procedure DoReleaseWindowHandle; virtual; abstract; + procedure SetParentWindow(const AValue: TfpgWindowBase); + function GetParentWindow: TfpgWindowBase; + function GetCanvas: TfpgCanvasBase; virtual; + procedure AllocateWindowHandle; + procedure ReleaseWindowHandle; public // make some setup before the window shows procedure AdjustWindowStyle; virtual; // forms modify the window creation parameters procedure SetWindowParameters; virtual; // invoked after the window is created - // general properties + // general properties and functions + function Right: TfpgCoord; + function Bottom: TfpgCoord; + procedure UpdateWindowPosition; property HasHandle: boolean read HandleIsValid; property WindowType: TWindowType read FWindowType write FWindowType; property WindowAttributes: TWindowAttributes read FWindowAttributes write FWindowAttributes; @@ -312,6 +295,8 @@ type property Height: TfpgCoord read FHeight write FHeight; property MinWidth: TfpgCoord read FMinWidth write FMinWidth; property MinHeight: TfpgCoord read FMinHeight write FMinHeight; + property Canvas: TfpgCanvasBase read GetCanvas; + property ParentWindow: TfpgWindowBase read GetParentWindow write SetParentWindow; end; @@ -361,6 +346,35 @@ end; { TfpgWindowBase } +procedure TfpgWindowBase.SetParentWindow(const AValue: TfpgWindowBase); +begin + FParentWindow := AValue; +end; + +function TfpgWindowBase.GetParentWindow: TfpgWindowBase; +begin + result := FParentWindow; +end; + +function TfpgWindowBase.GetCanvas: TfpgCanvasBase; +begin + Result := FCanvas; +end; + +procedure TfpgWindowBase.AllocateWindowHandle; +begin + DoAllocateWindowHandle(FParentWindow); +end; + +procedure TfpgWindowBase.ReleaseWindowHandle; +begin + if HasHandle then + begin + Canvas.FreeResources; + DoReleaseWindowHandle; + end; +end; + procedure TfpgWindowBase.AdjustWindowStyle; begin // does nothing here @@ -371,6 +385,22 @@ begin // does nothing end; +function TfpgWindowBase.Right: TfpgCoord; +begin + Result := FLeft + FWidth - 1; +end; + +function TfpgWindowBase.Bottom: TfpgCoord; +begin + Result := FTop + FHeight - 1; +end; + +procedure TfpgWindowBase.UpdateWindowPosition; +begin + if HasHandle then + DoUpdateWindowPosition(FLeft, FTop, FWidth, FHeight); +end; + { TfpgCanvasBase } procedure TfpgCanvasBase.DrawRectangle(x, y, w, h: TfpgCoord); diff --git a/prototypes/fpgui2/source/core/predefinedcolors.inc b/prototypes/fpgui2/source/core/predefinedcolors.inc new file mode 100644 index 00000000..2eb0b848 --- /dev/null +++ b/prototypes/fpgui2/source/core/predefinedcolors.inc @@ -0,0 +1,66 @@ + + + // The following colors match the predefined Delphi Colors + // NOTE: + // The format is always RRGGBB (Red, Green, Blue); + + clBlack = TfpgColor($000000); + clMaroon = TfpgColor($800000); + clGreen = TfpgColor($008000); + clOlive = TfpgColor($808000); + clNavy = TfpgColor($000080); + clPurple = TfpgColor($800080); + clTeal = TfpgColor($008080); + clGray = TfpgColor($808080); + clSilver = TfpgColor($C0C0C0); + clRed = TfpgColor($FF0000); + clLime = TfpgColor($00FF00); + clYellow = TfpgColor($FFFF00); + clBlue = TfpgColor($0000FF); + clFuchsia = TfpgColor($FF00FF); + clAqua = TfpgColor($00FFFF); + clLtGray = TfpgColor($C0C0C0); + clDkGray = TfpgColor($808080); + clWhite = TfpgColor($FFFFFF); + clCream = TfpgColor($FFFBF0); + clNone = TfpgColor($1FFFFFFF); + clDefault = TfpgColor($20000000); + + clMoneyGreen = TfpgColor($C0DCC0); + clSkyBlue = TfpgColor($A6CAF0); + clMedGray = TfpgColor($A0A0A4); + + + + + // System named color identifiers. DON'T CHANGE THE ORDER! + + clWindowBackground = $80000001; + clBoxColor = $80000002; + clButtonFace = $80000003; + clShadow1 = $80000004; + clShadow2 = $80000005; + clHilite1 = $80000006; + clHilite2 = $80000007; + clText1 = $80000008; + clText2 = $80000009; + clText3 = $8000000A; + clText4 = $8000000B; + clSelection = $8000000C; + clSelectionText = $8000000D; + clInactiveSel = $8000000E; + clInactiveSelText = $8000000F; + clScrollBar = $80000010; + clListBox = $80000011; + clGridLines = $80000012; + clGridHeader = $80000013; + clWidgetFrame = $80000014; + clInactiveWgFrame = $80000015; + clTextCursor = $80000016; + clChoiceListBox = $80000017; + clUnset = $80000018; + clMenuText = $80000019; + clMenuDisabled = $8000001A; + + + diff --git a/prototypes/fpgui2/source/core/x11/gfx_x11.pas b/prototypes/fpgui2/source/core/x11/gfx_x11.pas index 4635fcb0..48790287 100644 --- a/prototypes/fpgui2/source/core/x11/gfx_x11.pas +++ b/prototypes/fpgui2/source/core/x11/gfx_x11.pas @@ -117,12 +117,12 @@ type protected FWinHandle: TfpgWinHandle; FModalForWin: TfpgWindowImpl; - procedure DoAllocateWindowHandle(aparent: TfpgWindowImpl); - procedure DoReleaseWindowHandle; + procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; + procedure DoReleaseWindowHandle; override; function HandleIsValid: boolean; override; procedure DoSetWindowTitle(const atitle: string); procedure DoMoveWindow(x, y: TfpgCoord); - procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); + procedure DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override; property WinHandle: TfpgWinHandle read FWinHandle; public constructor Create(AOwner: TComponent); override; @@ -267,6 +267,7 @@ end; type PWindowLookupRec = ^WindowLookupRec; + // single direction linked list WindowLookupRec = record w: TfpgWindowImpl; Next: PWindowLookupRec; @@ -750,7 +751,7 @@ end; { TfpgWindowImpl } -procedure TfpgWindowImpl.DoAllocateWindowHandle(aparent: TfpgWindowImpl); +procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); var pwh: TfpgWinHandle; wh: TfpgWinHandle; @@ -763,7 +764,7 @@ begin Exit; if aparent <> nil then - pwh := aparent.WinHandle + pwh := TfpgWindowImpl(AParent).WinHandle else pwh := xapplication.RootWindow; @@ -821,8 +822,8 @@ begin 1);// send close event instead of quitting the whole application... // for modal windows, this is necessary - if (FWindowType = wtModalForm) and (aparent <> nil) then - XSetTransientForHint(xapplication.display, self.FWinHandle, aparent.WinHandle); + if (FWindowType = wtModalForm) and (AParent <> nil) then + XSetTransientForHint(xapplication.display, self.FWinHandle, TfpgWindowImpl(AParent).WinHandle); XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or ButtonPressMask or ButtonReleaseMask or diff --git a/prototypes/fpgui2/tests/bitmaptest.dpr b/prototypes/fpgui2/tests/bitmaptest.dpr index 4c058339..c8b98193 100644 --- a/prototypes/fpgui2/tests/bitmaptest.dpr +++ b/prototypes/fpgui2/tests/bitmaptest.dpr @@ -26,7 +26,7 @@ type procedure TMainForm.AfterCreate; begin SetPosition(100, 100, 256, 256); - WindowTitle := 'fpGUI2 Bitmap Test'; + WindowTitle := 'fpGUI Bitmap Test'; end; procedure TMainForm.HandlePaint; diff --git a/prototypes/fpgui2/tests/fpgcanvas.lpr b/prototypes/fpgui2/tests/fpgcanvas.lpr index 7cae700f..978d21b2 100644 --- a/prototypes/fpgui2/tests/fpgcanvas.lpr +++ b/prototypes/fpgui2/tests/fpgcanvas.lpr @@ -12,13 +12,6 @@ uses gui_form, gfx_imgfmt_bmp; -const - // We need to define more such constants in fpGFX as standard - // RRGGBB - clRed = $FF0000; - clGreen = $00FF00; - clBlue = $0000FF; - clBlack = $000000; type -- cgit v1.2.3-70-g09d2