View Issue Details

IDProjectCategoryView StatusLast Update
0027618LazarusLCLpublic2015-03-07 11:05
ReporterVojtech CihakAssigned ToMartin Friebe 
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Platformamd64OSLinuxOS VersionChakra 64-bit
Product Version1.5 (SVN)Product Build48141 
Target Version1.6Fixed in Version1.5 (SVN) 
Summary0027618: [Patch] Property Style for TDividerBevel
DescriptionThis patch implements property Style for TDividerBevel. Styles are same as GrabStyles of TCoolBar.
Steps To ReproduceApply patch, rebuild IDE, paste TDividerBevel on the form and change its Style property.
Additional InformationLazarus 1.5 r48141M FPC 3.1.1 x86_64-linux-qt
TagsNo tags attached.
Fixed in Revision48159
LazTarget1.6
Widgetset
Attached Files
  • divider.diff (5,660 bytes)
    Index: dividerbevel.pas
    ===================================================================
    --- dividerbevel.pas	(revision 48141)
    +++ dividerbevel.pas	(working copy)
    @@ -17,7 +17,7 @@
     
     uses
       Classes, LResources, Forms, Controls, Graphics, Dialogs, Types,
    -  LCLType, LCLIntf, LCLProc, Math, GraphType, ComCtrls, ExtCtrls;
    +  LCLType, LCLIntf, LCLProc, Math, GraphType, ComCtrls, ExtCtrls, Themes;
     
     type
       { TDividerBevel }
    @@ -29,6 +29,7 @@
         FCaptionSpacing: Integer;
         FLeftIndent: Integer;
         FOrientation: TTrackBarOrientation;
    +    FStyle: TGrabStyle;
         FTransparent: Boolean;
         procedure SetBevelStyle(AValue: TBevelStyle);
         procedure SetBevelWidth(AValue: Integer);
    @@ -35,6 +36,7 @@
         procedure SetCaptionSpacing(const AValue: Integer);
         procedure SetLeftIndent(const AValue: Integer);
         procedure SetOrientation(AValue: TTrackBarOrientation);
    +    procedure SetStyle(AValue: TGrabStyle);
         procedure SetTransparent(AValue: Boolean);
       protected
         FBevelHeight: Integer;
    @@ -79,6 +81,7 @@
         property ParentShowHint;
         property PopupMenu;
         property ShowHint;
    +    property Style: TGrabStyle read FStyle write SetStyle default gsSimple;
         property Transparent: Boolean read FTransparent write SetTransparent default True;
         property Visible;
         property OnChangeBounds;
    @@ -154,6 +157,13 @@
       Invalidate;
     end;
     
    +procedure TDividerBevel.SetStyle(AValue: TGrabStyle);
    +begin
    +  if FStyle=AValue then Exit;
    +  FStyle:=AValue;
    +  Invalidate;
    +end;
    +
     procedure TDividerBevel.SetTransparent(AValue: Boolean);
     begin
       if FTransparent = AValue then Exit;
    @@ -186,8 +196,79 @@
     var
       aBevel: TGraphicsBevelCut;
       aHorizontal: Boolean;
    +  PaintRect: TRect;
    +  aStyle: TGrabStyle;
    +
    +  procedure PaintBevel;
    +  var aDetails: TThemedElementDetails;
    +      aRect: TRect;
    +      w, l: Integer;
    +  begin
    +    case aStyle of
    +      gsSimple: Canvas.Frame3D(PaintRect, 1, aBevel);
    +      gsDouble: if aHorizontal then begin
    +          aRect.TopLeft := PaintRect.TopLeft;
    +          aRect.Right := PaintRect.Right;
    +          w := (PaintRect.Bottom - PaintRect.Top - 2) div 2;
    +          aRect.Bottom :=  aRect.Top + w;
    +          Canvas.Frame3D(aRect, 1, aBevel);
    +          aRect.Left := PaintRect.Left;
    +          aRect.Top := PaintRect.Bottom - w;
    +          aRect.BottomRight := PaintRect.BottomRight;
    +          Canvas.Frame3D(aRect, 1, aBevel);
    +        end else begin
    +          aRect.TopLeft := PaintRect.TopLeft;
    +          w := (PaintRect.Right - PaintRect.Left - 2) div 2;
    +          aRect.Right :=  aRect.Left + w;
    +          aRect.Bottom := PaintRect.Bottom;
    +          Canvas.Frame3D(aRect, 1, aBevel);
    +          aRect.Left := PaintRect.Right - w;
    +          aRect.Top := PaintRect.Top;
    +          aRect.BottomRight := PaintRect.BottomRight;
    +          Canvas.Frame3D(aRect, 1, aBevel);
    +        end;
    +      gsHorLines: begin
    +          aRect.TopLeft := PaintRect.TopLeft;
    +          aRect.Right :=  PaintRect.Right;
    +          l := (PaintRect.Bottom - aRect.Top + 1) div 3;
    +          inc(aRect.Top);
    +          Canvas.Pen.Color := clBtnShadow;
    +          for w := 0 to l - 1 do
    +            Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
    +          Canvas.Pen.Color := clBtnHighlight;
    +          inc(aRect.Top);
    +          for w := 0 to l - 1 do
    +            Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
    +        end;
    +      gsVerLines: begin
    +          aRect.TopLeft := PaintRect.TopLeft;
    +          l := (PaintRect.Right - aRect.Left + 1) div 3;
    +          aRect.Bottom :=  PaintRect.Bottom + 1;
    +          inc(aRect.Left);
    +          Canvas.Pen.Color := clBtnShadow;
    +          for w := 0 to l - 1 do
    +            Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
    +          Canvas.Pen.Color := clBtnHighlight;
    +          inc(aRect.Left);
    +          for w := 0 to l - 1 do
    +            Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
    +        end;
    +      gsGripper: begin
    +         if aHorizontal then
    +           aDetails := ThemeServices.GetElementDetails(trGripper)
    +         else
    +           aDetails := ThemeServices.GetElementDetails(trGripperVert);
    +         ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
    +        end;
    +      gsButton: begin
    +          aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal);
    +          ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
    +        end;
    +    end;
    +  end;
    +
    +var
       aIndent, aRight, j: Integer;
    -  PaintRect: TRect;
     begin
       CalcSize;
       if not FTransparent then begin
    @@ -202,6 +283,13 @@
         aBevel := bvRaised;
       aHorizontal := (Orientation = trHorizontal);
     
    +  aStyle := Style;
    +  if not aHorizontal then
    +    case aStyle of
    +      gsHorLines: aStyle := gsVerLines;
    +      gsVerLines: aStyle := gsHorLines;
    +    end;
    +
       if aHorizontal then begin
         PaintRect.Left := 0;
         PaintRect.Top := FBevelTop;
    @@ -217,7 +305,7 @@
           PaintRect.Right := Width
         else
           PaintRect.Bottom := Height;
    -    Canvas.Frame3D(PaintRect, 1, aBevel);
    +    PaintBevel;
         exit;
       end;
     
    @@ -245,7 +333,7 @@
           PaintRect.Right := aRight
         else
           PaintRect.Bottom := aRight;
    -    Canvas.Frame3D(PaintRect, 1, aBevel);
    +    PaintBevel;
       end;
     
       if aIndent > 0 then inc(aIndent, FCaptionSpacing);
    @@ -262,7 +350,7 @@
         PaintRect.Right := FBevelTop + FBevelHeight;
         PaintRect.Bottom := Height;
       end;
    -  Canvas.Frame3D(PaintRect, 1, aBevel);
    +  PaintBevel;
     
       Canvas.Brush.Style := bsClear;
       j := Max((FBevelHeight - FTextExtent.cy) div 2, 0);
    
    divider.diff (5,660 bytes)

