source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntButtons.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 30.7 KB
Line 
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.