_gclass.pas

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

    property DragMode;
    property Enabled;
    property FocusControl: TWinControl read FFocusControl write FFocusControl;
    property Interval    : Integer read GetInterval write SetInterval;
    property StartDelay    : Integer read GetStartDelay write SetStartDelay;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
    property UpNumGlyphs: TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs default 1;
    property Visible;
    property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDrag;
    property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
  end;


  TArrowSettings = class(TAbPersistent)
  private
    FShape: Integer;
    FColorPen: TColor;
    FColorBrush: TColor;
    FColorCP1Pen: TColor;
    FColorCP1Brush: TColor;
    FColorCP2Pen: TColor;
    FColorCP2Brush: TColor;
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure SetShape(Value: Integer);
    procedure SetColorPen(Value: TColor);
    procedure SetColorBrush(Value: TColor);
    procedure SetColorCP1Pen(Value: TColor);
    procedure SetColorCP1Brush(Value: TColor);
    procedure SetColorCP2Pen(Value: TColor);
    procedure SetColorCP2Brush(Value: TColor);
  public
    constructor Create;
  published
    property Shape: Integer read FShape write SetShape default 0;
    property ColorPen: TColor read FColorPen write SetColorPen default clBlack;
    property ColorBrush: TColor read FColorBrush write SetColorBrush default
    clLime;
    property ColorCP1Pen: TColor read FColorCP1Pen write SetColorCP1Pen default
    clBlack;
    property ColorCP1Brush: TColor read FColorCP1Brush write SetColorCP1Brush
    default clBlack;
    property ColorCP2Pen: TColor read FColorCP2Pen write SetColorCP2Pen default
    clBlack;
    property ColorCP2Brush: TColor read FColorCP2Brush write SetColorCP2Brush
    default clBtnFace;
  end;

  TLED = class(TAbPersistent)
  private
    FShape: TLEDShape;
    FColorOn: TColor;
    FColorOff: TColor;
    FWidth: Integer;
    FHeight: Integer;
  protected
    procedure SetShape(Value: TLEDShape);
    procedure SetColorOn(Value: TColor);
    procedure SetColorOff(Value: TColor);
    procedure SetWidth(Value: Integer);
    procedure SetHeight(Value: Integer);
  public
    Rect: TRect;
    procedure Draw(can: TCanvas; Checked: Boolean);
    constructor Create;
  published
    property Shape: TLEDShape read FShape write SetShape default sRound;
    property ColorOn: TColor read FColorOn write SetColorOn default clLime;
    property ColorOff: TColor read FColorOff write SetColorOff default
    clBtnFace;
    property Width: Integer read FWidth write SetWidth default 13;
    property Height: Integer read FHeight write SetHeight default 13;
  end;

  TAbBtnBevel = class(TAbPersistent)
  private
    FShadowColFrom: TColor;
    FShadowColTo: TColor;
    FHighlightColFrom: TColor;
    FHighlightColTo: TColor;
    FWidth: Integer;
    procedure SetShadowColFrom(Value: TColor);
    procedure SetShadowColTo(Value: TColor);
    procedure SetHighlightColFrom(Value: TColor);
    procedure SetHighlightColTo(Value: TColor);
    procedure SetWidth(Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create;
    procedure PaintBevel(can: TCanvas; var r: TRect; up, filled: Boolean; Col:
      TColor);
  published
    property ShadowColFrom: TColor read FShadowColFrom write SetShadowColFrom
    default clBlack;
    property ShadowColTo: TColor read FShadowColTo write SetShadowColTo default
    clBtnShadow;
    property HighlightColFrom: TColor read FHighlightColFrom write
    SetHighlightColFrom default $00D2D2D2;
    property HighlightColTo: TColor read FHighlightColTo write SetHighlightColTo
    default clBtnHighlight;
    property Width: Integer read FWidth write SetWidth;

  end;

  TAbGradSettings = class(TAbPersistent)
  private
    FColorFrom: TColor;
    FColorTo: TColor;
    FVisible: Boolean;
    FStyle: TGradientStyle;
    procedure SetColorFrom(Value: TColor);
    procedure SetColorTo(Value: TColor);
    procedure SetVisible(Value: Boolean);
    procedure SetStyle(Value: TGradientStyle);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create;
  published
    property ColorFrom: TColor read FColorFrom write SetColorFrom default
    14869218;
    property ColorTo: TColor read FColorTo write SetColorTo default 9408399;
    property Visible: Boolean read FVisible write SetVisible;
    property Style: TGradientStyle read FStyle write SetStyle;
  end;


  TAbSBevel = class(TAbPersistent)
  private
    FStyle: TBevelStyle;
    FSpacing: Integer;
    FBevelLine: TBevelLine;
    FWidth: Integer;
    FColor: TColor;
    FOffset: TAbOffset;

    FColorShadowFrom: TColor;
    FColorShadowTo: TColor;
    FColorHighLightFrom: TColor;
    FColorHighLightTo: TColor;

    FPenColor: TColor;
    FSurfaceGrad: TAbGradSettings;

    RoundBmp: TBitmap;                  // the round bevel bitmap
    RoundBmpCreated: Boolean;           // true if bitmap is created

    procedure SetStyle(Value: TBevelStyle);
    procedure SetSpacing(Value: Integer);
    procedure SetBevelLine(Value: TBevelLine);
    procedure SetWidth(Value: Integer);
    procedure SetColor(Value: TColor);

    procedure SetColorShadowFrom(Value: TColor);
    procedure SetColorShadowTo(Value: TColor);
    procedure SetColorHighLightFrom(Value: TColor);
    procedure SetColorHighLightTo(Value: TColor);

    procedure SetPenColor(Value: TColor);
    procedure PaintGradBevel(can: TCanvas; // the canvas
      var r: TRect;                     // Btn Rectangle
      up,                               // up or down
      filled: Boolean;                  // filled inside
      Col: TColor);                     // fill color
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    isRound: Boolean;                   // if true then RoundBmp will be created
    TotalWidth: Integer;
    TotalHeight: Integer;
    procedure Change; override;
    constructor Create;
    destructor Destroy; override;
    procedure ParamChange(Sender: TObject);
    procedure PaintFilledBevel(can: TCanvas; var r: TRect);
    procedure PaintBevel(can: TCanvas; var r: TRect);
    procedure PaintRoundBevel(can: TCanvas; var r: TRect; Left, Top: Integer);
  published
    property Offset: TAbOffset read FOffset write FOffset;
    property Style: TBevelStyle read FStyle write SetStyle ;
    property Spacing: Integer read FSpacing write SetSpacing;
    property BevelLine: TBevelLine read FBevelLine write SetBevelLine;
    property Width: Integer read FWidth write SetWidth;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property ColorShadowFrom: TColor read FColorShadowFrom write
    SetColorShadowFrom default clBtnShadow;
    property ColorShadowTo: TColor read FColorShadowTo write SetColorShadowTo
    default clBtnShadow;
    property ColorHighLightFrom: TColor read FColorHighLightFrom write
    SetColorHighLightFrom default clBtnHighlight;
    property ColorHighLightTo: TColor read FColorHighLightTo write
    SetColorHighLightTo default clBtnHighlight;
    property PenColor: TColor read FPenColor write SetPenColor default clBlack;
    property SurfaceGrad: TAbGradSettings read FSurfaceGrad write FSurfaceGrad;
  end;


  TBarSettings = class(TAbPersistent)
  private
    FColor: TColor;
    FBkColor: TColor;
    FFont: TFont;
    FOptions: TBarOptions;
    FStyle: TBarStyle;
    FBevel: TAbSBevel;
    FMinWidth: Integer;
    FMinHeight: Integer;
    w: Integer;
    h: Integer;

    procedure SetStyle(Value: TBarStyle);
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetOptions(Value: TBarOptions);
    procedure SetBkColor(Value: TColor);
    procedure SetBevel(Value: TAbSBevel);
    procedure SetMinHeight(Value: Integer);
    procedure SetMinWidth(Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    ClientRect: TRect;
    BarRect: TRect;
    ValueUnit: string;
    Value: string;
    SectorCol: TColor;
    ppt0: Integer;                      // 0 position for bidirectional scale
    constructor Create;
    destructor Destroy; override;
    procedure PaintBar(can: TCanvas; PPT: Integer);
    procedure PaintHBar(can: TCanvas; PPT: Integer);
    procedure PaintVBar(can: TCanvas; PPT: Integer);
  published
    property Style: TBarStyle read FStyle write SetStyle;
    property Font: TFont read FFont write SetFont;
    property Options: TBarOptions read FOptions write SetOptions;  // default [opUnit] ;
    property Color: TColor read FColor write SetColor ;
    property BkColor: TColor read FBkColor write SetBkColor ;
    property Bevel: TAbSBevel read FBevel write SetBevel;
    property minHeight: Integer read FMinHeight write SetMinHeight ;
    property minWidth: Integer read FMinWidth write SetMinWidth ;
  end;

  TSignalSettings = class(TAbPersistent)
  private
    FDigitalFrom: LongInt;
    FDigitalTo: LongInt;
    FName1: string;
    FName2: string;
    FValueFormat: string;
    FValueFrom: Single;
    FValueTo: Single;
    FValueUnit: string;
    procedure SetDigitalFrom(Value: LongInt);
    procedure SetDigitalTo(Value: LongInt);
    procedure SetName1(Value: string);
    procedure SetName2(Value: string);
    procedure SetValueFormat(Value: string);
    procedure SetValueFrom(Value: Single);
    procedure SetValueTo(Value: Single);
    procedure SetValueUnit(Value: string);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    LogScale: Boolean;
    TotalValue: Single;
    TotalDigit: LongInt;
    ValuePerDigit: Single;
    ValueSizeStr: string;
    DigitPerValue: Single;
    PPTPerValue: Single;
    procedure Change; override;
    function GetPPT(Value: Single): LongInt; {calculate PPT from Value}
    function GetValue(Value : Integer): Single; {calculate Value from PPT}
    function AbGetValueFormat(var FormatStr: string): string;
    constructor Create;
  published
    property DigitalFrom: LongInt read FDigitalFrom
    write SetDigitalFrom
      default 0;
    property DigitalTo: LongInt read FDigitalTo
    write SetDigitalTo
      default 1000;
    property Name1: string read FName1
    write SetName1;
    property Name2: string read FName2
    write SetName2;
    property ValueFormat: string read FValueFormat write SetValueFormat;
    property ValueFrom: Single read FValueFrom write SetValueFrom;
    property ValueTo: Single read FValueTo write SetValueTo;
    property ValueUnit: string read FValueUnit write SetValueUnit;
  end;

  TMinMax = class(TAbPersistent)
  private
    procedure SetMax(Value: Single);
    procedure SetMin(Value: Single);
    procedure SetMaxColor(Value: TColor);
    procedure SetMinColor(Value: TColor);
    procedure SetUseSectorCol(Value: Boolean);
    procedure SetMinVisible(Value: Boolean);
    procedure SetMaxVisible(Value: Boolean);
  public
    FMax: Single;
    FMaxDateTime: TDateTime;
    FMin: Single;
    FMinDateTime: TDateTime;
    FMaxColor: TColor;
    FMinColor: TColor;
    FUseSectorCol: Boolean;
    FMinVisible: Boolean;
    FMaxVisible: Boolean;
    constructor Create;
  published
    property Max: Single read FMax write SetMax stored false;
    property MaxDateTime: TDateTime read FMaxDateTime write FMaxDateTime stored
    false;
    property Min: Single read FMin write SetMin stored false;
    property MinDateTime: TDateTime read FMinDateTime write FMinDateTime stored
    false;
    property MaxColor: TColor read FMaxColor write SetMaxColor default clAqua;
    property MinColor: TColor read FMinColor write SetMinColor default clAqua;
    property UseSectorCol: Boolean read FUseSectorCol write SetUseSectorCol
    default true;
    property MinVisible: Boolean read FMinVisible write SetMinVisible default
    true;
    property MaxVisible: Boolean read FMaxVisible write SetMaxVisible default
    true;
  end;


  TChSettings = class(TSignalSettings)
  private
    FDigit: LongInt;
    FValue: Single;
    FColor: TColor;
    FPenWidth: Integer;
    FVisible: Boolean;
    FOnValueChange: TNotifyEvent;
    procedure SetDigit(Value: LongInt);
    procedure SetValue(Value: Single);
    procedure SetColor(Value: TColor);
    procedure SetVisible(Value: Boolean);
    procedure SetPenWidth(Value : Integer);
    procedure ValueChange;
  public
    PixelPerDigit: Single;
    AbsDigit: Integer;
    constructor Create;
    destructor Destroy; override;
    procedure GetAbsDigit;
    function AbsDigitToValue(AbsDigit: Integer): Single;
  published
    property OnValueChange: TNotifyEvent read FOnValueChange write
    FOnValueChange;
    property Value: Single read FValue write SetValue;
    property Digit: LongInt read FDigit write SetDigit;
    property Color: TColor read FColor write SetColor;
    property Visible: Boolean read FVisible write SetVisible default true;
    property PenWidth: Integer read FPenWidth write SetPenWidth default 1;
  end;



  TSectorSettings = class(TAbPersistent)
  private
    FSector1Color: TColor;
    FSector1From: LongInt;
    FSector1To: LongInt;
    FSector2Color: TColor;
    FSector2From: LongInt;
    FSector2To: LongInt;
    FSector3Color: TColor;
    FSector3From: LongInt;
    FSector3To: LongInt;
    FOffset : Integer;
    FWidthOffset  : Integer;
    LogScale: Boolean;
    procedure SetSector1Color(Value: TColor);
    procedure SetSector1From(Value: LongInt);
    procedure SetSector1To(Value: LongInt);
    procedure SetSector2Color(Value: TColor);
    procedure SetSector2From(Value: LongInt);
    procedure SetSector2To(Value: LongInt);
    procedure SetSector3Color(Value: TColor);
    procedure SetSector3From(Value: LongInt);
    procedure SetSector3To(Value: LongInt);
    procedure SetOffset(Value : Integer);
    procedure SetWidthOffset(Value : Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    function CheckSectorColor(PPT: LongInt; var Col: TColor): Boolean;
    constructor Create;
  published
    property Sector1Color: TColor read FSector1Color
    write SetSector1Color
      default clYellow;
    property Sector1From: LongInt read FSector1From
    write SetSector1From
      default 0;
    property Sector1To: LongInt read FSector1To
    write SetSector1To
      default 333;
    property Sector2Color: TColor read FSector2Color
    write SetSector2Color
      default clGreen;
    property Sector2From: LongInt read FSector2From
    write SetSector2From
      default 334;
    property Sector2To: LongInt read FSector2To
    write SetSector2To
      default 666;
    property Sector3Color: TColor read FSector3Color
    write SetSector3Color
      default clRed;
    property Sector3From: LongInt read FSector3From
    write SetSector3From
      default 667;
    property Sector3To: LongInt read FSector3To
    write SetSector3To
      default 1000;
    property Offset : Integer read FOffset write SetOffset;
    property WidthOffset : Integer read FWidthOffset write SetWidthOffset;
  end;