Ignore:
Timestamp:
May 9, 2020, 4:02:07 PM (4 years ago)
Author:
chronos
Message:
  • Modified: Improved HighDPI branch. Imported new changes from trunk branch.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/Packages/CevoComponents/ButtonA.pas

    r178 r210  
    44
    55uses
    6   ButtonBase,
    7   Classes, Graphics, LCLIntf, LCLType, UDpiControls;
     6  UDpiControls, ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools;
    87
    98type
     
    1211  private
    1312    FCaption: string;
    14     procedure SetCaption(x: string);
    15     procedure SetFont(const x: TDpiFont);
     13    procedure SetCaption(Text: string);
     14    procedure SetFont(const Font: TDpiFont);
    1615  published
    1716    property Visible;
     
    2625procedure Register;
    2726
     27
    2828implementation
    2929
    3030procedure Register;
    3131begin
    32   RegisterComponents('Samples', [TButtonA]);
     32  RegisterComponents('C-evo', [TButtonA]);
    3333end;
    3434
     
    4343begin
    4444  with Canvas do
    45     if FGraphic <> nil then begin
    46       DpiBitBlt(Canvas.Handle, 0, 0, 100, 25, Graphic.Canvas.Handle, 195,
    47         243 + 26 * Byte(Down), SRCCOPY);
     45    if FGraphic <> nil then
     46    begin
     47      DpiBitCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195,
     48        243 + 26 * Byte(Down));
    4849      Canvas.Brush.Style := bsClear;
    49       TextOut(50 - (TextWidth(FCaption) + 1) div 2, 12 - TextHeight(FCaption)
     50      Textout(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption)
    5051        div 2, FCaption);
    51     end else begin
     52    end
     53    else
     54    begin
    5255      Brush.Color := $0000FF;
    5356      FrameRect(Rect(0, 0, 100, 25))
    54     end
     57    end;
    5558end;
    5659
    57 procedure TButtonA.SetCaption(x: string);
     60procedure TButtonA.SetCaption(Text: string);
    5861begin
    59   if x <> FCaption then
    60   begin
    61     FCaption := x;
    62     Invalidate
    63   end
     62  if Text <> FCaption then begin
     63    FCaption := Text;
     64    Invalidate;
     65  end;
    6466end;
    6567
    66 procedure TButtonA.SetFont(const x: TDpiFont);
     68procedure TButtonA.SetFont(const Font: TDpiFont);
    6769begin
    68   Canvas.Font.Assign(x);
     70  Canvas.Font.Assign(Font);
    6971  Canvas.Font.Color := $000000;
    7072end;
Note: See TracChangeset for help on using the changeset viewer.