abvcind.pas

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

unit AbVCInd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  _GClass, _AbProc;

type


  TAbVCInd = class(TAbGraphicControl)
  private
    { Private-Deklarationen }

    FIndDeviation : TAbValInd;
    FIndCourse    : TAbValInd;
    FIndPitch     : TAbValInd;
    FIndRoll      : TAbValInd;

    FArrShouldSize : Integer;
    FArrShouldOffs : Integer;
    FArrShouldCol : TColor;
    FArrowSize : Integer;

    FScaleHeight : Integer;

    FHorizonLine : TAbLineSettings;
    FPitchLine : TAbLineSettings;

    FPitchScale : TAbFlexScale;
    FPitchScaleOffs : Integer;


    FCourse : Single;
    FCourseBkColor : TColor;
    FCourseScale : TAbScale;
    FCourseShould : Single;
    FColor : TColor;
    FColorSky    : TColor;
    FColorGround : TColor;

    FOuterSpacing : Integer;
    FInnerSpacing : Integer;
    FRoll : Single;
    FRollBkColor : TColor;
    FRollScale : TAbScale;
    FPitch : Single;

    FBevelOuter  : TAbBevelSettings;
    FBevelMiddle : TAbBevelSettings;
    FBevelInner  : TAbBevelSettings;

    yPitch : Integer;

    bmp : TBitmap;
    cp : TPoint;      // the center-point
    rInd : TRect;
    rHorizon : TRect;

    init : Boolean;
    pPosLeftTop : TPoint;

    PixelPerValue : Single;     // Pitch scale and horizon
    PixelPerSubStep : Single;

    ArrowCourse : Array[0..2] of TPoint;
    ArrowCourseShould : Array[0..2] of TPoint;
    ArrowRoll   : Array[0..2] of TPoint;

    OffsetIndicator : Integer;     // offset for Indicator-region from center

    FCourseScaleText : String;
    FRollScaleText   : String;

    // component region's
    rgnOuter : THandle;
    rgnBevel : THandle;

    // round region's , from big to small
    rgnOuterCircle  : THandle;
    rgnOuterBevel   : THandle;
    rgnInnerBevel   : THandle;
    rgnInnerCircle  : THandle;

    // polygon regions
    rgnTmpIndicatorTop     : THandle;
    rgnTmpIndicatorBottom  : THandle;

    // complex region's
    rgnRoundRing : THandle;
    rgnCourse  : THandle;
    rgnRoll    : THandle;
    rgnSurface : THandle;

    procedure SetArrowSize(Value : Integer);
    procedure SetArrShouldSize(Value : Integer);
    procedure SetArrShouldOffs(Value : Integer);
    procedure SetArrShouldCol(Value : TColor);

    procedure SetScaleHeight(Value : Integer);

    Procedure SetCourse(Value : Single);
    Procedure SetCourseBkColor(Value : TColor);
    Procedure SetCourseShould(Value : Single);
    Procedure SetRoll(Value : Single);
    Procedure SetRollBkColor(Value : TColor);
    Procedure SetPitch(Value : Single);
    procedure SetPitchScaleOffs(Value : Integer);

    Procedure SetColor(Value : TColor);
    Procedure SetColorSky(Value : TColor);
    Procedure SetColorGround(Value : TColor);
    Procedure SetOuterSpacing(Value : Integer);
    Procedure SetInnerSpacing(Value : Integer);
    Procedure DrawCourseScale;
    Procedure DrawRollScale;
    Procedure DrawPitchScale;
    procedure DrawHorizon;
    procedure DrawValueInd;

    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure DeleteRegion;
    procedure CreateRegion( r : TRect);
    Procedure ShowRegions(can: TCanvas; r : TRect);

  protected
    { Protected-Deklarationen }
    Procedure Paint; override;
    procedure ChangeCourseScale(Sender: TObject);
    procedure ChangeRollScale(Sender: TObject);
    procedure ChangePitchScale(Sender: TObject);
    procedure ParamChange(Sender: TObject); override;
  public
    { Public-Deklarationen }
    procedure Loaded; override;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    { Published-Deklarationen }

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnStartDrag;

    Property BevelOuter : TAbBevelSettings read FBevelOuter write FBevelOuter;
    Property BevelMiddle : TAbBevelSettings read FBevelMiddle write FBevelMiddle;
    Property BevelInner : TAbBevelSettings read FBevelInner write FBevelInner;
    
    property ArrShouldSize : Integer read FArrShouldSize write SetArrShouldSize;
    property ArrShouldOffs : Integer read FArrShouldOffs write SetArrShouldOffs;
    property ArrShouldCol  : TColor read FArrShouldCol write SetArrShouldCol;
    property ArrowSize     : Integer read FArrowSize write SetArrowSize;

    Property Course : Single read FCourse write SetCourse;
    Property CourseScale : TAbScale read FCourseScale write FCourseScale;
    Property CourseShould : Single read FCourseShould write SetCourseShould;

    property HorizonLine : TAbLineSettings read FHorizonLine write FHorizonLine;
    property PitchLine : TAbLineSettings read FPitchLine write FPitchLine;
    property PitchScaleOffs : Integer read FPitchScaleOffs write SetPitchScaleOffs;

    property IndDeviation : TAbValInd read FIndDeviation write FIndDeviation;
    property IndCourse : TAbValInd read FIndCourse write FIndCourse;
    property IndPitch : TAbValInd read FIndPitch write FIndPitch;
    property IndRoll : TAbValInd read FIndRoll write FIndRoll;

    Property Roll : Single read FRoll write SetRoll;
    Property RollScale : TAbScale read FRollScale write FRollScale;
    Property Pitch : Single read FPitch write SetPitch;

    property ScaleHeight : Integer read FScaleHeight write SetScaleHeight;

    property Color : TColor read FColor write SetColor;
    property ColorSky : TColor read FColorSky write SetColorSky;
    property ColorGround : TColor read FColorGround write SetColorGround;

    property CourseBkColor : TColor read FCourseBkColor write SetCourseBkColor;
    property RollBkColor : TColor read FRollBkColor write SetRollBkColor;

    property OuterSpacing : Integer read FOuterSpacing write SetOuterSpacing;
    property InnerSpacing : Integer read FInnerSpacing write SetInnerSpacing;

    property PitchScale : TAbFlexScale read FPitchScale write FPitchScale;
  end;