Activities

Vojtech Cihak

2015-03-07 03:01

reporter  

divider.diff (5,660 bytes)
Index: dividerbevel.pas
===================================================================
--- dividerbevel.pas	(revision 48141)
+++ dividerbevel.pas	(working copy)
@@ -17,7 +17,7 @@
 
 uses
   Classes, LResources, Forms, Controls, Graphics, Dialogs, Types,
-  LCLType, LCLIntf, LCLProc, Math, GraphType, ComCtrls, ExtCtrls;
+  LCLType, LCLIntf, LCLProc, Math, GraphType, ComCtrls, ExtCtrls, Themes;
 
 type
   { TDividerBevel }
@@ -29,6 +29,7 @@
     FCaptionSpacing: Integer;
     FLeftIndent: Integer;
     FOrientation: TTrackBarOrientation;
+    FStyle: TGrabStyle;
     FTransparent: Boolean;
     procedure SetBevelStyle(AValue: TBevelStyle);
     procedure SetBevelWidth(AValue: Integer);
@@ -35,6 +36,7 @@
     procedure SetCaptionSpacing(const AValue: Integer);
     procedure SetLeftIndent(const AValue: Integer);
     procedure SetOrientation(AValue: TTrackBarOrientation);
+    procedure SetStyle(AValue: TGrabStyle);
     procedure SetTransparent(AValue: Boolean);
   protected
     FBevelHeight: Integer;
