⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iloggauge.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 4 页
字号:
                         else    Result := Top    + FEndsMargin + Distance;
                       end;
                     end;
      else           begin
                       case FReverseScale of
                         False : Result := Left  + FEndsMargin + Distance;
                         else    Result := Right - FEndsMargin - Distance;
                       end;
                     end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.CalcPoints;
var
  ClientRect : TRect;
  MaxMargin  : Integer;
  x          : Integer;
begin
  ClientRect := Rect(0, 0 ,Width, Height);

  MaxMargin := 0;

  for x := 0 to PointerManager.Count -1 do
    begin
      if PointerManager.Items[x].Margin > MaxMargin then MaxMargin := PointerManager.Items[x].Margin;
    end;

  if (ShowMaxPointer or ShowMinPointer) then
    if MinMaxPointerMargin > MaxMargin then MaxMargin := MinMaxPointerMargin;

  for x := 0 to LimitCount - 1 do
    begin
      if (LimitShowUpperPointer[x] or LimitShowLowerPointer[x]) then
        if LimitPointerMargin[x] > MaxMargin then MaxMargin := LimitPointerMargin[x];
    end;

  if MaxMargin < 0 then MaxMargin := 0;

  FPointerOverlap := MaxMargin;

  with ClientRect do
    case FOrientation of
      ioVertical   : case FOrientationTickMarks of
                       iosBottomRight : FBarRect := Rect(Left  + FPointerOverlap,                   Top    + FEndsMargin,
                                                         Left  + FPointerOverlap + TickMajorLength, Bottom - FEndsMargin);
                       iosTopLeft     : FBarRect := Rect(Right - FPointerOverlap - TickMajorLength, Top    + FEndsMargin,
                                                         Right - FPointerOverlap,                   Bottom - FEndsMargin);
                    end;
      ioHorizontal : case FOrientationTickMarks of
                       iosBottomRight : FBarRect := Rect(Left  + FEndsMargin, Top    + FPointerOverlap,
                                                         Right - FEndsMargin, Top    + FPointerOverlap + TickMajorLength);
                       iosTopLeft     : FBarRect := Rect(Left  + FEndsMargin, Bottom - FPointerOverlap - TickMajorLength,
                                                         Right - FEndsMargin, Bottom - FPointerOverlap                  );
                    end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.CalcAutoCenterOffsets;
var
  TotalWidth : Integer;
  ATextWidth : Integer;
begin
  FCenterOffsetX := 0;
  FCenterOffsetY := 0;

  if not FAutoCenter then Exit;

  if ShowTickLabels then
    begin
      with Canvas do
        begin
          Canvas.Font.Assign(TickLabelFont);
          case Orientation of
            ioVertical   : ATextWidth := TextWidth (Trim(Format('%.' + IntToStr(GetDecimalPoints) + 'f', [PositionMax])));
            else           ATextWidth := TextHeight(Trim(Format('%.' + IntToStr(GetDecimalPoints) + 'f', [PositionMax])));
          end;
          TotalWidth := TickLabelMargin + ATextWidth;
        end;
    end
  else TotalWidth := 0;

  case FOrientation of
    ioVertical   : begin
                     TotalWidth := TotalWidth + FBarRect.Right - FBarRect.Left + FPointerOverlap;
                     FCenterOffsetX := (Width - TotalWidth) div 2;
                   end;
    ioHorizontal : begin
                     TotalWidth     := TotalWidth + FBarRect.Bottom - FBarRect.Top + FPointerOverlap;
                     FCenterOffsetY := (Height - TotalWidth) div 2;
                   end;
  end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.iPaintTo(Canvas: TCanvas);
