abcompas.pas

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

unit AbCompas;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                          Component TAbCompass                                }
{                                                                              }
{******************************************************************************}
{        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,
  Messages,
  SysUtils,
 {****** Abakus VCL - Units ******}
  _GClass,
  _AbProc,
  _AbInfo;

type
  TCompassOption = (opArrowShould, opBevelOuterRnd, opBevelInnerRnd,
    opBevelOuter,
    opName1, opName2, opSubSteps, opValue);
  TCompassOptions = set of TCompassOption;

  TAbCompass = class(TAbAnalogGControl)
  private
    FDeviation: Single;
    FValueShould: Single;
    FBevelOuterRnd: TAbSBevel;
    FBevelInnerRnd: TAbSBevel;
    FBevelOuter: TAbSBevel;
    FBevelValue: TAbSBevel;
    FFontValue: TFont;
    FFontScaleText: TFont;
    FOptions: TCompassOptions;
    FColorArrow: TColor;
    FColorArrowShould: TColor;
    FColorScale: TColor;
    FScaleText: string;
    FSpaceText: Integer;
    FSpaceScale: Integer;
    FVInd1Caption: string;
    FVInd2Caption: string;

    sName1: TSize;
    sName2: TSize;

    sDigInd: TSize;                     {size of the digital indicators-string}
    rDigInd1: TRect;                    {1st digital indicator }
    rDigInd2: TRect;                    {2nd digital indicator }

    rScale: TRect;
    ClipRgn: HRgn;                      {Cliparea}
    ClipOff: HRgn;                      {NullRegion}
    Init: Boolean;
    ScaleTextArray: array[0..7] of string;
    ArrowP: array[0..2] of TPoint;
    OrgP: array[0..10] of TPoint;
    DrawP: array[0..10] of TPoint;
    ShouldP: array[0..2] of TPoint;
    ShouldOrgP: array[0..2] of TPoint;
    cp: TPoint;
    Spacing: Integer;
    sl1: Integer;
    sl2: Integer;
    TextW: Integer;
    TextH: Integer;
    RadScale: Integer;

  protected
    procedure Paint; override;
    procedure ValueChange; override;
    procedure ParamChange(Sender: TObject); override;
    procedure PosChange(Sender: TObject);
    procedure SetOptions(Value: TCompassOptions);
    procedure SetFontValue(Value: TFont);
    procedure SetFontScaleText(Value: TFont);
    procedure SetValueShould(Value: Single);
    procedure SetDeviation(Value: Single);
    procedure SetColorArrow(Value: TColor);
    procedure SetColorArrowShould(Value: TColor);
    procedure SetColorScale(Value: TColor);
    procedure SetScaleText(Value: string);
    procedure SetSpaceText(Value: Integer);
    procedure SetSpaceScale(Value: Integer);
    procedure SetVInd1Caption(Value: string);
    procedure SetVInd2Caption(Value: string);
    procedure CompassScale(can: TCanvas; var r: TRect; CourseIs, CourseShould:
      Single; FullRedraw: Boolean);
  public
    DeviationStr: string;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Font;
    property Visible;
    property ColorArrow: TColor read FColorArrow write SetColorArrow;
    property ColorArrowShould: TColor read FColorArrowShould write
    SetColorArrowShould;
    property ColorScale: TColor read FColorScale write SetColorScale;

    property FontValue: TFont read FFontValue
    write SetFontValue;
    property FontScaleText: TFont read FFontScaleText
    write SetFontScaleText;
    property BevelOuterRnd: TAbSBevel read FBevelOuterRnd
    write FBevelOuterRnd;
    property BevelInnerRnd: TAbSBevel read FBevelInnerRnd
    write FBevelInnerRnd;
    property BevelOuter: TAbSBevel read FBevelOuter
    write FBevelOuter;
    property BevelValue: TAbSBevel read FBevelValue
    write FBevelValue;
    property Options: TCompassOptions read FOptions
    write SetOptions;
    property Deviation: Single read FDeviation
    write SetDeviation;
    property ValueShould: Single read FValueShould
    write SetValueShould;
    property ScaleText: string read FScaleText
    write SetScaleText;
    property SpaceText: Integer read FSpaceText
    write SetSpaceText;
    property SpaceScale: Integer read FSpaceScale
    write SetSpaceScale;
    property VInd1Caption: string read FVInd1Caption
    write SetVInd1Caption;
    property VInd2Caption: string read FVInd2Caption
    write SetVInd2Caption;
  end;

implementation

constructor TAbCompass.Create(AOwner: TComponent);
begin
  BeginUpdate;
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;

  Init := true;

  Height := 281;
  Width := 257;

  FFontValue := TFont.Create;
  FFontValue.Color := clLime;
  FFontValue.Name := 'System';
  FFontValue.Size := 10;

  FFontScaleText := TFont.Create;
  FFontScaleText.Color := clBtnHighlight;
  FFontScaleText.Name := 'Arial';
  FFontScaleText.Size := 14;
  FFontScaleText.Style := [fsBold];

  FBevelOuterRnd := TAbSBevel.Create;
  FBevelOuterRnd.isRound := true;
  FBevelOuterRnd.ColorShadowFrom := clBtnHighlight;
  FBevelOuterRnd.ColorShadowTo := clBtnShadow;
  FBevelOuterRnd.Style := bsLowered;
  FBevelOuterRnd.Spacing := 0;
  FBevelOuterRnd.Width := 5;
  FBevelOuterRnd.Color := clNavy;
  FBevelOuterRnd.BevelLine := blInner;

  FBevelOuter := TAbSBevel.Create;
  FBevelOuter.Spacing := 5;
  FBevelOuter.BevelLine := blOuter;
  FBevelOuter.Width := 2;

  FBevelInnerRnd := TAbSBevel.Create;
  FBevelInnerRnd.isRound := true;
  FBevelInnerRnd.ColorShadowFrom := clBtnHighlight;
  FBevelInnerRnd.ColorShadowTo := clBtnShadow;
  FBevelInnerRnd.PenColor := clBtnShadow;
  FBevelInnerRnd.Spacing := 0;
  FBevelInnerRnd.BevelLine := blInner;
  FBevelInnerRnd.Width := 5;

  FBevelValue := TAbSBevel.Create;
  FBevelValue.Style := bsLowered;
  FBevelValue.Spacing := 0;
  FBevelValue.Color := clBlack;
  FBevelValue.BevelLine := blNone;
  FBevelValue.Width := 2;

  FOptions := [opArrowShould, opBevelOuterRnd, opBevelInnerRnd, opBevelOuter,
    opName1, opName2, opSubSteps, opValue];

  FColorScale := clAqua;
  FColorArrow := clRed;
  FColorArrowShould := clYellow;

  FSpaceScale := 5;
  FSpaceText := 5;

  FVInd1Caption := 'Course';
  FVInd2Caption := 'deviation';

  ScaleText := 'N;NE;E;SE;S;SW;W;NW';

  SignalSettings.ValueFormat := '##0.0