Smaller custom component between design & Running mode

Damien Leveugle · April 3, 2020

HI folks,

First, I'm glad to join back a delphi community. I used to code in Delphi many years ago and leave it when Borland died.

I recently downloaded RAD studio and try to rebuild the custom VCL package I built in 2006. Everything still compile very well ! Surprising...

Except one general strange behaviour :

I have coded custom checkbox, radiobuttons , ... they are derived from TCustomControl and I take care of the complete drawing of them through Paint method.

FFor the checkbox for example, i use Tcanvas.Rectangle to draw the box and I don't get the same size of box depending on the fact that i see the component in design mode or running ... very strange for me.

I have checked the PixelPerInch change of the form, but it doesn't change between the 2 modes.

Does anyone of you have an idea about this behaviour ?

Best regards

Remy Lebeau · April 3, 2020

You are going to have to show your actual painting code. The fundamentals of painting controls haven't changed over the years (certainly newer APIs - ie theming - have been added, but that is secondary). Your old painting code should still be functioning the same way it always did.

Damien Leveugle · April 3, 2020

Thanks for your answer Remy.

In fact I just realize that the running mode display the correct size (since i'm using a 3000 x 2000 resolution).

It's in the RAD IDE that the component is double sized in display.

Here's the whole checkbox code

unit DLSCheckBox;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, DLSColors, Messages, Windows, Graphics,
  Forms;

type

  TDLSCheckBoxLayout = (clCheckLeft, clCheckRight, clCheckTop, clCheckBottom);
  TDLSCheckSize = (csSmall, csNormal, csLarge);

  TDLSCheckBox = class(TCustomControl)
  private
    { Private declarations }
    FDLSColors : TDLSCheckBoxColors;
    FChecked : Boolean;
    FCheckSize : TDLSCheckSize;
    FMargin : Integer;
    FSpacing : Integer;
    FLayout : TDLSCheckBoxLayout;
    FMouseIn : Boolean;
    FPressed : Boolean;
    FIsHotTracked : Boolean;
    FButtonCheckBox : Boolean;

    FOnMouseEnter : TNotifyEvent;
    FOnMouseExit : TNotifyEvent;

    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

    function GetCheckSize : TSize;

    procedure SetButtonCheckBox(Value : Boolean);
    procedure SetChecked(Value : Boolean);
    procedure SetCheckSize(Value : TDLSCheckSize);
    procedure SetColors(Value : TDLSCheckBoxColors);
    procedure SetIsHotTracked(Value : Boolean);
    procedure SetLayout(Value : TDLSCheckBoxLayout);
    procedure SetMargin(Value : Integer);
    procedure SetSpacing(Value : Integer);
  protected
    { Protected declarations }
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure LayoutChanged;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    procedure ToggleCheck;

    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    { Public declarations }
    constructor Create(Aowner : TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property Anchors;
    property ButtonCheckBox : Boolean read FButtonCheckBox write SetButtonCheckBox;
    property Caption;
    property Checked : Boolean read FChecked write SetChecked;
    property CheckSize : TDLSCheckSize read FCheckSize write SetCheckSize;
    property Constraints;
    property Ctl3D;
    property DLSColors : TDLSCheckBoxColors read FDLSColors write SetColors;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property IsHotTracked : Boolean read FIsHotTracked write SetIsHotTracked;
    property Layout : TDLSCheckBoxLayout read FLayout write SetLayout;
    property Margin : Integer read Fmargin write SetMargin;
    property ParentFont;
    property ShowHint;
    property Spacing : Integer read FSpacing write SetSpacing;
    property TabOrder;
    property TabStop default True;
    property Visible;

    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit : TNotifyEvent read FOnMouseExit write FOnMouseExit;
    property OnMouseMove;
    property OnMouseUp;
    property PopupMenu;
    property OnStartDock;
    property OnStartDrag;
  end;


implementation

{$R ..\res\DLSCheckBox.res}

uses DLSUtils, Types;

constructor TDLSCheckBox.Create(Aowner : TComponent);
begin
  inherited;
  FDLSColors := TDLSCheckBoxColors.Create(Self);
  ControlStyle := ControlStyle + [csSetCaption, csOpaque];
  FChecked := False;
  FCheckSize := csNormal;
  FMargin := 5;
  FSpacing := 5;
  Height := 20;
  Width := 120;
  FLayout := clCheckLeft;
  FMouseIn := False;
  FPressed := False;
  FIsHotTracked := True;
  TabStop := True;
  Ctl3D := False;
end;

destructor TDLSCheckBox.Destroy;
begin
  FDLSColors.Free;
  inherited;
end;

procedure TDLSCheckBox.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  LayoutChanged;
end;

procedure TDLSCheckBox.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
  begin
    if (IsAccel(CharCode,Caption)) and (CanFocus) then
    begin
      Click;
      Result := 1;
      SetFocus;
      ToggleCheck;
    end
    else
      inherited;
  end;
end;

procedure TDLSCheckBox.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  LayoutChanged;
end;

procedure TDLSCheckBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FMouseIn := True;
    LayoutChanged;
    if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  end;
end;

procedure TDLSCheckBox.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    FMouseIn := False;
    LayoutChanged;
    if Assigned(FOnMouseExit) then FOnMouseExit(Self);
  end;
end;

procedure TDLSCheckBox.CMTextChanged(var Message: TMessage);
begin
  inherited;
  LayoutChanged;
end;

procedure TDLSCheckBox.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then ToggleCheck;
end;

function TDLSCheckBox.GetCheckSize : TSize;
begin
  case FCheckSize of
    csSmall : Result.cx := 10;
    csNormal : Result.cx := 12;
    csLarge : Result.cx := 14;
    else Result.cx := 12
  end;
  Result.cy := Result.cx;
end;

procedure TDLSCheckBox.SetButtonCheckBox(Value : Boolean);
begin
  if Value <> FButtonCheckBox then
  begin
    FButtonCheckBox := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.SetChecked(Value : Boolean);
begin
  if Value <> FChecked then
  begin
    FChecked := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.SetCheckSize(Value : TDLSCheckSize);
begin
  if Value <> FCheckSize then
  begin
    FCheckSize := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.SetColors(Value : TDLSCheckBoxColors);
begin
  FDLSColors.Assign(Value);
end;

procedure TDLSCheckBox.SetIsHotTracked(Value : Boolean);
begin
  if Value <> FIsHotTracked then
  begin
    FIsHotTracked := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_SPACE) or (Key = VK_RETURN) then ToggleCheck;
  inherited;
end;

procedure TDLSCheckBox.LayoutChanged;
begin
  Invalidate;
end;

procedure TDLSCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  inherited;
  FPressed := True;
  SetFocus;
  LayoutChanged;
end;

procedure TDLSCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  inherited;
  FPressed := False;
  ToggleCheck;
end;

procedure TDLSCheckBox.Paint;
var
  CheckBitmap : TBitmap;
  R : TRect;

begin
  CheckBitmap := TBitmap.Create;
  try
    CheckBitmap.Height := Height;
    CheckBitmap.Width := Width;
    R := Rect(0, 0, Width, Height);
    CheckBitmap.Canvas.Font := Self.Font;
    CheckBitmap.Canvas.Brush.Color := FDLSColors.BackGround;
    CheckBitmap.Canvas.Pen.Color := FDLSColors.BackGround;
    CheckBitmap.Canvas.Rectangle(ClientRect);

    //CheckBitmap.PixelFormat :=  pfDevice ;

    DLS_DrawCheckBox( CheckBitmap.Canvas,
                      DLSColors.CheckBoxColorMap,
                      R,
                      Point(0,0),
                      GetCheckSize,
                      Caption,
                      Layout,
                      Margin, Spacing,
                      Checked,
                      FPressed,
                      Focused,
                      FMouseIn,
                      FIsHotTracked,
                      Enabled,
                      Ctl3D,
                      FButtonCheckBox,
                      0);

    BitBlt( Canvas.Handle, 0, 0, Width, Height,
        CheckBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    CheckBitmap.Free;
  end;
end;

procedure TDLSCheckBox.ToggleCheck;
begin
  Checked := not Checked;
end;


procedure TDLSCheckBox.SetLayout(Value : TDLSCheckBoxLayout);
begin
  if Value <> FLayout then
  begin
    FLayout := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.SetMargin(Value : Integer);
begin
  if Value <> FMargin then
  begin
    FMargin := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.SetSpacing(Value : Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    LayoutChanged;
  end;
end;

procedure TDLSCheckBox.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTCHARS;
end;

procedure TDLSCheckBox.WMKillFocus(var Message: TWMSetFocus);
begin
  inherited;
  LayoutChanged;
end;

procedure TDLSCheckBox.WMSetFocus(var Message: TWMSetFocus); 
begin
  inherited;
  LayoutChanged;
end;

procedure TDLSCheckBox.WMSize(var Message: TWMSize);
begin
  inherited;
  LayoutChanged;
end;
  
end.

unit DLSUtils;

interface

uses Windows, Graphics, Types, Math, SysUtils, Controls, DLSButtons, DLSColors,
  DLSCheckBox, DLSRadioButton, Dialogs, Classes;

type
  TDLSTriangleDirection = (tdUp, tdDown, tdLeft, tdRight);
  TDLSTriangleEffect = (teNormal, teShadowed, teHighlighted);
  TDLSObjectLayout = (olObjectLeft, olObjectRight, olObjectTop, olObjectBottom);

procedure DLS_DrawTriangle(const ACanvas : TCanvas; ARect : TRect; AColor : TColor;
  Direction : TDLSTriangleDirection; ForceSquare : Boolean; Effect : TDLSTriangleEffect = teNormal);
procedure DLS_ShortenString(const Canvas : TCanvas; ARect : TRect; InitString : String;
  var ShortenString : String);
procedure DLS_RotateRect(var rect : TRect);
function DLS_GetShadowColor (Color : TColor) : TColor;
function DLS_GetHighLightColor(Color : TColor) : TColor;
function DLS_BlendColors (Color1, Color2: TColor): TColor;
function DLS_BlackOrWhite(Color : TColor) : TColor;
function DLS_InvertColor(Color : TColor) : TColor;

procedure DLS_DrawLine(
            const ACanvas : TCanvas;
            const P : TPoint;
            const Ctl3D : Boolean;
            ColorState : TDLSColorLineState;
            ColorMap : TDLSLineColorsMap); overload;

procedure DLS_DrawLine(
            const ACanvas : TCanvas;
            StartPoint, EndPoint : TPoint;
            const Ctl3D : Boolean;
            LightColor, DarkColor, BorderColor: TColor); overload;

procedure DLS_DrawText(
            const ACanvas : TCanvas;
            TextBounds : TRect;
            const Ctl3D : Boolean;
            LightColor, DarkColor, FaceColor: TColor);
            
procedure DLS_DrawRectangle(
            const ACanvas : TCanvas;                // canvas where to draw the gradient
            const R : TRect;                        // Rectangle to draw
            const Ctl3D : Boolean;                  // 3d rectangle
            const WithGradient : Boolean;           // Filled with gradient ?
            FaceColor,                              // Colors
            GradColor,
            LightColor,
            DarkColor,
            BorderColor: TColor);

procedure DLS_GradientFillRect(
            const ACanvas: TCanvas;                 // canvas where to draw the gradient
            Rect: TRect;                            // rectangle to fill
            StartColor,                             // Start color for the gradient (top)
            EndColor: TColor);                      // End color for the gradient (bottom)

procedure DLS_CalcButtonLayout(
            const ACanvas: TCanvas;                 // canvas where to draw the button
            const Client: TRect;                    // rectangle limit of the button
            const Offset: TPoint;
            const Caption: string;                  // button text
            const FGlyph : TBitmap;                 // button glyph
            Layout: TDLSButtonLayout;               // where to place the glyph vs text
            Margin, Spacing: Integer;
            var GlyphPos: TPoint;                   // Calculated position of the glyph
            var TextBounds: TRect;                  // Calculated position of the text
            BiDiFlags: LongInt);

procedure DLS_DrawButton(
            const ACanvas : TCanvas;                // canvas where to draw the button
            const ColorMap : TDLSButtonColorsMap;   // colors to use
            R : TRect;                              // rectangle limit of the button
            Offset: TPoint;
            const FGlyph : TBitmap;                 // button glyph
            const Caption : String;                 // button text
            Layout: TDLSButtonLayout;               // where to place the glyph vs text
            Margin, Spacing: Integer;
            IsDown,                                 // is the button down ?
            IsFocused,                              // is the button focused ?
            IsMouseIn,                              // is the mouse in ?
            IsHotTracked,                           // is the button hot tracked
            Enabled : Boolean;                      // Is the button enabled
            State : TDLSButtonState;                // State of the button
            Ctl3D : Boolean;                        // 3-D button
            Flags : Longint); overload;

procedure DLS_DrawButton(
            const ACanvas : TCanvas;
            FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, FocusColor: TColor;
            WithGradient : Boolean;
            R : TRect;
            Offset: TPoint;
            const FGlyph : TBitmap;
            const Caption : String;
            Layout: TDLSButtonLayout;
            Margin, Spacing: Integer;
            IsDown, IsFocused : Boolean;
            State : TDLSButtonState;
            Ctl3D : Boolean;
            Flags : Longint); overload;

procedure DLS_DrawButtonGlyph(
            const ACanvas: TCanvas;                 // canvas where to draw the button text
            const FGlyph : TBitmap;                 // glyph to draw
            const GlyphPos: TPoint);                // glyph position

procedure DLS_DrawButtonText(
            const ACanvas: TCanvas;                 // canvas where to draw the button text
            const Caption: string;                  // button text
            TextBounds: TRect;                      // rectangle limits for the text
            State: TDLSButtonState;                 // State of the button
            BiDiFlags: LongInt);

procedure DLS_CalcObjectTextLayout(
            const ACanvas: TCanvas;                 // canvas where to draw
            const Client: TRect;                    // rectangle limit for calculatio
            const Offset: TPoint;
            const Caption: string;                  // text
            const ObjectSize : TSize;               // object size
            Layout: TDLSObjectLayout;               // where to place the glyph vs text
            Margin, Spacing: Integer;
            var ObjectPos: TPoint;                  // Calculated position of the glyph
            var TextBounds: TRect;                  // Calculated position of the text
            BiDiFlags: LongInt);

procedure DLS_DrawCheckBox(
            const ACanvas : TCanvas;                // canvas where to draw the checkbox
            const ColorMap : TDLSCheckBoxColorMap;  // colors to use
            R : TRect;                              // rectangle limit of the checkbox
            const Offset: TPoint;                   // offset
            const CheckSize : TSize;
            const Caption : String;                 // Checkbox text
            Layout: TDLSCheckBoxLayout;               // where to place the check vs text
            Margin, Spacing: Integer;
            Checked,                                // Is the box checked ?
            IsDown,                                 // is the check down ?
            IsFocused,                              // is the check focused ?
            IsMouseIn,                              // is the mouse in ?
            IsHotTracked,                           // is the check hot tracked
            Enabled,                                // Is the check enabled
            Ctl3D,                                  // 3-D button
            ButtonCheckBox : Boolean;               // Is it a button checkbox
            Flags : Longint); overload;

procedure DLS_DrawCheckBox(
            const ACanvas : TCanvas;
            FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, TextBackgroundColor,
              FocusColor: TColor;
            WithGradient : Boolean;
            R : TRect;
            const Offset: TPoint;
            const CheckSize : TSize;
            const Caption : String;
            Layout: TDLSCheckBoxLayout;
            Margin, Spacing: Integer;
            Checked,
            IsFocused,
            IsMouseIn,
            IsHotTracked,
            Ctl3D,
            ButtonCheckBox : Boolean;
            Flags : Longint); overload;
                        
procedure DLS_DrawCheckMark(
            const ACanvas : TCanvas;                // canvas where to draw the check mark
            CheckRect : TRect);                     // rectangle limit of the check mark

procedure DLS_DrawRadioButton(
            const ACanvas : TCanvas;                // canvas where to draw the radio button
            const ColorMap : TDLSRadioButtonColorMap;  // colors to use
            R : TRect;                              // rectangle limit of the radio button
            const Offset: TPoint;                   // offset
            const RadioSize : TSize;
            const Caption : String;                 // radio button text
            Layout: TDLSRadioButtonLayout;               // where to place the check vs text
            Margin, Spacing: Integer;
            Checked,                                // Is the radio button checked ?
            IsDown,                                 // is the radio button down ?
            IsFocused,                              // is the radio button focused ?
            IsMouseIn,                              // is the mouse in ?
            IsHotTracked,                           // is the radio button hot tracked
            Enabled,                                // Is the radio button enabled
            Ctl3D,                                  // 3-D radio button
            ButtonRadioButton : Boolean;               // Is it a button radio button
            Flags : Longint);

procedure DLS_DrawRadioMark(
            const ACanvas : TCanvas;                // canvas where to draw the radio mark
            RadioRect : TRect);                     // rectangle limit of the radio mark

procedure DLS_DrawEllipse(
            const ACanvas : TCanvas;                // canvas where to draw the gradient
            const R : TRect;                        // Rectangle to draw
            const Ctl3D : Boolean;                  // 3d rectangle
            const WithGradient : Boolean;           // Filled with gradient ?
            FaceColor,                              // Colors
            GradColor,
            LightColor,
            DarkColor,
            BorderColor: TColor );            


{*******************************************************************************
                    CONVERSION ROUTINES
*******************************************************************************}

// Is value an integer ?
function DLS_IsInteger(Value : String) : Boolean; overload;
// Is value an integer and what is this value => IntegerValue
function DLS_IsInteger(Value : String; var IntegerValue : Integer) : Boolean; overload;
// Is value a double ?
function DLS_IsFloat(Value : String) : Boolean; overload;
// Is value a double and what is this value => FloatValue
function DLS_IsFloat(Value : String; var FloatValue : Double) : Boolean; overload;
// String to date conversion
function DLS_StrToDate(Value : String) : TDate; overload;
// String to date conversion with format
function DLS_StrToDate(Value : String; Format : String) : TDate; overload;
// Is string value a date ?
function DLS_StrIsDate(Value : String) : Boolean; overload;
// Is string value a date considering the given format ?
function DLS_StrIsDate(Value : String; Format : String) : Boolean; overload;
// Is string value a date considering the given format and what is the value?
function DLS_StrIsDate(Value : String; Format : String; var DateValue : TDate) : Boolean; overload;
// Is string value a date and what is the value?
function DLS_StrIsDate(Value : String; var DateValue : TDate) : Boolean; overload;
// Date to string conversion
function DLS_DateToStr(Value : TDate) : String; overload;
// Date to string conversion with given format
function DLS_DateToStr(Value : TDate; Format : String) : String; overload;


implementation

procedure DLS_DrawTriangle(const ACanvas : TCanvas; ARect : TRect; AColor : TColor;
  Direction : TDLSTriangleDirection; ForceSquare : Boolean; Effect : TDLSTriangleEffect = teNormal);
var
  i, nStep : Integer;
  BaseX, BaseY : Integer;
  OldPenColor, OldBrushColor : TColor;
  WithEffect : Boolean;
  MinDim : Integer;
  TP, EffectTP : array[0..2] of TPoint;    // Points of the triangle passed to Polygon function
begin
  // saving current canvas colors
  OldPenColor := ACanvas.Pen.Color;
  OldBrushColor := ACanvas.Brush.Color;
  WithEffect := Effect <> teNormal;

  try
    if WithEffect then
    begin
      Dec(ARect.Right);
      Dec(ARect.Bottom);
    end;
    if ForceSquare then
    begin
      MinDim := Min((ARect.Right - ARect.Left), (ARect.Bottom - ARect.Top)) + 1;
      ARect.Left := ARect.Left + ((ARect.Right - ARect.Left - MinDim) div 2);
      ARect.Right := ARect.Left + MinDim - 1;
      ARect.Top := ARect.Top + ((ARect.Bottom - ARect.Top - MinDim) div 2);
      ARect.Bottom := ARect.Top + MinDim - 1;
    end;
    if (ARect.Right - ARect.Left) MOD 2 = 1 then Dec(ARect.Right);
    case Direction of
      tdUp :
        begin
          TP[0] := Point(ARect.Left, ARect.Bottom);
          TP[1] := Point((ARect.Right + ARect.Left) div 2 , ARect.Top);
          TP[2] := Point(ARect.Right, ARect.Bottom);
        end;
      tdDown :
        begin
          TP[0] := Point(ARect.Left, ARect.Top);
          TP[1] := Point(ARect.Right, ARect.Top);
          TP[2] := Point((ARect.Right + ARect.Left)div 2 , ARect.Bottom);
        end;
    end;

    if WithEffect then
    begin
      EffectTP[0] := Point(TP[0].X + 1, TP[0].Y + 1);
      EffectTP[1] := Point(TP[1].X + 1, TP[1].Y + 1);
      EffectTP[2] := Point(TP[2].X + 1, TP[2].Y + 1);
      case Effect of
        teShadowed :
        begin
          with ACanvas do
          begin
            Pen.Color := DLS_GetShadowColor(AColor);
            Brush.Color := DLS_GetShadowColor(AColor);
            Polygon(EffectTP);
          end;
        end;
        teHighlighted :
        begin
          with ACanvas do
          begin
            Pen.Color := DLS_GetHighLightColor(AColor);
            Brush.Color := DLS_GetHighLightColor(AColor);
            Polygon(EffectTP);
          end;
        end;
      end;
    end;

    with ACanvas do
    begin
      Pen.Color := AColor;
      Brush.Color := AColor;
      Polygon(TP);
    end;
  finally
    ACanvas.Pen.Color := OldPenColor;
    ACanvas.Brush.Color := OldBrushColor;
  end;
end;

procedure DLS_RotateRect(var rect : TRect);
var
  temp : Integer;
begin
	temp := rect.left;
	rect.left := rect.top;
	rect.top := temp;

	temp := rect.right;
	rect.right := rect.bottom;
	rect.bottom := temp;
end;

function DLS_GetShadowColor(Color : TColor) : TColor;
begin
  Result := DLS_BlendColors (Color, clBlack);
end;

function DLS_GetHighLightColor(Color : TColor) : TColor;
begin
  Result := DLS_BlendColors (Color, clWhite);
end;




type TRGB = packed record
  R, G, B, X: byte;
end;

function DLS_BlendColors (Color1, Color2: TColor): TColor;
var
  RGB1: TRGB;
  RGB2: TRGB;
begin
  Result := 0;
  RGB1 := TRGB(ColorToRGB (Color1));
  RGB2 := TRGB(ColorToRGB (COlor2));
  with TRGB(Result) do
  begin
    R := RGB1.R div 2 + RGB2.R div 2;
    G := RGB1.G div 2 + RGB2.G div 2;
    B := RGB1.B div 2 + RGB2.B div 2;
  end
end;

function DLS_InvertColor(Color : TColor) : TColor;
begin
  Result := TColor(Integer(Color) xor $FFFFFF);
end;

function DLS_BlackOrWhite(Color : TColor) : TColor;
var
  TCR : TColorRef;
begin
  TCR := ColorToRGB(Color);
  if (GetRValue(TCR) + GetGValue(TCR) + GetBValue(TCR)) > ((3*255) div 2) then
   Result := clBlack
  else
   Result := clWhite;
end;


procedure DLS_ShortenString(const Canvas : TCanvas; ARect : TRect; InitString : String;
  var ShortenString : String);
const
  SH_CUT = '...';
var
  LoopWidth : Integer;
begin
  // Initialization
  ShortenString := InitString;
  LoopWidth := Canvas.TextWidth(ShortenString);

  while (LoopWidth > (ARect.Right - ARect.Left - 2)) and (Length(ShortenString) > 0) do
  begin
    ShortenString := Copy(ShortenString, 1, length(ShortenString) - 1);
    LoopWidth := Canvas.TextWidth(ShortenString + SH_CUT);
  end;
  if ShortenString <> InitString then
    ShortenString := ShortenString + SH_CUT;
end;


function DLS_IsInteger(Value : String) : Boolean;
var
  IntValue : Integer;
begin
  Result := DLS_IsInteger(Value, IntValue);
end;

function DLS_IsInteger(Value : String; var IntegerValue : Integer) : Boolean;
begin
  try
    IntegerValue := StrToInt(Value);
    Result := True;
  except
    IntegerValue := 0;
    Result := False;
  end;
end;

function DLS_IsFloat(Value : String) : Boolean;
var
  FloatValue : Double;
begin
  Result := DLS_IsFloat(Value, FloatValue);
end;

function DLS_IsFloat(Value : String; var FloatValue : Double) : Boolean;
begin
  try
    FloatValue := StrToFloat(Value);
    Result := True;
  except
    FloatValue := 0;
    Result := False;
  end;
end;

// Is string value a date ?
function DLS_StrIsDate(Value : String) : Boolean;
var
  fs : TFormatSettings;
begin
  GetLocaleFormatSettings(GetUserDefaultLCID, fs);
  Result := DLS_StrIsDate(Value, fs.ShortDateFormat);
end;

// Is string value a date considering the given format ?
function DLS_StrIsDate(Value : String; Format : String) : Boolean;
var
  DateValue : TDate;
begin
  Result := DLS_StrIsDate(Value, Format, DateValue);
end;

// Is string value a date and what is the value?
function DLS_StrIsDate(Value : String; var DateValue : TDate) : Boolean;
var
  fs : TFormatSettings;
begin
  GetLocaleFormatSettings(GetUserDefaultLCID, fs);
  Result := DLS_StrIsDate(Value, fs.ShortDateFormat, DateValue);
end;

// Is string value a date considering the given format and what is the value?
function DLS_StrIsDate(Value : String; Format : String; var DateValue : TDate) : Boolean;
begin
  try
    DateValue := DLS_StrToDate(Value, Format);
    Result := True;
  except
    DateValue := 0;
    Result := False;    
  end;
end;

// String to date conversion
function DLS_StrToDate(Value : String) : TDate; overload;
begin
  Result := StrToDate(Value);
end;

// String to date conversion with format
function DLS_StrToDate(Value : String; Format : String) : TDate; overload;
var
  fs : TFormatSettings;
begin
  if Format <> '' then
  begin
    GetLocaleFormatSettings(GetUserDefaultLCID, fs);
    fs.ShortDateFormat := Format;
    fs.TwoDigitYearCenturyWindow := 0;
    Result := StrToDate(Value, fs);
  end
  else
    Result := DLS_StrToDate(Value);
end;

// Date to string conversion
function DLS_DateToStr(Value : TDate) : String;
begin
  Result := DateToStr(Value);
end;
// Date to string conversion with given format
function DLS_DateToStr(Value : TDate; Format : String) : String;
var
  fs : TFormatSettings;
begin
  if Format <> '' then
  begin
    GetLocaleFormatSettings(GetThreadLocale, fs);
    fs.ShortDateFormat := Format;
    Result := DateToStr(Value, fs);
  end
  else
    Result := DLS_DateToStr(Value);
end;

procedure DLS_GradientFillRect(const ACanvas: TCanvas; Rect: TRect;
                StartColor, EndColor: TColor);
var
  Steps: Integer;
  StartR, StartG, StartB, EndR, EndG, EndB: Byte;
  CrrR, CrrG, CrrB: Double;
  IncR, IncG, incB: Double;
  i: integer;
begin
  Steps:= Rect.Bottom - Rect.Top;

  StartR:= GetRValue(StartColor);  EndR:= GetRValue(EndColor);
  StartG:= GetGValue(StartColor);  EndG:= GetGValue(EndColor);
  StartB:= GetBValue(StartColor);  EndB:= GetBValue(EndColor);

  IncR:= (EndR - StartR) / steps;
  IncG:= (EndG - StartG) / steps;
  IncB:= (EndB - StartB) / steps;

  CrrR:= StartR;
  CrrG:= StartG;
  CrrB:= StartB;

  for i:= Rect.Top to Rect.Bottom - 1 do begin
    ACanvas.Pen.Color:= RGB(Round(CrrR), Round(CrrG), Round(CrrB));
    ACanvas.MoveTo(Rect.Left, i);
    ACanvas.LineTo(Rect.Right , i);
    CrrR:= CrrR + IncR;
    CrrG:= CrrG + IncG;
    CrrB:= CrrB + IncB;
  end;
end;

procedure DLS_GradientFillEllipse(const ACanvas: TCanvas; Rect: TRect;
                StartColor, EndColor: TColor);
var
  TmpBitmap : TBitmap;
  Rgn : HRGN;
begin
  TmpBitmap := TBitmap.Create;
  try
    TmpBitmap.Width := Rect.Right - Rect.Left;
    TmpBitmap.Height := Rect.Bottom - Rect.Top;
    DLS_GradientFillRect(TmpBitmap.Canvas, Classes.Rect(0,0,TmpBitmap.Width,TmpBitmap.Height),
      StartColor, EndColor);
    Rgn := CreateEllipticRgn(0,0,TmpBitmap.Width + 1,TmpBitmap.Height + 1);
    OffsetRgn(Rgn, Rect.Left, Rect.Top);
    SelectClipRgn(ACanvas.Handle, Rgn);
    ACanvas.CopyRect(Rect, TmpBitmap.Canvas, Classes.Rect(0,0,TmpBitmap.Width,TmpBitmap.Height));
  finally
    SelectClipRgn(ACanvas.Handle, 0);
    DeleteObject(Rgn);
    TmpBitmap.Free;
  end;
end;

procedure DLS_CalcButtonLayout(const ACanvas: TCanvas; const Client: TRect;
  const Offset: TPoint; const Caption: string; const FGlyph : TBitmap; Layout: TDLSButtonLayout; Margin,
  Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
  BiDiFlags: LongInt);
var
  ObjectSize : TSize;
begin
  if Assigned(FGlyph) then
  begin
    ObjectSize.cx := FGlyph.Width;
    ObjectSize.cy := FGlyph.Height;
  end
  else
  begin
    ObjectSize.cx := 0;
    ObjectSize.cy := 0;
  end;
  DLS_CalcObjectTextLayout( ACanvas, Client, Offset, Caption,
     ObjectSize, TDLSObjectLayout(Layout), Margin, Spacing, GlyphPos,
     TextBounds, BiDiFlags);
end;

procedure DLS_DrawButton(
            const ACanvas : TCanvas;
            FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, FocusColor: TColor;
            WithGradient : Boolean;
            R : TRect;
            Offset: TPoint;
            const FGlyph : TBitmap;
            const Caption : String;
            Layout: TDLSButtonLayout;
            Margin, Spacing: Integer;
            IsDown, IsFocused : Boolean;
            State : TDLSButtonState;
            Ctl3D : Boolean;
            Flags : Longint);
var
  GlyphPos : TPoint;
  TextBounds : TRect;
  ColorState : TDLSColorButtonState;
begin

  DLS_CalcButtonLayout(ACanvas, R, Offset, Caption, FGlyph, Layout, Margin, Spacing,
    GlyphPos, TextBounds, Flags);

  DLS_DrawRectangle(ACanvas,
                    R,
                    Ctl3D,
                    WithGradient,
                    FaceColor,
                    GradColor,
                    LightColor,
                    DarkColor,
                    BorderColor);


  ACanvas.Font.Color := TextColor;

  if IsDown then
  begin
    Inc(GlyphPos.X, 1);
    Inc(GlyphPos.Y, 1);
  end;
  if Assigned(FGlyph) then DLS_DrawButtonGlyph(ACanvas, FGlyph, GlyphPos);

  if IsDown then OffsetRect(TextBounds, 1, 1);
  DLS_DrawButtonText(ACanvas, Caption, TextBounds, State, Flags);

  if IsFocused then
  begin
    ACanvas.Pen.Color:= FocusColor;
    ACanvas.Brush.Style:= bsClear;
    InflateRect(R, -4, -4);
    ACanvas.Rectangle(R);
  end;
end;

procedure DLS_DrawButton(
            const ACanvas : TCanvas;
            const ColorMap : TDLSButtonColorsMap;
            R : TRect;
            Offset: TPoint;
            const FGlyph : TBitmap;
            const Caption : String;
            Layout: TDLSButtonLayout;
            Margin, Spacing: Integer;
            IsDown,
            IsFocused,
            IsMouseIn,
            IsHotTracked,
            Enabled : Boolean;
            State : TDLSButtonState;
            Ctl3D : Boolean;                        
            Flags : Longint);
var
  GlyphPos : TPoint;
  TextBounds : TRect;
  FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor,FocusColor: TColor;
  ColorState : TDLSColorButtonState;
begin
  if IsDown then
    ColorState := cbsDown
  else if IsHotTracked then
    ColorState := cbsHotTracked
  else if IsMouseIn then
    ColorState := cbsOver
  else
    ColorState := cbsStandard;
  if not Enabled then ColorState := cbsDisabled;

  with ColorMap do
  begin
    FaceColor:= Colors[ColorState, cbpFace];
    GradColor:= Colors[ColorState, cbpGradient];
    LightColor:= Colors[ColorState, cbpLight];
    DarkColor:= Colors[ColorState, cbpDark];
    BorderColor:= Colors[ColorState, cbpBorder];
    TextColor:= Colors[ColorState, cbpText];
  end;
  FocusColor := ColorMap.FocusColor;
  DLS_DrawButton( ACanvas,
                  FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, FocusColor,
                  ColorMap.WithGradient,
                  R,
                  Offset,
                  FGlyph,
                  Caption,
                  Layout,
                  Margin, Spacing,
                  IsDown, IsFocused,
                  State,
                  Ctl3D,
                  Flags);

end;

procedure DLS_DrawButtonGlyph(const ACanvas: TCanvas; const FGlyph : TBitmap; const GlyphPos: TPoint);
begin
  FGlyph.TransparentMode := tmAuto;
  FGlyph.Transparent := True;
  ACanvas.Draw(GlyphPos.X, GlyphPos.Y, FGlyph);
end;

procedure DLS_DrawButtonText(const ACanvas: TCanvas; const Caption: string;
  TextBounds: TRect; State: TDLSButtonState; BiDiFlags: LongInt);
begin
  with ACanvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE or BiDiFlags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE or BiDiFlags);
    end else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE or BiDiFlags);
  end;
end;

procedure DLS_DrawRectangle(
            const ACanvas : TCanvas;                // canvas where to draw the gradient
            const R : TRect;                        // Rectangle to draw
            const Ctl3D : Boolean;                  // 3d rectangle
            const WithGradient : Boolean;           // Filled with gradient ?
            FaceColor,                              // Colors
            GradColor,
            LightColor,
            DarkColor,
            BorderColor: TColor );
begin
  with ACanvas do
  begin
    Brush.Color:= FaceColor;
    Brush.Style:= bsSolid;
    Rectangle(R);
  end;
  if WithGradient then DLS_GradientFillRect(ACanvas, R, FaceColor, GradColor);

  with ACanvas do
  begin
    Pen.Style:= psSolid;
    Brush.Color:= FaceColor;
    Pen.Color:= BorderColor;
    Brush.Style:= bsClear;
    Rectangle(R);

    if Ctl3D then
    begin
      Pen.Color:= LightColor;
      MoveTo(R.Left + 1, R.Bottom - 2);
      LineTo(R.Left + 1, R.Top + 1);
      LineTo(R.Right -1 , R.Top + 1);

      Pen.Color:= DarkColor;
      MoveTo(R.Right - 2, R.Top + 1);
      LineTo(R.Right - 2, R.Bottom - 2);
      LineTo(R.Left + 1, R.Bottom - 2);
    end;
  end;
end;

procedure DLS_DrawLine(
            const ACanvas : TCanvas;
            const P : TPoint;
            const Ctl3D : Boolean;
            ColorState : TDLSColorLineState;
            ColorMap : TDLSLineColorsMap);
var
  FaceColor, LightColor, DarkColor, BorderColor: TColor;
begin
  with ColorMap do
  begin
    FaceColor:= Colors[ColorState, clpFace];
    LightColor:= Colors[ColorState, clpLight];
    DarkColor:= Colors[ColorState, clpDark];
    BorderColor:= Colors[ColorState, clpBorder];
  end;

  with ACanvas do
  begin
    Brush.Color:= FaceColor;
    Brush.Style:= bsSolid;
    Polygon([PenPos,P]);
  end;

  with ACanvas do
  begin
    Pen.Style:= psSolid;
    Brush.Color:= FaceColor;
    Pen.Color:= BorderColor;
    Brush.Style:= bsClear;
    Polygon([PenPos,P]);

    {if Ctl3D then
    begin
      Pen.Color:= LightColor;
      MoveTo(R.Left + 1, R.Bottom - 2);
      LineTo(R.Left + 1, R.Top + 1);
      LineTo(R.Right -1 , R.Top + 1);

      Pen.Color:= DarkColor;
      MoveTo(R.Right - 2, R.Top + 1);
      LineTo(R.Right - 2, R.Bottom - 2);
      LineTo(R.Left + 1, R.Bottom - 2);
    end;}
  end;
end;

procedure DLS_DrawLine(
            const ACanvas : TCanvas;
            StartPoint, EndPoint : TPoint;
            const Ctl3D : Boolean;
            LightColor, DarkColor, BorderColor: TColor);
var
  B,E : TPoint;
begin
  B := StartPoint;
  E := EndPoint;
  with ACanvas do
  begin
    if Ctl3D then
    begin
      Pen.Color:= LightColor;
      B.X := StartPoint.X - 1; B.Y := StartPoint.Y - 1;
      E.X := EndPoint.X - 1; E.Y := EndPoint.Y - 1;
      MoveTo(B.X, B.Y);
      LineTo(E.X, E.Y);

      B.X := StartPoint.X + 1; B.Y := StartPoint.Y + 1;
      E.X := EndPoint.X + 1; E.Y := EndPoint.Y + 1;
      Pen.Color:= BorderColor;
      MoveTo(B.X, B.Y);
      LineTo(E.X, E.Y);
    end;
    Pen.Color:= DarkColor;
    MoveTo(StartPoint.X, StartPoint.Y);
    LineTo(EndPoint.X, EndPoint.Y);
  end;
end;

procedure DLS_CalcObjectTextLayout(
            const ACanvas: TCanvas;
            const Client: TRect;
            const Offset: TPoint;
            const Caption: string;
            const ObjectSize : TSize;
            Layout: TDLSObjectLayout;
            Margin, Spacing: Integer;
            var ObjectPos: TPoint;
            var TextBounds: TRect;
            BiDiFlags: LongInt);
var
  TextPos: TPoint;
  ClientSize,  TextSize: TPoint;
  TotalSize: TPoint;
begin
  if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
    if Layout = olObjectLeft then Layout := olObjectRight
    else
      if Layout = olObjectRight then Layout := olObjectLeft;
  { calculate the item sizes }
  ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
    Client.Top);

  // Calculate text bounds
  if Length(Caption) > 0 then
  begin
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    DrawText(ACanvas.Handle, PChar(Caption), Length(Caption), TextBounds,
      DT_CALCRECT or BiDiFlags);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
      TextBounds.Top);
  end
  else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  { If the layout has the object on the right or the left, then both the
    text and the object are centered vertically.  If the object is on the top
    or the bottom, then both the text and the object are centered horizontally.}
  if Layout in [olObjectLeft, olObjectRight] then
  begin
    ObjectPos.Y := (ClientSize.Y - ObjectSize.cy + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    ObjectPos.X := (ClientSize.X - ObjectSize.cx + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;

  { if there is no text or no bitmap, then Spacing is irrelevant }
  if (TextSize.X = 0) or (ObjectSize.cx = 0) then
    Spacing := 0;

  { adjust Margin and Spacing }
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ObjectSize.cx + TextSize.X, ObjectSize.cy + TextSize.Y);
      if Layout in [olObjectLeft, olObjectRight] then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else
    begin
      TotalSize := Point(ObjectSize.cx + Spacing + TextSize.X, ObjectSize.cy +
        Spacing + TextSize.Y);
      if Layout in [olObjectLeft, olObjectRight] then
          Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ClientSize.X - (Margin + ObjectSize.cx), ClientSize.Y -
        (Margin + ObjectSize.cy));
      if Layout in [olObjectLeft, olObjectRight] then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    olObjectLeft:
      begin
        ObjectPos.X := Margin;
        TextPos.X := ObjectPos.X + ObjectSize.cx + Spacing;
      end;
    olObjectRight:
      begin
        ObjectPos.X := ClientSize.X - Margin - ObjectSize.cx;
        TextPos.X := ObjectPos.X - Spacing - TextSize.X;
      end;
    olObjectTop:
      begin
        ObjectPos.Y := Margin;
        if ObjectSize.cy = 0 then
          TextPos.Y := (ClientSize.Y div 2) - (TextSize.Y div 2) 
        else
          TextPos.Y := ObjectPos.Y + ObjectSize.cy + Spacing;
      end;
    olObjectBottom:
      begin
        ObjectPos.Y := ClientSize.Y - Margin - ObjectSize.cy;
        if ObjectSize.cy = 0 then
          TextPos.Y := (ClientSize.Y div 2) - (TextSize.Y div 2) 
        else
          TextPos.Y := ObjectPos.Y - Spacing - TextSize.Y;
      end;
  end;

  { fixup the result variables }
    Inc(ObjectPos.X, Client.Left + Offset.X);
    Inc(ObjectPos.Y, Client.Top + Offset.Y);
  OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X,
    TextPos.Y + Client.Top + Offset.X);
