source: trunk/Packages/bgracontrols/customdrawn_win7/customdrawn_windows7.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 30.5 KB
Line 
1unit customdrawn_windows7;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, Graphics, types, Math,
9 { Custom Drawn }
10 customdrawn_common, customdrawndrawers, FPCanvas,
11 { BGRABitmap }
12 bgrabitmap, bgrabitmaptypes, bgraslicescaling;
13
14procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
15
16const
17 WIN7_3DDKSHADOW_COLOR = $00696969;
18 WIN7_3DLIGHT_COLOR = $00E3E3E3;
19 WIN7_ACTIVEBORDER_COLOR = $00B4B4B4;
20 WIN7_ACTIVECAPTION_COLOR = $00D1B499;
21 WIN7_APPWORKSPACE_COLOR = $00ABABAB;
22 WIN7_BACKGROUND_COLOR = clBlack;
23 WIN7_BTNFACE_COLOR = $00F0F0F0;
24 WIN7_BTNHIGHLIGHT_COLOR = clWhite;
25 WIN7_BTNSHADOW_COLOR = $00A0A0A0;
26 WIN7_BTNTEXT_COLOR = clBlack;
27 WIN7_CAPTIONTEXT_COLOR = clBlack;
28 WIN7_FORM_COLOR = $00F0F0F0;
29 WIN7_GRADIENTACTIVECAPTION_COLOR = $00EAD1B9;
30 WIN7_GRADIENTINACTIVECAPTION_COLOR = $00F2E4D7;
31 WIN7_GRAYTEXT_COLOR = $006D6D6D;
32 WIN7_HIGHLIGHTTEXT_COLOR = $00FF9933;
33 WIN7_HIGHLIGHT_COLOR = $00FF9933;
34 WIN7_HOTLIGHT_COLOR = $00CC6600;
35 WIN7_INACTIVEBORDER_COLOR = $00FCF7F4;
36 WIN7_INACTIVECAPTIONTEXT_COLOR = $00544E43;
37 WIN7_INACTIVECAPTION_COLOR = $00DBCDBF;
38 WIN7_INFOBK_COLOR = $00E1FFFF;
39 WIN7_INFOTEXT_COLOR = clBlack;
40 WIN7_MENUBAR_COLOR = $00F0F0F0;
41 WIN7_MENUHIGHLIGHT_COLOR = $00FF9933;
42 WIN7_MENUTEXT_COLOR = clBlack;
43 WIN7_MENU_COLOR = $00F0F0F0;
44 WIN7_SCROLLBAR_COLOR = $00C8C8C8;
45 WIN7_WINDOWFRAME_COLOR = $00646464;
46 WIN7_WINDOWTEXT_COLOR = clBlack;
47 WIN7_WINDOW_COLOR = clWhite;
48
49type
50
51 { TBitmapTheme }
52
53 TBitmapTheme = class
54 private
55 // general
56 FButton: TBGRAMultiSliceScaling;
57 FCheckBox: TBGRAMultiSliceScaling;
58 FRadioButton: TBGRAMultiSliceScaling;
59 FProgressBarHorizontalBackground: TBGRAMultiSliceScaling;
60 FProgressBarVerticalBackground: TBGRAMultiSliceScaling;
61 FProgressBarHorizontalFill: TBGRAMultiSliceScaling;
62 FProgressBarVerticalFill: TBGRAMultiSliceScaling;
63 // extra
64 FArrow: TBGRAMultiSliceScaling;
65 FArrowLeft: TBGRAMultiSliceScaling;
66 FArrowRight: TBGRAMultiSliceScaling;
67 FCloseButton: TBGRAMultiSliceScaling;
68 // settings
69 FFolder: string;
70 FTickmark: boolean;
71 FDPI: integer;
72 FDebug: boolean;
73 FResourcesLoaded: boolean;
74 function GetArrowLeftSkin: TBGRAMultiSliceScaling;
75 function GetArrowRightSkin: TBGRAMultiSliceScaling;
76 function GetArrowSkin: TBGRAMultiSliceScaling;
77 function GetButtonSkin: TBGRAMultiSliceScaling;
78 function GetCheckBoxSkin: TBGRAMultiSliceScaling;
79 function GetCloseButtonSkin: TBGRAMultiSliceScaling;
80 function GetProgressBarHorizontalBackgroundSkin: TBGRAMultiSliceScaling;
81 function GetProgressBarHorizontalFillSkin: TBGRAMultiSliceScaling;
82 function GetProgressBarVerticalBackgroundSkin: TBGRAMultiSliceScaling;
83 function GetProgressBarVerticalFillSkin: TBGRAMultiSliceScaling;
84 function GetRadioButtonSkin: TBGRAMultiSliceScaling;
85 procedure SetFDebug(AValue: boolean);
86 procedure SetFDPI(AValue: integer);
87 procedure SetFFolder(AValue: string);
88 procedure SetFTickmark(AValue: boolean);
89 protected
90 procedure LoadBitmapResources;
91 procedure FreeBitmapResources;
92 public
93 constructor Create(Folder: string);
94 destructor Destroy; override;
95 public
96 // general
97 property Button: TBGRAMultiSliceScaling read GetButtonSkin;
98 property CheckBox: TBGRAMultiSliceScaling read GetCheckBoxSkin;
99 property RadioButton: TBGRAMultiSliceScaling read GetRadioButtonSkin;
100 property ProgressBarHorizontalBackground: TBGRAMultiSliceScaling
101 read GetProgressBarHorizontalBackgroundSkin;
102 property ProgressBarVerticalBackground: TBGRAMultiSliceScaling
103 read GetProgressBarVerticalBackgroundSkin;
104 property ProgressBarHorizontalFill: TBGRAMultiSliceScaling
105 read GetProgressBarHorizontalFillSkin;
106 property ProgressBarVerticalFill: TBGRAMultiSliceScaling
107 read GetProgressBarVerticalFillSkin;
108 // extra
109 property Arrow: TBGRAMultiSliceScaling read GetArrowSkin;
110 property ArrowLeft: TBGRAMultiSliceScaling read GetArrowLeftSkin;
111 property ArrowRight: TBGRAMultiSliceScaling read GetArrowRightSkin;
112 property CloseButton: TBGRAMultiSliceScaling read GetCloseButtonSkin;
113 // settings
114 property Folder: string read FFolder write SetFFolder;
115 property Tickmark: boolean read FTickmark write SetFTickmark;
116 property DPI: integer read FDPI write SetFDPI;
117 property Debug: boolean read FDebug write SetFDebug;
118 end;
119
120 { TCDWin7 }
121
122 TCDWin7 = class(TCDDrawerCommon)
123 procedure LoadFallbackPaletteColors; override;
124 // General
125 function GetMeasures(AMeasureID: Integer): Integer; override;
126 function GetMeasuresEx(ADest: TCanvas; AMeasureID: Integer;
127 AState: TCDControlState; AStateEx: TCDControlStateEx): Integer; override;
128 procedure CalculatePreferredSize(ADest: TCanvas; AControlId: TCDControlID;
129 AState: TCDControlState; AStateEx: TCDControlStateEx;
130 var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
131 function GetColor(AColorID: Integer): TColor; override;
132 function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID;
133 AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; override;
134 function DPIAdjustment(const AValue: Integer): Integer;
135 // General drawing routines
136 procedure DrawFocusRect(ADest: {TCanvas}TFPCustomCanvas; ADestPos: TPoint;
137 ASize: TSize); override;
138 // TCDButton
139 procedure DrawButton(ADest: TFPCustomCanvas; ASize: TSize;
140 AState: TCDControlState; AStateEx: TCDButtonStateEx); override;
141 // TCDCheckBox
142 procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint;
143 ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
144 procedure DrawCheckBox(ADest: TCanvas; ASize: TSize;
145 AState: TCDControlState; AStateEx: TCDControlStateEx); override;
146 // TCDRadioButton
147 procedure DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint;
148 ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
149 procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
150 AState: TCDControlState; AStateEx: TCDControlStateEx); override;
151 // TCDStaticText
152 procedure DrawStaticText(ADest: TCanvas; ASize: TSize;
153 AState: TCDControlState; AStateEx: TCDControlStateEx); override;
154 // TCDProgressBar
155 procedure DrawProgressBar(ADest: TCanvas; ASize: TSize;
156 AState: TCDControlState; AStateEx: TCDProgressBarStateEx); override;
157 // Extra buttons drawing routines
158 procedure DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint;
159 ASize: TSize; AState: TCDControlState); override;
160 // TCDScrollBar
161 procedure DrawScrollBar(ADest: TCanvas; ASize: TSize;
162 AState: TCDControlState; AStateEx: TCDPositionedCStateEx); override;
163 procedure DrawSlider(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
164 AState: TCDControlState); override;
165 end;
166
167 { TCDWin7Extra }
168
169 TCDWin7Extra = class(TCDWin7)
170 // TCDButton
171 procedure DrawButton(ADest: TFPCustomCanvas; ASize: TSize;
172 AState: TCDControlState; AStateEx: TCDButtonStateEx); override;
173 end;
174
175var
176 win7: TBitmapTheme;
177
178implementation
179
180uses SysUtils;
181
182{ TBitmapTheme }
183
184procedure TBitmapTheme.SetFDebug(AValue: boolean);
185begin
186 if FDebug = AValue then
187 Exit;
188 FDebug := AValue;
189end;
190
191function TBitmapTheme.GetArrowLeftSkin: TBGRAMultiSliceScaling;
192begin
193 LoadBitmapResources;
194 result := FArrowLeft;
195end;
196
197function TBitmapTheme.GetArrowRightSkin: TBGRAMultiSliceScaling;
198begin
199 LoadBitmapResources;
200 result := FArrowRight;
201end;
202
203function TBitmapTheme.GetArrowSkin: TBGRAMultiSliceScaling;
204begin
205 LoadBitmapResources;
206 result := FArrow;
207end;
208
209function TBitmapTheme.GetButtonSkin: TBGRAMultiSliceScaling;
210begin
211 LoadBitmapResources;
212 result := FButton;
213end;
214
215function TBitmapTheme.GetCheckBoxSkin: TBGRAMultiSliceScaling;
216begin
217 LoadBitmapResources;
218 result := FCheckBox;
219end;
220
221function TBitmapTheme.GetCloseButtonSkin: TBGRAMultiSliceScaling;
222begin
223 LoadBitmapResources;
224 result := FCloseButton;
225end;
226
227function TBitmapTheme.GetProgressBarHorizontalBackgroundSkin: TBGRAMultiSliceScaling;
228begin
229 LoadBitmapResources;
230 result := FProgressBarHorizontalBackground;
231end;
232
233function TBitmapTheme.GetProgressBarHorizontalFillSkin: TBGRAMultiSliceScaling;
234begin
235 LoadBitmapResources;
236 result := FProgressBarHorizontalFill;
237end;
238
239function TBitmapTheme.GetProgressBarVerticalBackgroundSkin: TBGRAMultiSliceScaling;
240begin
241 LoadBitmapResources;
242 result := FProgressBarVerticalBackground;
243end;
244
245function TBitmapTheme.GetProgressBarVerticalFillSkin: TBGRAMultiSliceScaling;
246begin
247 LoadBitmapResources;
248 result := FProgressBarVerticalFill;
249end;
250
251function TBitmapTheme.GetRadioButtonSkin: TBGRAMultiSliceScaling;
252begin
253 LoadBitmapResources;
254 result := FRadioButton;
255end;
256
257procedure TBitmapTheme.SetFDPI(AValue: integer);
258begin
259 if FDPI = AValue then
260 Exit;
261 FDPI := AValue;
262 FreeBitmapResources;
263end;
264
265procedure TBitmapTheme.SetFFolder(AValue: string);
266begin
267 if FFolder = AValue then Exit;
268 FFolder := AValue;
269 FreeBitmapResources;
270end;
271
272procedure TBitmapTheme.SetFTickmark(AValue: boolean);
273begin
274 if FTickmark = AValue then
275 Exit;
276 FTickmark := AValue;
277end;
278
279procedure TBitmapTheme.LoadBitmapResources;
280var
281 dpi_str: string;
282begin
283 if FResourcesLoaded then exit;
284
285 if (FDPI > 96) and (FDPI <= 120) then
286 dpi_str := '120'
287 else if (FDPI > 120) then
288 dpi_str := '144'
289 else
290 dpi_str := '';
291
292 FreeBitmapResources;
293
294 // general
295 FButton := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'Button');
296 FCheckBox := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'CheckBox' + dpi_str);
297 FRadioButton := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini',
298 'RadioButton' + dpi_str);
299 FProgressBarHorizontalBackground :=
300 TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'ProgressBar');
301 FProgressBarVerticalBackground :=
302 TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'ProgressBarV');
303 FProgressBarHorizontalFill :=
304 TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'ProgressBarFill');
305 FProgressBarVerticalFill := TBGRAMultiSliceScaling.Create(FFolder +
306 'skin.ini', 'ProgressBarFillV');
307 // extra
308 FArrow := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini', 'Arrow' + dpi_str);
309 FArrowLeft := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini',
310 'ArrowLeft' + dpi_str);
311 FArrowRight := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini',
312 'ArrowRight' + dpi_str);
313 FCloseButton := TBGRAMultiSliceScaling.Create(FFolder + 'skin.ini',
314 'CloseButton' + dpi_str);
315 FResourcesLoaded:= True;
316end;
317
318procedure TBitmapTheme.FreeBitmapResources;
319begin
320 if not FResourcesLoaded then exit;
321
322 // general
323 if FButton <> nil then FreeAndNil(FButton);
324 if FCheckBox <> nil then FreeAndNil(FCheckBox);
325 if FRadioButton <> nil then FreeAndNil(FRadioButton);
326 if FProgressBarHorizontalBackground <> nil then FreeAndNil(FProgressBarHorizontalBackground);
327 if FProgressBarVerticalBackground <> nil then FreeAndNil(FProgressBarVerticalBackground);
328 if FProgressBarHorizontalFill <> nil then FreeAndNil(FProgressBarHorizontalFill);
329 if FProgressBarVerticalFill <> nil then FreeAndNil(FProgressBarVerticalFill);
330 // extra
331 if FArrow <> nil then FreeAndNil(FArrow);
332 if FArrowLeft <> nil then FreeAndNil(FArrowLeft);
333 if FArrowRight <> nil then FreeAndNil(FArrowRight);
334 if FCloseButton <> nil then FreeAndNil(FCloseButton);
335 FResourcesLoaded:= false;
336end;
337
338constructor TBitmapTheme.Create(Folder: string);
339begin
340 FDPI := 96;
341 FFolder := Folder;
342 FResourcesLoaded := false;
343 inherited Create;
344end;
345
346destructor TBitmapTheme.Destroy;
347begin
348 FreeBitmapResources;
349 inherited Destroy;
350end;
351
352{ TCDWin7Extra }
353
354procedure TCDWin7Extra.DrawButton(ADest: TFPCustomCanvas; ASize: TSize;
355 AState: TCDControlState; AStateEx: TCDButtonStateEx);
356var
357 { number of bitmap used }
358 number: integer;
359 { bgrabitmap }
360 FBGRA: TBGRABitmap;
361begin
362 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
363 AssignFontToBGRA(AStateEx.Font, FBGRA);
364
365 if csfEnabled in AState then
366 begin
367 number := 0;
368 if csfHasFocus in AState then
369 number := 4;
370 if csfMouseOver in AState then
371 number := 1;
372 if csfSunken in AState then
373 number := 2;
374 end
375 else
376 number := 3;
377
378 if (number = 4) then
379 if (AStateEx.Caption = 'arrowleft') or (AStateEx.Caption = 'arrowright') or
380 (AStateEx.Caption = 'closebutton') then
381 number := 0;
382
383 if AStateEx.Caption = 'arrowleft' then
384 win7.ArrowLeft.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.Debug)
385 else if AStateEx.Caption = 'arrowright' then
386 win7.ArrowRight.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.Debug)
387 else if AStateEx.Caption = 'arrow' then
388 win7.Arrow.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.Debug)
389 else if AStateEx.Caption = 'closebutton' then
390 win7.CloseButton.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.Debug);
391
392 { Draw and Free }
393 FBGRA.Draw(TCanvas(ADest), 0, 0, True);
394 FBGRA.Free;
395end;
396
397{ TCDWin7 }
398
399procedure TCDWin7.LoadFallbackPaletteColors;
400begin
401 with Palette do
402 begin
403 ActiveBorder := WIN7_ACTIVEBORDER_COLOR;
404 ActiveCaption := WIN7_ACTIVECAPTION_COLOR;
405 AppWorkspace := WIN7_APPWORKSPACE_COLOR;
406 Background := WIN7_BACKGROUND_COLOR;
407 BtnFace := WIN7_BTNFACE_COLOR;
408 BtnHighlight := WIN7_BTNHIGHLIGHT_COLOR;
409 BtnShadow := WIN7_BTNSHADOW_COLOR;
410 BtnText := WIN7_BTNTEXT_COLOR;
411 CaptionText := WIN7_CAPTIONTEXT_COLOR;
412 color3DDkShadow := WIN7_3DDKSHADOW_COLOR;
413 color3DLight := WIN7_3DLIGHT_COLOR;
414 Form := WIN7_FORM_COLOR;
415 GradientActiveCaption := WIN7_GRADIENTACTIVECAPTION_COLOR;
416 GradientInactiveCaption := WIN7_GRADIENTINACTIVECAPTION_COLOR;
417 GrayText := WIN7_GRAYTEXT_COLOR;
418 Highlight := WIN7_HIGHLIGHT_COLOR;
419 HighlightText := WIN7_HIGHLIGHTTEXT_COLOR;
420 HotLight := WIN7_HOTLIGHT_COLOR;
421 InactiveBorder := WIN7_INACTIVEBORDER_COLOR;
422 InactiveCaption := WIN7_INACTIVECAPTION_COLOR;
423 InactiveCaptionText := WIN7_INACTIVECAPTIONTEXT_COLOR;
424 InfoBk := WIN7_INFOBK_COLOR;
425 InfoText := WIN7_INFOTEXT_COLOR;
426 Menu := WIN7_MENU_COLOR;
427 MenuBar := WIN7_MENUBAR_COLOR;
428 MenuHighlight := WIN7_MENUHIGHLIGHT_COLOR;
429 MenuText := WIN7_MENUTEXT_COLOR;
430 ScrollBar := WIN7_SCROLLBAR_COLOR;
431 Window := WIN7_WINDOW_COLOR;
432 WindowFrame := WIN7_WINDOWFRAME_COLOR;
433 WindowText := WIN7_WINDOWTEXT_COLOR;
434 end;
435end;
436
437function TCDWin7.GetMeasures(AMeasureID: Integer): Integer;
438begin
439 Result:=inherited GetMeasures(AMeasureID);
440end;
441
442function TCDWin7.GetMeasuresEx(ADest: TCanvas; AMeasureID: Integer;
443 AState: TCDControlState; AStateEx: TCDControlStateEx): Integer;
444begin
445 Result:=inherited GetMeasuresEx(ADest, AMeasureID, AState, AStateEx);
446end;
447
448procedure TCDWin7.CalculatePreferredSize(ADest: TCanvas;
449 AControlId: TCDControlID; AState: TCDControlState;
450 AStateEx: TCDControlStateEx; var PreferredWidth, PreferredHeight: integer;
451 WithThemeSpace: Boolean);
452begin
453 inherited CalculatePreferredSize(ADest, AControlId, AState, AStateEx,
454 PreferredWidth, PreferredHeight, WithThemeSpace);
455end;
456
457function TCDWin7.GetColor(AColorID: Integer): TColor;
458begin
459 case AColorId of
460 TCDEDIT_BACKGROUND_COLOR: Result := WIN7_WINDOW_COLOR;
461 TCDEDIT_TEXT_COLOR: Result := WIN7_WINDOWTEXT_COLOR;
462 TCDEDIT_SELECTED_BACKGROUND_COLOR: Result := WIN7_HIGHLIGHTTEXT_COLOR;
463 TCDEDIT_SELECTED_TEXT_COLOR: Result := WIN7_WINDOW_COLOR;
464 TCDBUTTON_DEFAULT_COLOR: Result := WIN7_BTNFACE_COLOR;
465 else
466 Result := clBlack;
467 end;
468end;
469
470function TCDWin7.GetClientArea(ADest: TCanvas; ASize: TSize;
471 AControlId: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx
472 ): TRect;
473begin
474 Result:=inherited GetClientArea(ADest, ASize, AControlId, AState, AStateEx);
475end;
476
477function TCDWin7.DPIAdjustment(const AValue: Integer): Integer;
478begin
479 {if Screen.PixelsPerInch <= 96 then Result := AValue
480 else Result := Round(AValue * Screen.PixelsPerInch / 96);}
481 Result := Round(AValue * win7.DPI / 96);
482end;
483
484procedure TCDWin7.DrawFocusRect(ADest: {TCanvas}TFPCustomCanvas; ADestPos: TPoint;
485 ASize: TSize);
486
487 procedure DrawTileBackground(ABitmap: TBGRABitmap; Multiply: integer);
488 var
489 temp: TBGRABitmap;
490 begin
491 temp := TBGRABitmap.Create(2, 2);
492 temp.SetPixel(0, 1, clBlack);
493 temp.SetPixel(1, 0, clBlack);
494 BGRAReplace(temp, temp.Resample(2 * Multiply, 2 * Multiply, rmSimpleStretch));
495 ABitmap.Fill(temp, dmSet);
496 temp.Free;
497 end;
498
499var
500 FBGRA: TBGRABitmap;
501begin
502 FBGRA := TBGRABitmap.Create(ASize.CX, ASize.CY);
503 DrawTileBackground(FBGRA, 1);
504 FBGRA.AlphaFillRect(2, 2, FBGRA.Width - 2, FBGRA.Height - 2, 0);
505 FBGRA.Draw(TCanvas(ADest), ADestPos.X, ADestPos.Y, False);
506 FBGRA.Free;
507end;
508
509procedure TCDWin7.DrawButton(ADest: TFPCustomCanvas; ASize: TSize;
510 AState: TCDControlState; AStateEx: TCDButtonStateEx);
511var
512 Str: string;
513 lGlyphLeftSpacing: integer = 0;
514 lTextOutPos: TPoint;
515 lGlyphCaptionHeight: integer;
516 { number of bitmap used }
517 number: integer;
518 { bgrabitmap }
519 FBGRA: TBGRABitmap;
520 FBGRAGlyph: TBGRABitmap;
521begin
522 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
523 AssignFontToBGRA(AStateEx.Font, FBGRA);
524
525 if csfEnabled in AState then
526 begin
527 number := 0;
528 if csfHasFocus in AState then
529 number := 4;
530 if csfMouseOver in AState then
531 number := 1;
532 if csfSunken in AState then
533 number := 2;
534 end
535 else
536 number := 3;
537
538 win7.button.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.debug);
539
540 { Position calculations }
541 Str := AStateEx.Caption;
542 lGlyphCaptionHeight := Max(FBGRA.TextSize(Str).cy, AStateEx.Glyph.Height);
543 lTextOutPos.X := (ASize.cx - FBGRA.TextSize(Str).cx - AStateEx.Glyph.Width) div 2;
544 lTextOutPos.Y := (ASize.cy - lGlyphCaptionHeight) div 2;
545 lTextOutPos.X := Max(lTextOutPos.X, 5);
546 lTextOutPos.Y := Max(lTextOutPos.Y, 5);
547
548 { Glyph }
549 if not AStateEx.Glyph.Empty then
550 begin
551 FBGRAGlyph := TBGRABitmap.Create(AStateEx.Glyph);
552 if csfEnabled in AState then
553 else
554 BGRAReplace(FBGRAGlyph, FBGRAGlyph.FilterGrayscale);
555 FBGRA.PutImage(lTextOutPos.X, lTextOutPos.Y, FBGRAGlyph, dmDrawWithTransparency);
556 lGlyphLeftSpacing := FBGRAGlyph.Width + 5;
557 FBGRAGlyph.Free;
558 end;
559
560 { Text }
561 lTextOutPos.X := lTextOutPos.X + lGlyphLeftSpacing;
562 lTextOutPos.Y := (ASize.cy - FBGRA.TextSize(Str).cy) div 2;
563
564 if csfEnabled in AState then
565 FBGRA.TextOut(lTextOutPos.X, lTextOutPos.Y, AStateEx.Caption, Palette.WindowText)
566 else
567 begin
568 FBGRA.TextOut(lTextOutPos.X + 1, lTextOutPos.Y + 1, AStateEx.Caption,
569 Palette.Window);
570 FBGRA.TextOut(lTextOutPos.X, lTextOutPos.Y, AStateEx.Caption, Palette.GrayText);
571 end;
572
573 { Draw and Free }
574 FBGRA.Draw(TCanvas(ADest), 0, 0, True);
575 FBGRA.Free;
576end;
577
578procedure TCDWin7.DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint;
579 ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
580begin
581 inherited DrawCheckBoxSquare(ADest, ADestPos, ASize, AState, AStateEx);
582end;
583
584procedure TCDWin7.DrawCheckBox(ADest: TCanvas; ASize: TSize;
585 AState: TCDControlState; AStateEx: TCDControlStateEx);
586var
587 lSquareHeight: integer;
588 number: integer;
589 FBGRA: TBGRABitmap;
590begin
591 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
592 AssignFontToBGRA(AStateEx.Font, FBGRA);
593
594 lSquareHeight := win7.CheckBox.SliceScalingArray[0].BitmapHeight;
595
596 number := 0;
597
598 if csfOn in AState then
599 if win7.tickmark then
600 number := 16
601 else
602 number := 4;
603
604 // for the xp theme
605 if (csfOn in AState) and (win7.folder = 'luna' + pathdelim) then
606 number := 4;
607
608 if csfPartiallyOn in AState then
609 number := 8;
610
611 if csfEnabled in AState then
612 begin
613 if csfMouseOver in AState then
614 begin
615 Inc(number, +1);
616 if csfSunken in AState then
617 Inc(number, +1);
618 end
619 else
620 if csfSunken in AState then
621 Inc(number, +2);
622 end
623 else
624 Inc(number, +3);
625
626 win7.checkbox.Draw(number, FBGRA, 0, 0, lSquareHeight, lSquareHeight, win7.debug);
627
628 if csfEnabled in AState then
629 FBGRA.TextOut(lSquareHeight + 5, 0, AStateEx.Caption, Palette.WindowText)
630 else
631 begin
632 FBGRA.TextOut(lSquareHeight + 6, 1, AStateEx.Caption, Palette.Window);
633 FBGRA.TextOut(lSquareHeight + 5, 0, AStateEx.Caption, Palette.GrayText);
634 end;
635
636 { Draw and Free }
637 FBGRA.Draw(ADest, 0, 0);
638 FBGRA.Free;
639
640 // The text selection
641 if (csfHasFocus in AState) {and using the keyboard} then
642 DrawFocusRect(ADest, Point(lSquareHeight + 4, 0),
643 Size(ASize.cx - lSquareHeight - 4, ASize.cy));
644end;
645
646procedure TCDWin7.DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint;
647 ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
648begin
649 inherited DrawRadioButtonCircle(ADest, ADestPos, ASize, AState, AStateEx);
650end;
651
652procedure TCDWin7.DrawRadioButton(ADest: TCanvas; ASize: TSize;
653 AState: TCDControlState; AStateEx: TCDControlStateEx);
654var
655 lCircleHeight: integer;
656 FBGRA: TBGRABitmap;
657 number: integer;
658begin
659 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
660 AssignFontToBGRA(AStateEx.Font, FBGRA);
661
662 lCircleHeight := win7.RadioButton.SliceScalingArray[0].BitmapHeight;
663
664 number := 0;
665
666 if csfOn in AState then
667 number := 4;
668
669 if csfEnabled in AState then
670 begin
671 if csfMouseOver in AState then
672 begin
673 Inc(number, +1);
674 if csfSunken in AState then
675 Inc(number, +1);
676 end
677 else
678 if csfSunken in AState then
679 Inc(number, +2);
680 end
681 else
682 Inc(number, +3);
683
684 win7.radiobutton.Draw(number, FBGRA, 0, 0, lCircleHeight, lCircleHeight, win7.debug);
685
686 if csfEnabled in AState then
687 FBGRA.TextOut(lCircleHeight + 5, 0, AStateEx.Caption, Palette.WindowText)
688 else
689 begin
690 FBGRA.TextOut(lCircleHeight + 6, 1, AStateEx.Caption, Palette.Window);
691 FBGRA.TextOut(lCircleHeight + 5, 0, AStateEx.Caption, Palette.GrayText);
692 end;
693
694 { Draw and Free }
695 FBGRA.Draw(ADest, 0, 0);
696 FBGRA.Free;
697
698 // The text selection
699 if (csfHasFocus in AState) {and using the keyboard} then
700 DrawFocusRect(ADest, Point(lCircleHeight + 3, 0),
701 Size(ASize.cx - lCircleHeight - 3, ASize.cy));
702end;
703
704procedure TCDWin7.DrawStaticText(ADest: TCanvas; ASize: TSize;
705 AState: TCDControlState; AStateEx: TCDControlStateEx);
706var
707 FBGRA: TBGRABitmap;
708begin
709 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
710 AssignFontToBGRA(AStateEx.Font, FBGRA);
711
712 if csfEnabled in AState then
713 FBGRA.TextOut(0, 0, AStateEx.Caption, Palette.WindowText)
714 else
715 begin
716 FBGRA.TextOut(1, 1, AStateEx.Caption, Palette.Window);
717 FBGRA.TextOut(0, 0, AStateEx.Caption, Palette.GrayText);
718 end;
719
720 { Draw and Free }
721 FBGRA.Draw(ADest, 0, 0);
722 FBGRA.Free;
723end;
724
725procedure TCDWin7.DrawProgressBar(ADest: TCanvas; ASize: TSize;
726 AState: TCDControlState; AStateEx: TCDProgressBarStateEx);
727var
728 lProgWidth: integer;
729 lPoint: TPoint;
730 FBGRA: TBGRABitmap;
731begin
732 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
733 AssignFontToBGRA(AStateEx.Font, FBGRA);
734
735 lPoint := Point(0, 0);
736
737 if (csfHorizontal in AState) or (csfRightToLeft in AState) then
738 begin
739 win7.ProgressBarHorizontalBackground.Draw(0, FBGRA, 0, 0, ASize.cx,
740 ASize.cy, win7.debug);
741
742 lProgWidth := Round(ASize.cx * AStateEx.PercentPosition);
743
744 if csfRightToLeft in AState then
745 lPoint.x := ASize.cx - lProgWidth;
746
747 win7.ProgressBarHorizontalFill.Draw(0, FBGRA, lPoint.x, lPoint.y, lProgWidth,
748 ASize.cy, win7.Debug);
749 end;
750
751 if (csfVertical in AState) or (csfTopDown in AState) then
752 begin
753 win7.ProgressBarVerticalBackground.Draw(0, FBGRA, 0, 0, ASize.cx,
754 ASize.cy, win7.debug);
755
756 lProgWidth := Round(ASize.cy * AStateEx.PercentPosition);
757
758 if csfTopDown in AState then
759 lPoint.y := ASize.cy - lProgWidth;
760
761 win7.ProgressBarVerticalFill.Draw(0, FBGRA, lPoint.x, lPoint.y,
762 ASize.cx, lProgWidth, win7.Debug);
763 end;
764
765 { Draw and Free }
766 FBGRA.Draw(ADest, 0, 0);
767 FBGRA.Free;
768end;
769
770procedure TCDWin7.DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint;
771 ASize: TSize; AState: TCDControlState);
772var
773 number: integer;
774 { bgrabitmap }
775 FBGRA: TBGRABitmap;
776begin
777 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy);
778
779 //if csfEnabled in AState then
780 //begin
781 number := 0;
782 if csfHasFocus in AState then
783 number := 4;
784 if csfMouseOver in AState then
785 number := 1;
786 if csfSunken in AState then
787 number := 2;
788 //end
789 //else
790 // number := 3;
791
792 win7.button.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.debug);
793
794 { Draw and Free }
795 FBGRA.Draw(ADest, ADestPos.X, ADestPos.Y, False);
796 FBGRA.Free;
797
798 // Now the arrow
799 DrawArrow(ADest, Point(ADestPos.X + ASize.CY div 4, ADestPos.Y + ASize.CY * 3 div 8),
800 AState, ASize.CY div 2);
801end;
802
803procedure TCDWin7.DrawScrollBar(ADest: TCanvas; ASize: TSize;
804 AState: TCDControlState; AStateEx: TCDPositionedCStateEx);
805var
806 lPos: TPoint;
807 lSize: TSize;
808 lArrowState: TCDControlState;
809 { number of bitmap used }
810 number: integer;
811 { bgrabitmap }
812 FBGRA: TBGRABitmap;
813 FBGRAOut: TBGRABitmap;
814begin
815 FBGRAOut := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
816 AssignFontToBGRA(AStateEx.Font, FBGRAOut);
817
818 // START BACKGROUND //
819 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy, AStateEx.ParentRGBColor);
820 AssignFontToBGRA(AStateEx.Font, FBGRA);
821
822 if csfEnabled in AState then
823 begin
824 number := 0;
825 //if csfHasFocus in AState then
826 // number := 4;
827 //if csfMouseOver in AState then
828 // number := 1;
829 if csfSunken in AState then
830 number := 2;
831 end
832 else
833 number := 3;
834
835 win7.button.Draw(number, FBGRA, 0, 0, ASize.cx, ASize.cy, win7.debug);
836
837 { Draw and Free }
838 FBGRAOut.PutImage(0, 0, FBGRA, dmDrawWithTransparency);
839 FBGRA.Free;
840 // END BACKGROUND //
841
842 // START L/T BUTTON //
843 lPos := Point(0, 0);
844
845 if csfHorizontal in AState then
846 lSize := Size(GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH), ASize.CY)
847 else
848 lSize := Size(ASize.CX, GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH));
849
850 if csfEnabled in AState then
851 begin
852 number := 0;
853 //if csfHasFocus in AState then
854 // number := 4;
855 //if csfMouseOver in AState then
856 // number := 1;
857 if csfSunken in AState then
858 number := 2;
859 end
860 else
861 number := 3;
862
863 if csfLeftArrow in AState then
864 begin
865 lArrowState := [csfSunken];
866 number := 2;
867 end
868 else
869 lArrowState := [];
870
871 FBGRA := TBGRABitmap.Create(lSize.cx, lSize.cy);
872 AssignFontToBGRA(AStateEx.Font, FBGRA);
873
874 win7.button.Draw(number, FBGRA, 0, 0, lSize.cx, lSize.cy, win7.debug);
875
876 { Draw and Free }
877 FBGRAOut.PutImage(lPos.x, lPos.y, FBGRA, dmDrawWithTransparency);
878 FBGRA.Free;
879
880 if csfHorizontal in AState then
881 DrawArrow(FBGRAOut.Canvas, Point(lPos.X + 5, lPos.Y + 5),
882 [csfLeftArrow] + lArrowState)
883 else
884 DrawArrow(FBGRAOut.Canvas, Point(lPos.X + 5, lPos.Y + 5),
885 [csfUpArrow] + lArrowState);
886 // END L/T BUTTON //
887
888 // START R/B BUTTON //
889 if csfHorizontal in AState then
890 lPos.X := lPos.X + ASize.CX - GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH)
891 else
892 lPos.Y := lPos.Y + ASize.CY - GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH);
893
894 if csfEnabled in AState then
895 begin
896 number := 0;
897 //if csfHasFocus in AState then
898 // number := 4;
899 //if csfMouseOver in AState then
900 // number := 1;
901 if csfSunken in AState then
902 number := 2;
903 end
904 else
905 number := 3;
906
907 if csfRightArrow in AState then
908 begin
909 lArrowState := [csfSunken];
910 number := 2;
911 end
912 else
913 lArrowState := [];
914
915 FBGRA := TBGRABitmap.Create(lSize.cx, lSize.cy);
916 AssignFontToBGRA(AStateEx.Font, FBGRA);
917
918 win7.button.Draw(number, FBGRA, 0, 0, lSize.cx, lSize.cy, win7.debug);
919
920 { Draw and Free }
921 FBGRAOut.PutImage(lPos.x, lPos.y, FBGRA, dmDrawWithTransparency);
922 FBGRA.Free;
923
924 if csfHorizontal in AState then
925 DrawArrow(FBGRAOut.Canvas, Point(lPos.X + 5, lPos.Y + 5),
926 [csfRightArrow] + lArrowState)
927 else
928 DrawArrow(FBGRAOut.Canvas, Point(lPos.X + 5, lPos.Y + 5),
929 [csfDownArrow] + lArrowState);
930 // END R/B BUTTON //
931
932 // START SLIDER //
933 lPos := Point(0, 0);
934 if csfHorizontal in AState then
935 begin
936 if AStateEx.FloatPageSize > 0 then
937 lSize.cx := Round(AStateEx.FloatPageSize * (ASize.cx -
938 GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) * 2));
939 if lSize.cx < 5 then
940 lSize.cx := 5;
941
942 lPos.X := Round(GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) +
943 AStateEx.FloatPos * (ASize.cx - GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) *
944 2 - lSize.cx));
945 end
946 else
947 begin
948 if AStateEx.FloatPageSize > 0 then
949 lSize.cy := Round(AStateEx.FloatPageSize * (ASize.cy -
950 GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) * 2));
951 if lSize.cy < 5 then
952 lSize.cy := 5;
953
954 lPos.Y := Round(GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) +
955 AStateEx.FloatPos * (ASize.cy - GetMeasures(TCDSCROLLBAR_BUTTON_WIDTH) *
956 2 - lSize.cy));
957 end;
958
959 if csfEnabled in AState then
960 begin
961 number := 0;
962 //if csfHasFocus in AState then
963 // number := 4;
964 //if csfMouseOver in AState then
965 // number := 1;
966 if csfSunken in AState then
967 number := 2;
968 end
969 else
970 number := 3;
971
972 FBGRA := TBGRABitmap.Create(lSize.cx, lSize.cy);
973 AssignFontToBGRA(AStateEx.Font, FBGRA);
974
975 win7.button.Draw(number, FBGRA, 0, 0, lSize.cx, lSize.cy, win7.debug);
976
977 { Draw and Free }
978 FBGRAOut.PutImage(lPos.x, lPos.y, FBGRA, dmDrawWithTransparency);
979 FBGRA.Free;
980 // END SLIDER //
981
982 FBGRAOut.Draw(ADest, 0, 0);
983 FBGRAOut.Free;
984end;
985
986procedure TCDWin7.DrawSlider(ADest: TCanvas; ADestPos: TPoint;
987 ASize: TSize; AState: TCDControlState);
988var
989 { number of bitmap used }
990 number: integer;
991 { bgrabitmap }
992 FBGRA: TBGRABitmap;
993begin
994 if csfHorizontal in AState then
995 FBGRA := TBGRABitmap.Create(ASize.cx, ASize.cy)
996 else
997 FBGRA := TBGRABitmap.Create(ASize.cy, ASize.cx);
998
999 if csfEnabled in AState then
1000 begin
1001 number := 0;
1002 if csfHasFocus in AState then
1003 number := 4;
1004 //if csfMouseOver in AState then
1005 // number := 1;
1006 //if csfSunken in AState then
1007 // number := 2;
1008 end
1009 else
1010 number := 3;
1011
1012 win7.button.Draw(number, FBGRA, 0, 0, FBGRA.Width, FBGRA.Height, win7.debug);
1013
1014 { Draw and Free }
1015 if csfHorizontal in AState then
1016 FBGRA.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, False)
1017 else
1018 FBGRA.Draw(TCanvas(ADest), ADestPos.y, ADestPos.x, False);
1019 FBGRA.Free;
1020end;
1021
1022procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
1023begin
1024 Dest.FontAntialias := True;
1025
1026 Dest.FontName := Source.Name;
1027 Dest.FontStyle := Source.Style;
1028 Dest.FontOrientation := Source.Orientation;
1029
1030 case Source.Quality of
1031 fqNonAntialiased: Dest.FontQuality := fqSystem;
1032 fqAntialiased: Dest.FontQuality := fqFineAntialiasing;
1033 fqProof: Dest.FontQuality := fqFineClearTypeRGB;
1034 fqDefault, fqDraft, fqCleartype, fqCleartypeNatural: Dest.FontQuality :=
1035 fqSystemClearType;
1036 end;
1037
1038 Dest.FontHeight := -Source.Height;
1039end;
1040
1041initialization
1042 win7 := TBitmapTheme.Create('aero' + pathdelim);
1043 RegisterDrawer(TCDWin7.Create, dsWindows7);
1044 RegisterDrawer(TCDWin7Extra.Create, dsExtra1);
1045
1046finalization
1047 win7.Free;
1048
1049end.
Note: See TracBrowser for help on using the repository browser.