vrscanner.pas

作工控的好控件

{*****************************************************}
{                                                     }
{     Varian Component Workshop                       }
{                                                     }
{     Varian Software NL (c) 1996-2000                }
{     All Rights Reserved                             }
{                                                     }
{*****************************************************}

unit VrScanner;

{$I VRLIB.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VrTypes, VrClasses, VrControls, VrSysUtils, VrThreads;

type
  TVrLedStyle = (lsRaised, lsLowered, lsNone, lsFlat);

  TVrLedGroup = class(TVrGraphicImageControl)
  private
    FSpacing: Integer;
    FStyle: TVrLedStyle;
    FPlainColors: Boolean;
    FColorWidth: Integer;
    FOnChange: TNotifyEvent;
    Collection: TVrCollection;
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TVrLedStyle);
    procedure SetPlainColors(Value: Boolean);
    procedure SetColorWidth(Value: Integer);
  protected
    procedure Change; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property Style: TVrLedStyle read FStyle write SetStyle default lsRaised;
    property PlainColors: Boolean read FPlainColors write SetPlainColors default false;
    property ColorWidth: Integer read FColorWidth write SetColorWidth default 1;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TVrScanDirection = (sdBoth, sdLeftRight, sdRightLeft);

  TVrScanner = class;

  TVrScannerLed = class(TVrCollectionItem)
  private
    FActive: Boolean;
    procedure SetActive(Value: Boolean);
  public
    constructor Create(Collection: TVrCollection); override;
    property Active: Boolean read FActive write SetActive;
  end;

  TVrScannerLeds = class(TVrCollection)
  private
    FOwner: TVrScanner;
    function GetItem(Index: Integer): TVrScannerLed;
  protected
    procedure Update(Item: TVrCollectionItem); override;
  public
    constructor Create(AOwner: TVrScanner);
    property Items[Index: Integer]: TVrScannerLed read GetItem;
  end;

  TVrScanner = class(TVrLedGroup)
  private
    FLeds: Integer;
    FPalette: TVrPalette;
    FActive: Boolean;
    FPosition: Integer;
    FDirection: TVrScanDirection;
    FThreaded: Boolean;
    ToLeft: Boolean;
    PrevPosition: Integer;
    FTimer: TVrTimer;
    function GetTimeInterval: Integer;
    procedure SetLeds(Value: Integer);
    procedure SetActive(Value: Boolean);
    procedure SetTimeInterval(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetPalette(Value: TVrPalette);
    procedure SetThreaded(Value: Boolean);
    procedure TimerEvent(Sender: TObject);
    procedure PaletteModified(Sender: TObject);
  protected
    procedure CreateItems;
    procedure UpdateLed(Index: Integer);
    procedure UpdateLeds;
    procedure UpdateLedState;
    procedure Paint; override;
    procedure GetItemRect(Index: Integer; var R: TRect);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Threaded: Boolean read FThreaded write SetThreaded default True;
    property Leds: Integer read FLeds write SetLeds default 7;
    property Palette: TVrPalette read FPalette write SetPalette;
    property Active: Boolean read FActive write SetActive default false;
    property Direction: TVrScanDirection read FDirection write FDirection default sdBoth;
    property TimeInterval: Integer read GetTimeInterval write SetTimeInterval default 100;
    property Position: Integer read FPosition write SetPosition default 0;
    property Spacing;
    property Style;
    property PlainColors;
    property ColorWidth;
    property Transparent default false;
    property OnChange;
    property Align;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Hint;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}    
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrIndicator = class;

  TVrIndicatorLed = class(TVrScannerLed)
  private
    FColorLow: TColor;
    FColorHigh: TColor;
  public
    constructor Create(Collection: TVrCollection); override;
    property ColorLow: TColor read FColorLow write FColorLow;
    property ColorHigh: TColor read FColorHigh write FColorHigh;
  end;

  TVrIndicatorLeds = class(TVrCollection)
  private
    FOwner: TVrIndicator;
    function GetItem(Index: Integer): TVrIndicatorLed;
  protected
    procedure Update(Item: TVrCollectionItem); override;
  public
    constructor Create(AOwner: TVrIndicator);
    property Items[Index: Integer]: TVrIndicatorLed read GetItem;
  end;

  TVrIndicator = class(TVrLedGroup)
  private
    FPosition: Integer;
    FMaxValue: Integer;
    FMinValue: Integer;
    FLedsLow: Integer;
    FLedsMedium: Integer;
    FLedsHigh: Integer;
    FPalette1: TVrPalette;
    FPalette2: TVrPalette;
    FPalette3: TVrPalette;
    FStep: Integer;
    Leds: Integer;
    function GetPercentDone: Longint;
    procedure SetPosition(Value: Integer);
    procedure SetMaxValue(Value: Integer);
    procedure SetMinValue(Value: Integer);
    procedure SetLedsLow(Value: Integer);
    procedure SetLedsMedium(Value: Integer);
    procedure SetLedsHigh(Value: Integer);
    procedure SetPalette1(Value: TVrPalette);
    procedure SetPalette2(Value: TVrPalette);
    procedure SetPalette3(Value: TVrPalette);
    procedure PaletteModified(Sender: TObject);
  protected
    procedure CreateItems;
    procedure UpdateLed(Index: Integer);
    procedure UpdateLeds;
    procedure UpdatePosition;
    procedure Paint; override;
    procedure GetItemRect(Index: Integer; var R: TRect);
  public
    constructor Create(AOwner: TComponent); override;
    procedure StepIt;
    procedure StepBy(Delta: Integer);
    property PercentDone: Longint read GetPercentDone;
  published
    property Palette1: TVrPalette read FPalette1 write SetPalette1;
    property Palette2: TVrPalette read FPalette2 write SetPalette2;
    property Palette3: TVrPalette read FPalette3 write SetPalette3;
    property MaxValue: Integer read FMaxValue write SetMaxValue default 100;
    property MinValue: Integer read FMinValue write SetMinValue default 0;
    property Position: Integer read FPosition write SetPosition default 0;
    property LedsLow: Integer read FLedsLow write SetLedsLow default 3;
    property LedsMedium: Integer read FLedsMedium write SetLedsMedium default 2;
    property LedsHigh: Integer read FLedsHigh write SetLedsHigh default 2;
    property Step: Integer read FStep write FStep default 10;
    property ColorWidth;
    property Spacing;
    property Style;
    property PlainColors;
    property Transparent default false;
    property OnChange;
    property Align;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Hint;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}    
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;