end;

procedure DLS_DrawCheckBox(
            const ACanvas : TCanvas;
            FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, TextBackgroundColor,
              FocusColor: TColor;
            WithGradient : Boolean;
            R : TRect;
            const Offset: TPoint;
            const CheckSize : TSize;
            const Caption : String;
            Layout: TDLSCheckBoxLayout;
            Margin, Spacing: Integer;
            Checked,
            IsFocused,
            IsMouseIn,
            IsHotTracked,
            Ctl3D,
            ButtonCheckBox : Boolean;
            Flags : Longint);
var
  CheckPos : TPoint;
  TextBounds, CheckRect, CheckMarkRect, DrawRect : TRect;
  CheckState : TDLSColorCheckBoxState;
  X,Y, Gap : Integer;
begin
  //***************************************************************************
  // Initialization
  //***************************************************************************

  DLS_CalcObjectTextLayout(ACanvas, R, Offset, Caption, CheckSize, TDLSObjectLayout(Layout), Margin, Spacing,
    CheckPos, TextBounds, Flags);

  //***************************************************************************
  // Drawing the check rectangle
  //***************************************************************************
  CheckRect := Rect(CheckPos.X, CheckPos.Y, CheckPos.X + CheckSize.cx, CheckPos.Y + CheckSize.cy);

  if (ButtonCheckBox and IsHotTracked and IsMouseIn) or (ButtonCheckBox and not IsHotTracked) then
    DrawRect := R
  else
    DrawRect := CheckRect;

  DLS_DrawRectangle(ACanvas,
                    DrawRect,
                    Ctl3D,
                    WithGradient,
                    FaceColor,
                    GradColor,
                    LightColor,
                    DarkColor,
                    BorderColor);

  //***************************************************************************
  // Drawing the check mark
  //***************************************************************************
    CheckMarkRect := CheckRect;
  if CheckSize.cx <= 12 then Gap := 2 else Gap := 3;
  InflateRect(CheckMarkRect, -Gap, -Gap);
  if (ButtonCheckBox and IsHotTracked and IsMouseIn) or (ButtonCheckBox and not IsHotTracked) then
  begin
    ACanvas.Pen.Color := BorderColor;
    ACanvas.Polygon([ Point(CheckRect.Left, CheckRect.Top), Point(CheckRect.Right - 1, CheckRect.Top),
                      Point(CheckRect.Right - 1, CheckRect.Bottom - 1),
                      Point(CheckRect.Left, CheckRect.Bottom - 1)]);
  end;
  if Checked then
  begin
    ACanvas.Pen.Color := clBlack;
    DLS_DrawCheckMark(ACanvas, CheckMarkRect);
  end;

  //***************************************************************************
  // Drawing the text
  //***************************************************************************
  with ACanvas do
  begin
    Font.Color := TextColor;
    Brush.Style := bsClear;
    DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE or Flags);
  end;

  if IsFocused then
  begin
    ACanvas.Pen.Color:= FocusColor;
    ACanvas.Brush.Style:= bsClear;
    InflateRect(TextBounds, 2, 2);
    ACanvas.Rectangle(TextBounds);
  end;
