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