abvcind.pas

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

        end;
      end;
    end;
    pen.width := 1;
    pen.style := psSolid;
    pen.mode := pmCopy;
  end;

end;

Procedure TAbVCInd.DrawPitchScale;
var
  StartValue : Single;
  StartVal, EndVal, val : Single;
  StartPos : Integer;
  n, d, i, y : Integer;
  Offset : Integer;
  isStep : Boolean;
  r: TRect;
  lFrom, lTo, tPos  : TPoint;
  sclText : String;

begin
  r:= rHorizon;
  //AbBorder(r,BevelOuter.Width +

//  Offset := 0;


  StartValue := Pitch - (FPitchScale.SubStepsVis * (FPitchScale.SubStepAt / 2));

  StartPos :=  Round((StartValue / FPitchScale.SubStepAt) );

  EndVal := (StartPos + FPitchScale.SubStepsVis ) * FPitchScale.SubStepAt;

  StartVal := StartPos * FPitchScale.SubStepAt;

  Offset := Round((StartValue - StartVal) * PixelPerValue);


  with bmp.Canvas do begin
     font := FPitchScale.Font;
     Brush.Style := bsClear;
     for n := 0 to FPitchScale.SubStepsVis do begin
       val := EndVal - n * FPitchScale.SubStepAt;
       while val <= -180 do val := val +360;
       while val > 180 do val:= val - 360;

       i := Round(Val / (FPitchScale.StepMulti * FPitchScale.SubStepAt));
       isStep := (Abs(Val - ( i *(FPitchScale.StepMulti * FPitchScale.SubStepAt))) = 0);


       y :=  R.Top + Round(n * PixelPerSubStep) + Offset;


       if AbInRect(R.Left, y, r) then begin
         if  ( isStep  ) then  begin
           Pen := FPitchScale.StepLines.Pen;

           d := FPitchScale.StepLines.Length div 2 ;

           lFrom := AbRotate(Point(cp.x - d + FPitchScale.StepLines.Offset, y), cp, fRoll, true);
           lTo := AbRotate(Point(cp.x + d + FPitchScale.StepLines.Offset, y), cp, fRoll, true);


           if FPitchScale.StepLines.Visible then begin
             MoveTo(lFrom.x, lFrom.y);
             LineTo(lTo.x, lTo.y);
           end;
           d := d + TextWidth(FPitchScale.FormatStr) div 2 ;
           tPos := AbRotate(Point(cp.x + d  + 5 + FPitchScale.TextOffsetX  + FPitchScale.StepLines.Offset, y + FPitchScale.TextOffsetY), cp, fRoll, true);
          // tPos := AbRotate(Point(cp.x + d  + 5 + FPitchScale.TextOffsetX, y + FPitchScale.TextOffsetY), cp, fRoll, true);
         //  AbTextOut(Bmp.canvas, tPos.x, tPos.y, FormatFloat('##0.#',Val),toMidCenter);
           sclText := FormatFloat(FPitchScale.FormatStr,Val);

            if (FPitchScale.AngleMode = amAuto) then
              AbRotTextOut(bmp.canvas,tPos,Roll+FPitchScale.Angle, sclText,FPitchScale.TextAlignment)
            else
             { if (FPitchScale.Angle = 0) then
                AbTextOut(bmp.canvas,tPos.x, tPos.y,sclText,FPitchScale.TextAlignment)
              else    }
                AbRotTextOut(bmp.canvas,tPos,FPitchScale.Angle, sclText,FPitchScale.TextAlignment);

         end else begin
           Pen := FPitchScale.SubStepLines.Pen;

           d := FPitchScale.SubStepLines.Length div 2;
           lFrom := AbRotate(Point(cp.x - d + FPitchScale.SubStepLines.Offset + FPitchScale.StepLines.Offset, y), cp, fRoll, true);
           lTo := AbRotate(Point(cp.x + d + FPitchScale.SubStepLines.Offset + FPitchScale.StepLines.Offset, y), cp, fRoll, true);

           if FPitchScale.SubStepLines.Visible then begin
             MoveTo(lFrom.x, lFrom.y);
             LineTo(lTo.x, lTo.y);
           end;
         end;
       end;
     end;
    if FPitchLine.Visible then begin
       d := FPitchLine.Length div 2;
       Pen := FPitchLine.Pen;
       lFrom := AbRotate(Point(cp.x - d + FPitchLine.Offset, cp.y), cp, fRoll, true);
       lTo   := AbRotate(Point(cp.x + d + FPitchLine.Offset, cp.y), cp, fRoll, true);
       MoveTo(lFrom.x, lFrom.y);
       LineTo(lTo.x, lTo.y);
    end;
  end;