@@ -79,6 +81,7 @@
     property ParentShowHint;
     property PopupMenu;
     property ShowHint;
+    property Style: TGrabStyle read FStyle write SetStyle default gsSimple;
     property Transparent: Boolean read FTransparent write SetTransparent default True;
     property Visible;
     property OnChangeBounds;
@@ -154,6 +157,13 @@
   Invalidate;
 end;
 
+procedure TDividerBevel.SetStyle(AValue: TGrabStyle);
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  Invalidate;
+end;
+
 procedure TDividerBevel.SetTransparent(AValue: Boolean);
 begin
   if FTransparent = AValue then Exit;
@@ -186,8 +196,79 @@
 var
   aBevel: TGraphicsBevelCut;
   aHorizontal: Boolean;
+  PaintRect: TRect;
+  aStyle: TGrabStyle;
+
+  procedure PaintBevel;
+  var aDetails: TThemedElementDetails;
+      aRect: TRect;
+      w, l: Integer;
+  begin
+    case aStyle of
+      gsSimple: Canvas.Frame3D(PaintRect, 1, aBevel);
+      gsDouble: if aHorizontal then begin
+          aRect.TopLeft := PaintRect.TopLeft;
+          aRect.Right := PaintRect.Right;
+          w := (PaintRect.Bottom - PaintRect.Top - 2) div 2;
+          aRect.Bottom :=  aRect.Top + w;
+          Canvas.Frame3D(aRect, 1, aBevel);
+          aRect.Left := PaintRect.Left;
+          aRect.Top := PaintRect.Bottom - w;
+          aRect.BottomRight := PaintRect.BottomRight;
+          Canvas.Frame3D(aRect, 1, aBevel);
+        end else begin
+          aRect.TopLeft := PaintRect.TopLeft;
+          w := (PaintRect.Right - PaintRect.Left - 2) div 2;
+          aRect.Right :=  aRect.Left + w;
+          aRect.Bottom := PaintRect.Bottom;
+          Canvas.Frame3D(aRect, 1, aBevel);
+          aRect.Left := PaintRect.Right - w;
+          aRect.Top := PaintRect.Top;
+          aRect.BottomRight := PaintRect.BottomRight;
+          Canvas.Frame3D(aRect, 1, aBevel);
+        end;
+      gsHorLines: begin
+          aRect.TopLeft := PaintRect.TopLeft;
+          aRect.Right :=  PaintRect.Right;
+          l := (PaintRect.Bottom - aRect.Top + 1) div 3;
+          inc(aRect.Top);
+          Canvas.Pen.Color := clBtnShadow;
+          for w := 0 to l - 1 do
+            Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
+          Canvas.Pen.Color := clBtnHighlight;
+          inc(aRect.Top);
+          for w := 0 to l - 1 do
+            Canvas.Line(aRect.Left, aRect.Top + w * 3, aRect.Right, aRect.Top + w * 3);
+        end;
+      gsVerLines: begin
+          aRect.TopLeft := PaintRect.TopLeft;
+          l := (PaintRect.Right - aRect.Left + 1) div 3;
+          aRect.Bottom :=  PaintRect.Bottom + 1;
+          inc(aRect.Left);
+          Canvas.Pen.Color := clBtnShadow;
+          for w := 0 to l - 1 do
+            Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
+          Canvas.Pen.Color := clBtnHighlight;
+          inc(aRect.Left);
+          for w := 0 to l - 1 do
+            Canvas.Line(aRect.Left + w * 3, aRect.Top, aRect.Left + w * 3, aRect.Bottom);
+        end;
+      gsGripper: begin
+         if aHorizontal then
+           aDetails := ThemeServices.GetElementDetails(trGripper)
+         else
+           aDetails := ThemeServices.GetElementDetails(trGripperVert);
+         ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
+        end;
+      gsButton: begin
+          aDetails := ThemeServices.GetElementDetails(tbPushButtonNormal);
+          ThemeServices.DrawElement(Canvas.Handle, aDetails, PaintRect);
+        end;
+    end;
+  end;
+
+var
   aIndent, aRight, j: Integer;
