abvcind.pas

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

      AbCircleGradFill(can, rTemp, FBevelInner.ColorFrom, FBevelInner.ColorTo);



    SelectObject(Handle,rgnInnerCircle);
    pen.color := Color;
    Rectangle(r.left, r.top, r.right, r.bottom);


    SelectObject(Handle,rgnSurface);
    Rectangle(r.left, r.top, r.right, r.bottom);

//    SelectObject(Handle,rgnOuterCircle);
//    Brush.Color := Color;
    //Rectangle(r);

    SelectObject(Handle,tmpRgn);
    pen.width := 1;
    pen.color := FBevelMiddle.ColorTo;
    moveTo(cp.x, cp.y);
    LineTo(r.left, cp.y-OffsetIndicator);

    moveTo(cp.x, cp.y);
    LineTo(r.right, cp.y-OffsetIndicator);

    pen.color := FBevelMiddle.ColorFrom;
    moveTo(cp.x, cp.y);
    LineTo(r.left, cp.y+OffsetIndicator);

    moveTo(cp.x, cp.y);
    LineTo(r.right, cp.y+OffsetIndicator);


    SelectObject(Handle,rgnOuterCircle);
    pen.color := Color;
//    Brush.Color := Color;
    Polygon(ArrowCourse);
    Polygon(ArrowRoll);

   // Rectangle(r);

    SelectObject(Handle,rgnInnerBevel);
    p := FBevelOuter.Width + OuterSpacing  + FBevelMiddle.Width + FScaleHeight + FBevelInner.Width +1;
    rTemp := rInd;
    AbMultiBorder(rTemp,p,p,p,p);
    Brush.Style := bsSolid;
    Brush.Color := Color;
    pen.color   := Color;
    Ellipse(rTemp.left, rTemp.top, rTemp.right, rTemp.bottom);
    SelectObject(Handle,rgnOuterCircle);

  end;

  p :=  OuterSpacing + FBevelOuter.Width + FBevelMiddle.Width +(FScaleHeight div 2);
  x := p;

  FIndCourse.Draw(Bmp.Canvas, Point(x,cp.y-2),toBotCenter);
  FIndDeviation.Draw(Bmp.Canvas, Point(x,cp.y+2),toTopCenter);
  x := (Width - p) - 2;
  FIndPitch.Draw(Bmp.Canvas, Point(x,cp.y-2),toBotCenter);
  FIndRoll.Draw(Bmp.Canvas, Point(x,cp.y+2),toTopCenter);

  DeleteObject(tmpRgn);
  DrawCourseScale;
  DrawRollScale;
  DrawValueInd;
  SelectObject(Canvas.Handle,rgnOuter);
  Canvas.Draw(0,0,bmp);
end;


procedure TAbVCInd.DrawValueInd;
var
  FDeviation : Single;
begin

  FDeviation := Course - CourseShould;

  if FDeviation < -180 then
    FDeviation := 360 - ABS(FDeviation)
  else
    if FDeviation > 180 then FDeviation := FDeviation - 360;

  with Bmp.Canvas do begin
    SelectObject(Handle,rgnOuterCircle);

    FIndCourse.DrawValue(Bmp.Canvas, FCourse);
    FIndDeviation.DrawValue(Bmp.Canvas, FDeviation);
    FIndPitch.DrawValue(Bmp.Canvas, FPitch);
    FIndRoll.DrawValue(Bmp.Canvas, FRoll);

    pen.color := FBevelMiddle.ColorFrom;
    Brush.Color := Color;
    Polygon(ArrowCourse);
    Polygon(ArrowRoll);
    pen.color := FBevelMiddle.ColorTo;
    MoveTo(ArrowCourse[1].x,ArrowCourse[1].y);
    LineTo(ArrowCourse[2].x,ArrowCourse[2].y);
    MoveTo(ArrowRoll[1].x,ArrowRoll[1].y);
    LineTo(ArrowRoll[2].x,ArrowRoll[2].y);
  end;
end;

procedure TAbVCInd.DeleteRegion;
begin
  DeleteObject(rgnOuter);
  DeleteObject(rgnBevel);
  DeleteObject(rgnCourse);
  DeleteObject(rgnRoll);
  DeleteObject(rgnRoundRing);
  DeleteObject(rgnSurface);
  DeleteObject(rgnOuterCircle);
  DeleteObject(rgnOuterBevel);
  DeleteObject(rgnInnerCircle);
  DeleteObject(rgnInnerBevel);
  DeleteObject(rgnTmpIndicatorTop);
  DeleteObject(rgnTmpIndicatorBottom);
end;

procedure TAbVCInd.WMSize(var Message: TWMSize);
begin
  inherited;
  Paint;
  Message.Result := 0;
end;

procedure TAbVCInd.CreateRegion( r : TRect);
var
  pTemp : Array[0..5] of TPoint;  // array for polygon
  p : Integer;
