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

📄 previewform.pas

📁 delphi制作表格的控件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
          Inc(LinePos, FooterLineWidth + 2);
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);
        end
      else
        begin
          Pen.Width := FooterLineWidth;
          Pen.Style := FooterLineStyle;
          Pen.Mode := pmCopy;
          LinePos := DrawRect.Bottom - FooterExtent + FooterLineWidth Div 2;
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);
        end;
  end;

  procedure DrawFooterText(Footer: TFooter; TextAlign: Cardinal);
  var
    FooterRect: TRect;
    FooterText: string;
  begin
    if Footer.Content = '' then Exit;
    with DrawCanvas, Footer do
    begin
      FooterText := TranslateText(Content, PageIndex);
      FooterRect := DrawRect;
      FooterRect.Top := FooterRect.Bottom - CommonPageInfo.FooterExtent;
      Font.Name := FontName;
      Font.Size := FontSize;
      if Printing then Font.Size := Round(FontSize * ScreenToPrinterX);
      Font.Color := FontColor;
      Font.Style := FontStyle;
      DrawText(DrawCanvas.Handle, PChar(FooterText), Length(FooterText), FooterRect, TextAlign);
    end;
  end;

begin
  if ((PageIndex = 0) and (not CommonPageInfo.PrintFirstFooter)) or
     (CommonPageInfo.FooterExtent = 0) then Exit;
  with CommonPageInfo, DrawCanvas do
  begin
    DrawFooterText(Footer1, DT_LEFT or DT_BOTTOM or DT_SINGLELINE or DT_NOCLIP);
    DrawFooterText(Footer2, DT_CENTER or DT_BOTTOM or DT_SINGLELINE or DT_NOCLIP);
    DrawFooterText(Footer3, DT_RIGHT or DT_BOTTOM or DT_SINGLELINE or DT_NOCLIP);
    DrawFooterLine;
  end;
end;

procedure TPreviewForm.DrawHeader(DrawCanvas: TCanvas; DrawRect: TRect;
  PageIndex: Integer; Printing: Boolean);

  procedure DrawHeaderLine;
  var
    LinePos: Integer;
  begin
    if CommonPageInfo.HeaderLineWidth <= 0 then Exit;
    with CommonPageInfo, DrawCanvas do
      if HeaderDoubleLine then
        begin
          Pen.Width := HeaderLineWidth;
          Pen.Style := HeaderLineStyle;
          Pen.Mode := pmCopy;
          LinePos := DrawRect.Top + HeaderExtent - (HeaderLineWidth + 2 + HeaderLineWidth Div 2);
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);
          Inc(LinePos, HeaderLineWidth + 2);
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);
        end
      else
        begin
          Pen.Width := HeaderLineWidth;
          Pen.Style := HeaderLineStyle;
          Pen.Mode := pmCopy;
          LinePos := DrawRect.Top + HeaderExtent - HeaderLineWidth Div 2;
          DrawLine(DrawCanvas, DrawRect.Left, LinePos, DrawRect.Right, LinePos);
        end;
  end;

  procedure DrawHeaderText(Header: THeader; TextAlign: Cardinal);
  var
    HeaderRect: TRect;
    HeaderText: string;
  begin
    if Header.Content = '' then Exit;
    with DrawCanvas, Header do
    begin
      HeaderText := TranslateText(Content, PageIndex);
      HeaderRect := DrawRect;
      HeaderRect.Bottom := HeaderRect.Top + CommonPageInfo.HeaderExtent;
      Font.Name := FontName;
      Font.Size := FontSize;
      if Printing then Font.Size := Round(FontSize * ScreenToPrinterX);
      Font.Color := FontColor;
      Font.Style := FontStyle;
      DrawText(DrawCanvas.Handle, PChar(HeaderText), -1, HeaderRect, TextAlign);
    end;
  end;

begin
  if ((PageIndex = 0) and (not CommonPageInfo.PrintFirstHeader)) or
     (CommonPageInfo.HeaderExtent = 0) then Exit;
  with CommonPageInfo, DrawCanvas do
  begin
    DrawHeaderText(Header1, DT_LEFT or DT_TOP or DT_SINGLELINE or DT_NOCLIP);
    DrawHeaderText(Header2, DT_CENTER or DT_TOP or DT_SINGLELINE or DT_NOCLIP);
    DrawHeaderText(Header3, DT_RIGHT or DT_TOP or DT_SINGLELINE or DT_NOCLIP);
    DrawHeaderLine;
  end;
end;

procedure TPreviewForm.DrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer);
begin
  ACanvas.MoveTo(X1, Y1);
  ACanvas.LineTo(X2, Y2);
end;

