abled.pas

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

unit AbLED;

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

{$I abks.inc}

interface

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

type

  TAbLED = class(TAbBinGControl)
  private
    { Private declarations }
    FLED: TLED;
    FLED_Position: TLEDPos;
    FSpacing: Integer;
    wCaption: Integer;
    hCaption: Integer;
    Painting : Boolean;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure SetSpacing(Value: Integer);
    procedure SetLED_Position(Value: TLEDPos);
  public
    { Public declarations }
    procedure ParamChange(Sender: TObject); override;
    procedure Flash(status: Boolean); override;
    procedure StatusChanged; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Caption;
    property Font;
    property ParentFont;
    property LED: TLED read FLED write FLED;
    property LED_Position: TLEDPos read FLED_Position write SetLED_Position;
    property Spacing: Integer read FSpacing write SetSpacing;
    property Checked;
    property Flashing;
    property Frequency;
    property StatusInt;
    property StatusBit;
    property GroupIndex;
    property Mode;
    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 TAbLED.Flash(status: Boolean);
begin
  if Painting then exit;
  if Visible or (csDesigning in Componentstate) then LED.Draw(Canvas, status);
end;

procedure TAbLED.StatusChanged;
begin
  if Visible or (csDesigning in Componentstate) then LED.Draw(Canvas, Checked);
end;

procedure TAbLED.SetLED_Position(Value: TLEDPos);
begin
  if FLED_Position <> Value then
  begin
    FLED_Position := Value;
    ParamChange(self);
  end;
end;

procedure TAbLED.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    ParamChange(self);
  end;
end;

procedure TAbLED.Paint;
var
  d, w2, h2, dHeight, dWidth: Integer;
begin
  if Painting then exit;
  Painting := true;

  Canvas.Font := Font;
  wCaption := Canvas.TextWidth(Caption);
  hCaption := Canvas.Textheight(Caption);

  dHeight := FLED.Height;
  dWidth := FLED.Width;

  w2 := Width div 2;
  h2 := Height div 2;

  if FLED.Shape = sRound then
  begin
    d := AbMaxInt(dWidth, dHeight);
    dWidth := d;
    dHeight := d;
  end;
  FLED.Rect := Rect(0, 0, dWidth, dHeight);

  Canvas.Brush.Style := bsClear;
  case LED_Position of
    lpLeft:
      begin
        FLED.Rect.Top := h2 - (dHeight div 2);
        FLED.Rect.Bottom := FLED.Rect.Top + dHeight;
        AbTextOut(Canvas, FLED.Rect.Right + Spacing, h2, Caption, toMidLeft);
      end;
    lpRight:
      begin
        FLED.Rect.Top := h2 - (dHeight div 2);
        FLED.Rect.Bottom := FLED.Rect.Top + dHeight;
        FLED.Rect.Left := Width - dWidth;
        FLED.Rect.Right := Width;
        AbTextOut(Canvas, FLED.Rect.Left - Spacing, h2, Caption, toMidRight);
      end;
    lpTop:
      begin
        FLED.Rect.Left := w2 - (dWidth div 2);
        FLED.Rect.Right := FLED.Rect.Left + dWidth;
        AbTextOut(Canvas, w2, FLED.Rect.Bottom + Spacing, Caption, toTopCenter);
      end;
    lpBottom:
      begin
        FLED.Rect.Top := Height - dHeight;
        FLED.Rect.Bottom := Height;
        FLED.Rect.Left := w2 - (dWidth div 2);
        FLED.Rect.Right := FLED.Rect.Left + dWidth;
        AbTextOut(Canvas, w2, FLED.Rect.Top - Spacing, Caption, toBotCenter);
      end;
  end;
  Canvas.Brush.Style := bsSolid;
  LED.Draw(Canvas, Checked);
  Painting := false;
end;

procedure TAbLED.ParamChange(Sender: TObject);
begin
  Invalidate;
end;

constructor TAbLED.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  FLED := TLED.Create;
  FLED.OnChange := ParamChange;
  FLED_Position := lpLeft;
  Width := 73;
  Height := 33;
  Spacing := 5;
  Caption := Name;
end;

destructor TAbLED.Destroy;
begin
  FLED.Free;
  DelControl(self);
  inherited Destroy;
end;

end.