idualcompass.pas

iocopm3.04源码,一套很好的工控开发工具

    begin
      AHeight := AWidth;
      AWidth  := AWidth;
    end
  else if AHeight <> Height then
    begin
      AHeight := AHeight;
      AWidth  := AHeight;
    end;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.SetPointer1Position(const Value:Double);
var
  CanEdit : Boolean;
begin
  if FPointer1Position <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Pointer1Position', CanEdit);
      if CanEdit then
        begin
          FPointer1Position := Value;
          InvalidateChange;
          if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Pointer1Position');
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.SetPointer2Position(const Value:Double);
var
  CanEdit : Boolean;
begin
  if FPointer2Position <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Pointer2Position', CanEdit);
      if CanEdit then
        begin
          FPointer2Position := Value;
          InvalidateChange;
          if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Pointer2Position');
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.CalcPoints(Canvas: TCanvas);
var
  ATextWidth             : Integer;
  ATextHeight            : Integer;
  ScaleLabelMarginPixels : Integer;
begin
  FCenterPoint := GetCenterPoint(Canvas);

  Canvas.Font.Assign(FScaleFont);

  ATextWidth := 0;
  if Canvas.TextWidth(FNCaption ) > ATextWidth then ATextWidth := Canvas.TextWidth(FNCaption);
  if Canvas.TextWidth(FNWCaption) > ATextWidth then ATextWidth := Canvas.TextWidth(FNWCaption);
  if Canvas.TextWidth(FWCaption ) > ATextWidth then ATextWidth := Canvas.TextWidth(FWCaption);
  if Canvas.TextWidth(FSWCaption) > ATextWidth then ATextWidth := Canvas.TextWidth(FSECaption);
  if Canvas.TextWidth(FSCaption ) > ATextWidth then ATextWidth := Canvas.TextWidth(FSCaption);
  if Canvas.TextWidth(FSECaption) > ATextWidth then ATextWidth := Canvas.TextWidth(FSECaption);
  if Canvas.TextWidth(FECaption ) > ATextWidth then ATextWidth := Canvas.TextWidth(FECaption);
  if Canvas.TextWidth(FNECaption) > ATextWidth then ATextWidth := Canvas.TextWidth(FNECaption);

  ScaleLabelMarginPixels := Round(FScaleLabelMargin*ATextWidth);

  FScaleHeight := ScaleLabelMarginPixels + ATextWidth;

  FScaleOuterRadius  := Round(Width/2 - FOuterMargin);
  FScaleInnerRadius  := FScaleOuterRadius - FScaleHeight;

  FScaleCenterRadius := (FScaleOuterRadius + FScaleInnerRadius) div 2;

  Canvas.Font.Assign(FCenterDisplayFont);
  ATextHeight := Round(Canvas.TextHeight('0') * FCenterDisplayHeight);
  ATextWidth  := Round(Canvas.TextWidth ('0') * FCenterDisplayWidth);

  FCenterDisplayRect := Rect(FCenterPoint.x - ATextWidth  div 2, FCenterPoint.y - ATextHeight div 2,
                             FCenterPoint.x + ATextWidth  div 2, FCenterPoint.y + ATextHeight div 2);
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.iPaintTo(Canvas: TCanvas);
begin
  CalcPoints(Canvas);

  if CachedDrawing then
    begin
      if BackGroundChanged then
        begin
          CreateBackGroundBitmap;
          DrawBackGround     (BackGroundBitmap.Canvas, BackGroundColor);
          DrawScaleBackGround(BackGroundBitmap.Canvas);
          DrawLabels         (BackGroundBitmap.Canvas);

          if FShowPointer1 then DrawPointer1(BackGroundBitmap.Canvas);

          ResetBackGroundChange;
        end;

      TransferBackGround (Canvas);
      DrawScaleLabels    (Canvas);

      if FShowPointer2      then DrawPointer2     (Canvas);
      if FShowCenterDisplay then DrawCenterDisplay(Canvas);
    end
  else
    begin
                                 DrawBackGround     (Canvas, BackGroundColor);
                                 DrawScaleBackGround(Canvas);
                                 DrawLabels         (Canvas);
      if FShowPointer1      then DrawPointer1       (Canvas);
                                 DrawScaleLabels    (Canvas);
      if FShowPointer2      then DrawPointer2       (Canvas);
      if FShowCenterDisplay then DrawCenterDisplay  (Canvas);
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawScaleBackGround(Canvas: TCanvas);
begin
  with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := FScaleBackGroundColor;
      Pen.Color   := FScaleBackGroundColor;
      Ellipse(FCenterPoint.x - FScaleOuterRadius, FCenterPoint.y - FScaleOuterRadius,
              FCenterPoint.x + FScaleOuterRadius, FCenterPoint.y + FScaleOuterRadius);

      Brush.Color := FInnerColor;
      Pen.Color   := FInnerColor;

      Ellipse(FCenterPoint.x - FScaleInnerRadius, FCenterPoint.y - FScaleInnerRadius,
              FCenterPoint.x + FScaleInnerRadius, FCenterPoint.y + FScaleInnerRadius);
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawPointer1(Canvas: TCanvas);
begin
  with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := FPointer1Color;
      Pen.Color   := FPointer1Color;
      Rectangle(FCenterPoint.x                  - FPointer1Width div 2, FCenterPoint.y - FScaleOuterRadius,
                FCenterPoint.x + FPointer1Width - FPointer1Width div 2, FCenterPoint.y - FScaleInnerRadius);
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawScaleLabels(Canvas: TCanvas);
var
  x              : Integer;
  DegreePosition : Double;
  AText          : String;
  ALabelPoint    : TPoint;