procedure TPreviewForm.DrawTail(DrawCanvas: TCanvas; DrawRect: TRect; Printing: Boolean);

  procedure DrawTailText(Tail: TTail; TextAlign: Cardinal);
  var
    TailRect, ContentRect, IRect: TRect;
  begin
    if Tail.Content = '' then Exit;
    with CommonPageInfo, DrawCanvas, Tail do
    begin
      TailRect := DrawRect;
      TailRect.Bottom := DrawRect.Bottom - FooterExtent - ExtraFooterExtent;
      TailRect.Top := TailRect.Bottom - TailExtent;
      ContentRect := TailRect;
      ContentRect.Top := TailRect.Top + Distance;
      IntersectRect(IRect, TailRect, ContentRect);
      Font.Name := FontName;
      Font.Size := FontSize;
      if Printing then Font.Size := Round(FontSize * ScreenToPrinterX);
      Font.Color := FontColor;
      Font.Style := FontStyle;
      DrawText(DrawCanvas.Handle, PChar(Tail.Content), Length(Tail.Content), IRect, TextAlign);
    end;
  end;

begin
  with CommonPageInfo, DrawCanvas do
  begin
    DrawTailText(Tail1, DT_LEFT or DT_SINGLELINE);
    DrawTailText(Tail2, DT_CENTER or DT_SINGLELINE);
    DrawTailText(Tail3, DT_RIGHT or DT_SINGLELINE);
    DrawTailText(Tail4, DT_LEFT or DT_SINGLELINE);
    DrawTailText(Tail5, DT_CENTER or DT_SINGLELINE);
    DrawTailText(Tail6, DT_RIGHT or DT_SINGLELINE);
  end;
end;

procedure TPreviewForm.DrawTitle(DrawCanvas: TCanvas; DrawRect: TRect; Printing: Boolean);

  procedure DrawTitleText(Title: TTitle; TextAlign: Cardinal);
  var
    TitleRect, ContentRect, IRect: TRect;
  begin
    if Title.Content = '' then Exit;
    with CommonPageInfo, DrawCanvas, Title do
    begin
      TitleRect := DrawRect;
      TitleRect.Top := DrawRect.Top + HeaderExtent + ExtraHeaderExtent + ExtraTitleExtent;
      TitleRect.Bottom := TitleRect.Top + TitleExtent;
      ContentRect := TitleRect;
      ContentRect.Top := TitleRect.Top + Distance;
      IntersectRect(IRect, TitleRect, ContentRect);
      Font.Name := FontName;
      Font.Size := FontSize;
      if Printing then Font.Size := Round(FontSize * ScreenToPrinterX);
      Font.Color := FontColor;
      Font.Style := FontStyle;
      DrawText(DrawCanvas.Handle, PChar(Title.Content), -1, IRect, TextAlign);
    end;
  end;

begin
  with CommonPageInfo, DrawCanvas do
  begin
    DrawTitleText(MainTitle, DT_CENTER or DT_SINGLELINE);
    DrawTitleText(Title1, DT_LEFT or DT_SINGLELINE);
    DrawTitleText(Title2, DT_CENTER or DT_SINGLELINE);
    DrawTitleText(Title3, DT_RIGHT or DT_SINGLELINE);
    DrawTitleText(Title4, DT_LEFT or DT_SINGLELINE);
    DrawTitleText(Title5, DT_CENTER or DT_SINGLELINE);
    DrawTitleText(Title6, DT_RIGHT or DT_SINGLELINE);
  end;
end;

function TPreviewForm.TranslateText(Content: string; PageNo: Integer): string;
var
  i: Integer;
begin
  i := 1;
  Result := '';
  while i <= Length(Content) do
  begin
    if Content[i] <> '&' then
    begin
      Result := Result + Content[i];
      Inc(i);
      Continue;
    end;
    Inc(i);
    if UpperCase(Content[i]) = 'P' then
      Result := Result + IntToStr(CommonPageInfo.StartPageNo + PageNo)
    else if UpperCase(Content[i]) = 'D' then
      Result := Result + FormatDateTime('yyyy"年"mm"月"dd"日"',Date)
    else if UpperCase(Content[i]) = 'T' then
      Result := Result + FormatDateTime('hh":"mm',Time)
    else if UpperCase(Content[i]) = 'C' then
      Result := Result + IntToStr(FPageCount)
    else
      Result := Result + Content[i];
    Inc(i);
  end;
end;

procedure TPreviewForm.RefreshPages;
var
  i: Integer;
begin
  for i := 0 to FPageCount - 1 do
  begin
    FPages[i].PageWidth := FCommonPageInfo.PageWidth;
    FPages[i].PageHeight := FCommonPageInfo.PageHeight;
  end;
  AdjustPages;
  for i := 0 to FPageCount - 1 do FPages[i].Invalidate;
end;

procedure TPreviewForm.PriorPage;
begin
  if (FPageIndex = 0) then Exit;
  PageIndex := FPageIndex - 1;
