improved font handling and updated demo by Luiz Americo Pereira Camara

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@529 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/gradcontrols/src/ugradbtn.pas

@@ -35,9 +35,8 @@ type
 
     TGradButton = class(TCustomControl)
     private
-       FCaption : TCaption;
        FRotateDirection : TRotateDirection;
-FTextAlignment : TTextAlignment;
+       FTextAlignment : TTextAlignment;
        FButtonLayout: TButtonLayout;
        FTextPoint, FGlyphPoint : TPoint;
        FTextSize, FGlyphSize : TSize;
@@ -65,11 +64,11 @@ FTextAlignment : TTextAlignment;
        FBaseColor, FNormalBlendColor, FOverBlendColor, FDisabledColor,
          FBackgroundColor, FGlyphBackgroundColor, FClickColor: TColor;
        procedure InvPaint(StateCheck:Boolean=false);
+       procedure FontChanged(Sender: TObject); override;
        procedure GetBackgroundRect(var TheRect : TRect);
        function GetGlyph : TBitmap;
        procedure SetEnabled(Value: Boolean); override;
        procedure SetAutoWidth(const Value : Boolean); virtual;
-       procedure SetText(const Value: TCaption); virtual;
        procedure SetNormalBlend(const Value: Extended); virtual;
        procedure SetOverBlend(const Value: Extended); virtual;
        procedure SetBaseColor(const Value: TColor);  virtual;
@@ -90,6 +89,7 @@ FTextAlignment : TTextAlignment;
        procedure SetName(const Value: TComponentName); override;
        procedure SetShowFocusBorder(const Value: Boolean); virtual;
        procedure SetGlyph(const Value: TBitmap); virtual;
+       procedure TextChanged; override;
     public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
@@ -116,6 +116,7 @@ FTextAlignment : TTextAlignment;
        property Action;
        property Anchors;
        property Align;
+       property Caption;
        property Enabled;
        property PopupMenu;
        property Font;
@@ -136,7 +137,6 @@ FTextAlignment : TTextAlignment;
        property TabStop;
        property NormalBlend : Extended read FNormalBlend write SetNormalBlend;
        property OverBlend : Extended read FOverBlend write SetOverBlend;
-       property Caption: TCaption read FCaption write SetText;
        property BaseColor: TColor read FBaseColor write SetBaseColor;
        property Color: TColor read FBaseColor write SetBaseColor;
        property NormalBlendColor: TColor read FNormalBlendColor write SetNormalBlendColor;
@@ -208,6 +208,19 @@ begin
 
     //UpdateGlyph;
 end;
+
+procedure TGradButton.TextChanged;
+begin
+  inherited TextChanged;
+  FRotatedText.Text := Caption;
+
+   if FAutoWidth then
+      UpdateButton
+   else
+      UpdatePositions;
+
+   InvPaint;
+end;
     
 procedure TGradButton.SetName(const Value: TComponentName);
 begin
@@ -950,17 +963,12 @@ begin
   end;
 end;
 
-procedure TGradButton.SetText(const Value: TCaption);
+procedure TGradButton.FontChanged(Sender: TObject);
 begin
-     FCaption:=Value;
-     FRotatedText.Text:=Value;
-     
-     if FAutoWidth then
-        UpdateButton
-     else
-        UpdatePositions;
-     
-     InvPaint;
+  inherited FontChanged(Sender);
+  FRotatedText.Canvas.Font := Font;
+  FRotatedText.Update;
+  UpdatePositions;
 end;
 
 procedure TGradButton.DoEnter;
@@ -1007,22 +1015,6 @@ begin
       
    with bm do
    begin