begin
  with Canvas do
    begin
      Brush.Style := bsClear;

      Font.Assign(FScaleFont);
      for x := 0 to 7 do
        begin
          case x of
            0 : AText := FNCaption;
            1 : AText := FNECaption;
            2 : AText := FECaption;
            3 : AText := FSECaption;
            4 : AText := FSCaption;
            5 : AText := FSWCaption;
            6 : AText := FWCaption;
            7 : AText := FNWCaption;
          end;

          if Assigned(FOnCustomizeTickLabel) then FOnCustomizeTickLabel(Self, x, AText);

          DegreePosition := -x*45 + 90 + FPointer1Position;

          ALabelPoint := GetXYRadPoint(DegreePosition, FScaleCenterRadius, FCenterPoint);
          TextOut(ALabelPoint.x - TextWidth (AText) div 2, ALabelPoint.y - TextHeight(AText) div 2, AText);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawPointer2(Canvas: TCanvas);
var
  OuterPoint  : TPoint;
  BasePoint   : TPoint;
  InnerPoint1 : TPoint;
  InnerPoint2 : TPoint;
  DegreePosition : Double;
begin
  with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := FInnerColor;
      Pen.Color   := FInnerColor;

      DegreePosition := 90 - FPointer2Position + FPointer1Position;

      OuterPoint := GetXYRadPoint(DegreePosition, FScaleInnerRadius+FPointer2Height*FScaleHeight, FCenterPoint);

      BasePoint   := GetXYRadPoint(DegreePosition, FScaleInnerRadius-2, FCenterPoint);
      InnerPoint1 := GetXYRadPoint(DegreePosition + 90, FPointer2Width*FScaleHeight/2, BasePoint);
      InnerPoint2 := GetXYRadPoint(DegreePosition - 90, FPointer2Width*FScaleHeight/2, BasePoint);
      Polygon([InnerPoint1, OuterPoint, InnerPoint2]);
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawCenterDisplay(Canvas: TCanvas);
var
  AText           : String;
  PrecisionString : String;
  x               : Integer;
begin
  with Canvas, FCenterDisplayRect do
    begin
      Brush.Style := bsSolid;
      Brush.Color := FCenterDisplayBackGroundColor;
      Pen.Color   := FCenterDisplayBackGroundColor;
      Rectangle(FCenterDisplayRect.Left, FCenterDisplayRect.Top, FCenterDisplayRect.Right, FCenterDisplayRect.Bottom);

      Font.Assign(FCenterDisplayFont);
      Brush.Style := bsClear;

      for x := 1 to FCenterDisplayPrecision do
        PrecisionString := PrecisionString + '0';

      AText := Trim(FormatFloat('0.' + PrecisionString, FCenterDisplayPosition));

      TextOut((Left + Right) div 2 - TextWidth(AText) div 2, (Top + Bottom) div 2 - TextHeight(AText) div 2, AText);
    end;
end;
//****************************************************************************************************************************************************
procedure TiDualCompass.DrawLabels(Canvas: TCanvas);
var
  AText        : String;
  ARect        : TRect;
  AHeight      : Integer;
  MarginPixels : Integer;
begin
  with Canvas do
    begin
      //-------------------- Top -----------------------------------------------------------------------------
      Font.Assign(FLabelTopFont);
      Brush.Style := bsClear;

      AText   := FLabelTopText;
      AHeight := TextHeight(AText);
      MarginPixels := Round(AHeight*FLabelTopMargin);
      ARect   := Rect(FCenterDisplayRect.Left,  FCenterDisplayRect.Top - MarginPixels - AHeight,
                      FCenterDisplayRect.Right, FCenterDisplayRect.Top - MarginPixels);

      with ARect do
        TextOut((Left + Right) div 2 - TextWidth(AText) div 2, (Top + Bottom) div 2 - TextHeight(AText) div 2, AText);
      //-------------------- Bottom --------------------------------------------------------------------------
      Font.Assign(FLabelBottomFont);
      Brush.Style := bsClear;

      AText   := FLabelBottomText;
      AHeight := TextHeight(AText);
      MarginPixels := Round(AHeight*FLabelBottomMargin);
      ARect   := Rect(FCenterDisplayRect.Left,  FCenterDisplayRect.Bottom + MarginPixels,
                      FCenterDisplayRect.Right, FCenterDisplayRect.Bottom + MarginPixels + AHeight);

      with ARect do
        TextOut((Left + Right) div 2 - TextWidth(AText) div 2, (Top + Bottom) div 2 - TextHeight(AText) div 2, AText);
    end;
end;
//****************************************************************************************************************************************************
end.