abswitch.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit AbSwitch;

{******************************************************************************}
{ Abakus VCL                                                                   }
{       Components TAbLeverSwitch, TAbRockerSwitch, TAbToggleSwitch            }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com            }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2000 A.Baecker, All rights Reserved             }
{******************************************************************************}

interface

uses
  Windows,
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls,
  {****** Abakus VCL - Units ******}
  _AbInfo,
  _AbProc,
  _GClass;

type
  TBtnOrientation = (boHorizontal, boVertical);


  TAbSwitch = class(TAbBinGControl)
  private
    { Private-Deklarationen }
    FOrientation: TBtnOrientation;
    FBevelOuter: TAbSBevel;
    FSwapGraphic: Boolean;
    FBtnColorShadow: TColor;
    FBtnColorHighlight: TColor;
    FBtnColorFace: TColor;
    FBtnBevelWidth: Integer;
    procedure SetBtnColorHighlight(Value: TColor);
    procedure SetBtnColorShadow(Value: TColor);
    procedure SetBtnColorFace(Value: TColor);
    procedure SetBtnBevelWidth(Value: Integer);
  protected
    { Protected-Deklarationen }
    procedure SetOrientation(Value: TBtnOrientation);
    procedure SetSwapGraphic(Value: Boolean);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer);
      override;
  public
    { Public-Deklarationen }
    rSwitch: TRect;
    vertical: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    property Orientation: TBtnOrientation read FOrientation write
    SetOrientation;
    property SwapGraphic: Boolean read FSwapGraphic write SetSwapGraphic;
    procedure DrawSwitch(can: TCanvas; r: TRect; TopLeft, vertical: Boolean);
      virtual;
    procedure StatusChanged; override;
    procedure ParamChange(Sender: TObject); override;
    procedure Loaded; override;
  published
    { Published-Deklarationen }
    property BevelOuter: TAbSBevel read FBevelOuter write FBevelOuter;
    property BtnColorHighlight: TColor read FBtnColorHighlight write
    SetBtnColorHighlight;
    property BtnColorShadow: TColor read FBtnColorShadow write
    SetBtnColorShadow;
    property BtnColorFace: TColor read FBtnColorFace write SetBtnColorFace;
    property BtnBevelWidth: Integer read FBtnBevelWidth write SetBtnBevelWidth;
    property Mode;
    property Font;
    property Enabled;
    property ParentFont;
    property StatusInt;
    property StatusBit;
    property GroupIndex;
    property Checked;
    property OnStatusChanged;
    property OnStatusIntChanged;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  TAbRockerSwitch = class(TAbSwitch)
  private
    { Private-Deklarationen }
    FLEDColorOn: TColor;
    FLEDColorOff: TColor;
    FLEDHeight: Integer;
    FBtnBevel2Width: Integer;
    FBtnColorFaceHi: TColor;            {Hightlight surface color}
    FBtnColorFaceSh: TColor;            {Shadow surface color}
    procedure SetLEDColorOn(Value: TColor);
    procedure SetLEDColorOff(Value: TColor);
    procedure SetLedHeight(Value: Integer);
    procedure SetBtnBevel2Width(Value: Integer);
    procedure SetBtnColorFaceHi(Value: TColor);
    procedure SetBtnColorFaceSh(Value: TColor);
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    procedure DrawSwitch(can: TCanvas; r: TRect; TopLeft, vertical: Boolean);
      override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    { Published-Deklarationen }
    property Orientation;
    property SwapGraphic;
    property LEDHeight: Integer read FLEDHeight write SetLedHeight;
    property BtnColorFaceHi: TColor read FBtnColorFaceHi write
    SetBtnColorFaceHi;
    property BtnColorFaceSh: TColor read FBtnColorFaceSh write
    SetBtnColorFaceSh;
    property BtnBevel2Width: Integer read FBtnBevel2Width write
    SetBtnBevel2Width;
    property LEDColorOn: TColor read FLEDColorOn write SetLEDColorOn;
    property LEDColorOff: TColor read FLEDColorOff write SetLEDColorOff;
  end;

  TAbToggleSwitch = class(TAbSwitch)
  private
    { Private-Deklarationen }
    FTextOff: string;
    FTextOn: string;
    FColorOn: TColor;
    FColorOff: TColor;
    procedure SetTextOff(Value: string);
    procedure SetTextOn(Value: string);
    procedure SetColorOn(Value: TColor);
    procedure SetColorOff(Value: TColor);
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    procedure DrawSwitch(can: TCanvas; r: TRect; TopLeft, vertical: Boolean);
      override;
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
    property Orientation;
    property SwapGraphic;
    property TextOff: string read FTextOff write SetTextOff;
    property TextOn: string read FTextOn write SetTextOn;
    property ColorOn: TColor read FColorOn write SetColorOn;
    property ColorOff: TColor read FColorOff write SetColorOff;

  end;

  TAbLeverSwitch = class(TAbBinGControl)
  private
    { Private-Deklarationen }
    FTextOff: string;
    FTextOn: string;
    bmpGrad: TBitmap;
    procedure SetTextOff(Value: string);
    procedure SetTextOn(Value: string);
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    procedure DrawSwitch(can: TCanvas; r: TRect; TopLeft: Boolean);
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }
//    property Orientation;
//    property SwapGraphic;
    property TextOff: string read FTextOff write SetTextOff;
    property TextOn: string read FTextOn write SetTextOn;

  end;