implementation


{ TVrLedGroup }

constructor TVrLedGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  Width := 250;
  Height := 9;
  FSpacing := 2;
  FStyle := lsRaised;
  FPlainColors := false;
  FColorWidth := 1;
end;

destructor TVrLedGroup.Destroy;
begin
  Collection.Free;
  inherited Destroy;
end;

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

procedure TVrLedGroup.SetStyle(Value: TVrLedStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrLedGroup.SetPlainColors(Value: Boolean);
begin
  if FPlainColors <> Value then
  begin
    FPlainColors := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrLedGroup.SetColorWidth(Value: Integer);
begin
  if (FColorWidth <> Value) and (Value > 0) then
  begin
    FColorWidth := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrLedGroup.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ TVrScannerLed }

constructor TVrScannerLed.Create(Collection: TVrCollection);
begin
  FActive := false;
  inherited Create(Collection);
end;

procedure TVrScannerLed.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    Changed(false);
  end;
end;

{ VrScannerLeds }

constructor TVrScannerLeds.Create(AOwner: TVrScanner);
begin
  inherited Create;
  FOwner := AOwner;
end;

function TVrScannerLeds.GetItem(Index: Integer): TVrScannerLed;
begin
  Result := TVrScannerLed(inherited Items[Index]);
end;

procedure TVrScannerLeds.Update(Item: TVrCollectionItem);
begin
  if Item <> nil then
    FOwner.UpdateLed(Item.Index) else
    FOwner.UpdateLeds;
end;

{ TVrScanner }

constructor TVrScanner.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLeds := 7;
  FPalette := TVrPalette.Create;
  FPalette.OnChange := PaletteModified;
  FActive := false;
  FPosition := -1;
  FDirection := sdBoth;
  FThreaded := True;
  FTimer := TVrTimer.Create(Self);
  FTimer.Enabled := false;
  FTimer.Interval := 100;
  FTimer.OnTimer := TimerEvent;
  Collection := TVrScannerLeds.Create(Self);
  CreateItems;
end;

destructor TVrScanner.Destroy;
begin
  FPalette.Free;
  FTimer.Free;
  inherited Destroy;
end;

procedure TVrScanner.CreateItems;
var
  I: Integer;
begin
  Collection.Clear;
  for I := 0 to Pred(FLeds) do
    TVrScannerLed.Create(Collection);
end;

procedure TVrScanner.PaletteModified(Sender: TObject);
begin
  UpdateControlCanvas;
end;

procedure TVrScanner.UpdateLed(Index: Integer);
var
  R: TRect;
  AColor: TColor;
  Item: TVrScannerLed;
begin
  Item := TVrScannerLeds(Collection).Items[Index];
  AColor := FPalette.Colors[ord(Item.Active)];

  GetItemRect(Index, R);

  if not FPlainColors then
    DrawGradientExt(DestCanvas, R, AColor, clBlack, gdUpDown, ColorWidth)
  else
  begin
    DestCanvas.Brush.Color := AColor;
    DestCanvas.FillRect(R);
  end;