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

📄 iplottable.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 3 页
字号:
function TiPlotTable.GetColumn(Index: Integer): TiPlotTableColumn;
begin
  Result := FColumnList.Objects[Index] as TiPlotTableColumn;
end;
//****************************************************************************************************************************************************
function TiPlotTable.GetColumnCount: Integer;
begin
  Result := FColumnList.Count;
end;
//****************************************************************************************************************************************************
function TiPlotTable.AddColumn(Title: String): Integer;
var
  iPlotTableColumnObject : TiPlotTableColumn;
begin
  iPlotTableColumnObject                      := TiPlotTableColumn.Create;
  iPlotTableColumnObject.Visible              := True;
  iPlotTableColumnObject.AutoSize             := True;
  iPlotTableColumnObject.Title                := Title;
  iPlotTableColumnObject.TitleAlignment       := iahCenter;
  iPlotTableColumnObject.TitleAlignmentMargin := 1;
  iPlotTableColumnObject.TitleFontColor       := ColumnTitlesFont.Color;
  iPlotTableColumnObject.DataAlignment        := iahCenter;
  iPlotTableColumnObject.DataAlignmentMargin  := 1;
  iPlotTableColumnObject.DataFontColor        := DataFont.Color;
  iPlotTableColumnObject.Width                := 10;
  Result := FColumnList.AddObject('', iPlotTableColumnObject);
end;
//****************************************************************************************************************************************************
procedure TiPlotTable.DeleteColumn(Index: Integer);
begin
  FColumnList.Objects[Index].Free;
  FColumnList.Delete(Index);
end;
//****************************************************************************************************************************************************
procedure TiPlotTable.RemoveAllColumns;
begin
  while FColumnList.Count <> 0 do
    DeleteColumn(0);
end;
//****************************************************************************************************************************************************
procedure TiPlotTable.CalcRects(Canvas: TCanvas);
var
  Col                : Integer;
  Row                : Integer;
  ACharWidth         : Integer;
  ACharHeight        : Integer;
  MarginTopPixels    : Integer;
  MarginBottomPixels : Integer;
  MarginLeftPixels   : Integer;
  MarginRightPixels  : Integer;
  NewMax             : Integer;
  AText              : String;
  ColSpacingPixels   : Integer;
  RowSpacingPixels   : Integer;
  FirstRowCenterY    : Integer;
  LastRowCenterY     : Integer;
  ActualRows         : Integer;
