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

📄 gmgridprint.pas

📁 GmPrintSuite 2.96.7] a
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  CloseRow(FRowRect);
  Preview.EndUpdate;
end;

procedure TGmAbstractGridPrint.NewPage;
var
  RowRect: TGmRect;
  AHeight: Extended;
begin
  CloseRow(FRowRect);
  if FPreview.CurrentPageNum = FPreview.NumPages then
    FPreview.NewPage
  else
    FPreview.NextPage;
  if Assigned(FOnNewPage) then FOnNewPage(Self, FMarginTop, FMarginBottom);
  FCurrentXY.X := FTopLeft.X;
  FCurrentXY.Y := FMarginTop.AsInches;
  FTopLeft := FCurrentXY;
  AHeight := GetRowHeightInch(0);
  RowRect := GmRect(FCurrentXY.X,
                    FCurrentXY.Y,
                    FCurrentXY.X + FGridWidth,
                    FCurrentXY.Y + AHeight);
  DrawRow(RowRect, 0);
  FCurrentXY.Y := FCurrentXY.Y + AHeight;
end;

function TGmAbstractGridPrint.GetCutOffInch: Extended;
var
  AsInches: TGmSize;
begin
  AsInches := FPreview.GetPageSize(gmInches);
  Result := AsInches.Height - (FMarginBottom.AsInches + FPreview.Footer.Height[gmInches]);
end;

procedure TGmAbstractGridPrint.DrawCellBackground(ARect: TGmValueRect; ACol, ARow: integer);
begin
  if FMonochrome then Exit;
  if (FPreview.Canvas.Brush.Color = clWhite) or (FPreview.Brush.Style = bsClear) then Exit;
  FPreview.Canvas.Pen.Style := psClear;
  FPreview.Canvas.Rectangle(ARect.AsInchRect.Left,
  													ARect.AsInchRect.Top,
                            ARect.AsInchRect.Right,
                            ARect.AsInchRect.Bottom,
                            gmInches);
  //(FPreview.Canvas.LastObject as TGmRectangleShape).RectType := gmPolygon;
end;

procedure TGmAbstractGridPrint.DrawCellText(ARect: TGmValueRect; ACol, ARow: integer);
var
  AAlign: TAlignment;
  AVertAlign: TGmVertAlignment;
  AText: string;
begin
  AText := GetCellText(ACol, ARow);
  if AText = '' then Exit;
  AAlign := FDefaultCellAlign;
  AVertAlign := FDefaultCellVertAlign;
  if Assigned(FOnGetCellAlignment) then
    FOnGetCellAlignment(Self, ACol, ARow, AAlign, AVertAlign);
  FPreview.Canvas.Pen.Style := psClear;
  FPreview.Canvas.Brush.Style := bsClear;
  FPreview.Canvas.WordWrap := False;
  FPreview.Canvas.TextBoxExt(ARect.Left.AsInches,
                            ARect.Top.AsInches,
                            ARect.Right.AsInches,
                            ARect.Bottom.AsInches,
                            DEFAULT_CELL_PADDING,
                            AText,
                            AAlign,
                            AVertAlign,
                            gmInches);
  TGmTextBoxObject(FPreview.Canvas.LastObject).WordBreak := FWordWrap;
  TGmTextBoxObject(FPreview.Canvas.LastObject).ClipText := True;
end;

procedure TGmAbstractGridPrint.SetFont(AFont: TFont);
begin
  FFont.Assign(AFont);
end;

procedure TGmAbstractGridPrint.SetFixedFont(AFont: TFont);
begin
  FFixedCellFont.Assign(AFont);
end;

procedure TGmAbstractGridPrint.SetPreview(APreview: TGmPreview);
begin
  FPreview := APreview;
  if Assigned(FPreview) then
    FMarginBottom.AsInches := (FPreview.Footer.Height[gmInches] + FPreview.Margins.Bottom.AsInches);
end;

function TGmAbstractGridPrint.GetColWidth(index: integer; Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FColWidths[index], gmInches, Measurement);
end;

function TGmAbstractGridPrint.GetGrid: TCustomGrid;
begin
  Result := FGrid;
end;

function TGmAbstractGridPrint.GetScreenGridWidth: TGmValue;
var
  ICount: integer;
begin
  Result := FTempValue;
  Result.AsInches := 0;
  for ICount := 0 to GetColCount-1 do
    Result.AsInches := Result.AsInches + GetColWidthInch(ICount);
end;

procedure TGmAbstractGridPrint.NextRecord(ACurrentRecord: integer);
begin
  // used in decendant classes...
end;

function TGmAbstractGridPrint.GetRowHeightInch(ARow: integer): Extended;
var
  ARowHeight: TGmValue;
  ICount: integer;
  ACellText: string;
  AColWidth: Extended;
begin
  Result := GetDefaultRowHeight(ARow);
  if Assigned(FOnGetRowHeight) then
  begin
    ARowHeight := TGmValue.Create;
    try
      ARowHeight.AsInches := Result;
      FOnGetRowHeight(Self, ARow, ARowHeight);
      Result := ARowHeight.AsInches;
    finally
      ARowHeight.Free;
    end;
  end;
  if FAutoExpandRows then
  begin
    for ICount := 0 to GetColCount-1 do
    begin
      AColWidth := GetColWidth(ICount, gmInches);
      ACellText := GetCellText(ICount, ARow);
      
      FPreview.Canvas.WordWrap := FWordWrap;

      if ACellText <> '' then
        Result := MaxFloat(FPreview.Canvas.TextBoxHeight(AColWidth, ACellText, gmInches), Result);
    end;
  end;