-  PaintRect: TRect;
 begin
   CalcSize;
   if not FTransparent then begin
@@ -202,6 +283,13 @@
     aBevel := bvRaised;
   aHorizontal := (Orientation = trHorizontal);
 
+  aStyle := Style;
+  if not aHorizontal then
+    case aStyle of
+      gsHorLines: aStyle := gsVerLines;
+      gsVerLines: aStyle := gsHorLines;
+    end;
+
   if aHorizontal then begin
     PaintRect.Left := 0;
     PaintRect.Top := FBevelTop;
@@ -217,7 +305,7 @@
       PaintRect.Right := Width
     else
       PaintRect.Bottom := Height;
-    Canvas.Frame3D(PaintRect, 1, aBevel);
+    PaintBevel;
     exit;
   end;
 
@@ -245,7 +333,7 @@
       PaintRect.Right := aRight
     else
       PaintRect.Bottom := aRight;
-    Canvas.Frame3D(PaintRect, 1, aBevel);
+    PaintBevel;
   end;
 
   if aIndent > 0 then inc(aIndent, FCaptionSpacing);
@@ -262,7 +350,7 @@
     PaintRect.Right := FBevelTop + FBevelHeight;
     PaintRect.Bottom := Height;
   end;
-  Canvas.Frame3D(PaintRect, 1, aBevel);
+  PaintBevel;
 
   Canvas.Brush.Style := bsClear;
   j := Max((FBevelHeight - FTextExtent.cy) div 2, 0);
divider.diff (5,660 bytes)

Martin Friebe

2015-03-07 04:57

manager   ~0081697

Thanks, committed

please test and close if ok

Vojtech Cihak

2015-03-07 11:05

reporter   ~0081698

Tested with r.48159. Thanks.

Issue History

Date Modified Username Field Change
2015-03-07 03:01 Vojtech Cihak New Issue
2015-03-07 03:01 Vojtech Cihak File Added: divider.diff
2015-03-07 04:52 Martin Friebe Assigned To => Martin Friebe
2015-03-07 04:52 Martin Friebe Status new => assigned
2015-03-07 04:57 Martin Friebe Fixed in Revision => 48159
2015-03-07 04:57 Martin Friebe LazTarget => 1.6
2015-03-07 04:57 Martin Friebe Note Added: 0081697
2015-03-07 04:57 Martin Friebe Status assigned => resolved
2015-03-07 04:57 Martin Friebe Fixed in Version => 1.5 (SVN)
2015-03-07 04:57 Martin Friebe Resolution open => fixed
2015-03-07 04:57 Martin Friebe Target Version => 1.6
2015-03-07 11:05 Vojtech Cihak Note Added: 0081698
2015-03-07 11:05 Vojtech Cihak Status resolved => closed