end;

procedure DLS_DrawCheckBox(
            const ACanvas : TCanvas;
            const ColorMap : TDLSCheckBoxColorMap;
            R : TRect;
            const Offset: TPoint;
            const CheckSize : TSize;
            const Caption : String;
            Layout: TDLSCheckBoxLayout;
            Margin, Spacing: Integer;
            Checked,
            IsDown,
            IsFocused,
            IsMouseIn,
            IsHotTracked,
            Enabled,
            Ctl3D,
            ButtonCheckBox : Boolean;
            Flags : Longint);
var
  CheckPos : TPoint;
  TextBounds, CheckRect, CheckMarkRect, DrawRect : TRect;
  FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, TextBackgroundColor,
  FocusColor : TColor;
  CheckState : TDLSColorCheckBoxState;
  X,Y, Gap : Integer;
begin
  //***************************************************************************
  // Initialization
  //***************************************************************************
  if IsDown then
    CheckState := ccsDown
  else if IsHotTracked and IsMouseIn then
    CheckState := ccsHotTracked
  else if IsMouseIn then
    CheckState := ccsOver
  else
    CheckState := ccsStandard;
  if not Enabled then CheckState := ccsDisabled;

  with ColorMap do
  begin
    FaceColor := Colors[CheckState, ccpFace];
    GradColor := Colors[CheckState, ccpGradient];
    LightColor := Colors[CheckState, ccpLight];
    DarkColor := Colors[CheckState, ccpDark];
    BorderColor := Colors[CheckState, ccpBorder];
    TextColor := Colors[CheckState, ccpText];
  end;
  FocusColor := ColorMap.FocusColor;

  DLS_DrawCheckBox( ACanvas,
                    FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, TextBackgroundColor,
                    FocusColor,
                    ColorMap.WithGradient,
                    R,
                    Offset,
                    CheckSize,
                    Caption,
                    Layout,
                    Margin, Spacing,
                    Checked,
                    IsFocused,
                    IsMouseIn,
                    IsHotTracked,
                    Ctl3D,
                    ButtonCheckBox,
                    Flags);

