Damien Leveugle

Thanks Vandrovnik. Perfectly right. Just add a Muldiv conversion to the checkbox size and it works perfectly.

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).

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.

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