1 unit customdrawn_wince;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 // RTL
9 Classes, SysUtils, Types, Math,
10 fpimage, fpcanvas,
11 // LazUtils
12 lazutf8,
13 // LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
14 Graphics, Controls, LCLType,
15 // Others only for types
16 StdCtrls,
17 //
18 customdrawndrawers, customdrawn_common;
19
20 type
21
22 { TCDDrawerWinCE }
23
24 TCDDrawerWinCE = class(TCDDrawerCommon)
25 public
26 procedure LoadFallbackPaletteColors; override;
GetDrawStylenull27 function GetDrawStyle: TCDDrawStyle; override;
28 // General drawing routines
29 procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override;
30 procedure DrawSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override;
31 // ===================================
32 // Standard Tab
33 // ===================================
34 // TCDButton
35 procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
36 AState: TCDControlState; AStateEx: TCDButtonStateEx); override;
37 // TCDEdit
38 procedure DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
39 AState: TCDControlState; AStateEx: TCDEditStateEx); override;
40 procedure DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
41 AState: TCDControlState; AStateEx: TCDEditStateEx); override;
42 // TCDCheckBox
43 procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
44 AState: TCDControlState; AStateEx: TCDControlStateEx); override;
45 // TCDGroupBox
46 procedure DrawGroupBox(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize;
47 AState: TCDControlState; AStateEx: TCDControlStateEx); override;
48 // ===================================
49 // Common Controls Tab
50 // ===================================
51 // TCDCustomTabControl
52 procedure DrawTab(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
53 AState: TCDControlState; AStateEx: TCDCTabControlStateEx); override;
54 end;
55
56 implementation
57
58 procedure TCDDrawerWinCE.LoadFallbackPaletteColors;
59 begin
60 Palette.Form := $EFDFCE;
61 Palette.BtnFace := $EFDFCE;
62 Palette.BtnShadow := clBlack;
63 end;
64
TCDDrawerWinCE.GetDrawStylenull65 function TCDDrawerWinCE.GetDrawStyle: TCDDrawStyle;
66 begin
67 Result := dsWinCE;
68 end;
69
70 procedure TCDDrawerWinCE.DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint;
71 ASize: TSize);
72 begin
73 ADest.Pen.Style := psSolid;
74 ADest.Brush.Style := bsClear;
75 ADest.Pen.Color := clBlack;
76 ADest.Rectangle(Bounds(ADestPos.X, ADestPos.Y, ASize.cx, ASize.cy));
77 end;
78
79 procedure TCDDrawerWinCE.DrawSunkenFrame(ADest: TCanvas; ADestPos: TPoint;
80 ASize: TSize);
81 begin
82 ADest.Pen.Style := psSolid;
83 ADest.Brush.Style := bsClear;
84 ADest.Pen.Color := clBlack;
85 ADest.Rectangle(Bounds(ADestPos.X, ADestPos.Y, ASize.cx, ASize.cy));
86 end;
87
88 procedure TCDDrawerWinCE.DrawButton(ADest: TFPCustomCanvas;
89 ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx);
90 var
91 lDest: TCanvas absolute ADest;
92 Str: string;
93 begin
94 if not (ADest is TCanvas) then Exit; // ToDo support non-TCanvas
95 // Button background
96 if csfSunken in AState then
97 begin
98 ADest.Brush.Style := bsSolid;
99 lDest.Brush.Color := Palette.BtnShadow;
100 lDest.Pen.Color := clBlack;
101 ADest.Pen.Style := psSolid;
102 ADest.Rectangle(0, 0, ASize.cx, ASize.cy);
103 end
104 else
105 begin
106 ADest.Brush.Style := bsSolid;
107 lDest.Brush.Color := AStateEx.RGBColor;
108 lDest.Pen.Color := clBlack;
109 ADest.Pen.Style := psSolid;
110 ADest.Rectangle(0, 0, ASize.cx, ASize.cy);
111 end;
112
113 // Focus
114 if (csfHasFocus in AState) and not (csfSunken in AState) then
115 DrawFocusRect(lDest, Point(4, 4), Size(ASize.cx-8, ASize.cy-8));
116
117 // Button text
118 ADest.Font.Assign(AStateEx.Font);
119 ADest.Brush.Style := bsClear;
120 ADest.Pen.Style := psSolid;
121 if csfSunken in AState then lDest.Font.Color := clWhite;
122 Str := AStateEx.Caption;
123 lDest.TextOut((ASize.cx - lDest.TextWidth(Str)) div 2,
124 (ASize.cy - lDest.TextHeight(Str)) div 2, Str);
125 end;
126
127 procedure TCDDrawerWinCE.DrawEditFrame(ADest: TCanvas; ADestPos: TPoint;
128 ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx);
129 begin
130 // The frame
131 ADest.Brush.Style := bsClear;
132 ADest.Pen.Color := clBlack;
133 ADest.Pen.Style := psSolid;
134 ADest.Rectangle(0, 0, ASize.cx, ASize.cy);
135 end;
136
137 procedure TCDDrawerWinCE.DrawCaret(ADest: TCanvas; ADestPos: TPoint;
138 ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx);
139 var
140 lTextTopSpacing, lCaptionHeight, lLineHeight, lLineTop: Integer;
141 lControlText, lTmpText: string;
142 lTextBottomSpacing, lCaretPixelPos: Integer;
143 begin
144 if not AStateEx.CaretIsVisible then Exit;
145
146 lControlText := AStateEx.Lines.Strings[AStateEx.CaretPos.Y];
147 lCaptionHeight := GetMeasuresEx(ADest, TCDCONTROL_CAPTION_HEIGHT, AState, AStateEx);
148 lTextBottomSpacing := GetMeasures(TCDEDIT_BOTTOM_TEXT_SPACING);
149 lTextTopSpacing := GetMeasures(TCDEDIT_TOP_TEXT_SPACING);
150 lLineHeight := ADest.TextHeight(cddTestStr)+2;
151 lLineHeight := Min(ASize.cy-lTextBottomSpacing, lLineHeight);
152 lLineTop := lTextTopSpacing + AStateEx.CaretPos.Y * lLineHeight;
153
154 lTmpText := UTF8Copy(lControlText, AStateEx.VisibleTextStart.X, AStateEx.CaretPos.X-AStateEx.VisibleTextStart.X+1);
155 lCaretPixelPos := ADest.TextWidth(lTmpText) + GetMeasures(TCDEDIT_LEFT_TEXT_SPACING)
156 + AStateEx.LeftTextMargin;
157 ADest.Pen.Color := clBlack;
158 ADest.Pen.Style := psSolid;
159 ADest.Line(lCaretPixelPos, lLineTop, lCaretPixelPos, lLineTop+lCaptionHeight);
160 ADest.Line(lCaretPixelPos+1, lLineTop, lCaretPixelPos+1, lLineTop+lCaptionHeight);
161 end;
162
163 procedure TCDDrawerWinCE.DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint;
164 ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
165 var
166 lHalf, lSquareHalf, lSquareHeight: Integer;
167 begin
168 lHalf := ASize.cy div 2;
169 lSquareHalf := GetMeasures(TCDCHECKBOX_SQUARE_HALF_HEIGHT);
170 lSquareHeight := GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT);
171
172 // the square itself
173 ADest.Brush.Color := clWhite;
174 ADest.Pen.Style := psSolid;
175 if csfSunken in AState then ADest.Pen.Color := clGray
176 else ADest.Pen.Color := clBlack;
177 ADest.Rectangle(
178 1,
179 lHalf - lSquareHalf,
180 lSquareHeight+1,
181 lHalf + lSquareHalf);
182
183 // The selection inside the square
184 ADest.Brush.Style := bsClear;
185 ADest.Pen.Color := RGBToColor($31, $C6, $D6);
186 ADest.Pen.Style := psSolid;
187 if csfHasFocus in AState then
188 begin
189 ADest.Rectangle(
190 2,
191 lHalf - lSquareHalf+1,
192 lSquareHeight,
193 lHalf + lSquareHalf-1);
194 end;
195 end;
196
197 procedure TCDDrawerWinCE.DrawGroupBox(ADest: TFPCustomCanvas;
198 ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
199 var
200 FCaptionMiddle: integer;
201 lTextSize: TSize;
202 lCaption: String;
203 begin
204 FCaptionMiddle := (ADest as TCanvas).TextHeight(cddTestStr) div 2;
205 if FCaptionMiddle = 0 then FCaptionMiddle := AStateEx.Font.Size div 2;
206 if FCaptionMiddle = 0 then FCaptionMiddle := 5;
207
208 // Background
209 ADest.Brush.FPColor := TColorToFPColor(AStateEx.ParentRGBColor);
210 ADest.Brush.Style := bsSolid;
211 ADest.Pen.Style := psSolid;
212 ADest.Pen.FPColor := TColorToFPColor(AStateEx.ParentRGBColor);
213 ADest.Rectangle(0, 0, ASize.cx, ASize.cy);
214
215 // frame
216 ADest.Pen.FPColor := colBlack;
217 ADest.Pen.Style := psSolid;
218 ADest.Brush.Style := bsClear;
219 ADest.Rectangle(0, FCaptionMiddle, ASize.cx, ASize.cy);
220
221 // ToDo: Make the caption smaller if it is too big
222 lCaption := AStateEx.Caption;
223 lTextSize := (ADest as TCanvas).TextExtent(lCaption);
224
225 // fill the text background
226 ADest.Brush.Style := bsSolid;
227 ADest.Brush.FPColor := TColorToFPColor(AStateEx.ParentRGBColor);
228 ADest.Pen.Style := psClear;
229 ADest.Rectangle(Bounds(FCaptionMiddle, 0, lTextSize.cx+5, lTextSize.cy));
230
231 // paint text
232 ADest.Pen.Style := psClear;
233 ADest.Brush.Style := bsClear;
234 (ADest as TCanvas).TextOut(FCaptionMiddle+3, 0, lCaption);
235 end;
236
237 procedure TCDDrawerWinCE.DrawTab(ADest: TCanvas; ADestPos: TPoint;
238 ASize: TSize; AState: TCDControlState; AStateEx: TCDCTabControlStateEx);
239 var
240 IsSelected, IsAddButton: Boolean;
241 lTabWidth, lTabHeight, lTabTopPos: Integer;
242 Points: array of TPoint;
243 lCaption: String;
244 lTabHeightCorrection: Integer = 0;
245 begin
246 IsSelected := AStateEx.TabIndex = AStateEx.CurTabIndex;
247 IsAddButton := AStateEx.CurTabIndex = AStateEx.Tabs.Count;
248
249 if not IsSelected then lTabHeightCorrection := 3;
250
251 lTabTopPos := lTabHeightCorrection;
252 lTabHeight := GetMeasuresEx(ADest, TCDCTABCONTROL_TAB_HEIGHT, AState, AStateEx)-lTabHeightCorrection;
253 lTabWidth := GetMeasuresEx(ADest, TCDCTABCONTROL_TAB_WIDTH, AState, AStateEx);
254
255 // Fill the area inside the outer border
256 ADest.Pen.Style := psClear;
257 ADest.Brush.Style := bsSolid;
258 ADest.Brush.Color := clWhite;
259 SetLength(Points, 5);
260 Points[0] := Point(AStateEx.CurStartLeftPos, lTabTopPos);
261 Points[1] := Point(AStateEx.CurStartLeftPos+lTabWidth-5, lTabTopPos);
262 Points[2] := Point(AStateEx.CurStartLeftPos+lTabWidth, lTabTopPos+5);
263 Points[3] := Point(AStateEx.CurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight);
264 Points[4] := Point(AStateEx.CurStartLeftPos, lTabTopPos+lTabHeight);
265 ADest.Polygon(Points);
266
267 // Draw the outer border only in the top and right sides,
268 // and bottom if unselected
269 ADest.Pen.Style := psSolid;
270 ADest.Brush.Style := bsClear;
271 ADest.Pen.Color := ColorToRGB($009C9B91);
272 ADest.MoveTo(AStateEx.CurStartLeftPos+1, lTabTopPos);
273 ADest.LineTo(AStateEx.CurStartLeftPos+lTabWidth-5, lTabTopPos);
274 ADest.LineTo(AStateEx.CurStartLeftPos+lTabWidth, lTabTopPos+5);
275 ADest.LineTo(AStateEx.CurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight);
276
277 // If it is selected, add a selection frame
278 if IsSelected then
279 begin
280 ADest.Pen.Color := ColorToRGB($00D6C731);
281 ADest.Pen.Style := psSolid;
282 ADest.Brush.Style := bsClear;
283 ADest.Rectangle(
284 AStateEx.CurStartLeftPos+3, lTabTopPos+3,
285 AStateEx.CurStartLeftPos+lTabWidth-5, lTabTopPos+lTabHeight-3
286 );
287 end;
288
289 // Now the text
290 if IsAddButton then lCaption := '+'
291 else lCaption := AStateEx.Tabs.Strings[AStateEx.CurTabIndex];
292 ADest.TextOut(AStateEx.CurStartLeftPos+5, lTabTopPos+5, lCaption);
293 end;
294
295 initialization
296 RegisterDrawer(TCDDrawerWinCE.Create, dsWinCE);
297 end.
298
299