_gclass.pas

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

unit _GClass;

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

{$I Abks.inc}

interface               

uses
  Windows,
  Classes,
  Graphics,
  Controls,
  extctrls,
  Menus,
  SysUtils,
  Messages,
  Inifiles,
  Buttons,
  {****** Abakus VCL - Units ******}
  _AbInfo,
  _AbProc,
  AbFlashT;

type
  TAngleMode = (amAuto, amManual);

  TOverflowEvent = procedure(Sender: TObject; PPT: Integer) of object;
  TLimitEvent = procedure(Sender: TObject; Lower, Upper: Boolean) of object;
  TSectorChangeEvent = procedure(Sender: TObject; Sector1, Sector2, Sector3,
    Enter: Boolean) of object;
  THintOption = (hoAutoHint, hoValue, hoName1, hoName2, hoMin, hoMax,
    hoMinMaxDate, hoMinMaxTime);
  THintOptions = set of THintOption;

  TEnabledKey = ( _VK_PRIOR, _VK_NEXT, _VK_END, _VK_HOME, _VK_LEFT, _VK_DOWN,
                  _VK_UP, _VK_RIGHT);
  TEnabledKeys = set of TEnabledKey;

  TBarStyle = (bsBar, bsLED_Bar, bsPoint);
  TBarDirection = (bdHorizontal, bdVertical);
  TBarOption = (opValue, opUnit, opUseSectorCol, opBidir);
  TBarOptions = set of TBarOption;

  TPos = (pLeft, pRight, pTop, pBottom);
  TPosH = (phLeft, phRight, phCenter);
  TPosV = (pvTop, pvBottom, pvCenter);

  TBevelLine = (blNone, blOuter, blInner, blBoth);

  THandleIniEvent = procedure(Ini: TIniFile; Read: Boolean) of object;

  TNumGlyphs = Buttons.TNumGlyphs;

  TMode = (mButton, mSwitch, mIndicator, mRadioButton);

  TAbPersistent = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
  protected
  public
    procedure Change; virtual;
    procedure ChangeObject(Sender: TObject); virtual;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TAbOffset = class(TAbPersistent)
  private
    FTop: Integer;
    FLeft: Integer;
    FRight: Integer;
    FBottom: Integer;
  protected
    procedure AssignTo(Dest: TPersistent); override;
    constructor Create;
    procedure SetTop(Value: Integer);
    procedure SetLeft(Value: Integer);
    procedure SetRight(Value: Integer);
    procedure SetBottom(Value: Integer);
  public
    function SetOffset(r: TRect): TRect;
    procedure Write(oTop, oLeft, oRight, oBottom: Integer);
  published
    property Top: Integer read FTop write SetTop default 0;
    property Left: Integer read FLeft write SetLeft default 0;
    property Right: Integer read FRight write SetRight default 0;
    property Bottom: Integer read FBottom write SetBottom default 0;
  end;

  
  TAbBevelSettings = class(TAbPersistent)
  private
    FColorFrom : TColor;
    FColorTo   : TColor;
    FWidth      : Integer;
    procedure SetColorFrom(Value  : TColor);
    procedure SetColorTo(Value : TColor);
    procedure SetWidth(Value : Integer);
  protected
  public
    constructor Create;
    procedure SwapColors;
  published
    property ColorFrom : TColor  read FColorFrom write SetColorFrom;
    property ColorTo   : TColor  read FColorTo   write SetColorTo;
    property Width     : Integer read FWidth     write SetWidth;
  end;


  TAbLineSettings = class(TAbPersistent)
  private
    FPen : TPen;
    FLength : Integer;
    FOffset : Integer;
    FVisible : Boolean;
    procedure SetPen(Value : TPen);
    procedure SetLength(Value : Integer);
    procedure SetOffset(Value : Integer);
    procedure SetVisible(Value : Boolean);
  protected
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Pen : TPen read FPen write SetPen;
    property Length : Integer read FLength write SetLength;
    property Offset : Integer read FOffset write SetOffset default 0;
    property Visible : Boolean read FVisible write SetVisible default true;
  end;



  TAbCustomScale = class(TAbPersistent)
  private
    FFont : TFont;
    FFormatStr : String;
    FStepLines : TAbLineSettings;
    FSubStepLines : TAbLineSettings;
    FTextOffsetX  : Integer;
    FTextOffsetY  : Integer;
    FText         : String;
    FTextAlignment : ToPos;
    FAngle        : Integer;
    FAngleMode    : TAngleMode;
    procedure SetFormatStr(Value : String);
    procedure SetAngle(Value : Integer);
    procedure SetAngleMode(Value : TAngleMode);
    procedure SetFont(Value : TFont);
    procedure SetTextAlignment(Value : ToPos);
    procedure SetTextOffsetX(Value : Integer);
    procedure SetTextOffsetY(Value : Integer);
    procedure SetText(Value : String);
  protected
    property FormatStr : String read FFormatStr write SetFormatStr;
    property Angle : Integer read FAngle write SetAngle default 0;
    property AngleMode : TAngleMode read FAngleMode write SetAngleMode default amAuto;
    property Font : TFont read FFont write SetFont;
    property StepLines : TAbLineSettings read FStepLines write FStepLines;
    property SubStepLines : TAbLineSettings read FSubStepLines write FSubStepLines;
    property TextAlignment : ToPos read FTextAlignment write SetTextAlignment ;
    property TextOffsetX : Integer read FTextOffsetX write SetTextOffsetX default 0;
    property TextOffsetY : Integer read FTextOffsetY write SetTextOffsetY default 0;
    property Text : String read FText write SetText;
  public
    DefaultText : String;
    constructor Create;
    destructor Destroy; override;
  published
  end;

  TAbScale = class(TAbCustomScale)
  private
  protected
  public
  published
    property Angle;
    property AngleMode;