begin
  if UpdateCount > 0 then exit;

  pPosLeftTop := Point(Left, Top);

  rHorizon := rInd;
  AbBorder(rHorizon,
           FBevelOuter.Width +
           OuterSpacing +
           FBevelMiddle.Width +
           FScaleHeight +
           FBevelInner.Width +
           InnerSpacing + FPitchScaleOffs );

  PixelPerSubStep := (rHorizon.Bottom - rHorizon.Top) / FPitchScale.SubStepsVis;

  PixelPerValue := PixelPerSubStep * ( 1 / FPitchScale.SubStepAt) ;

  // delete all region's
  DeleteRegion;

  rgnOuter := CreateEllipticRgn( left, top, Left + Width, Top + Height);

  AbBorder(r, FBevelOuter.Width);
  rgnBevel := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);


  ArrowCourse[0] := Point(cp.x - ArrowSize, r.top + OuterSpacing - 1);
  ArrowCourse[1] := Point(cp.x , r.top  + 2 * ArrowSize + OuterSpacing- 1);
  ArrowCourse[2] := Point(cp.x + ArrowSize, r.top + OuterSpacing- 1);

  ArrowRoll[0] := Point(cp.x - ArrowSize, r.Bottom  - OuterSpacing - 1);
  ArrowRoll[1] := Point(cp.x , r.Bottom  - OuterSpacing - 2 * ArrowSize - 1);
  ArrowRoll[2] := Point(cp.x + ArrowSize, r.Bottom  - OuterSpacing - 1);

  p :=  ArrowCourse[1].y + FArrShouldOffs;
  ArrowCourseShould[0] := Point(cp.x - FArrShouldSize, p + 2 * FArrShouldSize);
  ArrowCourseShould[1] := Point(cp.x , p);
  ArrowCourseShould[2] := Point(cp.x + FArrShouldSize, p + 2 * FArrShouldSize);

  AbBorder(r, OuterSpacing);

 {
  ArrowCourseShould[0] := Point(cp.x - ArrowSize, r.top);
  ArrowCourseShould[1] := Point(cp.x , r.top + 2 * ArrowSize);
  ArrowCourseShould[2] := Point(cp.x + ArrowSize, r.top);
  }


  // polygon region
  pTemp[0] := r.TopLeft;
  pTemp[1].x := r.Right;
  pTemp[1].y := r.Top;
  pTemp[2].x := r.Right;
  pTemp[2].y := cp.y - OffsetIndicator;
  pTemp[3].x := cp.x;
  pTemp[3].y := cp.y;
  pTemp[4].x := r.Left;
  pTemp[4].y := cp.y - OffsetIndicator;
  pTemp[5]   := pTemp[0];

  rgnTmpIndicatorTop := CreatePolygonRgn(pTemp,6,WINDING);

  pTemp[0].x := r.Left;
  pTemp[0].y := r.Bottom;
  pTemp[1] := r.BottomRight;
  pTemp[2].x := r.Right;
  pTemp[2].y := cp.y + OffsetIndicator;
  pTemp[3].x := cp.x;
  pTemp[3].y := cp.y;
  pTemp[4].x := r.Left;
  pTemp[4].y := cp.y + OffsetIndicator;
  pTemp[5]   := pTemp[0];

  rgnTmpIndicatorBottom := CreatePolygonRgn(pTemp,6,WINDING);



  // Round regions , from big to small
  rgnOuterCircle := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  AbBorder(r, FBevelMiddle.Width);

  rgnOuterBevel := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  AbBorder(r, FScaleHeight);

  rgnInnerBevel := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  AbBorder(r, FBevelInner.Width);

  AbBorder(r, InnerSpacing);
  AbMultiBorder(r,1,1,0,0);
  rgnInnerCircle := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);


  // complex region's
  rgnRoundRing := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  CombineRgn(rgnRoundRing, rgnOuterBevel, rgnInnerBevel, RGN_DIFF);

  rgnCourse := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  CombineRgn(rgnCourse, rgnRoundRing, rgnTmpIndicatorTop, RGN_AND );

  rgnRoll := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  CombineRgn(rgnRoll, rgnRoundRing, rgnTmpIndicatorBottom, RGN_AND );


  rgnSurface := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  CombineRgn(rgnSurface, rgnOuterCircle, rgnTmpIndicatorBottom, RGN_XOR );

  CombineRgn(rgnSurface, rgnSurface, rgnTmpIndicatorTop, RGN_XOR );
  CombineRgn(rgnSurface, rgnSurface, rgnBevel, RGN_AND );

end;

procedure TAbVCInd.ParamChange(Sender: TObject);
begin
  if init then exit;
  invalidate;
 // CreateRegion(rInd);
 // Paint;
 // ShowRegions(bmp.Canvas, rInd);

end;

