abcbitbt.pas

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

unit AbCBitBt;

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

interface

{$I abks.inc}

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

type

  TFlashOption = (foGlyph, foText, foTextCol, foBtnCol);
  TFlashOptions = set of TFlashOption;

  TCheckedOption = (coGlyph, coText, coTextCol, coBtnCol, coBevel);
  TCheckedOptions = set of TCheckedOption;

  TAbColBitBtn = class(TAbBinGControl)
  private
    { Private-Deklarationen }
    FButtonBevel: TAbBtnBevel;
    FFlashOptions: TFlashOptions;
    FCheckedOptions: TCheckedOptions;
    FGlyph: TBitmap;
    FNumGlyph: Integer;
    FColorOff: TColor;
    FColorDisabled: TColor;
    FColorOn: TColor;
    FOffsetDown: Integer;
    FOffsetX: Integer;
    FOffsetY: Integer;
    FBeveled: Boolean;
    FTransparent: Boolean;
    FFlat: Boolean;
    FSpacing: Integer;
    FTextOn: string;
    FTextOff: string;
    FTextColOn: TColor;
    FTextColOff: TColor;
    FTextColDisabled: TColor;
    FText3D: Boolean;
    FEnabled: Boolean;

    FGradBtnFace: TAbGradSettings;

    fPosHorizontal: TPosH;
    fPosVertical: TPosV;
    fPosGlyph: TPos;
    FlashStatus : Boolean;
    BmpBackground: TBitmap;
    MouseInControl: Boolean;
    Painting : Boolean;
  protected
    { Protected-Deklarationen }

    procedure SetPosHorizontal(Value: TPosH);
    procedure SetPosVertical(Value: TPosV);
    procedure SetPosGlyph(Value: TPos);

    procedure SetFlashOptions(Value: TFlashOptions);
    procedure SetCheckedOptions(Value: TCheckedOptions);

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

    procedure Paint; override;
    procedure SetColorOff(Value: TColor);
    procedure SetColorDisabled(Value: TColor);
    procedure SetColorOn(Value: TColor);

    procedure SetOffsetX(Value: Integer);
    procedure SetOffsetY(Value: Integer);
    procedure SetOffsetDown(Value: Integer);
    procedure VisibleChanging; override;
    procedure SetGlyph(Value: TBitmap);
    procedure SetNumGlyph(Value: Integer);
    procedure SetBeveled(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetSpacing(Value: Integer);
    procedure SetTextOn(Value: string);
    procedure SetTextOff(Value: string);
    procedure SetTextColOn(Value: TColor);
    procedure SetTextColOff(Value: TColor);
    procedure SetTextColDisabled(Value: TColor);
    procedure SetText3D(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
{$IFDEF CEnabled} override;
{$ENDIF}
    function GetEnabled: Boolean;
{$IFDEF CEnabled} override;
{$ENDIF}
  public
    { Public-Deklarationen }
    procedure Flash(status: Boolean); override;
    procedure ParamChange(Sender: TObject); override;
    procedure StatusChanged; override;
    procedure Draw(stGlyph, stText, stTextCol, stBtn: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    { Published-Deklarationen }
    property PosHorizontal: TPosH read fPosHorizontal write SetPosHorizontal;
    property PosVertical: TPosV read fPosVertical write SetPosVertical;
    property PosGlyph: TPos read fPosGlyph write SetPosGlyph;

    property GradBtnFace: TAbGradSettings read FGradBtnFace write FGradBtnFace;
    property ButtonBevel: TAbBtnBevel read FButtonBevel write FButtonBevel;
    property FlashOptions: TFlashOptions read FFlashOptions write
    SetFlashOptions;
    property CheckedOptions: TCheckedOptions read FCheckedOptions write
    SetCheckedOptions;
    property ColorOff: TColor read FColorOff write SetColorOff;
    property ColorDisabled: TColor read FColorDisabled write SetColorDisabled;
    property ColorOn: TColor read FColorOn write SetColorOn;
    property OffsetX: Integer read FOffsetX write SetOffsetX;
    property OffsetY: Integer read FOffsetY write SetOffsetY;
    property OffsetDown: Integer read FOffsetDown write SetOffsetDown;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyph: Integer read FNumGlyph write SetNumGlyph;
    property Beveled: Boolean read FBeveled write SetBeveled;
    property Transparent: Boolean read FTransparent write SetTransparent;
    property Flat: Boolean read FFlat write SetFlat;
    property Spacing: Integer read FSpacing write SetSpacing;
    property TextOff: string read FTextOff write SetTextOff;
    property TextOn: string read FTextOn write SetTextOn;
    property TextColOn: TColor read FTextColOn write SetTextColOn;
    property TextColOff: TColor read FTextColOff write SetTextColOff;
    property TextColDisabled: TColor read FTextColDisabled write
    SetTextColDisabled;
    property Text3D: Boolean read FText3D write SetText3D;
    property Frequency;
    property Flashing;
    property GroupIndex;
    property StatusBit;
    property StatusInt;
    property Checked;
    property Mode;
    property Enabled;
    property Visible;
    property Font;
    property ParentFont;
    property OnStatusChanged;
    property OnStatusIntChanged;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;


implementation


procedure TAbColBitBtn.SetPosHorizontal(Value: TPosH);
begin
  if fPosHorizontal <> Value then
  begin
    fPosHorizontal := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetPosVertical(Value: TPosV);
begin
  if fPosVertical <> Value then
  begin
    fPosVertical := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetPosGlyph(Value: TPos);
begin
  if fPosGlyph <> Value then
  begin
    fPosGlyph := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetFlashOptions(Value: TFlashOptions);
begin
  FFlashOptions := Value;
end;

procedure TAbColBitBtn.SetCheckedOptions(Value: TCheckedOptions);
begin
  FCheckedOptions := Value;
  StatusChanged;
end;

procedure TAbColBitBtn.Flash(status: Boolean);
begin
  FlashStatus := status;
  if Painting then exit;
  StatusChanged;
end;

procedure TAbColBitBtn.SetTextColOn(Value: TColor);
begin
  if FTextColOn <> Value then
  begin
    FTextColOn := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetTextColOff(Value: TColor);
begin
  if FTextColOff <> Value then
  begin
    FTextColOff := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetTextColDisabled(Value: TColor);
begin
  if FTextColDisabled <> Value then
  begin
    FTextColDisabled := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetText3D(Value: Boolean);
begin
  if FText3D <> Value then
  begin
    FText3D := Value;
    StatusChanged;
  end;
end;

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

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

procedure TAbColBitBtn.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    StatusChanged;
  end;
end;

function TAbColBitBtn.GetEnabled: Boolean;
begin
  result := FEnabled;
end;



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

procedure TAbColBitBtn.SetFlat(Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if FFlat and not MouseInControl and FEnabled
    and (GetCapture = 0) then
  begin
    MouseInControl := true;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FFlat and MouseInControl and FEnabled then
  begin
    MouseInControl := false;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TAbColBitBtn.SetBeveled(Value: Boolean);
begin
  if FBeveled <> Value then
  begin
    FBeveled := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.VisibleChanging;
begin
  if not (csDesigning in Componentstate) then Invalidate;
end;

procedure TAbColBitBtn.SetGlyph(Value: TBitmap);
begin
  FGlyph.Assign(Value);
  if FGlyph.Height > 0 then
  begin
    FGlyph.TransparentColor := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1];
  end
  else
  begin
    FNumGlyph := 1;
  end;
  StatusChanged;
end;

procedure TAbColBitBtn.SetNumGlyph(Value: Integer);
begin
  if (FNumGlyph <> Value) and (Value > 0) then
  begin
    FNumGlyph := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetOffsetDown(Value: Integer);
begin
  if FOffsetDown <> Value then
  begin
    FOffsetDown := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetOffsetX(Value: Integer);
begin
  if FOffsetX <> Value then