procedure AbDrawLeverSwitch(can: TCanvas;
  r: TRect;
  radC,
  wh1,
  wh2,
  t: Integer;
  Col1,
  Col2: TColor;
  bmpGrad: TBitmap;
  Top: Boolean);

implementation

{XXXXXXX TAbLeverSwitch XXXXXXXXXXXX}

procedure AbDrawLeverSwitch(can: TCanvas;
  r: TRect;
  radC,
  wh1,
  wh2,
  t: Integer;
  Col1,
  Col2: TColor;
  bmpGrad: TBitmap;
  Top: Boolean);
var
  cp                : TPoint;           // Centerpoint
  rL                : TRect;
  aL                : array[0..3] of TPoint;
begin


  cp := AbCenterPoint(r);

//  dec(r.right);
//  dec(r.Bottom);

  Ab3DEllipse(can,
    r.TopLeft,
    cp,
    radC,
    radC,
    bmpGrad,
    clBtnShadow,
    true,
    true);

  Exit;
              //  exit;
{  can.brush.style := bsClear;
  can.pen.color := col2;
  can.Ellipse(cp.x - radC +1, cp.y -radC +1, cp.x + radC, cp.y +radC);
 }
  rL.Left := cp.x - wh1;
  rL.Right := cp.x + wh1 + 1;
  with can do
  begin
    Brush.Style := bsSolid;
    if Top then
    begin
      Brush.Color := Col1;
      Pen.Color := Col1;
      rL.Top := r.Top;
      rL.Bottom := r.Top + t;
      Rectangle(rL.Left, rL.Top, rL.Right, rL.Bottom);
      Dec(rL.Right);

      Brush.Color := Col2;
      Pen.Color := Col2;
      aL[0].x := rL.Left;
      aL[0].y := rL.Bottom;

      aL[1].x := rL.Right;
      aL[1].y := rL.Bottom;

      aL[2].x := cp.x + wh2;
      aL[2].y := cp.y + t div 2;
      aL[3].x := cp.x - wh2;
      aL[3].y := aL[2].y;

      Polygon(aL);

    end
    else
    begin
      Brush.Color := Col2;
      Pen.Color := Col2;
      rL.Top := r.Bottom - t - 1;
      rL.Bottom := r.Bottom;
      Rectangle(rL.Left, rL.Top, rL.Right, rL.Bottom);
      Dec(rL.Right);

      Brush.Color := Col1;
      Pen.Color := Col1;

      aL[1].x := cp.x + wh2;
      aL[1].y := cp.y - t div 2;

      aL[0].x := cp.x - wh2;
      aL[0].y := aL[1].y;


      aL[2].x := rL.Right;
      aL[2].y := rL.Top;
      aL[3].x := rL.Left;
      aL[3].y := rL.Top;

      Polygon(aL);
    end;
  end;                                  // with can do begin

end;

procedure TAbLeverSwitch.SetTextOff(Value: string);
begin
  if FTextOff <> Value then
  begin
    FTextOff := Value;
    Invalidate;
  end;
end;

procedure TAbLeverSwitch.SetTextOn(Value: string);
begin
  if FTextOn <> Value then
  begin
    FTextOn := Value;
    Invalidate;
  end;
end;

procedure TAbLeverSwitch.DrawSwitch(can: TCanvas; r: TRect; TopLeft: Boolean);
begin

end;

procedure TAbLeverSwitch.Paint;
begin
  with Canvas do
  begin
    bmpGrad.Width := 60;
    bmpGrad.Height := 60;
    AbCircleGradFill(bmpGrad.Canvas, bmpGrad.Canvas.Cliprect, $00EAEAEA,
      $00B7B7B7);

