previewform.pas

delphi制作表格的控件

// *****************************************************************************
//
// Note: This free package of source code can only be used for reference and
//       learning purpose, you can distribute it freely, but please do not use
//       it for profit sake.
//
//       Special thanks to: RICHBBS (www.delphibbs.com)
//
//                                                         Huang Qian, Feb 2002
//                                                         Wuhan University
//
// *****************************************************************************

unit PreviewForm;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Printers, Forms, FlatSB, CommCtrl,
  SysUtils, Math;

const
  crExcel = 1001;
  crZoomIn = 1002;
  crZoomOut = 1003;

resourcestring
  BadCommonPageInfo = '错误的页面信息, 该文件头可能已经损坏。';
  
type
  TMm = Double;

  // 页眉页脚信息
  THeader = class(TObject)
  public
    FontSize: Integer;                                  // 字体大小
    FontStyle: TFontStyles;                             // 字体风格
    FontColor: TColor;                                  // 字体颜色
    FontName: string;                                   // 字体名
    Content: string;                                    // 页眉页脚内容
    constructor Create;
    procedure LoadFromStream(AFileStream: TStream);
    procedure SaveToStream(AFileStream: TStream);
    procedure Assign(Source: Pointer);
  end;
  TFooter = THeader;

  // 标题与结尾信息
  TTitle = class(TObject)
  public
    Distance: Integer;                                  // 距离页眉页脚高度
    FontSize: Integer;                                  // 字体大小
    FontStyle: TFontStyles;                             // 字体风格
    FontColor: TColor;                                  // 字体颜色
    FontName: string;                                   // 字体名
    Content: string;                                    // 标题内容
    constructor Create;
    procedure LoadFromStream(AFileStream: TStream);
    procedure SaveToStream(AFileStream: TStream);
    procedure Assign(Source: Pointer);
  end;
  TTail = TTitle;

  // 通用页面信息
  TCommonPageInfo = class(TObject)
  public
    Orientation: TPrinterOrientation;                // 打印方向(横向/纵向)
    StartPageNo: Integer;                            // 起始页号
    PrintAllPages: Boolean;                          // 是否打印所有页
    StartPage, EndPage: Integer;                     // 打印页码范围
    PaperSize: Integer;                              // 纸张大小   
    PageWidth: Integer;                              // 页宽
    PageHeight: Integer;                             // 页高
    Margin: TRect;                                   // 页边距
    Scale: Integer;                                  // 缩放比例
    HeaderExtent, FooterExtent: Integer;             // 页眉页脚高度
    HeaderLineStyle, FooterLineStyle: TPenStyle;     // 页眉页脚线形
    HeaderLineWidth, FooterLineWidth: Integer;       // 页眉页脚线宽
    HeaderDoubleLine, FooterDoubleLine: Boolean;     // 页眉页脚是否打印双线
    ExtraHeaderExtent, ExtraFooterExtent: Integer;   // 正文距离页眉页脚高度
    PrintFirstHeader, PrintFirstFooter: Boolean;     // 是否在第一页打印页眉页脚
    TitleExtent: Integer;                            // 标题区高度
    ExtraTitleExtent: Integer;                       // 额外标题区高度
    TailExtent: Integer;                             // 结尾区高度
    Reserved: array [0..255] of Char;                // 保留空间
    Header1, Header2, Header3: THeader;              // 左、中、右页眉信息
    Footer1, Footer2, Footer3: TFooter;              // 左、中、右页脚信息
    MainTitle, Title1, Title2, Title3: TTitle;       // 标题信息
    Title4, Title5, Title6: TTitle;
    Tail1, Tail2, Tail3, Tail4, Tail5, Tail6: TTail; // 结尾信息
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromStream(AFileStream: TStream);
    procedure SaveToStream(AFileStream: TStream);
    procedure Assign(Source: Pointer);
  end;

  TPreviewForm = class;

  TPage = class(TCustomControl)
  private
    FBox: TPreviewForm;
    FPageIndex: Integer;
    FZoom: Integer;
    FMousePos: TPoint;
    FPageWidth, FPageHeight: Integer;
    procedure SetZoom(Value: Integer);
    procedure SetPageWidth(Value: Integer);
    procedure SetPageHeight(Value: Integer);
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Zoom: Integer read FZoom write SetZoom default 100;
    property PageWidth: Integer read FPageWidth write SetPageWidth default 50;
    property PageHeight: Integer read FPageHeight write SetPageHeight default 100;
    property Box: TPreviewForm read FBox write FBox;
  end;

  TPages = array of TPage;

  TPreviewFormState = (pbSelect, pbZoomIn, pbZoomOut);

  TDrawPageEvent = procedure(DrawCanvas: TCanvas; DrawRect: TRect; PageIndex: Integer; Printing: Boolean) of object;

  TPreviewForm = class(TScrollBox)
  private
    FPages: TPages;
    FState: TPreviewFormState;
    FZoom: Integer;
    FPageCount: Integer;
    FPageIndex: Integer;
    FInitializing: Boolean;
    FOnDrawPage: TDrawPageEvent;
    FCommonPageInfo: TCommonPageInfo;
    procedure SetZoom(Value: Integer);
    procedure SetPageCount(Value: Integer);
    procedure SetPageIndex(Value: Integer);
    procedure SeTPreviewFormState(NewState: TPreviewFormState);
    procedure SetCommonPageInfo(Value: TCommonPageInfo);
    procedure AdjustPages;    // 调整各页的位置
    procedure RefreshPages;   // 刷新页面显示
    procedure ZoomIn;
    procedure ZoomOut;

    procedure DrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer);
    function  TranslateText(Content: string; PageNo: Integer): string; // 解释页眉页脚文本
    procedure DrawHeader(DrawCanvas: TCanvas; DrawRect: TRect; PageIndex: Integer; Printing: Boolean);
    procedure DrawFooter(DrawCanvas: TCanvas; DrawRect: TRect; PageIndex: Integer; Printing: Boolean);
    procedure DrawTitle(DrawCanvas: TCanvas; DrawRect: TRect; Printing: Boolean);
    procedure DrawTail(DrawCanvas: TCanvas; DrawRect: TRect; Printing: Boolean);

    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawPage(DrawCanvas: TCanvas; DrawRect: TRect; PageIndex: Integer; Printing: Boolean); virtual;
    procedure NextPage;
    procedure PriorPage;
    procedure SwitchZoom;
    property State: TPreviewFormState read FState write SeTPreviewFormState;
    property Pages: TPages read FPages;
    property CommonPageInfo: TCommonPageInfo read FCommonPageInfo write SetCommonPageInfo;
  published
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PageCount: Integer read FPageCount write SetPageCount default 1;
    property PageIndex: Integer read FPageIndex write SetPageIndex default 0;
    property Zoom: Integer read FZoom write SetZoom default 20;
    property OnDrawPage: TDrawPageEvent read FOnDrawPage write FOnDrawPage;
  end;

  TGeTPreviewFormEvent = procedure (var Box: TPreviewForm) of object;
  TPaintEvent = procedure (Canvas: TCanvas; PageIndex: Integer) of object;

