1 unit CustomDrawn_Mac;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 // RTL
9 Classes, SysUtils, Types, fpcanvas, fpimage, Math,
10 // LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
11 Graphics, Controls, LCLType,
12 //
13 customdrawndrawers, customdrawn_common;
14
15 type
16
17 { TCDDrawerMac }
18
19 TCDDrawerMac = class(TCDDrawerCommon)
20 public
21 procedure DrawExpandTriangle(ADest: TCanvas; ASize: TSize;
22 AX, AY: Integer; AFacing: TCDControlStateFlag);
23 //
24 procedure DrawMacSquareButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
25 AState: TCDControlState; AStateEx: TCDButtonStateEx);
26 public
GetMeasuresnull27 function GetMeasures(AMeasureID: Integer): Integer; override;
28 // ===================================
29 // Standard Tab
30 // ===================================
31 // TCDButton
32 procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
33 AState: TCDControlState; AStateEx: TCDButtonStateEx); override;
34 // ===================================
35 // Common Controls Tab
36 // ===================================
37 // TCDToolBar
38 procedure DrawToolBarItem(ADest: TCanvas; ASize: TSize;
39 ACurItem: TCDToolBarItem; AX, AY: Integer;
40 AState: TCDControlState; AStateEx: TCDToolBarStateEx); override;
41 end;
42
43 implementation
44
45 const
46
47 // Button
48
49 MAC_SQUARE_BUTTON_FOCUS_FRAME_OUTTER = $00D7BE9F;
50 MAC_SQUARE_BUTTON_FOCUS_FRAME_INNER = $00F7DEBF; // actually it is a gradient as well
51 //
52 MAC_SQUARE_BUTTON_FRAME = $00AFAFAF;
53 MAC_SQUARE_BUTTON_FOCUS_GRADIENT_TOP = $00E3E3E3;
54 MAC_SQUARE_BUTTON_FOCUS_GRADIENT_BOTTOM = $00F7F7F7;
55 //
56 MAC_SQUARE_BUTTON_SUNKEN_GRADIENT_TOP = $00AFAFAF;
57 MAC_SQUARE_BUTTON_SUNKEN_GRADIENT_BOTTOM = $00C5C5C5;
58
59
60 { TCDDrawerMac }
61
62 procedure TCDDrawerMac.DrawExpandTriangle(ADest: TCanvas; ASize: TSize; AX,
63 AY: Integer; AFacing: TCDControlStateFlag);
64 var
65 lPoints: array of TPoint;
66 R: TRect;
67 begin
68 SetLength(lPoints, 3);
69 R := Bounds(AX, AY, ASize.CX, ASize.CY);
70
71 case AFacing of
72 csfLeftArrow:
73 begin
74 lPoints[0] := Types.Point(R.Right-1, R.Top);
75 lPoints[1] := Types.Point(R.Right-1, R.Bottom-2);
76 lPoints[2] := Types.Point(R.Left+1, (R.Top + R.Bottom-2) div 2);
77 end;
78 csfRightArrow: // face right
79 begin
80 lPoints[0] := Types.Point(R.Left+1, R.Top);
81 lPoints[1] := Types.Point(R.Left+1, R.Bottom-2);
82 lPoints[2] := Types.Point(R.Right-1, (R.Top + R.Bottom-2) div 2);
83 end;
84 csfDownArrow: // face down
85 begin
86 lPoints[0] := Types.Point(R.Left, R.Top);
87 lPoints[1] := Types.Point(R.Right-2, R.Top);
88 lPoints[2] := Types.Point((R.Left + R.Right-2) div 2, R.Bottom-2);
89 end;
90 csfUpArrow:
91 begin
92 lPoints[0] := Types.Point(R.Left, R.Bottom-2);
93 lPoints[1] := Types.Point(R.Right-2, R.Bottom-2);
94 lPoints[2] := Types.Point((R.Left + R.Right-2) div 2, R.Top);
95 end;
96 else
97 Exit;
98 end;
99
100 // select the appropriate brush & pen
101 ADest.Brush.Color := $797979;
102 ADest.Brush.Style := bsSolid;
103 ADest.Pen.Color := $797979;
104 ADest.Pen.Style := psSolid;
105
106 // Draw the triangle
107 ADest.Polygon(lPoints);
108 end;
109
110 procedure TCDDrawerMac.DrawMacSquareButton(ADest: TFPCustomCanvas;
111 ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx);
112 var
113 lDest: TCanvas absolute ADest;
114 Str: string;
115 lColor: TColor;
116 lRect: TRect;
117 lFrameDark, lFrameMedDark, lFrameMedium, lFrameLight: TColor;
118 lSelTop, lSelTopGrad, lSelBottomGrad, lSelBottom: TColor;
119 lGradientTop, lGradientBottom: TColor;
120 lPosX, lPosY: Integer;
121 begin
122 // Main body with gradient
123 if csfSunken in AState then
124 begin
125 lGradientTop := MAC_SQUARE_BUTTON_SUNKEN_GRADIENT_TOP;
126 lGradientBottom := MAC_SQUARE_BUTTON_SUNKEN_GRADIENT_BOTTOM;
127 end
128 else// if csfEnabled in AState then
129 begin
130 lGradientTop := MAC_SQUARE_BUTTON_FOCUS_GRADIENT_TOP;
131 lGradientBottom := MAC_SQUARE_BUTTON_FOCUS_GRADIENT_BOTTOM;
132 end;
133 lRect := Bounds(ADestPos.X, ADestPos.Y, ASize.cx, ASize.cy);
134 lDest.GradientFill(lRect, lGradientTop, lGradientBottom, gdVertical);
135
136 // outter rectangle
137 lColor := AStateEx.ParentRGBColor;
138 ADest.Brush.Style := bsClear;
139 if (csfHasFocus in AState) and not (csfSunken in AState) then
140 lDest.Pen.Color := MAC_SQUARE_BUTTON_FOCUS_FRAME_OUTTER
141 else
142 lDest.Pen.Color := MAC_SQUARE_BUTTON_FRAME;
143 ADest.Rectangle(Bounds(ADestPos.X, ADestPos.Y, ASize.cx, ASize.cy));
144 //ADest.Rectangle(1, 1, ASize.cx-1, ASize.cy-1);
145
146 // inner rectangle (only for focused)
147 if (csfHasFocus in AState) and not (csfSunken in AState) then
148 begin
149 lDest.Pen.Color := MAC_SQUARE_BUTTON_FOCUS_FRAME_INNER;
150 ADest.Rectangle(Bounds(ADestPos.X+1, ADestPos.Y+1, ASize.cx-2, ASize.cy-2));
151 //ADest.Rectangle(2, 2, ASize.cx-2, ASize.cy-2);
152 //ADest.Rectangle(3, 3, ASize.cx-3, ASize.cy-3);
153 end;
154
155 // Button text
156 if AStateEx.Font <> nil then
157 ADest.Font.Assign(AStateEx.Font);
158 ADest.Brush.Style := bsClear;
159 ADest.Pen.Style := psSolid;
160 if (csfSunken in AState) then
161 ADest.Font.FPColor := colWhite;
162 Str := AStateEx.Caption;
163 lPosX := ADestPos.X + (ASize.cx - lDest.TextWidth(Str)) div 2;
164 lPosY := ADestPos.Y + (ASize.cy - lDest.TextHeight(Str)) div 2;
165 lDest.TextOut(lPosX, lPosY, Str);
166 end;
167
GetMeasuresnull168 function TCDDrawerMac.GetMeasures(AMeasureID: Integer): Integer;
169 begin
170 case AMeasureID of
171 //
172 TCDTOOLBAR_ITEM_ARROW_WIDTH: Result := 10;
173 else
174 Result:=inherited GetMeasures(AMeasureID);
175 end;
176 end;
177
178 procedure TCDDrawerMac.DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
179 AState: TCDControlState; AStateEx: TCDButtonStateEx);
180 begin
181 DrawMacSquareButton(ADest, ADestPos, ASize, AState, AStateEx);
182 end;
183
184 procedure TCDDrawerMac.DrawToolBarItem(ADest: TCanvas; ASize: TSize;
185 ACurItem: TCDToolBarItem; AX, AY: Integer; AState: TCDControlState;
186 AStateEx: TCDToolBarStateEx);
187 var
188 lX, lY1, lY2, lEffWidth: Integer;
189
190 procedure DrawToolBarItemBorder();
191 begin
192 ADest.Pen.Style := psSolid;
193 ADest.Pen.Color := $AFAFAF;
194 ADest.Brush.Style := bsClear;
195 ADest.Rectangle(Bounds(AX, AY, ASize.cx, ASize.cy));
196 end;
197
198 begin
199 // tikDivider is centralized, tikSeparator is left-aligned
200 case ACurItem.Kind of
201 tikSeparator, tikDivider:
202 begin
203 lX := AX;
204 if ACurItem.Kind = tikDivider then
205 lX := AX + ASize.CX div 2 - 1;
206
207 lY1 := AY;
208 lY2 := AY+ASize.CY;
209
210 ADest.Pen.Style := psSolid;
211 ADest.Pen.Color := $DCDEE1;
212 ADest.Line(lX+1, lY1, lX+1, lY2);
213 ADest.Line(lX+3, lY1, lX+3, lY2);
214 ADest.Pen.Style := psSolid;
215 ADest.Pen.Color := $93979E;
216 ADest.Line(lX+2, lY1, lX+2, lY2);
217 end;
218 tikButton, tikCheckButton, tikDropDownButton:
219 begin
220 if ACurItem.SubpartKind = tiskArrow then
221 begin
222 // Centralize the arrow in the available space
223 if ACurItem.Width > 0 then
224 lEffWidth := ACurItem.Width
225 else
226 lEffWidth := Min(ASize.CX, GetMeasures(TCDTOOLBAR_ITEM_ARROW_WIDTH));
227 lX := AX + (ASize.CX - lEffWidth) div 2;
228 lY1 := AY + (ASize.CY - lEffWidth) div 2;
229 ASize.CY := lEffWidth;
230 ASize.CX := lEffWidth;
231 DrawExpandTriangle(ADest, ASize, lX, lY1, csfDownArrow);
232 Exit;
233 end;
234
235 if csfSunken in AState then
236 begin
237 ADest.GradientFill(Bounds(AX, AY, ASize.CX, ASize.CY),
238 $C4C4C4, $DBDBDB, gdVertical);
239 DrawToolBarItemBorder();
240 end
241 else if csfMouseOver in AState then
242 begin
243 ADest.GradientFill(Bounds(AX, AY, ASize.CX, ASize.CY),
244 $E3E3E3, $F7F7F7, gdVertical);
245 DrawToolBarItemBorder();
246 end;
247 end;
248 end;
249 end;
250
251 initialization
252 RegisterDrawer(TCDDrawerMac.Create, dsMacOSX);
253 end.
254
255