constructor TAbVCInd.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  ControlStyle := ControlStyle + [csOpaque];
  init := true;

  bmp := TBitmap.Create;
  bmp.Width := Width;
  bmp.Height := Height;

  BeginUpdate;

  FScaleHeight := 50;

  FPitchScaleOffs := 10;

  FBevelOuter  := TAbBevelSettings.Create;

  FIndDeviation := TAbValInd.Create;
  FIndDeviation.Caption.Pos := toBotCenter;
  FIndDeviation.Caption.Text := 'Dev.';

  FIndCourse    := TAbValInd.Create;
  FIndCourse.Caption.Pos := toTopCenter;
  FIndCourse.Caption.Text := 'Course';

  FIndPitch     := TAbValInd.Create;
  FIndPitch.Caption.Pos := toTopCenter;
  FIndPitch.Caption.Text := 'Pitch';

  FIndRoll      := TAbValInd.Create;
  FIndRoll.Caption.Pos := toBotCenter;
  FIndRoll.Caption.Text := 'Roll';

  FColor := clBtnFace;
  FColorSky := $00FFBFBF;
  FColorGround := $00008ECC;

  FOuterSpacing := 5;
  FInnerSpacing := 5;

  FArrowSize := 10;


  FCourseBkColor := clNavy;
  FRollBkColor := clMaroon;
  FArrShouldSize := 10;
  FArrShouldOffs := 0;
  FArrShouldCol := clRed;


  FCourseScale := TAbScale.Create;
  FCourseScale.Font.Name := 'Arial';
  FCourseScale.Font.Color := clWhite;
  FCourseScale.Font.Size := 18;
  FCourseScale.Font.Style := [fsBold];
  FCourseScale.StepLines.Length := 15;
  FCourseScale.SubStepLines.Length := 8;

  FRollScale := TAbScale.Create;
  FRollScale.Font.Name := 'Arial';
  FRollScale.Font.Color := clWhite;
  FRollScale.Font.Size := 18;
  FRollScale.Font.Style := [fsBold];
  FRollScale.StepLines.Length := 15;
  FRollScale.SubStepLines.Length := 8;

  FPitchScale := TAbFlexScale.Create;
  FPitchScale.Font.Name := 'Arial';
  FPitchScale.Font.Color := clWhite;
  FPitchScale.Font.Size := 8;
  FPitchScale.Font.Style := [fsBold];
  FPitchScale.StepLines.Length := 15;
  FPitchScale.SubStepLines.Length := 8;
  FPitchScale.SubStepLines.Pen.Color := clGray;
  FPitchScale.SubStepAt := 1;
  FPitchScale.StepMulti := 5;
  FPitchScale.SubStepsVis := 15;


  FHorizonLine := TAbLineSettings.Create;
  FHorizonLine.Length   := 100;
  FHorizonLine.Pen.Color    := clWhite;

  FPitchLine := TAbLineSettings.Create;
  FPitchLine.Length   := 50;
  FPitchLine.Pen.Color    := clWhite;


  FBevelMiddle := TAbBevelSettings.Create;
  FBevelMiddle.SwapColors;

  FBevelInner  := TAbBevelSettings.Create;

  SetBounds(Left,Top,273,273);

  OffsetIndicator := 60;

  rInd := Rect(0,0,width-1,Height-1);
  cp := AbCenterPoint(rInd);

//  CreateRegion(rInd);
  FCourseScale.DefaultText := 'N;NE;E;SE;S;SW;W;NW';
  FRollScale.DefaultText := '180;135;90;45;0;-45;-90;-135';

  FCourseScaleText := 'N;NE;E;SE;S;SW;W;NW';
  FRollScaleText   := '180;135;90;45;0;-45;-90;-135';

   if (csDesigning in ComponentState) then Loaded;
end;

procedure TAbVCInd.Loaded;
begin
  inherited Loaded;
  FCourseScale.OnChange :=  ChangeCourseScale;
  FRollScale.OnChange   :=  ChangeRollScale;
  FPitchScale.OnChange :=  ParamChange;
  FHorizonLine.OnChange := ChangeRollScale;
  FPitchLine.OnChange     := ChangeRollScale;
  FBevelOuter.OnChange := ParamChange;
  FBevelMiddle.OnChange := ParamChange;
  FBevelInner.OnChange := ParamChange;

  FIndDeviation.OnChange := ParamChange;
  FIndCourse.OnChange := ParamChange;
  FIndPitch.OnChange := ParamChange;
  FIndRoll.OnChange := ParamChange;
  pPosLeftTop := Point(Top, Left);

  EndUpdate;
  init := false;
end;

destructor TAbVCInd.Destroy;
begin
  FHorizonLine.Free;
  FPitchLine.Free;

  FBevelOuter.Free;
  FBevelMiddle.Free;
  FBevelInner.Free;

  FIndDeviation.Free;
  FIndCourse.Free;
  FIndPitch.Free;
  FIndRoll.Free;

  FCourseScale.Free;
  FRollScale.Free;
  FPitchScale.Free;

  DeleteRegion;
  bmp.free;
  inherited Destroy;
end;


end.