-   Canvas.Font.Color := Self.Font.Color;
-   Canvas.Font := Self.Font;
-
-   if FRotatedText.Canvas.Font.Color <> Self.Font.Color then
-   begin
-       FRotatedText.Canvas.Font.Color:=Self.Font.Color;
-       FRotatedText.Update;
-       UpdatePositions;
-   end;
-
-   if not FRotatedText.Canvas.Font.IsEqual(Self.Font) then
-   begin
-       FRotatedText.Canvas.Font := Self.Font;
-       FRotatedText.Update;
-       UpdatePositions;
-   end;
 
    Width := Self.Width;
    Height := Self.Height;
@@ -1044,13 +1036,9 @@ begin
      else Canvas.Draw(0,0,FDisabledBackgroundCache);
    end;
    
-   if (Caption <> '') then begin
+   if Caption <> '' then
       FRotatedText.Draw(FTextPoint.x+p, FTextPoint.y+p, bm);
-   end else if (csDesigning in ComponentState) then begin
-      FRotatedText.Text:=Name;
-      FRotatedText.Draw(FTextPoint.x+p, FTextPoint.y+p, bm);
-   end;
-   
+
    if FShowGlyph then
    begin
       if not FEnabled then

components/gradcontrols/src/ugradtabcontrol.pas

@@ -32,7 +32,7 @@ type
        procedure SetShowCloseButton(AValue: Boolean);
   protected
        procedure SetRotateDirection(const Value: TRotateDirection); override;
-       procedure SetText(const Value: TCaption); override;
+       procedure RealSetText(const Value: TCaption); override;
   public
        constructor Create(AOwner: TComponent); override;
        procedure Resize; override;
@@ -350,7 +350,7 @@ end;
 {-------------------------------------------------------------------------------
   TGradTabPageButton.SetText(const Value: TCaption)
  ------------------------------------------------------------------------------}
-procedure TGradTabPageButton.SetText(const Value: TCaption);
+procedure TGradTabPageButton.RealSetText(const Value: TCaption);
 var
    NewCaption : TCaption;
 begin
@@ -359,7 +359,7 @@ begin
    {if FShowCloseButton then
       NewCaption := NewCaption+'    ';}
 
-   inherited SetText(NewCaption);
+   inherited RealSetText(NewCaption);
 
    AlignCloseButton;
 

components/gradcontrols/src/urotatebitmap.pas

@@ -66,7 +66,7 @@ type
     private
        FBitmap : TBitmap;
        FText : String;
-       procedure SetText(Value: String);
+       procedure SetText(const Value: String);
        function GetCanvas : TCanvas;
        procedure PaintText;
     public
@@ -240,7 +240,7 @@ begin
     PaintText;
 end;
 
-procedure TRotatedText.SetText(Value: String);
+procedure TRotatedText.SetText(const Value: String);
 begin
     if FText <> Value then
     begin
@@ -261,12 +261,24 @@ var
 begin
     TextSize := FBitmap.Canvas.TextExtent(FText);
 
-    FBitmap.Width:=TextSize.cx;
-    FBitmap.Height:=TextSize.cy;
+    {$ifdef LCLWin32}
+    //win32 does not comput correct text extent when Italic style is set.
+    //small workaround to this bug
+    //not sure if other widgetsets alsoa have this bug. Enable it only for win32 for now
+    if fsItalic in FBitmap.Canvas.Font.Style then
+      Inc(TextSize.cx, 4);
+    {$endif}
+    FBitmap.SetSize(TextSize.cx, TextSize.cy);
 
-    FBitmap.Canvas.FillRect(0,0,FBitmap.Width, FBitmap.Height);
+    //check to allow Text with Fuchsia color
+    if FBitmap.Canvas.Font.Color = clFuchsia then
+      FBitmap.Canvas.Brush.Color := clWhite
+    else
+      FBitmap.Canvas.Brush.Color := clFuchsia;
 
-    FBitmap.Canvas.TextOut(0,0,FText);
+    FBitmap.Canvas.FillRect(0,0, FBitmap.Width, FBitmap.Height);
+
+    FBitmap.Canvas.TextOut(0,0, FText);
 
     Inherited LoadBitmap(FBitmap);
 end;