//    property FormatStr;
    property Font;
    property StepLines;
    property SubStepLines;
    property TextAlignment;
    property TextOffsetX;
    property TextOffsetY;
    property Text;
  end;

  TAbFlexScale = class(TAbCustomScale)
  private
    FSubStepAt : Single;   // substeps at Value (+ multible of)
    FStepMulti : Integer;  // Steps at Multible of Substeps
    FSubStepsVis : Integer; // no of visible substeps
    Procedure SetSubStepAt(Value : Single);
    procedure SetStepMulti(Value : Integer);
    procedure SetSubStepsVis(Value : Integer);
  protected
  public
  published
    property SubStepAt : Single read FSubStepAt write SetSubStepAt;
    property StepMulti : Integer read FStepMulti write SetStepMulti;
    property SubStepsVis : Integer read FSubStepsVis write SetSubStepsVis;
    property Angle;
    property AngleMode;
    property Font;
    property FormatStr;
    property StepLines;
    property SubStepLines;
    property TextAlignment;
    property TextOffsetX;
    property TextOffsetY;
  end;

  TAbText = class(TAbPersistent)
  private
    FText : String;
    FFont : TFont;
    FOffsetX : Integer;
    FOffsetY : Integer;
    FPos     : toPos;
    FVisible : Boolean;
    procedure SetText(Value : String);
    procedure SetOffsetX(Value : Integer);
    procedure SetOffsetY(Value : Integer);
    procedure SetPos(Value : toPos);
    procedure SetVisible(Value : Boolean);
    procedure SetFont(Value : TFont);
  protected
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Text : String read FText write SetText;
    property Font : TFont read FFont write SetFont;
    property OffsetX : Integer read FOffsetX write SetOffsetX;
    property OffsetY : Integer read FOffsetY write SetOffsetY;
    property Pos     : toPos read FPos write SetPos;
    property Visible : Boolean read FVisible write SetVisible;
  end;

  TAbValInd = class(TAbPersistent)
  private
    FFormatStr : String;
    FBevel     : TAbBevelSettings;
    FCaption   : TAbText;

    FColor : TColor;
    FFont  : TFont;
    FVisible : Boolean;

    FOffsetX : Integer;
    FOffsetY : Integer;
    FTxtSpacing : TAbOffset;

    procedure SetFormatStr(Value : String);
    procedure SetColor(Value : TColor);
    procedure SetVisible(Value : Boolean);
    procedure SetOffsetX(Value : Integer);
    procedure SetOffsetY(Value : Integer);
    procedure SetFont(Value : TFont);
  protected
  public

    rInd  : TRect;
    wCorr : Integer;

    procedure Draw(can: TCanvas; xyPos : TPoint; pos : toPos);
    procedure DrawValue(can: TCanvas; Value : Real);

    constructor Create;
    destructor Destroy; override;
  published
    property FormatStr : String read FFormatStr write SetFormatStr;
    property Bevel : TAbBevelSettings read FBevel write FBevel;
    property Caption : TAbText read FCaption write FCaption;
    property Color : TColor read FColor write SetColor;
    property Font : TFont read FFont write SetFont;
    property OffsetX : Integer read FOffsetX write SetOffsetX;
    property OffsetY : Integer read FOffsetY write SetOffsetY;
    property Visible : Boolean read FVisible write SetVisible;
    property TxtSpacing : TAbOffset read FTxtSpacing write FTxtSpacing;
  end;

  TIniSettings = class(TPersistent)
  private
    FFileName: string;
    FSection: string;
    FUseAppDir: Boolean;
    FAutoLoadSave: Boolean;
    IniFile: TIniFile;
    FOnHandleIniEvent: THandleIniEvent;
  public
    ErrString: string;
    Error: Boolean;
    constructor Create;
    destructor Destroy; override;
    procedure AutoHandle(Read: Boolean);
    procedure Handle(Read: Boolean);
  published
    property FileName: string read FFileName write FFileName;
    property Section: string read FSection write FSection;
    property UseAppDir: Boolean read FUseAppDir write FUseAppDir default true;
    property AutoLoadSave: Boolean read FAutoLoadSave write FAutoLoadSave default
    false;
    property OnHandleIniEvent: THandleIniEvent read FOnHandleIniEvent write
    FOnHandleIniEvent;
  end;


  TAbGraphicControl = class(TGraphicControl)
  private
    FAbInfo: TAbInfo;
    FUpdateCount: Integer;
  protected
    CompInvalidate : Boolean;  // true if invalidate is called
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer);
      override;
    procedure Change; dynamic; // proc to call ParamChange if UpdateCount = 0
    procedure ParamChange(Sender: TObject); dynamic;
    property UpdateCount: Integer read FUpdateCount;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Invalidate; override;
    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    {$IFDEF V5up} property OnContextPopup; {$ENDIF}
    property PopupMenu;
  end;

  TAbCustomControl = class(TCustomControl)
  private
    FAbInfo: TAbInfo;
    FUpdateCount: Integer;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x, y:
      Integer);
      override;
    procedure Change; dynamic; // proc to call ParamChange if UpdateCount = 0
    procedure ParamChange(Sender: TObject); virtual;
    property UpdateCount: Integer read FUpdateCount;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    {$IFDEF V5up} property OnContextPopup; {$ENDIF}
    property PopupMenu;
  end;

  TAbTimerSpeedBtn = class(TSpeedButton)
  private
    FAbInfo: TAbInfo;
    FInterval : Integer;
    FStartDelay : Cardinal;
    FTimerEnabled : Boolean;
    StartTime : Cardinal;
  protected
    procedure SetInterval(Value : Integer);
    procedure SetStartDelay(Value : Cardinal);
    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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    property Interval : Integer read FInterval write SetInterval default 100;
    property TimerEnabled : Boolean read FTimerEnabled write FTimerEnabled default true;
    property StartDelay : Cardinal read FStartDelay  write SetStartDelay default 500;
  end;

  TAbSpinButton = class (TWinControl)
  private
    FAbInfo: TAbInfo;
    FFocusedButton: TAbTimerSpeedBtn;
    FFocusControl: TWinControl;
    FOnUpClick: TNotifyEvent;
    FOnDownClick: TNotifyEvent;
    function CreateButton: TAbTimerSpeedBtn;
    function GetUpGlyph: TBitmap;
    function GetDownGlyph: TBitmap;
    procedure SetUpGlyph(Value: TBitmap);
    procedure SetDownGlyph(Value: TBitmap);
    function GetUpNumGlyphs: TNumGlyphs;
    function GetDownNumGlyphs: TNumGlyphs;
    procedure SetInterval(Value : Integer);
    function GetInterval: Integer;
    procedure SetStartDelay(Value : Integer);
    function GetStartDelay: Integer;
    procedure SetUpNumGlyphs(Value: TNumGlyphs);
    procedure SetDownNumGlyphs(Value: TNumGlyphs);
    procedure BtnClick(Sender: TObject);
    procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure myAdjustSize (var W, H: Integer);
    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  protected
    procedure Loaded; override;
    procedure SetEnabled(Value: Boolean); {$IFDEF CEnabled} override; {$ENDIF}
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    FUpButton: TAbTimerSpeedBtn;
    FDownButton: TAbTimerSpeedBtn;
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published

    property AbInfo: TAbInfo read FAbInfo write FAbInfo stored false;
    property Align;
    {$IFDEF CEnabled}
      property Anchors;
      property Constraints;
      property DragKind;
      property OnEndDock;
      property OnStartDock;
    {$ENDIF}
    property Ctl3D;
    property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
    property DownNumGlyphs: TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs default 1;
    property DragCursor;