end;

procedure TPreviewForm.NextPage;
begin
  if (FPageIndex = FPageCount - 1) then Exit;
  PageIndex := FPageIndex + 1;
end;

procedure TPreviewForm.SwitchZoom;
begin
  if (FState = pbZoomIn) then State := pbZoomOut else State := pbZoomIn; 
end;

procedure TPreviewForm.KeyDown(var Key: Word; Shift: TShiftState);
var
  Step: Integer;
begin
  inherited KeyDown(Key, Shift);
  Step := 10;
  case Key of
    VK_LEFT :
      if FState = pbZoomIn then
        begin
          if HorzScrollBar.Range > 0 then
            HorzScrollBar.Position := Max(HorzScrollBar.Position - Step, 0);
        end
      else PriorPage;
    VK_UP :
      if FState = pbZoomIn then
        begin
          if VertScrollBar.Range > 0 then
            VertScrollBar.Position := Max(VertScrollBar.Position - Step, 0);
        end
      else PriorPage;
    VK_RIGHT :
      if FState = pbZoomIn then
        begin
          if HorzScrollBar.Range > 0 then
            HorzScrollBar.Position := Min(HorzScrollBar.Position + Step, HorzScrollBar.Range);
        end
      else NextPage;
    VK_DOWN :
      if FState = pbZoomIn then
        begin
          if VertScrollBar.Range > 0 then
            VertScrollBar.Position := Min(VertScrollBar.Position + Step, VertScrollBar.Range);
        end
      else NextPage;
    VK_PRIOR : 
      if FState = pbZoomIn then
        begin
          if VertScrollBar.Range > 0 then
            VertScrollBar.Position := 0;
        end
      else PriorPage;
    VK_NEXT :
      if FState = pbZoomIn then
        begin
          if VertScrollBar.Range > 0 then
            VertScrollBar.Position := VertScrollBar.Range;
        end
      else NextPage;
    VK_HOME :
      if FState = pbZoomIn then
        begin
          if HorzScrollBar.Range > 0 then
            HorzScrollBar.Position := 0;
        end
      else PageIndex := 0;
    VK_END :
      if FState = pbZoomIn then
        begin
          if HorzScrollBar.Range > 0 then
            HorzScrollBar.Position := HorzScrollBar.Range;
        end
      else PageIndex := FPageCount - 1;
    VK_RETURN: SwitchZoom;
  end;
end;

{ TCommonPageInfo }

procedure TCommonPageInfo.Assign(Source: Pointer);
begin
  Orientation := TCommonPageInfo(Source).Orientation;
  StartPageNo := TCommonPageInfo(Source).StartPageNo;
  PrintAllPages := TCommonPageInfo(Source).PrintAllPages;
  StartPage := TCommonPageInfo(Source).StartPage;
  EndPage := TCommonPageInfo(Source).EndPage;
  PaperSize := TCommonPageInfo(Source).PaperSize;
  PageWidth := TCommonPageInfo(Source).PageWidth;
  PageHeight := TCommonPageInfo(Source).PageHeight;
  Margin := TCommonPageInfo(Source).Margin;
  Scale := TCommonPageInfo(Source).Scale;
  HeaderExtent := TCommonPageInfo(Source).HeaderExtent;
  FooterExtent := TCommonPageInfo(Source).FooterExtent;
  HeaderLineStyle := TCommonPageInfo(Source).HeaderLineStyle;
  FooterLineStyle := TCommonPageInfo(Source).FooterLineStyle;
  HeaderLineWidth := TCommonPageInfo(Source).HeaderLineWidth;
  FooterLineWidth := TCommonPageInfo(Source).FooterLineWidth;
  HeaderDoubleLine := TCommonPageInfo(Source).HeaderDoubleLine;
  FooterDoubleLine := TCommonPageInfo(Source).FooterDoubleLine;
  ExtraHeaderExtent := TCommonPageInfo(Source).ExtraHeaderExtent;
  ExtraFooterExtent := TCommonPageInfo(Source).ExtraFooterExtent;
  PrintFirstHeader := TCommonPageInfo(Source).PrintFirstHeader;
  PrintFirstFooter := TCommonPageInfo(Source).PrintFirstFooter;
  TitleExtent := TCommonPageInfo(Source).TitleExtent;
  ExtraTitleExtent := TCommonPageInfo(Source).ExtraTitleExtent;
  TailExtent := TCommonPageInfo(Source).TailExtent;
  Header1.Assign(TCommonPageInfo(Source).Header1);
  Header2.Assign(TCommonPageInfo(Source).Header2);
  Header3.Assign(TCommonPageInfo(Source).Header3);
  Footer1.Assign(TCommonPageInfo(Source).Footer1);

⌨️ 快捷键说明

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