end;

procedure TGmAbstractGridPrint.BuildColWidths;
var
  ICount: integer;
  AWidth: TGmValue;
begin
  FColWidths.Clear;
  AWidth := TGmValue.Create;
  try
    for ICount := 0 to GetColCount-1 do
    begin
      AWidth.AsInches := GetColWidthInch(ICount) * FWidthScale;
      if Assigned(FOnGetColWidth) then FOnGetColWidth(Self, ICount, AWidth);
      FColWidths.AddValue(AWidth.AsInches);
    end;
  finally
    AWidth.Free;
  end;
end;

procedure TGmAbstractGridPrint.CloseRow(ARect: TGmRect);
begin
  if gmGridBorder in FGridOptions then
  begin
    FPreview.Canvas.Brush.Style := bsClear;
    FPreview.Canvas.Rectangle(FTopLeft.X, FTopLeft.Y, ARect.Right, ARect.Bottom, gmInches);
    //(FPreview.Canvas.LastObject as TGmRectangleShape).RectType := gmPolyline;
  end;
end;

procedure TGmAbstractGridPrint.DrawRow(ARect: TGmRect; ARow: integer);
var
  ICount: integer;
  XPos: Extended;
  CellWidth: Extended;
  CellValueRect: TGmValueRect;
begin
  XPos := ARect.Left;
  CellValueRect := TGmValueRect.Create;
  try
    for ICount := 0 to GetColCount-1 do
    begin
      CellWidth := FColWidths[ICount];
      CellValueRect.AsInchRect := GmRect(XPos, ARect.Top, XPos + CellWidth, ARect.Bottom);
      if IsFixedCell(ICount, ARow) then
      begin
        FPreview.Canvas.Font.Assign(FFixedCellFont);
        FPreview.Canvas.Brush.Color := GetFixedCellColor;
      end
      else
      begin
        FPreview.Canvas.Brush.Color := clWhite;
        FPreview.Canvas.Font.Assign(FFont);
      end;
      if FScaleText then
      begin
      //  if FWidthScale < 1 then
       //   FPreview.Canvas.Font.Size := Round(FPreview.Canvas.Font.Size * FWidthScale);
      end;
      if OnDrawCellAssigned then
        CallOnDrawCell(ICount, ARow, CellValueRect)
      else
        DefaultDrawCell(CellValueRect, ICount, ARow);
      XPos := XPos + CellWidth;
    end;

    // draw grid lines...
    XPos := ARect.Left;
    FPreview.Canvas.Pen.Style := psSolid;
    FPreview.Canvas.Pen.Color := FCellPenColor;
    if (gmHorzLine in FGridOptions) and (ARow > 0) then
      FPreview.Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top, gmInches);
    for ICount := 0 to GetColCount-1 do
    begin
      CellWidth := FColWidths[ICount];
      CellValueRect.AsInchRect := GmRect(XPos, ARect.Top, XPos + CellWidth, ARect.Bottom);
      if (gmVertLine in FGridOptions) and (ICount > 0) then
        FPreview.Canvas.Line(XPos, ARect.Top, XPos, ARect.Bottom, gmInches);
      XPos := XPos + CellWidth;
    end;
  finally
    CellValueRect.Free;
  end;
end;

procedure TGmAbstractGridPrint.SetCustomGrid(AGrid: TCustomGrid);
begin
  FGrid := AGrid;
end;

procedure TGmAbstractGridPrint.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FPreview) then
    FPreview := nil;
  if (Operation = opRemove) and (AComponent = FGrid) then
    FGrid := nil;
end;

//------------------------------------------------------------------------------

function TGmGridPrint.GetGrid: TStringGrid;
begin
  Result := TStringGrid(FGrid);
end;

procedure TGmGridPrint.SetGrid(AGrid: TStringGrid);
begin
  inherited SetCustomGrid(AGrid);
end;

function TGmGridPrint.GetCellText(ACol, ARow: integer): string;
begin
  Result := Grid.Cells[ACol, ARow];
end;

function TGmGridPrint.GetColCount: integer;
begin
  Result := Grid.ColCount;
end;

function TGmGridPrint.GetColWidthInch(ACol: integer): Extended;
begin
  Result := Grid.ColWidths[ACol] / Screen.PixelsPerInch;
end;

function TGmGridPrint.GetDefaultRowHeight(ARow: integer): Extended;
begin
  Result := Grid.RowHeights[ARow] / Screen.PixelsPerInch;
end;

function TGmGridPrint.GetFixedCellColor: TColor;
begin
  Result := Grid.FixedColor;
end;

function TGmGridPrint.GetRowCount: integer;
begin
  if FRowCount = -1 then
    FRowCount := Grid.RowCount;
  Result := FRowCount;
end;

function TGmGridPrint.IsFixedCell(ACol, ARow: integer): Boolean;
begin
  Result := (ACol < Grid.FixedCols) or (ARow < Grid.FixedRows);
end;

function TGmGridPrint.OnDrawCellAssigned: Boolean;
begin
  Result := Assigned(FOnDrawCell);
end;

procedure TGmGridPrint.CallOnDrawCell(ACol, ARow: integer; ARect: TGmValueRect);
begin
  if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, FPreview.Canvas);
end;

end.

⌨️ 快捷键说明

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