procedure Register;
function HasPrinter: Boolean;
function GetPaperSize(var PaperSize, PaperLength, PaperWidth: Integer): Boolean;
function SetPaperSize(PaperSize, PaperLength, PaperWidth: Integer): Boolean;

var
  ScreenPixelsPerMmX: Integer;      // 屏幕水平方向的每毫米像素数
  ScreenPixelsPerMmY: Integer;      // 屏幕垂直方向的每毫米像素数
  ScreenPixelsPerInchX: Integer;    // 屏幕水平方向的每英寸像素数
  ScreenPixelsPerInchY: Integer;    // 屏幕垂直方向的每英寸像素数
  PrinterPixelsPerMmX: Integer;     // 打印机水平方向的每毫米像素数
  PrinterPixelsPerMmY: Integer;     // 打印机垂直方向的每毫米像素数
  PrinterPixelsPerInchX: Integer;   // 打印机水平方向的每英寸像素数
  PrinterPixelsPerInchY: Integer;   // 打印机垂直方向的每英寸像素数
  ScreenToPrinterX: Double;         // 屏幕与打印机水平方向的缩放比
  ScreenToPrinterY: Double;         // 屏幕与打印机垂直方向的缩放比

implementation

const
  MmsPerInch = 25.4;
  HPageSpace = 20;
  VPageSpace = 20;
  SegmentFlagValue = $FF;

procedure Register;
begin
  RegisterComponents('Discovery', [TPreviewForm]);
