1 { TDividerBevel
2 
3   Copyright (C) 2010 Lazarus team
4 
5   This library is free software; you can redistribute it and/or modify it
6   under the same terms as the Lazarus Component Library (LCL)
7 
8   See the file COPYING.modifiedLGPL.txt, included in this distribution,
9   for details about the license.
10 
11 }
12 unit DividerBevel;
13 
14 {$mode objfpc}{$H+}
15 
16 interface
17 
18 uses
19   Classes, Types, Math,
20   // LCL
21   LCLType, LCLIntf, Controls, Graphics, ComCtrls, ExtCtrls, Themes,
22   // LazUtils
23   GraphType;
24 
25 type
26   { TDividerBevel }
27 
28   TDividerBevel = class(TGraphicControl)
29   private
30     FBevelStyle: TBevelStyle;
31     FBevelWidth: Integer;
32     FCaptionSpacing: Integer;
33     FLeftIndent: Integer;
34     FOrientation: TTrackBarOrientation;
35     FStyle: TGrabStyle;
36     FTransparent: Boolean;
37     procedure SetBevelStyle(AValue: TBevelStyle);
38     procedure SetBevelWidth(AValue: Integer);
39     procedure SetCaptionSpacing(const AValue: Integer);
40     procedure SetLeftIndent(const AValue: Integer);
41     procedure SetOrientation(AValue: TTrackBarOrientation);
42     procedure SetStyle(AValue: TGrabStyle);
43     procedure SetTransparent(AValue: Boolean);
44   protected
45     FBevelHeight: Integer;
46     FBevelTop: Integer;
47     FNeedCalcSize: Boolean;
48     FTextExtent: TSize;
GetControlClassDefaultSizenull49     class function GetControlClassDefaultSize: TSize; override;
50     procedure CalcSize;
51     procedure Paint; override;
52     procedure FontChanged(Sender: TObject); override;
53     procedure SetAutoSize(Value: Boolean); override;
54     procedure TextChanged; override;
55     procedure CalculatePreferredSize(
56                          var PreferredWidth, PreferredHeight: Integer;
57                          {%H-}WithThemeSpace: Boolean); override;
58   public
59     constructor Create(AOwner: TComponent); override;
60     procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
61   published
62     property Caption;
63     property Align;
64     property AutoSize default True;
65     property Anchors;
66     property BevelStyle: TBevelStyle read FBevelStyle write SetBevelStyle default bsLowered;
67     property BevelWidth: Integer read FBevelWidth write SetBevelWidth default -1;
68     property BiDiMode;
69     property BorderSpacing;
70     property CaptionSpacing: Integer read FCaptionSpacing write SetCaptionSpacing
71              default 10;
72     property Color;
73     property Constraints;
74     property DragCursor;
75     property DragKind;
76     property DragMode;
77     property Font;
78     property Hint;
79     property LeftIndent: Integer read FLeftIndent write SetLeftIndent default 60;
80     property Orientation: TTrackBarOrientation read FOrientation write SetOrientation
81              default trHorizontal;
82     property ParentBiDiMode;
83     property ParentColor;
84     property ParentFont;
85     property ParentShowHint;
86     property PopupMenu;
87     property ShowHint;
88     property Style: TGrabStyle read FStyle write SetStyle default gsSimple;
89     property Transparent: Boolean read FTransparent write SetTransparent default True;
90     property Visible;
91     property OnChangeBounds;
92     property OnClick;
93     property OnContextPopup;
94     property OnDblClick;
95     property OnDragDrop;
96     property OnDragOver;
97     property OnEndDrag;
98     property OnMouseDown;
99     property OnMouseEnter;
100     property OnMouseLeave;
101     property OnMouseMove;
102     property OnMouseUp;
103     property OnResize;
104     property OnStartDrag;
105 end;
106 
107 implementation
108 
109 { TDividerBevel }
110 
111 procedure TDividerBevel.SetBevelStyle(AValue: TBevelStyle);
112 begin
113   if FBevelStyle = AValue then Exit;
114   FBevelStyle := AValue;
115   Invalidate;
116 end;
117 
118 procedure TDividerBevel.SetBevelWidth(AValue: Integer);
119 begin
120   if FBevelWidth = AValue then Exit;
121   FBevelWidth := AValue;
122   if AutoSize then begin
123     InvalidatePreferredSize;
124     AdjustSize;
125   end else
126     FNeedCalcSize := True;
127   Invalidate;
128 end;
129 
130 procedure TDividerBevel.SetCaptionSpacing(const AValue: Integer);
131 begin
132   if FCaptionSpacing = AValue then Exit;
133   FCaptionSpacing := AValue;
134   Invalidate;
135 end;
136 
137 procedure TDividerBevel.SetLeftIndent(const AValue: Integer);
138 begin
139   if FLeftIndent = AValue then Exit;
140   FLeftIndent := AValue;
141   Invalidate;
142 end;
143 
144 procedure TDividerBevel.SetOrientation(AValue: TTrackBarOrientation);
145 begin
146   if FOrientation = AValue then Exit;
147   FOrientation := AValue;
148   if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
149   if AutoSize then
150     begin
151       InvalidatePreferredSize;
152       AdjustSize;
153     end;
154   Invalidate;
155 end;
156 
157 procedure TDividerBevel.SetStyle(AValue: TGrabStyle);
158 begin
159   if FStyle=AValue then Exit;
160   FStyle:=AValue;
161   Invalidate;
162 end;
163 
164 procedure TDividerBevel.SetTransparent(AValue: Boolean);
165 begin
166   if FTransparent = AValue then Exit;
167   FTransparent := AValue;
168   Invalidate;
169 end;
170 
TDividerBevel.GetControlClassDefaultSizenull171 class function TDividerBevel.GetControlClassDefaultSize: TSize;
172 begin
173   Result.CX := 240;
174   Result.CY := 17;
175 end;
176 
177 procedure TDividerBevel.CalcSize;
178 begin
179   if not FNeedCalcSize then exit;
180   FNeedCalcSize := False;
181   if Caption = '' then
182     FTextExtent := Canvas.TextExtent(' ')
183   else
184     FTextExtent := Canvas.TextExtent(Caption);
185   if FBevelWidth < 0 then
186     FBevelHeight := Max(3, FTextExtent.cy div 5)
187   else
188     FBevelHeight := FBevelWidth;
189   FBevelTop := Max((FTextExtent.cy - FBevelHeight) div 2, 0);
190 end;
191 
192 procedure TDividerBevel.Paint;
193 var
194   aBevel: TGraphicsBevelCut;
195   aHorizontal: Boolean;
196   PaintRect: TRect;
197   aStyle: TGrabStyle;
198 
199   procedure PaintBevel;
200   var aDetails: TThemedElementDetails;
201       aRect: TRect;
202       w, l: Integer;
203   begin
204     case aStyle of
205       gsSimple: Canvas.Frame3D(PaintRect, 1, aBevel);
206       gsDouble: if aHorizontal then begin
207           aRect.TopLeft := PaintRect.TopLeft;
208           aRect.Right := PaintRect.Right;
209           w := (PaintRect.Bottom - PaintRect.Top - 2) div 2;
210           aRect.Bottom :=  aRect.Top + w;
211           Canvas.Frame3D(aRect, 1, aBevel);
212           aRect.Left := PaintRect.Left;
213           aRect.Top := PaintRect.Bottom - w;
214           aRect.BottomRight := PaintRect.BottomRight;
215           Canvas.Frame3D(aRect, 1, aBevel);
216         end else begin
217           aRect.TopLeft := PaintRect.TopLeft;
218           w := (PaintRect.Right - PaintRect.Left - 2) div 2;
219           aRect.Right :=  aRect.Left + w;
220           aRect.Bottom := PaintRect.Bottom;
221           Canvas.Frame3D(aRect, 1, aBevel);
222           aRect.Left := PaintRect.Right - w;
223           aRect.Top := PaintRect.Top;
224           aRect.BottomRight := PaintRect.BottomRight;
225           Canvas.Frame3D(aRect, 1, aBevel);
226         end;
227       gsHorLines: begin
228           aRect.TopLeft := PaintRect.TopLeft;
229           aRect.Right :=  PaintRect.Right;
230           l := (PaintRect.Bottom - aRect.Top + 1) div 3;
231           inc(aRect.Top);
232           Canvas.Pen.Color := clBtnShadow;
233           for w := 0 to l - 1 do
234             Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
235           Canvas.Pen.Color := clBtnHighlight;
236           inc(aRect.Top);
237           for w := 0 to l - 1 do
238             Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
239         end;
240       gsVerLines: begin
241           aRect.TopLeft := PaintRect.TopLeft;
242           l := (PaintRect.Right - aRect.Left + 1) div 3;
243           aRect.Bottom :=  PaintRect.Bottom + 1;
244           inc(aRect.Left);
245           Canvas.Pen.Color := clBtnShadow;
246           for w := 0 to l - 1 do
247             Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
248           Canvas.Pen.Color := clBtnHighlight;
249           inc(aRect.Left);
250           for w := 0 to l - 1 do
251             Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
252         end;
253       gsGripper: begin
254          if aHorizontal then
255            aDetails := ThemeServices.GetElementDetails(trGripper)
256          else
257            aDetails := ThemeServices.GetElementDetails(trGripperVert);
258          ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
259         end;
260       gsButton: begin
261           aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal);
262           ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
263         end;
264     end;
265   end;
266 
267 var
268   aIndent, aRight, j: Integer;
269 begin
270   CalcSize;
271   if not FTransparent then begin
272     Canvas.Brush.Color := Color;
273     Canvas.Brush.Style := bsSolid;
274     Canvas.FillRect(ClientRect);
275   end;
276 
277   if FBevelStyle = bsLowered then
278     aBevel := bvLowered
279   else
280     aBevel := bvRaised;
281   aHorizontal := (Orientation = trHorizontal);
282 
283   aStyle := Style;
284   if not aHorizontal then
285     case aStyle of
286       gsHorLines: aStyle := gsVerLines;
287       gsVerLines: aStyle := gsHorLines;
288     end;
289 
290   if aHorizontal then begin
291     PaintRect.Left := 0;
292     PaintRect.Top := FBevelTop;
293     PaintRect.Bottom := PaintRect.Top + FBevelHeight;
294   end else begin
295     PaintRect.Left := FBevelTop;
296     PaintRect.Top := 0;
297     PaintRect.Right := PaintRect.Left + FBevelHeight;
298   end;
299 
300   if Caption = '' then begin
301     if aHorizontal then
302       PaintRect.Right := Width
303     else
304       PaintRect.Bottom := Height;
305     PaintBevel;
306     exit;
307   end;
308 
309   if FLeftIndent > 0 then
310     aIndent := FLeftIndent
311   else
312     if FLeftIndent = 0 then
313       aIndent := 0
314     else begin
315       j := 2*FCaptionSpacing + FTextExtent.cx;
316       if aHorizontal then
317         aIndent := (Width - j) div 2
318       else
319         aIndent := (Height - j) div 2;
320     end;
321 
322   if not IsRightToLeft or not aHorizontal then
323     aRight := aIndent
324   else begin
325     aRight := Width - FTextExtent.cx - FCaptionSpacing - aIndent;
326     if aIndent > 0 then dec(aRight, FCaptionSpacing);
327   end;
328   if aRight > 0 then begin
329     if aHorizontal then
330       PaintRect.Right := aRight
331     else
332       PaintRect.Bottom := aRight;
333     PaintBevel;
334   end;
335 
336   if aIndent > 0 then inc(aIndent, FCaptionSpacing);
337   if aHorizontal then begin
338     PaintRect.Left := aRight + FCaptionSpacing + FTextExtent.cx;
339     if aIndent <> 0 then inc(PaintRect.Left, FCaptionSpacing);
340     PaintRect.Top := FBevelTop;
341     PaintRect.Right := Width;
342     PaintRect.Bottom := FBevelTop + FBevelHeight;
343   end else begin
344     PaintRect.Left := FBevelTop;
345     PaintRect.Top := aRight + FCaptionSpacing + FTextExtent.cx;
346     if aIndent <> 0 then inc(PaintRect.Top, FCaptionSpacing);
347     PaintRect.Right := FBevelTop + FBevelHeight;
348     PaintRect.Bottom := Height;
349   end;
350   PaintBevel;
351 
352   Canvas.Brush.Style := bsClear;
353   j := Max((FBevelHeight - FTextExtent.cy) div 2, 0);
354   if aHorizontal then begin
355     Canvas.Font.Orientation := 0;
356     if not IsRightToLeft then
357       Canvas.TextOut(aIndent, j, Caption)
358     else
359       Canvas.TextOut(Width - FTextExtent.cx - aIndent, j, Caption);
360   end else begin
361     Canvas.Font.Orientation := 900;
362     Canvas.TextOut(j, aIndent + FTextExtent.cx, Caption);
363   end;
364 end;
365 
366 procedure TDividerBevel.FontChanged(Sender: TObject);
367 begin
368   inherited FontChanged(Sender);
369   FNeedCalcSize := True;
370   Invalidate;
371 end;
372 
373 procedure TDividerBevel.SetAutoSize(Value: Boolean);
374 begin
375   inherited SetAutoSize(Value);
376   if Value then begin
377     InvalidatePreferredSize;
378     AdjustSize;
379   end;
380 end;
381 
382 procedure TDividerBevel.TextChanged;
383 begin
384   inherited TextChanged;
385   FNeedCalcSize := True;
386   Invalidate;
387 end;
388 
389 procedure TDividerBevel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
390   WithThemeSpace: Boolean);
391 begin
392   FNeedCalcSize := True;
393   CalcSize;
394   if Orientation = trHorizontal then begin
395     PreferredHeight := Max(FTextExtent.cy, FBevelHeight);
396     PreferredWidth := 0;
397   end else begin
398     PreferredHeight := 0;
399     PreferredWidth := Max(FTextExtent.cy, FBevelHeight);
400   end;
401 end;
402 
403 procedure TDividerBevel.ShouldAutoAdjust(var AWidth,
404   AHeight: Boolean);
405 begin
406   AWidth := not (AutoSize and (Orientation = trVertical));
407   AHeight := not (AutoSize and (Orientation = trHorizontal));
408 end;
409 
410 constructor TDividerBevel.Create(AOwner: TComponent);
411 begin
412   inherited Create(AOwner);
413   FBevelStyle := bsLowered;
414   FBevelWidth := -1;
415   FCaptionSpacing := 10;
416   FLeftIndent := 60;
417   FOrientation := trHorizontal;
418   FTransparent := True;
419   FNeedCalcSize := True;
420   if (AOwner = nil) or not (csLoading in AOwner.ComponentState) then
421     Font.Style := Font.Style + [fsBold];
422   with GetControlClassDefaultSize do
423     SetInitialBounds(0, 0, CX, CY);
424   AutoSize := True;
425 end;
426 
427 end.
428 
429