//  AbCircleGradFill(canvas,canvas.ClipRect, $00EAEAEA,$00B7B7B7);
    textout(0, 0, TextOn);
{    AbCircleGradFill( canvas,
                      ClientRect,
                      RGB(128,128,0),
                      RGB(255,255,128));
     }
{    AbDrawLeverSwitch( canvas,
                       ClientRect,
                       16, 12,6,7,
                       RGB(128,128,0),
                       RGB(255,255,128),
                       bmpGrad,
                       true);
 }
    Canvas.Draw(50, 50, bmpGrad);
  end;
end;

constructor TAbLeverSwitch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  bmpGrad := TBitmap.Create;

  SetBounds(Left, Top, 100, 100);
  FTextOn := 'ON';
  FTextOff := 'OFF';

end;

destructor TAbLeverSwitch.Destroy;
begin
  bmpGrad.Free;
  inherited Destroy;
end;




{XXXXXXX TAbSwitch XXXXXXXXXXXX}

procedure TAbSwitch.DrawSwitch(can: TCanvas; r: TRect; TopLeft, vertical:
  Boolean);
begin
   {virtual procedure...}
end;

procedure TAbSwitch.SetBtnBevelWidth(Value: Integer);
begin
  if (FBtnBevelWidth <> Value) and (Value >= 0) then
  begin
    FBtnBevelWidth := Value;
    StatusChanged;
  end;
end;

procedure TAbSwitch.SetSwapGraphic(Value: Boolean);
begin
  if FSwapGraphic <> Value then
  begin
    FSwapGraphic := Value;
    StatusChanged;
  end;
end;

procedure TAbSwitch.SetBtnColorHighlight(Value: TColor);
begin
  if FBtnColorHighlight <> Value then
  begin
    FBtnColorHighlight := Value;
    StatusChanged;
  end;
end;

procedure TAbSwitch.SetBtnColorShadow(Value: TColor);
begin
  if FBtnColorShadow <> Value then
  begin
    FBtnColorShadow := Value;
    StatusChanged;
  end;
end;

procedure TAbSwitch.SetBtnColorFace(Value: TColor);
begin
  if FBtnColorFace <> Value then
  begin
    FBtnColorFace := Value;
    StatusChanged;
  end;
end;

procedure TAbSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState; x,
  y: Integer);
var
  State             : Boolean;
begin
  if FSwapGraphic then
    State := not Checked
  else
    State := Checked;

  if ((State and vertical and (y > Height div 2))
    or (not State and vertical and (y < Height div 2))
    or (State and not vertical and (x > Width div 2))
    or (not State and not vertical and (x < Width div 2))) then
    inherited MouseDown(Button, Shift, x, y)


end;

procedure TAbSwitch.Paint;
var
  r                 : TRect;
begin
  if (not Visible) and not (csDesigning in Componentstate) then Exit;
  Canvas.Font := Font;
  r := ClientRect;
  FBevelOuter.PaintFilledBevel(Canvas, r);
  rSwitch := r;
  StatusChanged;
end;

procedure TAbSwitch.StatusChanged;
var
  State             : Boolean;
  TempBmp           : TBitmap;
begin
  TempBmp := TBitmap.Create;
  TempBmp.Width := rSwitch.Right - rSwitch.Left;
  TempBmp.Height := rSwitch.Bottom - rSwitch.Top;

  if (not Visible) and not (csDesigning in Componentstate) then Exit;
  if FSwapGraphic then
    State := not Checked
  else
    State := Checked;

  DrawSwitch(TempBmp.Canvas, TempBmp.Canvas.Cliprect, State, vertical);

  Canvas.Draw(rSwitch.Left, rSwitch.Top, TempBmp);

  TempBmp.Free;
end;

procedure TAbSwitch.ParamChange(Sender: TObject);
begin
  Repaint;
end;

constructor TAbSwitch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  FBevelOuter := TAbSBevel.Create;
  FBevelOuter.Width := 1;
  FBevelOuter.Spacing := 1;
  FBevelOuter.Style := bsLowered;
  FBevelOuter.Color := clBtnShadow;
  FBevelOuter.BevelLine := blInner;

  FBtnColorShadow := clBtnShadow;
  FBtnColorHighlight := clBtnHighlight;
  FBtnColorFace := clBtnFace;
  FBtnBevelWidth := 2;
  FOrientation := boVertical;
  Mode := mSwitch;
  vertical := true;

  if (csDesigning in Componentstate) then Loaded;

end;

procedure TAbSwitch.Loaded;
begin
  inherited Loaded;


  FBevelOuter.OnChange := ParamChange;

end;

destructor TAbSwitch.Destroy;
begin
  FBevelOuter.Free;