begin
  if (RowCount = 0) or (ColumnCount = 0) then
    begin
      FRequiredHeight := 0;
      FRequiredWidth  := 0;
      Exit;
    end;

  with Canvas, DrawRect do
    begin
      Font.Assign(FColumnTitlesFont);

      ACharWidth         := TextWidth ('0');
      ACharHeight        := TextHeight('0');

      MarginTopPixels    := Round(FMarginTop   *ACharHeight);
      MarginBottomPixels := Round(FMarginBottom*ACharHeight);
      MarginLeftPixels   := Round(FMarginLeft  *ACharWidth);
      MarginRightPixels  := Round(FMarginRight *ACharWidth);

      FGridRect.Left   := Left  + MarginLeftPixels;
      FGridRect.Right  := Right - MarginRightPixels;
      FGridRect.Top    := Top   + MarginTopPixels;
      FGridRect.Bottom := Bottom - MarginBottomPixels;

      if FColumnTitlesVisible then FTitleRect := Rect(FGridRect.Left, FGridRect.Top, FGridRect.Right, FGridRect.Top + ACharHeight)
      else                         FTitleRect := Rect(FGridRect.Left, FGridRect.Top, FGridRect.Right, FGridRect.Top);

      Font.Assign(FDataFont);
      ACharWidth  := TextWidth ('0');
      ACharHeight := TextHeight('0');

      RowSpacingPixels := Round(ACharHeight*FRowSpacing);
      FRowHeight       := RowSpacingPixels + ACharHeight;

      FRequiredHeight := MarginTopPixels  + MarginBottomPixels + FTitleRect.Bottom - FTitleRect.Top;

      if (FRowsMax <> 0) and (RowCount > FRowsMax) then
        begin
          ActualRows := FRowsMax;
          FGridRect.Bottom := FTitleRect.Bottom + (RowsMax)*FRowHeight;
          FRequiredHeight  := FRequiredHeight + (RowsMax)*FRowHeight;
        end
      else
        begin
          ActualRows := RowCount;
          FGridRect.Bottom := FTitleRect.Bottom + (RowCount)*FRowHeight;
          FRequiredHeight  := FRequiredHeight + (RowCount)*FRowHeight;
        end;

      FRequiredWidth  := MarginLeftPixels + MarginRightPixels;

      for Col := 0 to ColumnCount-1 do
        begin
          if not Column[Col].Visible then Continue;
          if Column[Col].AutoSize then
            begin
              NewMax := 0;
              Font.Assign(FColumnTitlesFont);
              ACharWidth  := TextWidth ('0');
              ColSpacingPixels := Round(ACharWidth*FColumnSpacing);
              if (TextWidth(Column[Col].Title) + ColSpacingPixels + ACharWidth) > NewMax then NewMax := TextWidth(Column[Col].Title) + ColSpacingPixels + ACharWidth;

              Font.Assign(FDataFont);
              ACharWidth  := TextWidth ('0');
              ColSpacingPixels := Round(ACharWidth*FColumnSpacing);
              for Row := 0 to FRowDataList.Count-1 do
                begin
                  AText := Data[Col, Row];
                  if (TextWidth(AText) + ColSpacingPixels + ACharWidth) > NewMax then NewMax := TextWidth(AText) + ColSpacingPixels + ACharWidth;
                end;
              Column[Col].WidthPixels := NewMax;
            end
          else
            begin
              Column[Col].WidthPixels := Round(ACharWidth * Column[Col].Width);
            end;

          FRequiredWidth := FRequiredWidth + Column[Col].WidthPixels;
        end;

      FGridRect.Right := FGridRect.Left + FRequiredWidth - MarginRightPixels - MarginLeftPixels;
      
      if FGridRect.Bottom > (Bottom - MarginBottomPixels) then
        begin
          ActualRows       := (Bottom - MarginBottomPixels - FTitleRect.Bottom) div FRowHeight;

          FGridRect.Bottom := FTitleRect.Bottom + ActualRows * FRowHeight;
        end;

      if RowCount > ActualRows then
        begin
          FirstRowCenterY := FTitleRect.Bottom + FRowHeight div 2;
          LastRowCenterY  := FTitleRect.Bottom + ActualRows * FRowHeight - FRowHeight div 2;

          FUpButton.DrawRect   := Rect(FGridRect.Right + 5, FirstRowCenterY - 8, FGridRect.Right + 5 + 17, FirstRowCenterY + 9);
          FDownButton.DrawRect := Rect(FGridRect.Right + 5, LastRowCenterY  - 8, FGridRect.Right + 5 + 17, LastRowCenterY  + 9);

          FUpButton.Visible   := True;
          FDownButton.Visible := True;

          FRequiredWidth  := FRequiredWidth + FUpButton.Width + 5;

          FItemViewStopIndex  := FItemViewStartIndex + ActualRows -1;

          if FItemViewStopIndex > (RowCount-1) then
            begin
              FItemViewStopIndex  := RowCount-1;
              FItemViewStartIndex := FItemViewStopIndex - (ActualRows-1);
            end;

          if FItemViewStartIndex < 0 then
            begin
              FItemViewStartIndex := 0;
              FItemViewStopIndex  := ActualRows-1;
            end;
        end
      else
        begin
          FUpButton.Visible   := False;
          FDownButton.Visible := False;

          FItemViewStartIndex := 0;
          FItemViewStopIndex  := ActualRows-1;
        end;


      FUpButton.Enabled   := FItemViewStartIndex <> 0;
      FDownButton.Enabled := FItemViewStopIndex <> (RowCount -1);
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotTable.Draw(const Canvas: TCanvas; const BackGroundColor: TColor);
begin
  if not Visible                         then Exit;
  if (RowCount = 0) or (ColumnCount = 0) then Exit;

  CalcRects(Canvas);

  with Canvas, DrawRect do
    begin
      Brush.Style := bsSolid;
      Pen.Style   := psSolid;

      if not FGridBackGroundTransparent then
        begin
          Brush.Color := FGridBackGroundColor;
          FillRect(FGridRect);
        end;

      DrawGrid        (Canvas);
      DrawColumnTitles(Canvas);
      DrawData        (Canvas);

      Font.Color := $FFEEDD; //Borland Bug Hack.
      Font.Assign(FDataFont);
      Brush.Style := bsClear;
    end;

  DrawUpButton  (Canvas);
  DrawDownButton(Canvas);

  if UserSelected then
    begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font.Color := clWhite;
      if Horizontal then iDrawFocusRect2(Canvas, Rect(DrawRect.Left,   DrawRect.Top+2, DrawRect.Right,   DrawRect.Bottom-2))
        else             iDrawFocusRect2(Canvas, Rect(DrawRect.Left, DrawRect.Top,   DrawRect.Right, DrawRect.Bottom  ))
    end;
end;
//****************************************************************************************************************************************************
procedure TiPlotTable.DrawGrid(const Canvas: TCanvas);
var
  x          : Integer;
  CurrentPos : Integer;
begin
  if not FGridLinesShow then Exit;

  with Canvas do
    begin
      Pen.Style := psSolid;
      Pen.Width := 1;
      Pen.Color := FGridLinesColor;

      //Vertical Lines
      CurrentPos := FGridRect.Left;
      for x := 0 to ColumnCount-1 do
        begin
          if not Column[x].Visible then Continue;
          Polyline([Point(CurrentPos, FGridRect.Top), Point(CurrentPos, FGridRect.Bottom)]);
          CurrentPos := CurrentPos + Column[x].WidthPixels;
        end;

      Polyline([Point(CurrentPos, FGridRect.Top), Point(CurrentPos, FGridRect.Bottom)]);

      //Horizontal Lines
      CurrentPos := FGridRect.Top;
      Polyline([Point(FGridRect.Left, CurrentPos), Point(FGridRect.Right+1, CurrentPos)]);

      CurrentPos := FTitleRect.Bottom;
      for x := FItemViewStartIndex to FItemViewStopIndex do
        begin
          Polyline([Point(FGridRect.Left, CurrentPos), Point(FGridRect.Right+1, CurrentPos)]);
          CurrentPos := CurrentPos + FRowHeight;
        end;

⌨️ 快捷键说明

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