end;

procedure DLS_DrawCheckMark(
            const ACanvas : TCanvas;
            CheckRect : TRect);
var
  X,Y : Integer;
begin
  X := CheckRect.Right - 1; Y := CheckRect.Top;
  while (Y + 3) <= CheckRect.Bottom do
  begin
    ACanvas.MoveTo(X,Y);
    ACanvas.LineTo(X, Y + 3);
    Dec(X);
    Inc(Y);
  end;
  Dec(Y, 2);

  while (X >= CheckRect.Left) do
  begin
    ACanvas.MoveTo(X,Y);
    ACanvas.LineTo(X, Y + 3);
    Dec(X);
    Dec(Y);
  end;
end;

procedure DLS_DrawRadioButton(
            const ACanvas : TCanvas;
            const ColorMap : TDLSRadioButtonColorMap;
            R : TRect;
            const Offset: TPoint;
            const RadioSize : TSize;
            const Caption : String;
            Layout: TDLSRadioButtonLayout;
            Margin, Spacing: Integer;
            Checked,
            IsDown,
            IsFocused,
            IsMouseIn,
            IsHotTracked,
            Enabled,
            Ctl3D,
            ButtonRadioButton : Boolean;
            Flags : Longint);
var
  RadioPos : TPoint;
  TextBounds, RadioRect, RadioMarkRect, DrawRect : TRect;
  FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor, TextBackgroundColor: TColor;
  RadioState : TDLSColorRadioButtonState;
  X,Y, Gap : Integer;