end;

procedure TAbVCInd.DrawHorizon;
var
  r : TRect;
  n : Integer;
  d : Integer;
  y0, y1 : Integer;
  Horizon1, Horizon2 : Array[0..3] of TPoint;

begin

  While FPitch > 180 do FPitch := FPitch - 180;
  While FPitch < -180 do FPitch := FPitch + 180;

  d := Round(180 * PixelPerValue);

  y0 := cp.y + Round((Pitch ) * PixelPerValue)-d;
  if y0 < 0 then y0 := 0;
  y1 := cp.y + Round((Pitch - 180) * PixelPerValue)-d;
  if y1 < 0 then y1 := 0;
  Horizon1[0] := Point(rInd.Left, y0);
  Horizon1[1] := Point(rInd.Right, y0);
  Horizon1[2] := Point(rInd.Right, y1);
  Horizon1[3] := Point(rInd.Left, y1);

  y0 := cp.y + Round(Pitch * PixelPerValue);
  if y0 > rInd.Bottom then y0 := rInd.Bottom;
  y1 := cp.y + Round((Pitch + 180) * PixelPerValue);
  if y1 > rInd.Bottom then y1 := rInd.Bottom;
  Horizon2[0] := Point(rInd.Left, y0);
  Horizon2[1] := Point(rInd.Right, y0);
  Horizon2[2] := Point(rInd.Right, y1);
  Horizon2[3] := Point(rInd.Left, y1);

  for n := 0 to 3 do Begin
    Horizon1[n] := AbRotate(Horizon1[n], cp, fRoll, true);
    Horizon2[n] := AbRotate(Horizon2[n], cp, fRoll, true);
  end;

  with bmp.Canvas do begin
    SelectObject(Handle,rgnInnerCircle);
    r := rInd;


    Brush.Style := bsSolid;
    Pen.Color := FColorSky;
    Brush.Color := FColorSky;
    Rectangle(r.left, r.top, r.right, r.bottom);
    Brush.Color := FColorGround;
    Pen.Color := FColorGround;
    Polygon(Horizon1);
    Polygon(Horizon2);

    DrawPitchScale;

    if FHorizonLine.Visible then begin
      d := FHorizonLine.Length div 2;
      pen := FHorizonLine.Pen;
      MoveTo(cp.x + FHorizonLine.Offset - d, cp.y);
      LineTo(cp.x + FHorizonLine.Offset + d, cp.y);
    end;
  end;

end;

Procedure TAbVCInd.SetCourse(Value : Single);
begin
  if ((pPosLeftTop.x <> Left) or (pPosLeftTop.y <> Top)) then
  begin
    pPosLeftTop := Point(Left, Top);
    CreateRegion(rInd);
  end;

  if fCourse <> Value then begin
    fCourse := Value;
    DrawCourseScale;
    DrawValueInd;
    SelectObject(Canvas.Handle,rgnOuter);
    Canvas.Draw(0,0,bmp);
  end;
end;

Procedure TAbVCInd.SetCourseShould(Value : Single);
begin
  if ((pPosLeftTop.x <> Left) or (pPosLeftTop.y <> Top)) then
  begin
    pPosLeftTop := Point(Left, Top);
    CreateRegion(rInd);
  end;
  if fCourseShould <> Value then begin
    fCourseShould := Value;
    DrawCourseScale;
    DrawValueInd;
    SelectObject(Canvas.Handle,rgnOuter);
    Canvas.Draw(0,0,bmp);
  end;
end;