implementation



{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
X        TAbVCInd
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
procedure TAbVCInd.SetArrowSize(Value : Integer);
begin
  if (FArrowSize <> Value) and (Value >= 0) then begin
    FArrowSize := Value;
    Change;
  end;
end;

procedure TAbVCInd.SetArrShouldSize(Value : Integer);
begin
  if (FArrShouldSize <> Value) and (Value >= 0) then begin
    FArrShouldSize := Value;
    Change;
  end;
end;

procedure TAbVCInd.SetArrShouldOffs(Value : Integer);
begin
  if (FArrShouldOffs <> Value) then begin
    FArrShouldOffs := Value;
    Change;
  end;
end;

procedure TAbVCInd.SetArrShouldCol(Value : TColor);
begin
  if (FArrShouldCol <> Value) then begin
    FArrShouldCol := Value;
    ChangeCourseScale(self);
  end;
end;


Procedure TAbVCInd.SetColor(Value : TColor);
begin
  if FColor <> Value then begin
    FColor := Value;
    Change;
  end;
end;

Procedure TAbVCInd.SetColorSky(Value : TColor);
begin
  if FColorSky <> Value then begin
    FColorSky := Value;
    Change;
  end;
end;

Procedure TAbVCInd.SetColorGround(Value : TColor);
begin
  if FColorGround <> Value then begin
    FColorGround := Value;
    Change;
  end;
end;

Procedure TAbVCInd.SetCourseBkColor(Value : TColor);
begin
  if FCourseBkColor <> Value then begin
    FCourseBkColor := Value;
    ChangeCourseScale(self);
  end;
end;

Procedure TAbVCInd.SetRollBkColor(Value : TColor);
begin
  if FRollBkColor <> Value then begin
    FRollBkColor := Value;
    ChangeRollScale(self);
  end;
end;

procedure TAbVCInd.SetScaleHeight(Value : Integer);
begin
  if (FScaleHeight <> Value) and (Value > 0) then begin
    FScaleHeight := Value;
    Change;
  end;
end;

Procedure TAbVCInd.SetOuterSpacing(Value : Integer);
begin
  if FOuterSpacing <> Value then begin
    FOuterSpacing := Value;
    Change;
  end;
end;

Procedure TAbVCInd.SetInnerSpacing(Value : Integer);
begin
  if FInnerSpacing <> Value then begin
    FInnerSpacing := Value;
    Change;
  end;
end;


procedure TAbVCInd.ChangeCourseScale(Sender: TObject);
Begin
  DrawCourseScale;
  SelectObject(Canvas.Handle,rgnOuter);
  DrawValueInd;
  Canvas.Draw(0,0,bmp);
end;

procedure TAbVCInd.ChangePitchScale(Sender: TObject);
Begin
  DrawHorizon;
  DrawValueInd;
  SelectObject(Canvas.Handle,rgnOuter);
  Canvas.Draw(0,0,bmp);
end;

procedure TAbVCInd.ChangeRollScale(Sender: TObject);
Begin
  DrawRollScale;
  DrawValueInd;
  SelectObject(Canvas.Handle,rgnOuter);
  Canvas.Draw(0,0,bmp);
end;

Procedure TAbVCInd.DrawCourseScale;
var
  Step, SubStep          : Integer;
  StepFrom, StepTo       : TPoint;
  SubStepFrom, SubStepTo : TPoint;
  OrgStepFrom, OrgStepTo : TPoint;
  OrgSubStepFrom, OrgSubStepTo : TPoint;
  r : TRect;
  Alpha, AlphaStep, AlphaSubStep : Single;
  OrgTextPos, TextPos : TPoint;
  txtHeight : Integer;
  sclText : String;
  txt : String;
  p, n : Integer;
  tmpArrowCourseShould : Array[0..2] of TPoint;
begin

  AlphaStep := 45;
  AlphaSubStep := 5;

  if FCourseScale.Text <> '' then
    sclText := FCourseScale.Text
  else
    sclText := FCourseScale.DefaultText;

  r := rInd;
  bmp.canvas.Font := FCourseScale.Font;

  with bmp.canvas do begin
    txtHeight := TextHeight('X');

    SelectObject(Handle,rgnCourse);
    Pen.Color   := FCourseBkColor;
    Brush.Color := FCourseBkColor;
    Rectangle(r.left, r.top, r.right, r.bottom);

    p := BevelOuter.Width + OuterSpacing + FBevelMiddle.Width ;
    OrgStepFrom := Point(cp.x, p  + 5 + FCourseScale.StepLines.Offset);
    OrgStepTo   := Point(OrgStepFrom.x, OrgStepFrom.y + FCourseScale.StepLines.Length);


    OrgSubStepFrom := Point(cp.x, p + 10 + FCourseScale.SubStepLines.Offset);
    OrgSubStepTo   := Point(OrgSubStepFrom.x, OrgSubStepFrom.y + FCourseScale.SubStepLines.Length);

//    p := p + 20;
    OrgTextPos := Point( cp.x + FCourseScale.TextOffsetX, OrgStepTo.y + FCourseScale.TextOffsety + txtHeight div 2);

    for n := 0 to 2 do begin
      tmpArrowCourseShould[n] := AbRotate(ArrowCourseShould[n], cp, CourseShould - Course    , true);
    end;
    pen.width := 1;
    pen.color := FArrShouldCol;
    Brush.Color := FArrShouldCol;
    Polygon(tmpArrowCourseShould);
    Brush.Style := bsClear;
//    Pen.Color := clWhite;

    for Step := 0 to 7 do begin
      Alpha := Step * AlphaStep - FCourse;
      
      while Alpha > 360 do Alpha := Alpha - 360;
      while Alpha < 0 do Alpha := Alpha + 360;

      txt := AbStrToken(sclText,';');

      if ((Alpha >= 260) and (Alpha <= 360)) or ((Alpha >= 0) and (Alpha < 80)) then begin

        if FCourseScale.StepLines.Visible then begin
          StepFrom := AbRotate(OrgStepFrom, cp, Alpha, true);
          StepTo   := AbRotate(OrgStepTo, cp, Alpha, true);
          Pen := FCourseScale.StepLines.Pen;
          MoveTo(StepFrom.x, StepFrom.y);
          LineTo(StepTo.x, StepTo.y);
        end;

        TextPos  := AbRotate(OrgTextPos, cp, Alpha, true);
        if (FCourseScale.AngleMode = amAuto) then
          AbRotTextOut(bmp.canvas,TextPos,Alpha+FCourseScale.Angle, txt,FCourseScale.TextAlignment)
        else
          if (FCourseScale.Angle = 0) then
            AbTextOut(bmp.canvas,TextPos.x, TextPos.y,txt,FCourseScale.TextAlignment)
          else
            AbRotTextOut(bmp.canvas,TextPos,FCourseScale.Angle, txt,FCourseScale.TextAlignment);

        if FCourseScale.SubStepLines.Visible then begin
          for SubStep := 1 to 8 do begin
            Pen := FCourseScale.SubStepLines.Pen;
            SubStepFrom := AbRotate(OrgSubStepFrom, cp, Alpha + (SubStep * AlphaSubStep) , true);
            SubStepTo   := AbRotate(OrgSubStepTo, cp, Alpha + (SubStep * AlphaSubStep), true);
            MoveTo(SubStepFrom.x, SubStepFrom.y);
            LineTo(SubStepTo.x, SubStepTo.y);
          end;