begin
  //***************************************************************************
  // Initialization
  //***************************************************************************
  if IsDown then
    RadioState := crbsDown
  else if IsHotTracked and IsMouseIn then
    RadioState := crbsHotTracked
  else if IsMouseIn then
    RadioState := crbsOver
  else
    RadioState := crbsStandard;
  if not Enabled then RadioState := crbsDisabled;

  with ColorMap do
  begin
    FaceColor := Colors[RadioState, crbpFace];
    GradColor := Colors[RadioState, crbpGradient];
    LightColor := Colors[RadioState, crbpLight];
    DarkColor := Colors[RadioState, crbpDark];
    BorderColor := Colors[RadioState, crbpBorder];
    TextColor := Colors[RadioState, crbpText];
  end;

  DLS_CalcObjectTextLayout(ACanvas, R, Offset, Caption, RadioSize, TDLSObjectLayout(Layout), Margin, Spacing,
    RadioPos, TextBounds, Flags);

  //***************************************************************************
  // Drawing the radio
  //***************************************************************************
  RadioRect := Rect(RadioPos.X, RadioPos.Y, RadioPos.X + RadioSize.cx, RadioPos.Y + RadioSize.cy);

  if (ButtonRadioButton and IsHotTracked and IsMouseIn) or (ButtonRadioButton and not IsHotTracked) then
    DLS_DrawRectangle(ACanvas,
                      R,
                      Ctl3D,
                      ColorMap.WithGradient,
                      FaceColor,
                      GradColor,
                      LightColor,
                      DarkColor,
                      BorderColor)
  else
    DLS_DrawEllipse(ACanvas,
                    RadioRect,
                    Ctl3D,
                    ColorMap.WithGradient,
                    FaceColor,
                    GradColor,
                    LightColor,
                    DarkColor,
                    BorderColor);

  //***************************************************************************
  // Drawing the radio mark
  //***************************************************************************
  RadioMarkRect := RadioRect;
  Gap := 3;
  InflateRect(RadioMarkRect, -Gap, -Gap);
  if (ButtonRadioButton and IsHotTracked and IsMouseIn) or (ButtonRadioButton and not IsHotTracked) then
  begin
    ACanvas.Pen.Color := BorderColor;
    ACanvas.Ellipse(RadioRect);
  end;
  if Checked then
  begin
    ACanvas.Pen.Color := clBlack;
    ACanvas.Brush.Color := clBlack;
    DLS_DrawRadioMark(ACanvas, RadioMarkRect);
  end;

  //***************************************************************************
  // Drawing the text
  //***************************************************************************
  with ACanvas do
  begin
    Font.Color := TextColor;
    Brush.Style := bsClear;
    DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE or Flags);
  end;

  if IsFocused then
  begin
    ACanvas.Pen.Color:= ColorMap.FocusColor;
    ACanvas.Brush.Style:= bsClear;
    InflateRect(TextBounds, 2, 2);
    ACanvas.Rectangle(TextBounds);
  end;
