_gclass.pas

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

  TAbAnalogGControl = class(TAbGraphicControl)
  private
    FDigit: LongInt;
    FHintOptions: THintOptions;
    FSectorSettings: TSectorSettings;
    FSignalSettings: TSignalSettings;
    FMinMax: TMinMax;
    FValue: Single;
    FLimitUpper: Single;
    FLimitLower: Single;
    FOnMinMaxChange: TNotifyEvent;
    FOnPosChanged : TNotifyEvent;
    FOnLimit: TLimitEvent;
    FOnOverflow: TOverflowEvent;
    FOnSettingsChange: TNotifyEvent;
    FOnSectorChange: TSectorChangeEvent;
    FOnValueChange: TNotifyEvent;
    FLogScale: Boolean;

    LogFactor1: real;                   // 2 precalculated values for log-scales
    LogFactor2: real;

    pPosLeftTop: TPoint;                // to detect scrolling

    procedure SetLogScale(Value: Boolean);
    procedure LimitCheck;               {check upper/lower limit}
    procedure SetLimitUpper(Value: Single);
    procedure SetLimitLower(Value: Single);
    procedure SetValue(Value: Single);
    procedure SetDigit(Value: LongInt);
    procedure SetHintOptions(Value: THintOptions);
    procedure SetHint;
  protected
    procedure ParamChange(Sender: TObject); override;
    procedure ValueChange; dynamic;
    procedure OverflowChange(PPT: Integer); dynamic;
    procedure LimitChange; dynamic;
    procedure MinMaxChange(Sender: TObject); dynamic;
    procedure LogScaleChanged; dynamic;
    property LogScale: Boolean read FLogScale write SetLogScale default false;
    procedure Paint; override;
    property OnPosChanged : TNotifyEvent read FOnPosChanged write FOnPosChanged;
  public
    ValueStr: string;
    DigitStr: string;
    UOverflow: Boolean;
    LOverflow: Boolean;
    ULimit: Boolean;
    LLimit: Boolean;
    ULimitPPT: LongInt;                 // limits in PPT
    LLimitPPT: LongInt;                 // limits in PPT
    PPT: LongInt;
    cAlarm0: TColor;
    cAlarm1: TColor;
    MaxPPT: LongInt;
    MinPPT: LongInt;
    InSector1: Boolean;
    InSector2: Boolean;
    InSector3: Boolean;
    ActSectorCol: TColor;
    procedure ResetMinMax;
    procedure SetMin(Value: Single; DT: TDateTime);
    procedure SetMax(Value: Single; DT: TDateTime);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnStartDrag;
    property Digit: LongInt read FDigit write SetDigit ;
    property LimitUpper: Single read FLimitUpper write SetLimitUpper;
    property LimitLower: Single read FLimitLower write SetLimitLower;
    property HintOptions: THintOptions read FHintOptions
    write SetHintOptions
      default [hoAutoHint, hoValue, hoName1, hoName2, hoMin, hoMax,
      hoMinMaxDate, hoMinMaxTime];
    property SectorSettings: TSectorSettings read FSectorSettings write
    FSectorSettings;
    property SignalSettings: TSignalSettings read FSignalSettings write
    FSignalSettings;
    property MinMax: TMinMax read FMinMax write FMinMax;
    property Value: Single read FValue write SetValue;
    property OnMinMaxChange: TNotifyEvent read FOnMinMaxChange write
    FOnMinMaxChange;
    property OnOverflow: TOverflowEvent read FOnOverflow write FOnOverflow;
    property OnSectorChange: TSectorChangeEvent read FOnSectorChange write
    FOnSectorChange;
    property OnSettingsChange: TNotifyEvent read FOnSettingsChange write
    FOnSettingsChange;
    property OnValueChange: TNotifyEvent read FOnValueChange write
    FOnValueChange;
    property OnLimit: TLimitEvent read FOnLimit write FOnLimit;
  end;

  TAbAnalogCControl = class(TAbCustomControl)
  private
    { Private-Deklarationen }
    FChangeLarge: LongInt;
    FChangeSmall: LongInt;
    FDigit: LongInt;
    FOnValueChange: TNotifyEvent;
    FOnValueChanged: TNotifyEvent;
    FValue: Single;
    FSignalSettings: TSignalSettings;
    FCursorSlide: TCursor;
    FEnableKeyboard: Boolean;
    FEnableMouseJump: Boolean;
    FEnabledKeys : TEnabledKeys;

    FColorFocus: TColor;
    FColorNonFocus: TColor;

    FValueIndicator: TAbAnalogGControl;

    VChange: Boolean;


    procedure SetColorFocus(Value: TColor);
    procedure SetColorNonFocus(Value: TColor);
    procedure SetValue(Value: Single);
    procedure SetDigit(Value: LongInt);
    procedure SetChangeLarge(Value: LongInt);
    procedure SetChangeSmall(Value: LongInt);
    procedure SetCursorSlide(Value: TCursor);
    procedure SetValueIndicator(Value: TAbAnalogGControl);
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMMouseWheel(var msg: TMessage); message $020A; {WM_MOUSEWHEEL}

  protected
    { Protected-Deklarationen }
    Painting: Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
      override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer);
      override;
    procedure MouseMove(Shift: TShiftState; x, y: Integer); override;
    procedure MouseSlide(Shift: TShiftState; x, y: Integer; SlideStartPos:
      TPoint); dynamic;
    procedure ValueChange; dynamic;
    procedure ParamChange(Sender: TObject); override;
    procedure SetEnabled(Value: Boolean);
{$IFDEF CEnabled}
    override;
{$ENDIF}
    property EnableMouseJump: Boolean read FEnableMouseJump write
    FEnableMouseJump default true;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

  public
    { Public-Deklarationen }
    ValueStr: string;
    DigitStr: string;
    MDown: Boolean;
    pMouseOld: TPoint;
    SlideRect: TRect;
    inSlideArea: Boolean;
    isCircle: Boolean;
    OldCursor: Integer;
    MaxPosDeviation: Integer;
    procedure DoChange(up, down: LongInt);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    { Published-Deklarationen }
    property Digit: LongInt read FDigit write SetDigit default 100;
    property ChangeLarge: LongInt read FChangeLarge write SetChangeLarge default
    10;
    property ChangeSmall: LongInt read FChangeSmall write SetChangeSmall default
    1;
    property OnValueChange: TNotifyEvent read FOnValueChange write
    FOnValueChange;
    property OnValueChanged: TNotifyEvent read FOnValueChanged write
    FOnValueChanged;
    property SignalSettings: TSignalSettings read FSignalSettings write
    FSignalSettings;
    property Value: Single read FValue write SetValue;
    property ColorFocus: TColor read FColorFocus write SetColorFocus default
    clLime;
    property ColorNonFocus: TColor read FColorNonFocus write SetColorNonFocus
    default clGreen;
    property CursorSlide: TCursor read FCursorSlide write SetCursorSlide default
    5;
    property EnableKeyboard: Boolean read FEnableKeyboard write FEnableKeyboard
    default true;
    property EnabledKeys : TEnabledKeys read FEnabledKeys write FEnabledKeys;
    property ValueIndicator: TAbAnalogGControl read FValueIndicator write
    SetValueIndicator;
    property ParentFont default false;
    property Enabled default true;
    property TabStop default true;
    property TabOrder;
    property Visible;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnStartDrag;
    property OnKeyDown;
    property OnKeyUp;
    property OnEnter;
    property OnExit;
    property OnMouseMove;
  end;

  TAbBinGControl = class(TGraphicControl)
  private
    FAbInfo: TAbInfo;
    FChecked: Boolean;
    FFrequency: TFlashFreq;
    FFlashing: Boolean;
    FStatusInt: LongInt;
    FStatusBit: Integer;
    FGroupIndex: Integer;
    FMode: TMode;
    FOnStatusChanged: TNotifyEvent;
    FOnStatusIntChanged: TNotifyEvent;
  protected
    procedure GetGroupStatusInt;
    procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
      override;
    procedure WMFlash(var Message: TMessage); message WM_FLASH;

    procedure SetChecked(Value: Boolean);
    procedure SetStatusInt(Value: LongInt);
    procedure SetStatusBit(Value: Integer);
    procedure SetFlashing(Value: Boolean);
    procedure SetFrequency(Value: TFlashFreq);
    procedure StartFlashing;
    procedure SetGroupIndex(Value: Integer);
    procedure SeTMode(Value: TMode);

    procedure ParamChange(Sender: TObject); virtual;

  public
    MouseIsDown: Boolean;
    FirstCheckedBit: Integer;
    procedure StatusChanged; virtual;
    procedure GroupIndexChanged; virtual;
    procedure StatusIntChanged; virtual;
    procedure Flash(status: Boolean); virtual;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Mode: TMode read FMode write SeTMode;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex;
    property Flashing: Boolean read FFlashing write SetFlashing;
    property Frequency: TFlashFreq read FFrequency write SetFrequency;
    property Checked: Boolean read FChecked write SetChecked;
    property StatusInt: LongInt read FStatusInt write SetStatusInt;
    property StatusBit: Integer read FStatusBit write SetStatusBit;
    property OnStatusChanged: TNotifyEvent read FOnStatusChanged write
    FOnStatusChanged;
    property OnStatusIntChanged: TNotifyEvent read FOnStatusIntChanged write
    FOnStatusIntChanged;
  published
    property Visible;
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    property PopupMenu;
  end;


  TScaleSettings = class(TAbPersistent)
  private
    FColor: TColor;
    FPointerColor: TColor;
    FFont: TFont;
    FSteps: Integer;
    FSubSteps: Integer;
    FDrawLine: Boolean;
    FValueFormat: string;
    FValueFormatLog: string;

    procedure SetColor(Value: TColor);
    procedure SetPointerColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetSteps(Value: Integer);
    procedure SetSubSteps(Value: Integer);
    procedure SetPosLeftTop(Value: Boolean);

    procedure SetDrawLine(Value: Boolean);
    procedure SetValueFormat(Value: string);
    procedure SetValueFormatLog(Value: string);
    function CalcLogScaleSteps(MaxSteps, Steps : integer): Integer;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    LogScale: Boolean;
    LogSteps : Integer;
    FPosLeftTop: Boolean;
    sl1: Integer;
    sl2: Integer;                       {length scale steps/substeps}
    cp: TPoint;                         {center point}
    PenW1: Integer;                     {pen width steps}
    PenW2: Integer;                     {pen width substeps}
    Spacing: Integer;                   {Border steps/substeps to text}
    Text: string;                       {Scale - text}
    TextW: Integer;                     {max width scale text}
    TextH: Integer;                     {max height scale text}
    TotalWidth: Integer;                {text + scale + Spacing}
    minHeight: Integer;                 {minHeight Scale}
    BarSpace: Integer;                  {space Scala - Bar}
    pos0: Integer;                      {scale position 0%}
    pos100: Integer;                    {scale position 100%}
    LinePos: array[0..3] of TPoint;
    exp1: Integer;                      {exponent for log-scale}
    exp2: Integer;                      {exponent for log-scale}
    constructor Create;
    destructor Destroy; override;
    procedure FontChange(Sender: TObject);
    procedure CalcSize(can: TCanvas; ValueFrom, ValueTo: Single);
    procedure CalcHSize(can: TCanvas; ValueFrom, ValueTo: Single);
    procedure CalcRSize(can: TCanvas; ValueFrom, ValueTo: Single);
    procedure HorizScala(can: TCanvas; r: TRect);
    procedure VertiScala(can: TCanvas; r: TRect);
    procedure RoundScala(can: TCanvas; var r: TRect; AlphaFrom, Alpha: Integer);
    procedure DialScala(can: TCanvas; var r: TRect; AlphaFrom, Alpha: Integer);
  published
    property Color: TColor read FColor write SetColor;
    property PointerColor: TColor read FPointerColor write SetPointerColor;
    property DrawLine: Boolean read FDrawLine write SetDrawLine;
    property Font: TFont read FFont write SetFont;
    property PosLeftTop: Boolean read FPosLeftTop write SetPosLeftTop;
    property Steps: Integer read FSteps write SetSteps;
    property SubSteps: Integer read FSubSteps write SetSubSteps;
    property ValueFormat: string read FValueFormat write SetValueFormat;
    property ValueFormatLog: string read FValueFormatLog write
    SetValueFormatLog;
  end;