Procedure TAbVCInd.SetRoll(Value : Single);
begin
  if ((pPosLeftTop.x <> Left) or (pPosLeftTop.y <> Top)) then
  begin
    pPosLeftTop := Point(Left, Top);
    CreateRegion(rInd);
  end;
  if fRoll <> Value then begin
    fRoll := Value;
    DrawRollScale;
    DrawHorizon;
    DrawValueInd;
    SelectObject(Canvas.Handle,rgnOuter);
    Canvas.Draw(0,0,bmp);
  end;
end;

Procedure TAbVCInd.SetPitch(Value : Single);
begin
  if ((pPosLeftTop.x <> Left) or (pPosLeftTop.y <> Top)) then
  begin
    pPosLeftTop := Point(Left, Top);
    CreateRegion(rInd);
  end;
  if fPitch <> Value then begin
    fPitch := Value;
    yPitch := Round(Value * PixelPerValue);
    DrawHorizon;
    DrawValueInd;
    SelectObject(Canvas.Handle,rgnOuter);
    Canvas.Draw(0,0,bmp);
  end;
end;

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

Procedure TAbVCInd.DrawRollScale;
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;
  p : Integer;
  txt : String;
begin

  AlphaStep := 45;
  AlphaSubStep := 5;

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

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

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

    SelectObject(Handle,rgnRoll);
    Brush.Color := FRollBkColor;
    Pen.Color := FRollBkColor;

    Rectangle(r.left, r.top, r.right, r.bottom);

    Brush.Style := bsClear;

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


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

    OrgTextPos := Point( cp.x + FRollScale.TextOffsetX, OrgStepTo.y + FRollScale.TextOffsety + txtHeight div 2);

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

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

      if ((Alpha >= 89) and (Alpha <= 260)) {or ((Alpha >= 0) and (Alpha < 80))} then begin

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

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

        if FRollScale.SubStepLines.Visible then begin
          for SubStep := 1 to 8 do begin
            Pen := FRollScale.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;
        end;
      end;
    end;
    pen.width := 1;
    pen.style := psSolid;
    pen.mode := pmCopy;
  end;
  DrawHorizon;
end;

Procedure TAbVCInd.Paint;
var
  d : Integer;
begin
  if UpdateCount > 0 then exit;
  if Width <> Height then begin
    d := AbMaxInt(Width, Height);
    SetBounds(Left, Top, d, d);
    perform(WM_Paint,0,0);
    //Invalidate;
    exit;
  end;

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


  bmp.Width := Width;
  bmp.Height := Height;


  CreateRegion(rInd);

  ShowRegions(bmp.Canvas, rInd);
end;

Procedure TAbVCInd.ShowRegions(can: TCanvas; r : TRect);
var
  tmpRgn : THandle;
  rTemp : TRect;
  p, x : Integer;
begin
  if UpdateCount > 0 then exit;
  
  tmpRgn := CreateEllipticRgn( r.left, r.top, r.right, r.Bottom);
  CombineRgn(tmpRgn, rgnOuterCircle, rgnInnerCircle, RGN_DIFF);

  with can do begin

    Brush.Style := bsSolid;
    Pen.Style := psSolid;

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

    if FBevelOuter.Width > 0 then
       AbCircleGradFill(can, r, FBevelOuter.ColorFrom, FBevelOuter.ColorTo);

    AbBorder(r, FBevelOuter.Width);

    pen.color := Color;
    Brush.Color := Color;
    Ellipse(r.left, r.top, r.right, r.bottom);

    AbBorder(r, OuterSpacing);

    //Rectangle(r);

    SelectObject(Handle,rgnOuterCircle);
 //   Brush.Color := clWhite;
//    Rectangle(r);
    if FBevelMiddle.Width > 0 then
      AbCircleGradFill(can, r, FBevelMiddle.ColorFrom, FBevelMiddle.ColorTo);

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

    rTemp := R;
    AbBorder(rTemp, FScaleHeight);
    SelectObject(Handle,rgnInnerBevel);
//    Brush.Color := clYellow;
    if FBevelInner.Width > 0 then