end;

procedure DLS_DrawRadioMark(
            const ACanvas : TCanvas;
            RadioRect : TRect);
begin
  ACanvas.Ellipse(RadioRect);
end;

procedure DLS_DrawEllipse(
            const ACanvas : TCanvas;                // canvas where to draw the gradient
            const R : TRect;                        // Rectangle to draw
            const Ctl3D : Boolean;                  // 3d rectangle
            const WithGradient : Boolean;           // Filled with gradient ?
            FaceColor,                              // Colors
            GradColor,
            LightColor,
            DarkColor,
            BorderColor: TColor );
begin
  with ACanvas do
  begin
    Brush.Color:= FaceColor;
    Brush.Style:= bsSolid;
    Ellipse(R);
  end;
  if WithGradient then DLS_GradientFillEllipse(ACanvas, R, FaceColor, GradColor);

  with ACanvas do
  begin
    Pen.Style:= psSolid;
    Brush.Color:= FaceColor;
    Pen.Color:= BorderColor;
    Brush.Style:= bsClear;
    Ellipse(R);

    if Ctl3D then
    begin
      Pen.Color:= LightColor;
      Arc(R.Left + 1, R.Top + 1, R.Right -1, R.Bottom - 1, R.Right, R.Top, R.Left, R.Bottom);

      Pen.Color:= DarkColor;
      Arc(R.Left + 1, R.Top + 1, R.Right -1, R.Bottom - 1, R.Left, R.Bottom, R.Right, R.Top);
    end;
  end;
