[教程]自绘开关组件效果 – QDAC数据访问组件网站

直接用PaintBox绘制的例子，同样的效果内置于 TZTextButtonBar 中，设置对应的按钮的 ButtonKind 为 bkSwitch 并且 ThemeDraw 为 False 时，即可。
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.GraphUtil,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TZSwitchPair = record
    Background: TColor;
    Font: TColor;
    Text: String;
    procedure Initialize(ABackgroundColor, AFontColor: TColor; AText: String);
  end;

  TZSwitchDrawer = record
    OnSettings: TZSwitchPair;
    OffSettings: TZSwitchPair;
    DisabledSettings: TZSwitchPair;
    Rad: TSize;
    IsEnabled, IsOn: Boolean;
    procedure Draw(ACanvas: TCanvas; R: TRect);
  end;

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Click(Sender: TObject);
  private
    { Private declarations }
    FSwitchDrawer: TZSwitchDrawer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSwitchDrawer.OnSettings.Initialize(clPurple, clHighlightText, '已开');
  FSwitchDrawer.OffSettings.Initialize(clSkyBlue, clGrayText, '已关');
  FSwitchDrawer.DisabledSettings.Initialize(clLtGray, clMedGray, '状态');
  FSwitchDrawer.Rad.cx := 5;
  FSwitchDrawer.Rad.cy := 5;
  FSwitchDrawer.IsEnabled := true;
  FSwitchDrawer.IsOn := true;
end;

procedure TForm1.PaintBox1Click(Sender: TObject);
begin
  FSwitchDrawer.IsOn := not FSwitchDrawer.IsOn;
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  FSwitchDrawer.Draw(PaintBox1.Canvas, PaintBox1.ClientRect);
end;

{ TZSwitchDrawer }

procedure TZSwitchDrawer.Draw(ACanvas: TCanvas; R: TRect);
var
  AText: String;
  ASavedColor: TColor;
  X: Integer;
begin
  if IsEnabled then
  begin
    if IsOn then
    begin
      ACanvas.Brush.Color := OnSettings.Background;
      ACanvas.Pen.Color := GetHighLightColor(OnSettings.Background, 10);
      ACanvas.Font.Color := OnSettings.Font;
      AText := OnSettings.Text;
    end
    else
    begin
      ACanvas.Brush.Color := OffSettings.Background;
      ACanvas.Pen.Color := GetShadowColor(OffSettings.Background, -10);
      ACanvas.Font.Color := OffSettings.Font;
      AText := OffSettings.Text;
    end;
  end
  else
  begin
    ACanvas.Brush.Color := DisabledSettings.Background;
    ACanvas.Pen.Color := GetShadowColor(OffSettings.Background, -10);
    ACanvas.Font.Color := DisabledSettings.Font;
    AText := DisabledSettings.Text;
  end;
  ACanvas.RoundRect(R, Rad.cx, Rad.cy);
  ASavedColor := ACanvas.Brush.Color;
  if not IsOn then
  begin
    X := R.Right - 4 - (R.Height - 8);
    ACanvas.Brush.Color := ACanvas.Font.Color;
    ACanvas.RoundRect(Rect(X, R.Top + 4, R.Right - 4, R.Bottom - 4),
      Rad.cx, Rad.cy);
    ACanvas.Brush.Color := ASavedColor;
    R.Right := X;
  end
  else
  begin
    X := R.Left - 4 + R.Height;
    ACanvas.Brush.Color := ACanvas.Font.Color;
    ACanvas.RoundRect(Rect(R.Left + 4, R.Top + 4, X, R.Bottom - 4),
      Rad.cx, Rad.cy);
    ACanvas.Brush.Color := ASavedColor;
    R.Left := X;;
  end;
  ACanvas.TextRect(R, AText, [tfSingleLine, tfVerticalCenter, tfCenter]);
end;

{ TZSwitchPair }

procedure TZSwitchPair.Initialize(ABackgroundColor, AFontColor: TColor;
  AText: String);
begin
  Background := ABackgroundColor;
  Font := AFontColor;
  Text := AText;
end;

end.
实际运行效果动图
登录