var
  GroupUpdate       : Boolean;

implementation


{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
X        TAbLineSettings
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
procedure TAbLineSettings.SetPen(Value : TPen);
begin
  if FPen <> Value then begin
    FPen.Assign(Value);
    Change;
  end;
end;

procedure TAbLineSettings.SetLength(Value : Integer);
begin
  if FLength <> Value then begin
    FLength := Value;
    Change;
  end;
end;

procedure TAbLineSettings.SetOffset(Value : Integer);
begin
  if FOffset <> Value then begin
    FOffset := Value;
    Change;
  end;
end;

procedure TAbLineSettings.SetVisible(Value : Boolean);
begin
  if FVisible <> Value then begin
    FVisible := Value;
    Change;
  end;
end;

constructor TAbLineSettings.Create;
begin
  inherited Create;
  FVisible := True;
  FPen := TPen.Create;
  FPen.OnChange := ChangeObject;
end;

destructor TAbLineSettings.Destroy;
begin
  FPen.Free;
  inherited Destroy;
end;

{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
X        TAbCustomScale
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
procedure TAbCustomScale.SetAngle(Value : Integer);
begin
  if FAngle <> Value then begin
    FAngle := Value;
    Change;
  end;
end;


procedure TAbCustomScale.SetAngleMode(Value : TAngleMode);
begin
  if FAngleMode <> Value then begin
    FAngleMode := Value;
    Change;
  end;
end;

procedure TAbCustomScale.SetFont(Value : TFont);
begin
  if FFont <> Value then begin
    FFont.Assign(Value);
    Change;
  end;
end;

procedure TAbCustomScale.SetFormatStr(Value : String);
begin