end;

procedure DLS_DrawText(
            const ACanvas : TCanvas;
            TextBounds : TRect;
            const Ctl3D : Boolean;
            LightColor, DarkColor, FaceColor: TColor);
begin

  {with ACanvas do
  begin
    Font.Color := FaceColor;
    Brush.Style := bsClear;
    DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE or Flags);
  end;}
end;


end.

Remy Lebeau · April 4, 2020

7 hours ago, Damien Leveugle said:

In fact I just realize that the running mode display the correct size (since i'm using a 3000 x 2000 resolution).

It's in the RAD IDE that the component is double sized in display.

Probably because the IDE is not HighDPI-aware, so it gets stretched by the OS.

7 hours ago, Damien Leveugle said:

Here's the whole checkbox code

It wasn't necessary to show EVERYTHING, most of that code is not related to painting.

Damien Leveugle · April 4, 2020

I don't think that it is coming from the High-DPI-awareness of the IDE since for the standard VCL provided by RAD IDE, nothing is stretched (see the attached img).

Vandrovnik · April 4, 2020

I guess in the IDE, you draw for example 12 px box, but whole IDE is scaled by Windows, so that it is displayed as 24 px (example).

In running application, if your application is HDPI enabled, than Windows does not do the scaling. So original checkbox is drawn 24 px, because it is able to do it by itself, but your component is drawn 12 px, because it does not calculate proper size.

Damien Leveugle · April 4, 2020

Thanks Vandrovnik. Perfectly right.

Just add a Muldiv conversion to the checkbox size and it works perfectly.

Sign In

Smaller custom component between design & Running mode

Recommended Posts

Damien Leveugle 0

Share this post

Link to post

Remy Lebeau 1394

Share this post

Link to post

Damien Leveugle 0

Share this post

Link to post

Remy Lebeau 1394

Share this post

Link to post

Damien Leveugle 0

Share this post

Link to post

Vandrovnik 214

Share this post

Link to post

Damien Leveugle 0

Share this post

Link to post

Create an account or sign in to comment

Create an account

Sign in

Browse

Activity