1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
{
A very quick and basic style implementation. It took all of 10 minutes.
To apply this style, follow these instructions:
* free the old fpgStyle
* instantiate the new style class
* and assign this new instance to fpgStyle variable
Example:
procedure MainProc;
var
frm: TMainForm;
begin
fpgApplication.Initialize;
frm := TMainForm.Create(nil);
try
// Free the old and set the new style
if Assigned(fpgStyle) then
fpgStyle.Free;
fpgStyle := TMyStyle.Create;
// now continue with the application
frm.Show;
fpgApplication.Run;
finally
frm.Free;
end;
end;
}
unit mystyle;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpg_main, fpg_base;
type
{ TMyStyle }
TMyStyle = class(TfpgStyle)
public
constructor Create; override;
procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); override;
procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); override;
procedure DrawMenuRow(ACanvas: TfpgCanvas; r: TfpgRect; AFlags: TfpgMenuItemFlags); override;
end;
implementation
{ TMyStyle }
constructor TMyStyle.Create;
begin
inherited Create;
fpgSetNamedColor(clWindowBackground, TfpgColor($eeeeec));
end;
procedure TMyStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord);
var
r: TfpgRect;
begin
r.SetRect(x, y, w, h);
ACanvas.SetColor(clShadow1);
ACanvas.Clear(clYellow);
ACanvas.DrawRectangle(r);
end;
procedure TMyStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags);
var
r: TfpgRect;
begin
r.SetRect(x, y, w, h);
if btfIsDefault in AFlags then
begin
ACanvas.SetColor(TfpgColor($7b7b7b));
ACanvas.SetLineStyle(1, lsSolid);
ACanvas.DrawRectangle(r);
InflateRect(r, -1, -1);
Exclude(AFlags, btfIsDefault);
fpgStyle.DrawButtonFace(ACanvas, r.Left, r.Top, r.Width, r.Height, AFlags);
Exit; //==>
end;
// Clear the canvas
ACanvas.SetColor(clWindowBackground);
ACanvas.FillRectangle(r);
if (btfFlat in AFlags) and not (btfIsPressed in AFlags) then
Exit; // no need to go further
// outer rectangle
ACanvas.SetLineStyle(1, lsSolid);
ACanvas.SetColor(TfpgColor($a6a6a6));
ACanvas.DrawRectangle(r);
// so we don't paint over the border
InflateRect(r, -1, -1);
// now paint the face of the button
if (btfIsPressed in AFlags) then
begin
ACanvas.GradientFill(r, TfpgColor($cccccc), TfpgColor($e4e4e4), gdVertical);
end
else
begin
ACanvas.GradientFill(r, TfpgColor($fafafa), TfpgColor($e2e2e2), gdVertical);
ACanvas.SetColor(TfpgColor($cccccc));
ACanvas.DrawLine(r.Right, r.Top, r.Right, r.Bottom); // right
ACanvas.DrawLine(r.Right, r.Bottom, r.Left, r.Bottom); // bottom
end;
end;
procedure TMyStyle.DrawMenuRow(ACanvas: TfpgCanvas; r: TfpgRect; AFlags: TfpgMenuItemFlags);
begin
inherited DrawMenuRow(ACanvas, r, AFlags);
if (mifSelected in AFlags) and not (mifSeparator in AFlags) then
ACanvas.GradientFill(r, TfpgColor($fec475), TfpgColor($fb9d24), gdVertical);
end;
end.
|
