vrlcd.pas

作工控的好控件

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

unit VrLcd;

{$I VRLIB.INC}

interface

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

type
  TVrNumStyle = (ns13x24, ns11x20, ns7x13, ns12x17, ns5x7);
  TVrNumAlignment = (naLeftJustify, naCenter, naRightJustify);

  TVrCustomNum = class(TVrGraphicImageControl)
  private
    FValue: Integer;
    FDigits: Integer;
    FMax: Integer;
    FMin: Integer;
    FSpacing: Integer;
    FStyle: TVrNumStyle;
    FLeadingZero: Boolean;
    FPalette: TVrPalette;
    FAlignment: TVrNumAlignment;
    FZeroBlank: Boolean;
    FAutoSize: Boolean;
    FOnChange: TNotifyEvent;
    Bitmap: TBitmap;
    ImageWidth: Integer;
    ImageHeight: Integer;
    BelowZero: Boolean;
    procedure SetDigits(Value: Integer);
    procedure SetValue(Value: Integer);
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TVrNumStyle);
    procedure SetLeadingZero(Value: Boolean);
    procedure SetAlignment(Value: TVrNumAlignment);
    procedure SetAutoSize(Value: Boolean);
    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetZeroBlank(Value: Boolean);
    procedure SetPalette(Value: TVrPalette);
    procedure PaletteModified(Sender: TObject);
  protected
    procedure LoadBitmaps; virtual;
    procedure DrawNum(Num: integer; X,Y: integer);
    procedure ChangeSize(NewWidth, NewHeight: Integer);
    procedure Paint; override;
    procedure Change; dynamic;
{$IFDEF VER110}
    procedure RequestAlign; override;
{$ELSE}
    procedure RequestAlign;
{$ENDIF}
    property Digits: Integer read FDigits write SetDigits default 4;
    property Value: Integer read FValue write SetValue default 0;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property Style: TVrNumStyle read FStyle write SetStyle default ns13x24;
    property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default false;
    property Palette: TVrPalette read FPalette write SetPalette;
    property Alignment: TVrNumAlignment read FAlignment write SetAlignment default naCenter;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default false;
    property Max: Integer read FMax write SetMax default 9999;
    property Min: Integer read FMin write SetMin default 0;
    property ZeroBlank: Boolean read FZeroBlank write SetZeroBlank default false;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TVrNum = class(TVrCustomNum)
    property Digits;
    property Value;
    property Spacing;
    property Style;
    property LeadingZero;
    property Palette;
    property Alignment;
    property AutoSize;
    property Max;
    property Min;
    property ZeroBlank;
    property Transparent default false;
    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 OnChange;
    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;

  TVrClockType = (ctRealTime, ctElapsed, ctCustom);
  TVrTimeZone = (tzPM, tzAM, tzNone);

  TVrClock = class(TVrCustomNum)
  private
    FHours: TVrHoursInt;
    FMinutes: TVrMinutesInt;
    FSeconds: TVrSecondsInt;
    FClockType: TVrClockType;
    FActive: Boolean;
    FShowSeconds: Boolean;
    FBlink: Boolean;
    FBlinkVisible: Boolean;
    FThreaded: Boolean;
    FHours24: Boolean;
    FShowTimeZone: Boolean;
    FHoursInternal: TVrHoursInt;
    FOnHoursChanged: TVrHoursChangeEvent;
    FOnMinutesChanged: TVrMinutesChangeEvent;
    FOnSecondsChanged: TVrSecondsChangeEvent;
    FTimer: TVrTimer;
    ElapsedTime: TDateTime;
    FSeperator: TBitmap;
    FTimeZoneImage: TBitmap;
    procedure SetHours(Value: TVrHoursInt);
    procedure SetMinutes(Value: TVrMinutesInt);
    procedure SetSeconds(Value: TVrSecondsInt);
    procedure SetActive(Value: Boolean);
    procedure SetClockType(Value: TVrClockType);
    procedure SetShowSeconds(Value: Boolean);
    procedure SetBlink(Value: Boolean);
    procedure SetShowTimeZone(Value: Boolean);
    procedure SetThreaded(Value: Boolean);
    procedure OnTimerEvent(Sender: TObject);
  protected
    procedure LoadBitmaps; override;
    procedure Paint; override;
    procedure DrawTimeZone(Hrs: Integer; X, Y: integer);
    procedure Loaded; override;
    procedure HoursChanged; virtual;
    procedure MinutesChanged; virtual;
    procedure SecondsChanged; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Threaded: Boolean read FThreaded write SetThreaded default True;
    property Hours: TVrHoursInt read FHours write SetHours default 0;
    property Minutes: TVrMinutesInt read FMinutes write SetMinutes default 0;
    property Seconds: TVrSecondsInt read FSeconds write SetSeconds default 0;
    property ClockType: TVrClockType read FClockType write SetClockType default ctRealTime;
    property Active: Boolean read FActive write SetActive default false;
    property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default false;
    property Blink: Boolean read FBlink write SetBlink default false;
    property Hours24: Boolean read FHours24 write FHours24 default True;
    property ShowTimeZone: Boolean read FShowTimeZone write SetShowTimeZone default false;
    property Transparent default false;
    property OnHoursChanged: TVrHoursChangeEvent read FOnHoursChanged write FOnHoursChanged;
    property OnMinutesChanged: TVrMinutesChangeEvent read FOnMinutesChanged write FOnMinutesChanged;
    property OnSecondsChanged: TVrSecondsChangeEvent read FOnSecondsChanged write FOnSecondsChanged;
    property Palette;
    property Spacing;
    property Style;
    property AutoSize;
    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