begin
  CalcPoints;
  CalcAutoCenterOffsets;

  case FOrientation of
    ioVertical   : begin
                     case FOrientationTickMarks of
                       iosBottomRight : begin
                                          OffsetRect(FBarRect,   OffsetX, 0);
                                          OffsetRect(FBarRect,   FCenterOffsetX, 0);
                                        end;
                       iosTopLeft     : begin
                                          OffsetRect(FBarRect,   -OffsetX, 0);
                                          OffsetRect(FBarRect,   -FCenterOffsetX, 0);
                                        end;
                     end;
                   end;
    ioHorizontal : begin
                     case FOrientationTickMarks of
                       iosBottomRight : begin
                                          OffsetRect(FBarRect,   0, OffsetY);
                                          OffsetRect(FBarRect,   0, FCenterOffsetY);
                                        end;
                       iosTopLeft     : begin
                                          OffsetRect(FBarRect,   0, -OffsetY);
                                          OffsetRect(FBarRect,   0, -FCenterOffsetY);
                                        end;
                     end;
                   end;
  end;

  if CachedDrawing then
    begin
      if PointerManager.Items[0].Style = ord(ilgpsColorBar) then
        begin
          DrawBackGround(Canvas, BackGroundColor);
          DrawSections  (Canvas);
          DrawIndicator (Canvas);
          DrawTicks     (Canvas);
          DrawTickAxis  (Canvas);
          DrawLimits    (Canvas);
          DrawMinMax    (Canvas);
        end
      else
        begin
          if BackGroundChanged then
            begin
              CreateBackGroundBitmap;
              DrawBackGround(BackGroundBitmap.Canvas, BackGroundColor);
              DrawSections  (BackGroundBitmap.Canvas);
              DrawTicks     (BackGroundBitmap.Canvas);
              DrawTickAxis  (BackGroundBitmap.Canvas);
              ResetBackGroundChange;
            end;

          TransferBackGround(Canvas);

          DrawIndicator (Canvas);
          DrawMinMax    (Canvas);
          DrawLimits    (Canvas);
        end;
    end
  else
    begin
      if PointerManager.Items[0].Style = ord(ilgpsColorBar) then
        begin
          DrawBackGround(Canvas, BackGroundColor);
          DrawSections  (Canvas);
          DrawIndicator (Canvas);
          DrawTicks     (Canvas);
          DrawTickAxis  (Canvas);
          DrawLimits    (Canvas);
          DrawMinMax    (Canvas);
        end
      else
        begin
          DrawBackGround(Canvas, BackGroundColor);
          DrawSections  (Canvas);
          DrawTicks     (Canvas);
          DrawTickAxis  (Canvas);
          DrawIndicator (Canvas);
          DrawMinMax    (Canvas);
          DrawLimits    (Canvas);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.DrawTickAxis(Canvas: TCanvas);
begin
  if FShowTicksAxis then
    with Canvas, FBarRect do
      begin
        Pen.Color := TickMajorColor;
        case FOrientation of
          ioVertical   : case FOrientationTickMarks of
                           iosBottomRight : begin
                                              Line(Canvas, Right,   Top, Right,   Bottom);
                                              Line(Canvas, Right-1, Top, Right-1, Bottom);
                                            end;
                           iosTopLeft     : begin
                                              Line(Canvas, Left,   Top, Left,   Bottom);
                                              Line(Canvas, Left+1, Top, Left+1, Bottom);
                                            end;
                         end;
          ioHorizontal : case FOrientationTickMarks of
                           iosBottomRight : begin
                                              Line(Canvas, Left, Bottom,   Right, Bottom);
                                              Line(Canvas, Left, Bottom-1, Right, Bottom-1);
                                              Line(Canvas, Left, Bottom-2, Right, Bottom-2);
                                            end;
                           iosTopLeft     : begin
                                              Line(Canvas, Left, Top,   Right, Top);
                                              Line(Canvas, Left, Top+1, Right, Top+1);
                                              Line(Canvas, Left, Top+2, Right, Top+2);
                                            end;
                         end;
        end;
      end;
end;
//****************************************************************************************************************************************************
procedure TiLogGauge.DrawSections(Canvas: TCanvas);
var
  x                : Integer;
  CurrentColor     : TColor;
  LastStartPixels  : Integer;
  CurrentEndPixels : Integer;
  LastStart        : Double;
  CurrentEnd       : Double;
begin
  LastStart := PositionMin;
  with Canvas, FBarRect do
    begin
      for x := 1 to SectionCount do
        begin
          case x of
            1 :  begin CurrentColor := SectionColor1; CurrentEnd := SectionEnd1 end;
            2 :  begin CurrentColor := SectionColor2; CurrentEnd := SectionEnd2 end;
            3 :  begin CurrentColor := SectionColor3; CurrentEnd := SectionEnd3 end;
            4 :  begin CurrentColor := SectionColor4; CurrentEnd := SectionEnd4 end;
            else begin CurrentColor := SectionColor5; CurrentEnd := PositionMax end;
          end;

          if CurrentEnd > PositionMax then CurrentEnd := PositionMax;
          if CurrentEnd < PositionMin then CurrentEnd := PositionMin;
          if CurrentEnd < LastStart   then CurrentEnd := PositionMax;
          if x = SectionCount         then CurrentEnd := PositionMax;


          Brush.Color := CurrentColor;
          Pen.Color   := CurrentColor;

          CurrentEndPixels := GetPositionPixels(CurrentEnd);
          LastStartPixels  := GetPositionPixels(LastStart);

          case FOrientation of
            ioVertical   : Rectangle(Left, CurrentEndPixels, Right, LastStartPixels);
            ioHorizontal : Rectangle(LastStartPixels, Top, CurrentEndPixels, Bottom);
          end;

          LastStart := CurrentEnd;

          if CurrentEnd = PositionMax then exit;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -