diff options
| -rw-r--r-- | examples/gui/concepttest/hello.lpi | 6 | ||||
| -rw-r--r-- | examples/gui/concepttest/hello.lpr | 2 | ||||
| -rw-r--r-- | gui/colors.inc | 11 | ||||
| -rw-r--r-- | gui/defimpl/defstyle.inc | 11 | ||||
| -rw-r--r-- | gui/form.inc | 5 | ||||
| -rw-r--r-- | gui/fpgui.pas | 5 | ||||
| -rw-r--r-- | gui/fpguipackage.lpk | 14 | ||||
| -rw-r--r-- | gui/fpguipackage.pas | 2 | ||||
| -rw-r--r-- | gui/motifstyle.pas | 117 | ||||
| -rw-r--r-- | gui/opensoftstyle.pas | 279 | ||||
| -rw-r--r-- | gui/style.inc | 163 | ||||
| -rw-r--r-- | gui/stylemanager.pas | 84 | ||||
| -rw-r--r-- | gui/widget.inc | 12 | ||||
| -rw-r--r-- | gui/win32/defstyle.inc | 8 | ||||
| -rw-r--r-- | gui/windowsstyle.pas | 39 |
15 files changed, 575 insertions, 183 deletions
diff --git a/examples/gui/concepttest/hello.lpi b/examples/gui/concepttest/hello.lpi index 58b32e42..98611428 100644 --- a/examples/gui/concepttest/hello.lpi +++ b/examples/gui/concepttest/hello.lpi @@ -23,7 +23,7 @@ </RunParams> <RequiredPackages Count="1"> <Item1> - <PackageName Value="fpGUI_laz"/> + <PackageName Value="fpguipackage"/> </Item1> </RequiredPackages> <Units Count="59"> @@ -31,8 +31,8 @@ <Filename Value="hello.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="hello"/> - <CursorPos X="25" Y="286"/> - <TopLine Value="270"/> + <CursorPos X="62" Y="10"/> + <TopLine Value="10"/> <EditorIndex Value="0"/> <UsageCount Value="136"/> <Loaded Value="True"/> diff --git a/examples/gui/concepttest/hello.lpr b/examples/gui/concepttest/hello.lpr index 0ac8138a..7e723696 100644 --- a/examples/gui/concepttest/hello.lpr +++ b/examples/gui/concepttest/hello.lpr @@ -7,7 +7,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Classes, - fpgui, gfxbase, frmCompilerOpt, OpenSoftStyle; + fpgui, gfxbase, frmCompilerOpt, OpenSoftStyle, fpguipackage; type diff --git a/gui/colors.inc b/gui/colors.inc index e83432b1..98785467 100644 --- a/gui/colors.inc +++ b/gui/colors.inc @@ -1,4 +1,7 @@ +{%mainunit fpgui.pp} + + { NOTE: The colors commented out below are not applicable to systems other than Windows. For this reason I don't see the need to define them. Under Linux, @@ -139,13 +142,17 @@ Khaki #f0e68c Lavender #e6e6fa LavenderBlush #fff0f5 LawnGreen #7cfc00 -LemonChiffon #fffacd +} + clLemonChiffon = TColor($CDFAFF); // #fffacd +{ LightBlue #add8e6 LightCoral #f08080 LightCyan #e0ffff LightGoldenrodYellow #fafad2 LightGreen #90ee90 -LightGrey #d3d3d3 +} + clLightGrey = TColor($D3D3D3); // #d3d3d3 +{ LightPink #ffb6c1 LightSalmon #ffa07a LightSeaGreen #20b2aa diff --git a/gui/defimpl/defstyle.inc b/gui/defimpl/defstyle.inc index 6b76c4c5..26dd6512 100644 --- a/gui/defimpl/defstyle.inc +++ b/gui/defimpl/defstyle.inc @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Library - Default Style class declarations + Basic Style class declarations Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this distribution, for details of the copyright. @@ -16,7 +16,7 @@ {$IFNDEF Has_DefaultStyle_GetGUIColor} -function TDefaultStyle.GetGUIColor(Color: TColor): TGfxColor; +function TBasicStyle.GetGUIColor(Color: TColor): TGfxColor; begin case Color of // UI element colors @@ -47,17 +47,12 @@ end; {$IFNDEF Has_DefaultStyle_DrawFocusRect} -procedure TDefaultStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); +procedure TBasicStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); begin - // !!!: Disabled for Linux as long a a certain nVidia X-Server has bugs with this... - Canvas.SetColor(GetUIColor(cl3DDkShadow)); Canvas.SetLineStyle(lsDot); Canvas.DrawRect(ARect); Canvas.SetLineStyle(lsSolid); - -// Canvas.SetColor(rgbaGray); -// Canvas.DrawRect(ARect); end; {$ENDIF} diff --git a/gui/form.inc b/gui/form.inc index 3eb1ae0a..7193db44 100644 --- a/gui/form.inc +++ b/gui/form.inc @@ -115,6 +115,9 @@ constructor TCustomForm.Create(AOwner: TComponent); begin + if not Assigned(FStyle) then + FStyle := gStyleManager.DefaultStyle; + inherited Create(AOwner); FCanExpandWidth := True; @@ -122,8 +125,6 @@ begin FCursor := crArrow; FWindowOptions := [woWindow]; - if not Assigned(FStyle) then - FStyle := gStyleManager.DefaultStyle; end; diff --git a/gui/fpgui.pas b/gui/fpgui.pas index 2ec385c0..cb12c6b8 100644 --- a/gui/fpgui.pas +++ b/gui/fpgui.pas @@ -51,8 +51,10 @@ const InfiniteSize = 16383; +// Insert loads of named colors {$I colors.inc} + resourcestring mbText_Yes = 'Yes'; mbText_No = 'No'; @@ -154,6 +156,9 @@ implementation uses Math ,stylemanager + ,MotifStyle // so they register with style manager + ,OpenSoftStyle // so they register with style manager + ,WindowsStyle // so they register with style manager ; diff --git a/gui/fpguipackage.lpk b/gui/fpguipackage.lpk index 02b65985..4e2e7e4e 100644 --- a/gui/fpguipackage.lpk +++ b/gui/fpguipackage.lpk @@ -27,7 +27,7 @@ <License Value="Modified LGPL "/> <Version Minor="3"/> - <Files Count="2"> + <Files Count="5"> <Item1> <Filename Value="stylemanager.pas"/> <UnitName Value="stylemanager"/> @@ -36,6 +36,18 @@ <Filename Value="fpgui.pas"/> <UnitName Value="fpGUI"/> </Item2> + <Item3> + <Filename Value="windowsstyle.pas"/> + <UnitName Value="WindowsStyle"/> + </Item3> + <Item4> + <Filename Value="motifstyle.pas"/> + <UnitName Value="MotifStyle"/> + </Item4> + <Item5> + <Filename Value="opensoftstyle.pas"/> + <UnitName Value="OpenSoftStyle"/> + </Item5> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/gui/fpguipackage.pas b/gui/fpguipackage.pas index 628f8804..7bd19a97 100644 --- a/gui/fpguipackage.pas +++ b/gui/fpguipackage.pas @@ -7,7 +7,7 @@ unit fpguipackage; interface uses - stylemanager, fpGUI; + stylemanager, fpGUI, WindowsStyle, MotifStyle, OpenSoftStyle; implementation diff --git a/gui/motifstyle.pas b/gui/motifstyle.pas new file mode 100644 index 00000000..917d218f --- /dev/null +++ b/gui/motifstyle.pas @@ -0,0 +1,117 @@ +{ + fpGUI - Free Pascal GUI Library + + Motif style implementation + + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + +unit MotifStyle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes + ,SysUtils + ,fpGUI + ,fpGFX + ; + + +type + + TMotifStyle = class(TBasicStyle) + public + // General + procedure DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); override; + // Buttons + procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TButtonFlags); override; + // Check boxes + procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TCheckboxFlags); override; + end; + + +implementation + + +{ MotifStyle } + +procedure TMotifStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; + Flags: TButtonFlags); +var + r: TRect; +begin + r := ARect; + + if btnIsSelected in Flags then + begin + SetUIColor(Canvas, cl3DDkShadow); + Canvas.DrawRect(r); + Inc(r.Left); + Inc(r.Top); + Dec(r.Right); + Dec(r.Bottom); + end; + + if btnIsPressed in Flags then + begin + SetUIColor(Canvas, cl3DShadow); + Canvas.DrawRect(r); + Inc(r.Left); + Inc(r.Top); + Dec(r.Right); + Dec(r.Bottom); + end else + begin + if btnIsEmbedded in Flags then + Draw3DFrame(Canvas, r, cl3DLight, cl3DHighlight, cl3DDkShadow, cl3DShadow) + else + Draw3DFrame(Canvas, r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); + Inc(r.Left, 2); + Inc(r.Top, 2); + Dec(r.Right, 2); + Dec(r.Bottom, 2); + end; + + SetUIColor(Canvas, cl3DFace); + Canvas.FillRect(r); + + if btnHasFocus in Flags then + begin + r.Left := ARect.Left + 4; + r.Top := ARect.Top + 4; + r.Right := ARect.Right - 4; + r.Bottom := ARect.Bottom - 4; + DrawFocusRect(Canvas, r); + end; +end; + +procedure TMotifStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); +begin + SetUIColor(Canvas, clGray); + Canvas.DrawRect(ARect); +end; + +procedure TMotifStyle.DrawCheckBox(Canvas: TFCanvas; const ARect, + LabelRect: TRect; Flags: TCheckboxFlags); +begin + inherited DrawCheckBox(Canvas, ARect, LabelRect, Flags); +end; + + +//initialization +//finalization +// gStyleManager.RegisterClass('Motif', TMotifStyle); + +end. + diff --git a/gui/opensoftstyle.pas b/gui/opensoftstyle.pas new file mode 100644 index 00000000..1752aa60 --- /dev/null +++ b/gui/opensoftstyle.pas @@ -0,0 +1,279 @@ +{ + fpGUI - Free Pascal GUI Library + + OpenSoft look-and-feel style implementation + + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + +unit OpenSoftStyle; + +{$mode objfpc}{$H+} + +interface +uses + Classes + ,fpGUI + ,gfxBase + ,fpGFX + ; + +type + + TGradientDirection = (gdTopToBottom, gdBottomToTop, gdLeftToRight, gdRightToLeft); + TCalcGradientEndX = function(Y, H: Integer): Integer; + + + TOpenSoftStyle = class(TBasicStyle) + private + procedure PaintGradient(pCanvas: TFCanvas; const R: TRect; StartColor, EndColor: TColor; Direction: TGradientDirection; GradLines: Integer = -1); + public + // Colors + function GetGUIColor(Color: TColor): TGfxColor; override; + // Buttons (todo) +// procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TButtonFlags); override; + // GroupBox + procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TWidgetState); override; + end; + + +implementation + +const + // Some predefined colors: + rgbaDkBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $8000; Alpha: $0000); + rgbaLtYellow: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $e100; Alpha: $0000); + + rgbaWindowText: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: $0000); + rgbaWindow: TGfxColor = (Red: $efef; Green: $efef; Blue: $efef; Alpha: $0000); + rgbaDkGrey: TGfxColor = (Red: $8686; Green: $8686; Blue: $8686; Alpha: $0000); + rgbaGbAALtGrey: TGfxColor = (Red: $baba; Green: $baba; Blue: $baba; Alpha: $0000); + rgbaGbAADkGrey: TGfxColor = (Red: $7878; Green: $7878; Blue: $7878; Alpha: $0000); + + +{ +procedure DrawGradient(Canvas: TCanvas; const R: TRect; StartColor, EndColor: TColor; + Direction: TGradientDirection; GradLines: Integer = -1; CalcEndX: TCalcGradientEndX = nil); +procedure DrawGradientEx(Canvas: TCanvas; const R: TRect; StartColor: TColor; + StartToMidHeight: Integer; MidColor, EndColor: TColor; + Direction: TGradientDirection; CalcEndX: TCalcGradientEndX = nil); + + +procedure ToRGB(c: TColor; out rgb: TRGB); +var + l: TColorRef; +begin + c := ColorFromColormap(c); + l := ColorToRGB(c); + rgb.r := TRGBValue(l).r; + rgb.g := TRGBValue(l).g; + rgb.b := TRGBValue(l).b; +end; +} + +{ TOpenSoftStyle } + +procedure TOpenSoftStyle.PaintGradient(pCanvas: TFCanvas; const R: TRect; + StartColor, EndColor: TColor; Direction: TGradientDirection; + GradLines: Integer = -1); +var + X: integer; + i: integer; + w: integer; + h: integer; + Count: integer; + EndCol: TGfxColor; + StartCol: TGfxColor; + AddCol: TGfxColor; + Tmp: TGfxColor; +begin +(* + w := R.Right - R.Left - 1; + h := R.Bottom - R.Top - 1; + if (w <= 0) or (h <= 0) then + Exit; //==> + + StartCol := GetGUIColor(StartColor); + EndCol := GetGUIColor(EndColor); + + case Direction of + gdTopToBottom: + Count := h; + gdLeftToRight: + Count := w; + gdBottomToTop: + begin + Count := h; + Tmp := EndCol; + EndCol := StartCol; + StartCol := Tmp; + end; + gdRightToLeft: + begin + Count := w; + Tmp := EndCol; + EndCol := StartCol; + StartCol := Tmp; + end; + else + Exit; //==> + end; + if GradLines < 0 then + GradLines := Count; + + AddCol.Red := (EndCol.Red - StartCol.Red) div GradLines; + AddCol.Green := (EndCol.Green - StartCol.Green) div GradLines; + AddCol.Blue := (EndCol.Blue - StartCol.Blue) div GradLines; + +// Canvas.Pen.Style := psSolid; + pCanvas.SaveState; +// Canvas.Start; + try +// StartColor := TColor(Round(StartCol.Red), Round(StartCol.Green), Round(StartCol.Blue)); +// Canvas.Pen.Color := StartColor; + pCanvas.SetColor(GetGUIColor(StartColor)); + for i := 0 to Count - 1 do + begin + if Direction in [gdTopToBottom, gdBottomToTop] then + begin +// pCanvas.MoveTo(R.Left, R.Top + i); +// if Assigned(CalcEndX) then +// X := CalcEndX(i, Count) +// else + X := 0; +// pCanvas.LineTo(R.Right + X, R.Top + i); + pCanvas.DrawLine(Point(R.Left, R.Top + i), Point(R.Right + X, R.Top + i)); + end + else + begin + pCanvas.DrawLine(Point(R.Left + i, R.Top), Point(R.Left + i, R.Bottom)) +// pCanvas.MoveTo(R.Left + i, R.Top); +// pCanvas.LineTo(R.Left + i, R.Bottom); + end; + StartCol.Red := StartCol.Red + AddCol.Red; + StartCol.Green := StartCol.Green + AddCol.Green; + StartCol.Blue := StartCol.Blue + AddCol.Blue; + EndColor := RGB(Round(StartCol.Red), Round(StartCol.Green), Round(StartCol.Blue)); + if StartColor <> EndColor then + begin +// Canvas.Pen.Color := EndColor; + pCanvas.SetColor(GetGUIColor(EndColor)); + StartColor := EndColor; + end; + end; // for + + finally +// Canvas.Stop; + pCanvas.RestoreState; + end; +*) +end; + + +function TOpenSoftStyle.GetGUIColor(Color: TColor): TGfxColor; +begin + Result := inherited GetGUIColor(Color); + case Color of + // UI element colors + clScrollBar: Result := GetUIColor(clLightGrey); //rgbaWindow; + clMenu: Result := GetUIColor(clLightGrey); //rgbaWindow; +// clWindow: Result := GetUIColor(clWhite); +// clMenuText: Result := GetUIColor(clBlack); +// clWindowText: Result := GetUIColor(clBlack); +// clAppWorkSpace: Result := GetUIColor(clGray); +// clHighlight: Result := GetUIColor(clNavy); +// clHighlightText: Result := GetUIColor(clWhite); + cl3DFace: Result := GetUIColor(clLightGrey); //rgbaWindow; +// cl3DShadow: Result := rgbaDkWhite; +// clGrayText: Result := GetUIColor(clGray); +// clBtnText: Result := GetUIColor(clBlack); +// cl3DHighlight: Result := GetUIColor(clWhite); + cl3DDkShadow: Result := GetUIColor(clBlack); +// cl3DLight: Result := GetUIColor(clDarkWhite); +// clInfoText: Result := GetUIColor(clBlack); +// clInfoBk: Result := GetUIColor(clLightYellow); +// +// else Result := GetUIColor(clWhite); + end; + +end; + +(* +procedure TOpenSoftStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; + Flags: TButtonFlags); +begin +// inherited DrawButtonFace(Canvas, ARect, Flags); +// PaintGradient(Canvas, ARect, Flags); + Draw3DFrame(Canvas, ARect, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); +end; +*) + +procedure TOpenSoftStyle.DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; + const ALabel: String; WidgetState: TWidgetState); +var + TitleWidth, TitleHeight, TopLine: Integer; +begin + TitleWidth := Canvas.TextWidth(ALabel); + TitleHeight := Canvas.FontCellHeight; + TopLine := ARect.Top + TitleHeight div 3; + + Canvas.SetColor(rgbaDkGrey); + // box outline + with ARect do + begin + // top + Canvas.DrawLine(Point(Left + 2, TopLine), Point(Left + 12, TopLine)); + Canvas.DrawLine(Point(Left + TitleWidth + 16, TopLine), Point(Right - 2, TopLine)); + // right + Canvas.DrawLine(Point(Right-1, TopLine + 2), Point(Right-1, Bottom - 2)); + // bottom + Canvas.DrawLine(Point(Right - 3, Bottom-1), Point(Left + 1, Bottom-1)); + // left + Canvas.DrawLine(Point(Left, Bottom - 3), Point(Left, TopLine + 1)); + end; + + // Text caption + SetUIColor(Canvas, clWindowText); + DrawText(Canvas, ARect.TopLeft + Point(14, 0), ALabel, WidgetState); + + { Anti-Aliasing - Top/Left } + Canvas.SetColor(rgbaGbAALtGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(0, TopLine+1)); + Canvas.DrawPoint(ARect.TopLeft + Point(1, TopLine)); + Canvas.SetColor(rgbaGbAADkGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(1, TopLine+1)); + { Anti-Aliasing - Top/Right } + Canvas.SetColor(rgbaGbAALtGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-1, TopLine+1)); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, TopLine)); + Canvas.SetColor(rgbaGbAADkGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, TopLine+1)); + { Anti-Aliasing - Bottom/Right } + Canvas.SetColor(rgbaGbAALtGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-1, ARect.Bottom-2)); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, ARect.Bottom-1)); + Canvas.SetColor(rgbaGbAADkGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(ARect.Right-2, ARect.Bottom-2)); + { Anti-Aliasing - Bottom/Left } + Canvas.SetColor(rgbaGbAALtGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(0, ARect.Bottom-2)); + Canvas.DrawPoint(ARect.TopLeft + Point(1, ARect.Bottom-1)); + Canvas.SetColor(rgbaGbAADkGrey); + Canvas.DrawPoint(ARect.TopLeft + Point(1, ARect.Bottom-2)); +end; + + +//initialization +//finalization +// gStyleManager.RegisterClass('OpenSoft', TOpenSoftStyle); + +end. + diff --git a/gui/style.inc b/gui/style.inc index 1af0272e..66b216bc 100644 --- a/gui/style.inc +++ b/gui/style.inc @@ -28,8 +28,8 @@ { Possible arrow directions } TArrowDirection = (arrowUp, arrowDown, arrowLeft, arrowRight); - { Style declarations } - TStyle = class(TObject) + { Abstract Style declarations } + TStyleAbs = class(TObject) protected UIColorCache: array[0..$18] of TGfxColor; public @@ -90,7 +90,7 @@ { TDefaultStyle } - TDefaultStyle = class(TStyle) + TBasicStyle = class(TStyleAbs) protected procedure DrawDirectionArrows(ACanvas: TFCanvas; const ARect: TRect; ADirection: TArrowDirection); procedure DrawCheckBoxCheck(ACanvas: TFCanvas; const ARect: TRect; AFlags: TCheckboxFlags); @@ -146,18 +146,6 @@ end; - { TMotifStyle } - - TMotifStyle = class(TDefaultStyle) - public - // General - procedure DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); override; - // Buttons - procedure DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TButtonFlags); override; - // Check boxes - procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TCheckboxFlags); override; - end; - {$ENDIF read_interface} @@ -165,16 +153,16 @@ {$IFDEF read_implementation} -{ TStyle } +{ TStyleAbs } -constructor TStyle.Create; +constructor TStyleAbs.Create; begin inherited Create; UpdateUIColorCache; end; -procedure TStyle.UpdateUIColorCache; +procedure TStyleAbs.UpdateUIColorCache; var i: TColor; begin @@ -183,7 +171,7 @@ begin end; -function TStyle.GetUIColor(AColor: TColor): TGfxColor; +function TStyleAbs.GetUIColor(AColor: TColor): TGfxColor; begin if (AColor >= clScrollBar) and (AColor <= clScrollBar + $18) then Result := UIColorCache[TColor(AColor - clScrollBar)] @@ -198,7 +186,7 @@ begin end; -procedure TStyle.SetUIColor(Canvas: TFCanvas; Color: TColor); +procedure TStyleAbs.SetUIColor(Canvas: TFCanvas; Color: TColor); var lGfxColor: TGfxColor; begin @@ -215,7 +203,7 @@ begin end; -{ TDefaultStyle } +{ TBasicStyle } const rgbaDkWhite: TGfxColor = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0); @@ -229,7 +217,7 @@ const {$I defimpl/defstyle.inc} {$ENDIF} -procedure TDefaultStyle.DrawDirectionArrows(ACanvas: TFCanvas; +procedure TBasicStyle.DrawDirectionArrows(ACanvas: TFCanvas; const ARect: TRect; ADirection: TArrowDirection); var peekx, peeky: Cardinal; @@ -276,7 +264,7 @@ begin end; end; -procedure TDefaultStyle.DrawCheckBoxCheck(ACanvas: TFCanvas; +procedure TBasicStyle.DrawCheckBoxCheck(ACanvas: TFCanvas; const ARect: TRect; AFlags: TCheckboxFlags); begin if (cbIsEnabled in AFlags) then @@ -308,7 +296,7 @@ end; Color4: Inner frame right & bottom } -procedure TDefaultStyle.Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; Color1, Color2, Color3, Color4: TColor); begin with ARect do @@ -336,7 +324,7 @@ begin end; end; -procedure TDefaultStyle.DrawSunkenOuterBorder(Canvas: TFCanvas; +procedure TBasicStyle.DrawSunkenOuterBorder(Canvas: TFCanvas; const ARect: TRect); begin with ARect do @@ -350,7 +338,7 @@ begin end; end; -procedure TDefaultStyle.DrawRaisedOuterBorder(Canvas: TFCanvas; +procedure TBasicStyle.DrawRaisedOuterBorder(Canvas: TFCanvas; const ARect: TRect); begin with ARect do @@ -364,7 +352,7 @@ begin end; end; -procedure TDefaultStyle.DrawText(Canvas: TFCanvas; const APosition: TPoint; +procedure TBasicStyle.DrawText(Canvas: TFCanvas; const APosition: TPoint; const AText: String; State: TWidgetState); begin if not (wsEnabled in State) then @@ -376,7 +364,7 @@ begin Canvas.TextOut(APosition, AText); end; -procedure TDefaultStyle.DrawItemBefore(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawItemBefore(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); begin if ifSelected in Flags then @@ -387,21 +375,21 @@ begin end; end; -procedure TDefaultStyle.DrawItemAfter(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawItemAfter(Canvas: TFCanvas; const ARect: TRect; Flags: TItemFlags); begin if ifFocused in Flags then DrawFocusRect(Canvas, ARect); end; -procedure TDefaultStyle.DrawWindowBackground(Canvas: TFCanvas; +procedure TBasicStyle.DrawWindowBackground(Canvas: TFCanvas; const ARect: TRect); begin // SetUIColor(Canvas, cl3DFace); Canvas.FillRect(ARect); end; -procedure TDefaultStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; Flags: TButtonFlags); var r: TRect; @@ -451,17 +439,17 @@ begin end; end; -function TDefaultStyle.GetButtonBorders: TRect; +function TBasicStyle.GetButtonBorders: TRect; begin Result := Rect(5, 5, 5, 5); end; -function TDefaultStyle.GetSeparatorSize: Integer; +function TBasicStyle.GetSeparatorSize: Integer; begin Result := 2; end; -procedure TDefaultStyle.DrawSeparator(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawSeparator(Canvas: TFCanvas; const ARect: TRect; AOrientation: TOrientation); var r: TRect; @@ -476,7 +464,7 @@ begin DrawSunkenOuterBorder(Canvas, r); end; -procedure TDefaultStyle.DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TWidgetState); var TitleWidth, TitleHeight, TopLine: Integer; @@ -510,14 +498,14 @@ begin DrawText(Canvas, ARect.TopLeft + Point(9, 0), ALabel, WidgetState); end; -function TDefaultStyle.GetGroupBoxBorders(Canvas: TFCanvas; +function TBasicStyle.GetGroupBoxBorders(Canvas: TFCanvas; const ALabel: String; var LabelWidth: Integer): TRect; begin Result := Rect(6, Canvas.FontCellHeight + 4, 6, 6); LabelWidth := Canvas.TextWidth(ALabel) + 6; end; -procedure TDefaultStyle.DrawEditBox(Canvas: TFCanvas; const ARect: TRect); +procedure TBasicStyle.DrawEditBox(Canvas: TFCanvas; const ARect: TRect); begin Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DFace); SetUIColor(Canvas, clWindow); @@ -525,12 +513,12 @@ begin Canvas.FillRect(Rect(Left + 2, Top + 2, Right - 2, Bottom - 2)); end; -function TDefaultStyle.GetEditBoxBorders: TRect; +function TBasicStyle.GetEditBoxBorders: TRect; begin Result := Rect(2, 2, 2, 2); end; -procedure TDefaultStyle.DrawCheckBox(Canvas: TFCanvas; +procedure TBasicStyle.DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TCheckboxFlags); var r: TRect; @@ -555,7 +543,7 @@ begin DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2)); end; -procedure TDefaultStyle.GetCheckBoxLayout(const LabelSize: TSize; +procedure TBasicStyle.GetCheckBoxLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); begin TotalSize := Size(LabelSize.cx + 21, Max(13, LabelSize.cy + 4)); @@ -563,7 +551,7 @@ begin end; -procedure TDefaultStyle.DrawRadioButton(Canvas: TFCanvas; +procedure TBasicStyle.DrawRadioButton(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TCheckboxFlags); var Index, BtnY: Integer; @@ -620,26 +608,26 @@ begin DrawFocusRect(Canvas, Rect(Left - 2, Top - 2, Right + 2, Bottom + 2)); end; -procedure TDefaultStyle.GetRadioButtonLayout(const LabelSize: TSize; +procedure TBasicStyle.GetRadioButtonLayout(const LabelSize: TSize; var TotalSize: TSize; var LabelPos: TPoint); begin TotalSize := Size(LabelSize.cx + 20, Max(12, LabelSize.cy + 4)); LabelPos := Point(18, (TotalSize.cy - LabelSize.cy) div 2); end; -function TDefaultStyle.GetComboBoxArrowSize: TSize; +function TBasicStyle.GetComboBoxArrowSize: TSize; begin Result.cx := 17; Result.cy := 17; end; -function TDefaultStyle.GetComboBoxBtnSize: TSize; +function TBasicStyle.GetComboBoxBtnSize: TSize; begin Result.cx := 18; Result.cy := 18; end; -procedure TDefaultStyle.DrawComboBoxArrow(Canvas: TFCanvas; +procedure TBasicStyle.DrawComboBoxArrow(Canvas: TFCanvas; const ARect: TRect; IsPressed, IsEnabled: Boolean); var r: TRect; @@ -660,23 +648,23 @@ begin DrawDirectionArrows(Canvas, r, arrowDown); end; -function TDefaultStyle.GetScrollBarBorders(Orientation: TOrientation): TRect; +function TBasicStyle.GetScrollBarBorders(Orientation: TOrientation): TRect; begin Result := Rect(1, 1, 1, 1); end; -function TDefaultStyle.GetScrollBarBtnSize(Orientation: TOrientation): TSize; +function TBasicStyle.GetScrollBarBtnSize(Orientation: TOrientation): TSize; begin Result.cx := 16; Result.cy := 16; end; -function TDefaultStyle.GetScrollBarBtnMinSize: Integer; +function TBasicStyle.GetScrollBarBtnMinSize: Integer; begin Result := 30; end; -procedure TDefaultStyle.DrawScrollBarBorder(Canvas: TFCanvas; +procedure TBasicStyle.DrawScrollBarBorder(Canvas: TFCanvas; const ARect: TRect); begin with ARect do @@ -695,7 +683,7 @@ begin end; end; -procedure TDefaultStyle.DrawScrollBarButton(Canvas: TFCanvas; +procedure TBasicStyle.DrawScrollBarButton(Canvas: TFCanvas; const ARect: TRect; Direction: TArrowDirection; IsPressed, IsEnabled: Boolean); var @@ -717,18 +705,18 @@ begin DrawDirectionArrows(Canvas, r, Direction); end; -function TDefaultStyle.GetScrollBoxBorders: TRect; +function TBasicStyle.GetScrollBoxBorders: TRect; begin Result := Rect(2, 2, 2, 2); end; -procedure TDefaultStyle.DrawScrollBoxBorder(Canvas: TFCanvas; const ARect: TRect); +procedure TBasicStyle.DrawScrollBoxBorder(Canvas: TFCanvas; const ARect: TRect); begin Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DLight); end; -function TDefaultStyle.GetMenuBorders(pCanvas: TFCanvas; const pText: string; +function TBasicStyle.GetMenuBorders(pCanvas: TFCanvas; const pText: string; var pTextWidth: Integer): TRect; begin pTextWidth := pCanvas.TextWidth(pText) + 6; @@ -737,12 +725,12 @@ begin // Result := Rect(6, pCanvas.FontCellHeight + 4, 6, 6); end; -function TDefaultStyle.GetPanelBorders: TRect; +function TBasicStyle.GetPanelBorders: TRect; begin Result := Rect(5, 5, 5, 5); end; -procedure TDefaultStyle.DrawPanel(Canvas: TFCanvas; const ARect: TRect; +procedure TBasicStyle.DrawPanel(Canvas: TFCanvas; const ARect: TRect; ABevelStyle: TBevelStyle); begin // bsPlain, bsLowered, bsRaised @@ -756,71 +744,6 @@ begin end; -{ MotifStyle } - -procedure TMotifStyle.DrawButtonFace(Canvas: TFCanvas; const ARect: TRect; - Flags: TButtonFlags); -var - r: TRect; -begin - r := ARect; - - if btnIsSelected in Flags then - begin - SetUIColor(Canvas, cl3DDkShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end; - - if btnIsPressed in Flags then - begin - SetUIColor(Canvas, cl3DShadow); - Canvas.DrawRect(r); - Inc(r.Left); - Inc(r.Top); - Dec(r.Right); - Dec(r.Bottom); - end else - begin - if btnIsEmbedded in Flags then - Draw3DFrame(Canvas, r, cl3DLight, cl3DHighlight, cl3DDkShadow, cl3DShadow) - else - Draw3DFrame(Canvas, r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow); - Inc(r.Left, 2); - Inc(r.Top, 2); - Dec(r.Right, 2); - Dec(r.Bottom, 2); - end; - - SetUIColor(Canvas, cl3DFace); - Canvas.FillRect(r); - - if btnHasFocus in Flags then - begin - r.Left := ARect.Left + 4; - r.Top := ARect.Top + 4; - r.Right := ARect.Right - 4; - r.Bottom := ARect.Bottom - 4; - DrawFocusRect(Canvas, r); - end; -end; - -procedure TMotifStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); -begin - SetUIColor(Canvas, clGray); - Canvas.DrawRect(ARect); -end; - -procedure TMotifStyle.DrawCheckBox(Canvas: TFCanvas; const ARect, - LabelRect: TRect; Flags: TCheckboxFlags); -begin - inherited DrawCheckBox(Canvas, ARect, LabelRect, Flags); -end; - - {$ENDIF read_implementation} diff --git a/gui/stylemanager.pas b/gui/stylemanager.pas index 5cfe4013..8e2c0ba5 100644 --- a/gui/stylemanager.pas +++ b/gui/stylemanager.pas @@ -26,18 +26,21 @@ uses ,fpGUI ; +const + cDefaultStyle = 'auto'; + type // A class reference for the TStyle descendants - TStyleClass = class of TStyle; + TStyleClass = class of TStyleAbs; // A class to hold the TStyle class mappings. The factory maintains // a list of these and uses the StyleClass property to create the objects. TStyleClassMapping = class(TObject) private - FsMappingName : string; - FStyleClass : TStyleClass; + FsMappingName: string; + FStyleClass: TStyleClass; public constructor Create(const AMappingName: string; AStyleClass: TStyleClass); overload; property MappingName: string read FsMappingName; @@ -52,19 +55,19 @@ type TStyleManager = class(TObject) private FList : TObjectList; - FDefaultStyle: TStyle; - FUserStyle: TStyle; + FDefaultStyle: TStyleAbs; + FUserStyle: TStyleAbs; FDefaultStyleType: string; - function GetDefaultStyle: TStyle; + function GetDefaultStyle: TStyleAbs; public constructor Create; destructor Destroy; override; - property DefaultStyle: TStyle read GetDefaultStyle; - procedure SetStyle(pNewStyle: TStyle); + property DefaultStyle: TStyleAbs read GetDefaultStyle; + procedure SetStyle(const AStyleName: string); procedure RegisterClass(const AStyleName: string; AStyleClass : TStyleClass); - function CreateInstance(const AStyleName: string): TStyle; overload; - function CreateInstance: TStyle; overload; - procedure AssignStyleTypes(AStrings : TStrings); + function CreateInstance(const AStyleName: string): TStyleAbs; overload; + function CreateInstance: TStyleAbs; overload; + procedure AssignStyleTypes(AStrings: TStrings); end; @@ -76,6 +79,9 @@ implementation uses SysUtils ,fpGFX + ,WindowsStyle + ,OpenSoftStyle + ,MotifStyle ; var @@ -90,18 +96,15 @@ begin result := uStyleManager; end; + { TStyleManager } -function TStyleManager.GetDefaultStyle: TStyle; +function TStyleManager.GetDefaultStyle: TStyleAbs; begin - if Assigned(FUserStyle) then - Result := FUserStyle - else - begin - if not Assigned(FDefaultStyle) then - FDefaultStyle := TDefaultStyle.Create; - Result := FDefaultStyle; - end; + if not Assigned(FDefaultStyle) then +// FDefaultStyle.Free; + FDefaultStyle := CreateInstance(FDefaultStyleType); + Result := FDefaultStyle; end; constructor TStyleManager.Create; @@ -110,26 +113,31 @@ begin FList := TObjectList.Create; FUserStyle := nil; FDefaultStyle := nil; - FDefaultStyleType := 'auto'; + FDefaultStyleType := cDefaultStyle; // will change later end; destructor TStyleManager.Destroy; begin + FDefaultStyle.Free; FList.Free; - - {$Note These will be removed later} - if FUserStyle <> nil then - FUserStyle.Free; - if FDefaultStyle <> nil then - FDefaultStyle.Free; inherited Destroy; end; -procedure TStyleManager.SetStyle(pNewStyle: TStyle); +procedure TStyleManager.SetStyle(const AStyleName: string); +var + i: integer; begin - if Assigned(FUserStyle) then - FUserStyle.Free; - FUserStyle := pNewStyle; + for i := 0 to FList.Count - 1 do + if UpperCase(TStyleClassMapping(FList.Items[i]).MappingName) = + UpperCase(AStyleName) then + begin + FDefaultStyleType := AStyleName; + Break; //==> + end; + + Assert(FDefaultStyleType <> AStyleName, + Format('<%s> does not identify a registered style class.', + [AStyleName])); end; // Register a TStyle class for creation by the factory @@ -146,19 +154,21 @@ begin [AStyleName])); FList.Add(TStyleClassMapping.Create(AStyleName, AStyleClass)); +// writeln('Registering style: ' + AStyleName); // we will use this later // FDefaultStyleType := UpperCase(AStyleName); end; // Call the factory to create an instance of TStyle -function TStyleManager.CreateInstance(const AStyleName: string): TStyle; +function TStyleManager.CreateInstance(const AStyleName: string): TStyleAbs; var i: integer; begin result := nil; for i := 0 to FList.Count - 1 do if UpperCase(TStyleClassMapping(FList.Items[i]).MappingName) = - UpperCase(AStyleName) then begin + UpperCase(AStyleName) then + begin result := TStyleClassMapping(FList.Items[i]).StyleClass.Create; Break; //==> end; @@ -168,7 +178,7 @@ begin [AStyleName])); end; -function TStyleManager.CreateInstance: TStyle; +function TStyleManager.CreateInstance: TStyleAbs; begin result := CreateInstance(FDefaultStyleType); end; @@ -197,7 +207,11 @@ end; initialization - uStyleManager := nil; +// gStyleManager.RegisterClass(cDefaultStyle, TWindowsStyle); + gStyleManager.RegisterClass(cDefaultStyle, TOpenSoftStyle); + gStyleManager.RegisterClass('Windows', TWindowsStyle); + gStyleManager.RegisterClass('OpenSoft', TOpenSoftStyle); + gStyleManager.RegisterClass('Motif', TMotifStyle); finalization uStyleManager.Free; diff --git a/gui/widget.inc b/gui/widget.inc index 1b1b85d8..f6d58742 100644 --- a/gui/widget.inc +++ b/gui/widget.inc @@ -178,7 +178,7 @@ function GetWidth: Integer; function GetHeight: Integer; procedure SetEnabled(AEnabled: Boolean); - procedure SetStyle(const AValue: TStyle); + procedure SetStyle(const AValue: TStyleAbs); procedure SetVisible(AVisible: Boolean); // Event handling function EvCalcSizes(Event: TCalcSizesEventObj): Boolean; @@ -192,7 +192,7 @@ protected FCursor: TFCursor; FText: string; - FStyle: TStyle; + FStyle: TStyleAbs; FCanExpandHeight: Boolean; FCanExpandWidth: Boolean; FEnabled: Boolean; @@ -225,7 +225,7 @@ function DoMouseEnter(AShift: TShiftState; AMousePos: TPoint): Boolean; // Properties - function GetStyle: TStyle; + function GetStyle: TStyleAbs; procedure SetCanExpandWidth(allow: Boolean); procedure SetCanExpandHeight(allow: Boolean); procedure SetText(const AText: String); virtual; @@ -265,7 +265,7 @@ property MaxSize: TSize read FMaxSize; property DefSize: TSize read FDefSize; property ClientRect: TRect read FClientRect; - property Style: TStyle read GetStyle write SetStyle; + property Style: TStyleAbs read GetStyle write SetStyle; property Enabled: Boolean read FEnabled write SetEnabled default True; property Visible: Boolean read FVisible write SetVisible default True; end; @@ -852,7 +852,7 @@ begin end; end; -procedure TWidget.SetStyle(const AValue: TStyle); +procedure TWidget.SetStyle(const AValue: TStyleAbs); begin FStyle := AValue; end; @@ -1044,7 +1044,7 @@ begin Event.Free; end; -function TWidget.GetStyle: TStyle; +function TWidget.GetStyle: TStyleAbs; var Widget: TWidget; begin diff --git a/gui/win32/defstyle.inc b/gui/win32/defstyle.inc index 7f57494a..41c36f5f 100644 --- a/gui/win32/defstyle.inc +++ b/gui/win32/defstyle.inc @@ -1,9 +1,9 @@ { fpGUI - Free Pascal GUI Library - Default Style implementation for Win32 + Basic Style implementation for Win32 - Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -16,7 +16,7 @@ {$DEFINE Has_DefaultStyle_GetGUIColor} -function TDefaultStyle.GetGUIColor(Color: TColor): TGfxColor; +function TBasicStyle.GetGUIColor(Color: TColor): TGfxColor; begin Color := Windows.GetSysColor(Color and $ffff); Result.Red := (Color and $ff) * 257; @@ -28,7 +28,7 @@ end; {$DEFINE Has_DefaultStyle_DrawFocusRect} -procedure TDefaultStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); +procedure TBasicStyle.DrawFocusRect(Canvas: TFCanvas; const ARect: TRect); var Rect: Windows.TRect; begin diff --git a/gui/windowsstyle.pas b/gui/windowsstyle.pas new file mode 100644 index 00000000..550d490b --- /dev/null +++ b/gui/windowsstyle.pas @@ -0,0 +1,39 @@ +{ + fpGUI - Free Pascal GUI Library + + Windows style implementation + + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + +unit WindowsStyle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes + ,SysUtils + ,fpGUI + ; + + +type + + TWindowsStyle = class(TBasicStyle) + end; + +implementation + + +end. + |