end;

function HasPrinter: Boolean;
begin
  Result := Printer.Printers.Count > 0;
end;

function GetPaperSize(var PaperSize, PaperLength, PaperWidth: Integer): Boolean;
var
  ADevice, ADriver, APort: array [0..255] of Char;
  DeviceHandle: THandle;
  DevMode: PDeviceMode;
begin
  Result := False;
  Printer.GetPrinter(ADevice, ADriver, APort, DeviceHandle);
  if (DeviceHandle <> 0) then
  begin
    DevMode := GlobalLock(DeviceHandle);
    PaperSize := DevMode^.dmPaperSize;
    PaperLength := DevMode^.dmPaperLength;
    PaperWidth := DevMode^.dmPaperWidth;
    GlobalUnlock(DeviceHandle);
    Result := True;
  end;
end;

function SetPaperSize(PaperSize, PaperLength, PaperWidth: Integer): Boolean;
var
  ADevice, ADriver, APort: array [0..255] of Char;
  DevMode: PDeviceMode;
  DeviceHandle: THandle;
begin
  Result := False;
  Printer.GetPrinter(ADevice, ADriver, APort, DeviceHandle);
  if (DeviceHandle <> 0) then
  begin
    DevMode := GlobalLock(DeviceHandle);
    with DevMode^ do
    begin
      dmFields := dmFields or DM_PAPERSIZE or DM_PAPERLENGTH or DM_PAPERWIDTH;
      dmPaperSize := PaperSize;
      dmPaperLength := PaperLength;
      dmPaperWidth := PaperWidth;
      Printer.SetPrinter(ADevice, ADriver, APort, DeviceHandle);
      GlobalUnlock(DeviceHandle);
      Result := True;
    end;
  end;
end;

procedure GetResolution;
var
  DC: HDC;
begin
  DC := GetDC(0);
  try
    ScreenPixelsPerInchX := GetDeviceCaps(DC, LOGPIXELSX);
    ScreenPixelsPerInchY := GetDeviceCaps(DC, LOGPIXELSY);
    ScreenPixelsPerMmX := Round(ScreenPixelsPerInchX / MmsPerInch);
    ScreenPixelsPerMmY := Round(ScreenPixelsPerInchY / MmsPerInch);
    if HasPrinter then
      begin
        PrinterPixelsPerInchX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
        PrinterPixelsPerInchY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
      end
    else
      begin
        PrinterPixelsPerInchX := 180;
        PrinterPixelsPerInchY := 180;
      end;
    PrinterPixelsPerMmX := Round(PrinterPixelsPerInchX / MmsPerInch);
    PrinterPixelsPerMmY := Round(PrinterPixelsPerInchY / MmsPerInch);
    ScreenToPrinterX := ScreenPixelsPerInchX / PrinterPixelsPerInchX;
    ScreenToPrinterY := ScreenPixelsPerInchY / PrinterPixelsPerInchY;
  finally
    ReleaseDC(0, DC);
  end;
end;

//TPage

constructor TPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FZoom := 100;
  FPageHeight := 100;
  FPageWidth := 50;
  FMousePos.x := 0; FMousePos.y := 0;
  DoubleBuffered := True;
end;

procedure TPage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  FMousePos := Point(X, Y);
  if FBox.State = pbZoomIn then begin FBox.State := pbZoomOut; Exit; end;
  if FBox.State = pbSelect then
    begin
      FBox.PageIndex := FPageIndex;
      FBox.State := pbZoomOut;
    end
  else FBox.State := pbZoomIn;
end;

procedure TPage.Paint;
var
  OldWindowExtent, OldViewPortExtent: TSize;
  OldMapMode: Integer;
  NewZoom, X, Y, Edge, Offset: Integer;
  DrawRect: TRect;
begin
  with Canvas do
  begin
    Brush.Color := clWhite;
    Pen.Width := 1;
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;

    // 画页面图形
    if FPageIndex = FBox.PageIndex then
    begin
      Brush.Color := clRed;
      FillRect(Rect(0, 0, Width, Height));
      Pen.Color := clBlack;
      Brush.Color := clWhite;
      Rectangle(2, 2, Width - 2, Height - 2);
      Offset := 2;
    end
    else
    begin
      Brush.Color := FBox.Color;
      FillRect(Rect(0, 0, Width, Height));