source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntButtons.pas@ 1232

Last change on this file since 1232 was 453, checked in by Kevin Toppenberg, 17 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 30.7 KB
RevLine 
[453]1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntButtons;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Windows, Messages, Classes, Controls, Graphics, StdCtrls,
20 ExtCtrls, CommCtrl, Buttons,
21 TntControls;
22
23type
24 ITntGlyphButton = interface
25 ['{15D7E501-1E33-4293-8B45-716FB3B14504}']
26 function GetButtonGlyph: Pointer;
27 procedure UpdateInternalGlyphList;
28 end;
29
30{TNT-WARN TSpeedButton}
31 TTntSpeedButton = class(TSpeedButton {TNT-ALLOW TSpeedButton}, ITntGlyphButton)
32 private
33 FPaintInherited: Boolean;
34 function GetCaption: TWideCaption;
35 procedure SetCaption(const Value: TWideCaption);
36 function GetHint: WideString;
37 procedure SetHint(const Value: WideString);
38 function IsCaptionStored: Boolean;
39 function IsHintStored: Boolean;
40 procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
41 procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
42 protected
43 function GetButtonGlyph: Pointer;
44 procedure UpdateInternalGlyphList; dynamic;
45 procedure PaintButton; dynamic;
46 procedure Paint; override;
47 procedure DefineProperties(Filer: TFiler); override;
48 function GetActionLinkClass: TControlActionLinkClass; override;
49 procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
50 published
51 property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
52 property Hint: WideString read GetHint write SetHint stored IsHintStored;
53 end;
54
55{TNT-WARN TBitBtn}
56 TTntBitBtn = class(TBitBtn {TNT-ALLOW TBitBtn}, ITntGlyphButton)
57 private
58 FPaintInherited: Boolean;
59 FMouseInControl: Boolean;
60 function IsCaptionStored: Boolean;
61 function GetCaption: TWideCaption;
62 procedure SetCaption(const Value: TWideCaption);
63 function IsHintStored: Boolean;
64 function GetHint: WideString;
65 procedure SetHint(const Value: WideString);
66 procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
67 procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
68 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
69 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
70 protected
71 function GetButtonGlyph: Pointer;
72 procedure UpdateInternalGlyphList; dynamic;
73 procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
74 procedure CreateWindowHandle(const Params: TCreateParams); override;
75 procedure DefineProperties(Filer: TFiler); override;
76 function GetActionLinkClass: TControlActionLinkClass; override;
77 procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
78 published
79 property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
80 property Hint: WideString read GetHint write SetHint stored IsHintStored;
81 end;
82
83procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
84 const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
85 Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
86 BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
87
88function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
89 const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
90 Spacing: Integer; State: TButtonState; Transparent: Boolean;
91 BiDiFlags: Longint {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
92
93implementation
94
95uses
96 SysUtils, ActnList, TntForms, TntStdCtrls, TypInfo, RTLConsts, TntWindows,
97 {$IFDEF THEME_7_UP} Themes, {$ENDIF} TntClasses, TntActnList, TntSysUtils;
98
99type
100 EAbortPaint = class(EAbort);
101
102// Many routines in this unit are nearly the same as those found in Buttons.pas. They are
103// included here because the VCL implementation of TButtonGlyph is completetly inaccessible.
104
105type
106 THackButtonGlyph_D6_D7_D9 = class
107 protected
108 FOriginal: TBitmap;
109 FGlyphList: TImageList;
110 FIndexs: array[TButtonState] of Integer;
111 FxxxxTransparentColor: TColor;
112 FNumGlyphs: TNumGlyphs;
113 end;
114
115 THackBitBtn_D6_D7_D9 = class(TButton{TNT-ALLOW TButton})
116 protected
117 FCanvas: TCanvas;
118 FGlyph: Pointer;
119 FxxxxStyle: TButtonStyle;
120 FxxxxKind: TBitBtnKind;
121 FxxxxLayout: TButtonLayout;
122 FxxxxSpacing: Integer;
123 FxxxxMargin: Integer;
124 IsFocused: Boolean;
125 end;
126
127 THackSpeedButton_D6_D7_D9 = class(TGraphicControl)
128 protected
129 FxxxxGroupIndex: Integer;
130 FGlyph: Pointer;
131 FxxxxDown: Boolean;
132 FDragging: Boolean;
133 end;
134
135 {$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
136 THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
137 THackBitBtn = THackBitBtn_D6_D7_D9;
138 THackSpeedButton = THackSpeedButton_D6_D7_D9;
139 {$ENDIF}
140 {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
141 THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
142 THackBitBtn = THackBitBtn_D6_D7_D9;
143 THackSpeedButton = THackSpeedButton_D6_D7_D9;
144 {$ENDIF}
145 {$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
146 THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
147 THackBitBtn = THackBitBtn_D6_D7_D9;
148 THackSpeedButton = THackSpeedButton_D6_D7_D9;
149 {$ENDIF}
150 {$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
151 THackButtonGlyph = THackButtonGlyph_D6_D7_D9;
152 THackBitBtn = THackBitBtn_D6_D7_D9;
153 THackSpeedButton = THackSpeedButton_D6_D7_D9;
154 {$ENDIF}
155
156function GetButtonGlyph(Control: TControl): THackButtonGlyph;
157var
158 GlyphButton: ITntGlyphButton;
159begin
160 if Control.GetInterface(ITntGlyphButton, GlyphButton) then
161 Result := GlyphButton.GetButtonGlyph
162 else
163 raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
164end;
165
166procedure UpdateInternalGlyphList(Control: TControl);
167var
168 GlyphButton: ITntGlyphButton;
169begin
170 if Control.GetInterface(ITntGlyphButton, GlyphButton) then
171 GlyphButton.UpdateInternalGlyphList
172 else
173 raise ETntInternalError.Create('Internal Error: Control does not support ITntGlyphButton.');
174end;
175
176function TButtonGlyph_CreateButtonGlyph(Control: TControl; State: TButtonState): Integer;
177var
178 ButtonGlyph: THackButtonGlyph;
179 NumGlyphs: Integer;
180begin
181 ButtonGlyph := GetButtonGlyph(Control);
182 NumGlyphs := ButtonGlyph.FNumGlyphs;
183
184 if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
185 Result := ButtonGlyph.FIndexs[State];
186 if (Result = -1) then begin
187 UpdateInternalGlyphList(Control);
188 Result := ButtonGlyph.FIndexs[State];
189 end;
190end;
191
192procedure TButtonGlyph_DrawButtonGlyph(Control: TControl; Canvas: TCanvas; const GlyphPos: TPoint;
193 State: TButtonState; Transparent: Boolean);
194var
195 ButtonGlyph: THackButtonGlyph;
196 Glyph: TBitmap;
197 GlyphList: TImageList;
198 Index: Integer;
199 {$IFDEF THEME_7_UP}
200 Details: TThemedElementDetails;
201 R: TRect;
202 Button: TThemedButton;
203 {$ENDIF}
204begin
205 ButtonGlyph := GetButtonGlyph(Control);
206 Glyph := ButtonGlyph.FOriginal;
207 GlyphList := ButtonGlyph.FGlyphList;
208 if Glyph = nil then Exit;
209 if (Glyph.Width = 0) or (Glyph.Height = 0) then Exit;
210 Index := TButtonGlyph_CreateButtonGlyph(Control, State);
211 with GlyphPos do
212 {$IFDEF THEME_7_UP}
213 if ThemeServices.ThemesEnabled then begin
214 R.TopLeft := GlyphPos;
215 R.Right := R.Left + Glyph.Width div ButtonGlyph.FNumGlyphs;
216 R.Bottom := R.Top + Glyph.Height;
217 case State of
218 bsDisabled:
219 Button := tbPushButtonDisabled;
220 bsDown,
221 bsExclusive:
222 Button := tbPushButtonPressed;
223 else
224 // bsUp
225 Button := tbPushButtonNormal;
226 end;
227 Details := ThemeServices.GetElementDetails(Button);
228 ThemeServices.DrawIcon(Canvas.Handle, Details, R, GlyphList.Handle, Index);
229 end else
230 {$ENDIF}
231 if Transparent or (State = bsExclusive) then
232 ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
233 clNone, clNone, ILD_Transparent)
234 else
235 ImageList_DrawEx(GlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
236 ColorToRGB(clBtnFace), clNone, ILD_Normal);
237end;
238
239procedure TButtonGlyph_DrawButtonText(Canvas: TCanvas; const Caption: WideString;
240 TextBounds: TRect; State: TButtonState;
241 BiDiFlags: LongInt {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
242begin
243 with Canvas do
244 begin
245 Brush.Style := bsClear;
246 if State = bsDisabled then
247 begin
248 OffsetRect(TextBounds, 1, 1);
249 Font.Color := clBtnHighlight;
250
251 {$IFDEF COMPILER_7_UP}
252 if WordWrap then
253 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
254 DT_CENTER or DT_VCENTER or BiDiFlags or DT_WORDBREAK)
255 else
256 {$ENDIF}
257 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
258 DT_CENTER or DT_VCENTER or BiDiFlags);
259
260 OffsetRect(TextBounds, -1, -1);
261 Font.Color := clBtnShadow;
262
263 {$IFDEF COMPILER_7_UP}
264 if WordWrap then
265 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
266 DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
267 else
268 {$ENDIF}
269 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
270 DT_CENTER or DT_VCENTER or BiDiFlags);
271
272 end else
273 begin
274 {$IFDEF COMPILER_7_UP}
275 if WordWrap then
276 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
277 DT_CENTER or DT_WORDBREAK or BiDiFlags) { TODO: Figure out why DT_VCENTER is not used }
278 else
279 {$ENDIF}
280 Tnt_DrawTextW(Handle, PWideChar(Caption), Length(Caption), TextBounds,
281 DT_CENTER or DT_VCENTER or BiDiFlags);
282 end;
283 end;
284end;
285
286procedure TButtonGlyph_CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect;
287 const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout;
288 Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
289 BiDiFlags: Integer {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF});
290var
291 TextPos: TPoint;
292 ClientSize,
293 GlyphSize,
294 TextSize: TPoint;
295 TotalSize: TPoint;
296 Glyph: TBitmap;
297 NumGlyphs: Integer;
298 ButtonGlyph: THackButtonGlyph;
299begin
300 ButtonGlyph := GetButtonGlyph(Control);
301 Glyph := ButtonGlyph.FOriginal;
302 NumGlyphs := ButtonGlyph.FNumGlyphs;
303
304 if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
305 if Layout = blGlyphLeft then
306 Layout := blGlyphRight
307 else
308 if Layout = blGlyphRight then
309 Layout := blGlyphLeft;
310
311 // Calculate the item sizes.
312 ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
313
314 if Assigned(Glyph) then
315 GlyphSize := Point(Glyph.Width div NumGlyphs, Glyph.Height)
316 else
317 GlyphSize := Point(0, 0);
318
319 if Length(Caption) > 0 then
320 begin
321 {$IFDEF COMPILER_7_UP}
322 TextBounds := Rect(0, 0, Client.Right - Client.Left - GlyphSize.X - 3, 0); { TODO: Figure out why GlyphSize.X is in here. }
323 {$ELSE}
324 TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
325 {$ENDIF}
326
327 {$IFDEF COMPILER_7_UP}
328 if WordWrap then
329 Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_WORDBREAK
330 or DT_CALCRECT or BiDiFlags)
331 else
332 {$ENDIF}
333 Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
334
335 TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
336 end
337 else
338 begin
339 TextBounds := Rect(0, 0, 0, 0);
340 TextSize := Point(0, 0);
341 end;
342
343 // If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
344 // If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.
345 if Layout in [blGlyphLeft, blGlyphRight] then
346 begin
347 GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
348 TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
349 end
350 else
351 begin
352 GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
353 TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
354 end;
355
356 // If there is no text or no bitmap, then Spacing is irrelevant.
357 if (TextSize.X = 0) or (GlyphSize.X = 0) then
358 Spacing := 0;
359
360 // Adjust Margin and Spacing.
361 if Margin = -1 then
362 begin
363 if Spacing = -1 then
364 begin
365 TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
366 if Layout in [blGlyphLeft, blGlyphRight] then
367 Margin := (ClientSize.X - TotalSize.X) div 3
368 else
369 Margin := (ClientSize.Y - TotalSize.Y) div 3;
370 Spacing := Margin;
371 end
372 else
373 begin
374 TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
375 if Layout in [blGlyphLeft, blGlyphRight] then
376 Margin := (ClientSize.X - TotalSize.X + 1) div 2
377 else
378 Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
379 end;
380 end
381 else
382 begin
383 if Spacing = -1 then
384 begin
385 TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
386 if Layout in [blGlyphLeft, blGlyphRight] then
387 Spacing := (TotalSize.X - TextSize.X) div 2
388 else
389 Spacing := (TotalSize.Y - TextSize.Y) div 2;
390 end;
391 end;
392
393 case Layout of
394 blGlyphLeft:
395 begin
396 GlyphPos.X := Margin;
397 TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
398 end;
399 blGlyphRight:
400 begin
401 GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
402 TextPos.X := GlyphPos.X - Spacing - TextSize.X;
403 end;
404 blGlyphTop:
405 begin
406 GlyphPos.Y := Margin;
407 TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
408 end;
409 blGlyphBottom:
410 begin
411 GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
412 TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
413 end;
414 end;
415
416 // Fixup the Result variables.
417 with GlyphPos do
418 begin
419 Inc(X, Client.Left + Offset.X);
420 Inc(Y, Client.Top + Offset.Y);
421 end;
422
423 {$IFDEF THEME_7_UP}
424 { Themed text is not shifted, but gets a different color. }
425 if ThemeServices.ThemesEnabled then
426 OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top)
427 else
428 {$ENDIF}
429 OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y);
430end;
431
432function TButtonGlyph_Draw(Control: TControl; Canvas: TCanvas; const Client: TRect;
433 const Offset: TPoint; const Caption: WideString; Layout: TButtonLayout; Margin: Integer;
434 Spacing: Integer; State: TButtonState; Transparent: Boolean;
435 BiDiFlags: Longint {$IFDEF COMPILER_7_UP}; WordWrap: Boolean {$ENDIF}): TRect;
436var
437 GlyphPos: TPoint;
438begin
439 TButtonGlyph_CalcButtonLayout(Control, Canvas.Handle, Client, Offset, Caption, Layout, Margin,
440 Spacing, GlyphPos, Result, BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
441 TButtonGlyph_DrawButtonGlyph(Control, Canvas, GlyphPos, State, Transparent);
442 TButtonGlyph_DrawButtonText(Canvas, Caption, Result, State,
443 BiDiFlags {$IFDEF COMPILER_7_UP}, WordWrap {$ENDIF});
444end;
445
446{ TTntSpeedButton }
447
448procedure TTntSpeedButton.DefineProperties(Filer: TFiler);
449begin
450 inherited;
451 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
452end;
453
454function TTntSpeedButton.IsCaptionStored: Boolean;
455begin
456 Result := TntControl_IsCaptionStored(Self)
457end;
458
459function TTntSpeedButton.GetCaption: TWideCaption;
460begin
461 Result := TntControl_GetText(Self);
462end;
463
464procedure TTntSpeedButton.SetCaption(const Value: TWideCaption);
465begin
466 TntControl_SetText(Self, Value);
467end;
468
469function TTntSpeedButton.IsHintStored: Boolean;
470begin
471 Result := TntControl_IsHintStored(Self)
472end;
473
474function TTntSpeedButton.GetHint: WideString;
475begin
476 Result := TntControl_GetHint(Self)
477end;
478
479procedure TTntSpeedButton.SetHint(const Value: WideString);
480begin
481 TntControl_SetHint(Self, Value);
482end;
483
484procedure TTntSpeedButton.CMHintShow(var Message: TMessage);
485begin
486 ProcessCMHintShowMsg(Message);
487 inherited;
488end;
489
490procedure TTntSpeedButton.CMDialogChar(var Message: TCMDialogChar);
491begin
492 with Message do
493 if IsWideCharAccel(CharCode, Caption) and Enabled and Visible and
494 (Parent <> nil) and Parent.Showing then
495 begin
496 Click;
497 Result := 1;
498 end else
499 inherited;
500end;
501
502function TTntSpeedButton.GetButtonGlyph: Pointer;
503begin
504 Result := THackSpeedButton(Self).FGlyph;
505end;
506
507procedure TTntSpeedButton.UpdateInternalGlyphList;
508begin
509 FPaintInherited := True;
510 try
511 Repaint;
512 finally
513 FPaintInherited := False;
514 end;
515 Invalidate;
516 raise EAbortPaint.Create('');
517end;
518
519procedure TTntSpeedButton.Paint;
520begin
521 if FPaintInherited then
522 inherited
523 else
524 PaintButton;
525end;
526
527procedure TTntSpeedButton.PaintButton;
528const
529 DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
530 FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
531var
532 PaintRect: TRect;
533 DrawFlags: Integer;
534 Offset: TPoint;
535 {$IFDEF THEME_7_UP}
536 Button: TThemedButton;
537 ToolButton: TThemedToolBar;
538 Details: TThemedElementDetails;
539 {$ENDIF}
540begin
541 try
542 if not Enabled then
543 begin
544 FState := bsDisabled;
545 THackSpeedButton(Self).FDragging := False;
546 end
547 else if FState = bsDisabled then
548 if Down and (GroupIndex <> 0) then
549 FState := bsExclusive
550 else
551 FState := bsUp;
552 Canvas.Font := Self.Font;
553
554 {$IFDEF THEME_7_UP}
555 if ThemeServices.ThemesEnabled then
556 begin
557 {$IFDEF COMPILER_7_UP}
558 PerformEraseBackground(Self, Canvas.Handle);
559 {$ENDIF}
560 SelectObject(Canvas.Handle, Canvas.Font.Handle); { For some reason, PerformEraseBackground sometimes messes the font up. }
561
562 if not Enabled then
563 Button := tbPushButtonDisabled
564 else
565 if FState in [bsDown, bsExclusive] then
566 Button := tbPushButtonPressed
567 else
568 if MouseInControl then
569 Button := tbPushButtonHot
570 else
571 Button := tbPushButtonNormal;
572
573 ToolButton := ttbToolbarDontCare;
574 if Flat then
575 begin
576 case Button of
577 tbPushButtonDisabled:
578 Toolbutton := ttbButtonDisabled;
579 tbPushButtonPressed:
580 Toolbutton := ttbButtonPressed;
581 tbPushButtonHot:
582 Toolbutton := ttbButtonHot;
583 tbPushButtonNormal:
584 Toolbutton := ttbButtonNormal;
585 end;
586 end;
587
588 PaintRect := ClientRect;
589 if ToolButton = ttbToolbarDontCare then
590 begin
591 Details := ThemeServices.GetElementDetails(Button);
592 ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
593 PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
594 end
595 else
596 begin
597 Details := ThemeServices.GetElementDetails(ToolButton);
598 ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
599 PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
600 end;
601
602 if Button = tbPushButtonPressed then
603 begin
604 // A pressed speed button has a white text. This applies however only to flat buttons.
605 if ToolButton <> ttbToolbarDontCare then
606 Canvas.Font.Color := clHighlightText;
607 Offset := Point(1, 0);
608 end
609 else
610 Offset := Point(0, 0);
611 TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
612 Transparent, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
613 end
614 else
615 {$ENDIF}
616 begin
617 PaintRect := Rect(0, 0, Width, Height);
618 if not Flat then
619 begin
620 DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
621 if FState in [bsDown, bsExclusive] then
622 DrawFlags := DrawFlags or DFCS_PUSHED;
623 DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
624 end
625 else
626 begin
627 if (FState in [bsDown, bsExclusive]) or
628 (MouseInControl and (FState <> bsDisabled)) or
629 (csDesigning in ComponentState) then
630 DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
631 FillStyles[Transparent] or BF_RECT)
632 else if not Transparent then
633 begin
634 Canvas.Brush.Color := Color;
635 Canvas.FillRect(PaintRect);
636 end;
637 InflateRect(PaintRect, -1, -1);
638 end;
639 if FState in [bsDown, bsExclusive] then
640 begin
641 if (FState = bsExclusive) and (not Flat or not MouseInControl) then
642 begin
643 Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
644 Canvas.FillRect(PaintRect);
645 end;
646 Offset.X := 1;
647 Offset.Y := 1;
648 end
649 else
650 begin
651 Offset.X := 0;
652 Offset.Y := 0;
653 end;
654 TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
655 Layout, Margin, Spacing, FState, Transparent,
656 DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, False {$ENDIF});
657 end;
658 except
659 on E: EAbortPaint do
660 ;
661 else
662 raise;
663 end;
664end;
665
666function TTntSpeedButton.GetActionLinkClass: TControlActionLinkClass;
667begin
668 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
669end;
670
671{$IFDEF COMPILER_10_UP}
672type
673 TAccessGraphicControl = class(TGraphicControl);
674{$ENDIF}
675
676procedure TTntSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
677{$IFDEF COMPILER_10_UP}
678// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
679type
680 CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
681var
682 M: TMethod;
683{$ENDIF}
684begin
685 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
686 {$IFNDEF COMPILER_10_UP}
687 inherited;
688 {$ELSE}
689 // call TGraphicControl.ActionChange (bypass TSpeedButton.ActionChange)
690 M.Code := @TAccessGraphicControl.ActionChange;
691 M.Data := Self;
692 CallActionChange(M)(Sender, CheckDefaults);
693 // call Delphi2005's TSpeedButton.ActionChange
694 if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
695 with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
696 begin
697 if CheckDefaults or (Self.GroupIndex = 0) then
698 Self.GroupIndex := GroupIndex;
699 { Copy image from action's imagelist }
700 if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
701 (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
702 CopyImage(ActionList.Images, ImageIndex);
703 end;
704 {$ENDIF}
705end;
706
707{ TTntBitBtn }
708
709procedure TTntBitBtn.CreateWindowHandle(const Params: TCreateParams);
710begin
711 CreateUnicodeHandle(Self, Params, 'BUTTON');
712end;
713
714procedure TTntBitBtn.DefineProperties(Filer: TFiler);
715begin
716 inherited;
717 TntPersistent_AfterInherited_DefineProperties(Filer, Self);
718end;
719
720function TTntBitBtn.IsCaptionStored: Boolean;
721var
722 BaseClass: TClass;
723 PropInfo: PPropInfo;
724begin
725 Assert(Self is TButton{TNT-ALLOW TButton});
726 Assert(Self is TBitBtn{TNT-ALLOW TBitBtn});
727 if Kind = bkCustom then
728 // don't use TBitBtn, it's broken for Kind <> bkCustom
729 BaseClass := TButton{TNT-ALLOW TButton}
730 else begin
731 //TBitBtn has it's own storage specifier, based upon the button kind
732 BaseClass := TBitBtn{TNT-ALLOW TBitBtn};
733 end;
734 PropInfo := GetPropInfo(BaseClass, 'Caption');
735 if PropInfo = nil then
736 raise EPropertyError.CreateResFmt(PResStringRec(@SUnknownProperty), ['Caption']);
737 Result := IsStoredProp(Self, PropInfo);
738end;
739
740function TTntBitBtn.GetCaption: TWideCaption;
741begin
742 Result := TntControl_GetText(Self)
743end;
744
745procedure TTntBitBtn.SetCaption(const Value: TWideCaption);
746begin
747 TntControl_SetText(Self, Value);
748end;
749
750function TTntBitBtn.IsHintStored: Boolean;
751begin
752 Result := TntControl_IsHintStored(Self)
753end;
754
755function TTntBitBtn.GetHint: WideString;
756begin
757 Result := TntControl_GetHint(Self)
758end;
759
760procedure TTntBitBtn.SetHint(const Value: WideString);
761begin
762 TntControl_SetHint(Self, Value);
763end;
764
765procedure TTntBitBtn.CMDialogChar(var Message: TCMDialogChar);
766begin
767 TntButton_CMDialogChar(Self, Message);
768end;
769
770function TTntBitBtn.GetButtonGlyph: Pointer;
771begin
772 Result := THackBitBtn(Self).FGlyph;
773end;
774
775procedure TTntBitBtn.UpdateInternalGlyphList;
776begin
777 FPaintInherited := True;
778 try
779 Repaint;
780 finally
781 FPaintInherited := False;
782 end;
783 Invalidate;
784 raise EAbortPaint.Create('');
785end;
786
787procedure TTntBitBtn.CNDrawItem(var Message: TWMDrawItem);
788begin
789 if FPaintInherited then
790 inherited
791 else
792 DrawItem(Message.DrawItemStruct^);
793end;
794
795procedure TTntBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
796var
797 IsDown, IsDefault: Boolean;
798 State: TButtonState;
799 R: TRect;
800 Flags: Longint;
801 FCanvas: TCanvas;
802 IsFocused: Boolean;
803 {$IFDEF THEME_7_UP}
804 Details: TThemedElementDetails;
805 Button: TThemedButton;
806 Offset: TPoint;
807 {$ENDIF}
808begin
809 try
810 FCanvas := THackBitBtn(Self).FCanvas;
811 IsFocused := THackBitBtn(Self).IsFocused;
812 FCanvas.Handle := DrawItemStruct.hDC;
813 R := ClientRect;
814
815 with DrawItemStruct do
816 begin
817 FCanvas.Handle := hDC;
818 FCanvas.Font := Self.Font;
819 IsDown := itemState and ODS_SELECTED <> 0;
820 IsDefault := itemState and ODS_FOCUS <> 0;
821
822 if not Enabled then State := bsDisabled
823 else if IsDown then State := bsDown
824 else State := bsUp;
825 end;
826
827 {$IFDEF THEME_7_UP}
828 if ThemeServices.ThemesEnabled then
829 begin
830 if not Enabled then
831 Button := tbPushButtonDisabled
832 else
833 if IsDown then
834 Button := tbPushButtonPressed
835 else
836 if FMouseInControl then
837 Button := tbPushButtonHot
838 else
839 if IsFocused or IsDefault then
840 Button := tbPushButtonDefaulted
841 else
842 Button := tbPushButtonNormal;
843
844 Details := ThemeServices.GetElementDetails(Button);
845 // Parent background.
846 ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
847 // Button shape.
848 ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
849 R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);
850
851 if Button = tbPushButtonPressed then
852 Offset := Point(1, 0)
853 else
854 Offset := Point(0, 0);
855 TButtonGlyph_Draw(Self, FCanvas, R, Offset, Caption, Layout, Margin, Spacing, State, False,
856 DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});
857
858 if IsFocused and IsDefault then
859 begin
860 FCanvas.Pen.Color := clWindowFrame;
861 FCanvas.Brush.Color := clBtnFace;
862 DrawFocusRect(FCanvas.Handle, R);
863 end;
864 end
865 else
866 {$ENDIF}
867 begin
868 R := ClientRect;
869
870 Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
871 if IsDown then Flags := Flags or DFCS_PUSHED;
872 if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
873 Flags := Flags or DFCS_INACTIVE;
874
875 { DrawFrameControl doesn't allow for drawing a button as the
876 default button, so it must be done here. }
877 if IsFocused or IsDefault then
878 begin
879 FCanvas.Pen.Color := clWindowFrame;
880 FCanvas.Pen.Width := 1;
881 FCanvas.Brush.Style := bsClear;
882 FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
883
884 { DrawFrameControl must draw within this border }
885 InflateRect(R, -1, -1);
886 end;
887
888 { DrawFrameControl does not draw a pressed button correctly }
889 if IsDown then
890 begin
891 FCanvas.Pen.Color := clBtnShadow;
892 FCanvas.Pen.Width := 1;
893 FCanvas.Brush.Color := clBtnFace;
894 FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
895 InflateRect(R, -1, -1);
896 end
897 else
898 DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
899
900 if IsFocused then
901 begin
902 R := ClientRect;
903 InflateRect(R, -1, -1);
904 end;
905
906 FCanvas.Font := Self.Font;
907 if IsDown then
908 OffsetRect(R, 1, 1);
909
910 TButtonGlyph_Draw(Self, FCanvas, R, Point(0, 0), Caption, Layout, Margin, Spacing, State,
911 False, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});
912
913 if IsFocused and IsDefault then
914 begin
915 R := ClientRect;
916 InflateRect(R, -4, -4);
917 FCanvas.Pen.Color := clWindowFrame;
918 FCanvas.Brush.Color := clBtnFace;
919 DrawFocusRect(FCanvas.Handle, R);
920 end;
921 end;
922 FCanvas.Handle := 0;
923 except
924 on E: EAbortPaint do
925 ;
926 else
927 raise;
928 end;
929end;
930
931procedure TTntBitBtn.CMMouseEnter(var Message: TMessage);
932begin
933 FMouseInControl := True;
934 inherited;
935end;
936
937procedure TTntBitBtn.CMMouseLeave(var Message: TMessage);
938begin
939 FMouseInControl := False;
940 inherited;
941end;
942
943{$IFDEF COMPILER_10_UP}
944type
945 TAccessButton = class(TButton{TNT-ALLOW TButton});
946{$ENDIF}
947
948procedure TTntBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
949{$IFDEF COMPILER_10_UP}
950// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
951type
952 CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
953var
954 M: TMethod;
955{$ENDIF}
956begin
957 TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
958 {$IFNDEF COMPILER_10_UP}
959 inherited;
960 {$ELSE}
961 // call TButton.ActionChange (bypass TBitBtn.ActionChange)
962 M.Code := @TAccessButton.ActionChange;
963 M.Data := Self;
964 CallActionChange(M)(Sender, CheckDefaults);
965 // call Delphi2005's TBitBtn.ActionChange
966 if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
967 with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
968 begin
969 { Copy image from action's imagelist }
970 if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
971 (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
972 CopyImage(ActionList.Images, ImageIndex);
973 end;
974 {$ENDIF}
975end;
976
977function TTntBitBtn.GetActionLinkClass: TControlActionLinkClass;
978begin
979 Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
980end;
981
982end.
Note: See TracBrowser for help on using the repository browser.