{$R VRLCD.D32}

const
  ResNumId: array[TVrNumStyle] of PChar =
    ('NUM13x24', 'NUM11x20', 'NUM7x13', 'NUM12x17', 'NUM5x7');
  ResClockId: array[TVrNumStyle] of PChar =
    ('CLOCKSEP1', 'CLOCKSEP2', 'CLOCKSEP3', 'CLOCKSEP4', 'CLOCKSEP5');
  ResTimeZoneId: array[TVrNumStyle] of PChar =
    ('AMPM13x24', 'AMPM11x20', 'AMPM7x13', 'AMPM12x17', 'AMPM5x7');


{TVrCustomNum}

constructor TVrCustomNum.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  Width := 100;
  Height := 26;
  ParentColor := false;
  Color := clBlack;
  FDigits := 4;
  FValue := 0;
  FSpacing := 2;
  FLeadingZero := false;
  FPalette := TVrPalette.Create;
  FPalette.OnChange := PaletteModified;
  FStyle := ns13x24;
  FAlignment := naCenter;
  FAutoSize := false;
  FMin := 0;
  FMax := 9999;
  FZeroBlank := false;
  BelowZero := false;
  Bitmap := TBitmap.Create;
  LoadBitmaps;
end;

destructor TVrCustomNum.Destroy;
begin
  FPalette.Free;
  Bitmap.Free;
  inherited Destroy;
end;

procedure TVrCustomNum.LoadBitmaps;
begin
  Bitmap.Handle := LoadBitmap(hInstance, ResNumId[Style]);
  FPalette.ToBMP(Bitmap, ResColorLow, ResColorHigh);
  ImageWidth := Bitmap.Width div 13;
  ImageHeight := Bitmap.Height;
end;

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

procedure TVrCustomNum.SetDigits(Value: Integer);
begin
  if (FDigits <> Value) and (Value > 0) and (Value < 16) then
  begin
    FDigits := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetValue(Value: Integer);
begin
  AdjustRange(Value, FMin, FMax);
  if FValue <> Value then
  begin
    FValue := Value;
    UpdateControlCanvas;
    Change;
  end;
end;

procedure TVrCustomNum.SetMin(Value: Integer);
begin
  if (FMin <> Value) and (Value < FMax) then
  begin
    FMin := Value;
    BelowZero := FMin < 0;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetMax(Value: Integer);
begin
  if (FMax <> Value) and (Value > FMin) then
  begin
    FMax := Value;
    UpdateControlCanvas;
  end;
end;

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

procedure TVrCustomNum.SetStyle(Value: TVrNumStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    LoadBitmaps;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetLeadingZero(Value: Boolean);
begin
  if FLeadingZero <> Value then
  begin
    FLeadingZero := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetAlignment(Value: TVrNumAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetAutoSize(Value: Boolean);
begin
  if (FAutoSize <> Value) then
  begin
    FAutoSize := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrCustomNum.SetZeroBlank(Value: Boolean);
begin
  if FZeroBlank <> Value then
  begin
    FZeroBlank := Value;
    UpdateControlCanvas;