preport.~pas

是 delphi6的函数库

    Property OnDragDrop;
    Property EditStatus: boolean Read FCreportEdit Write setCreportEdit;  //代表是否处在模板编辑程序调用中
    //property OnUpdateLine;
  End;
  TDatasetItem = Class(TObject)
    pDataset: TDataset;
    strName: String;
  End;
  TMyRect = Class(TObject)
  Public
    Left: Integer;
    Top: Integer;
    Right: Integer;
    Bottom: Integer;
  End;

  TPRToExcel = Class(TComponent)
  Private
    FCol: word;
    FRow: word;
    FDataSet: TDataSet;
    Stream: TStream;
    FWillWriteHead: boolean;
    FBookMark: TBookmark;
    Procedure IncColRow;
    Procedure WriteBlankCell;
    Procedure WriteFloatCell(Const AValue: Double);
    Procedure WriteIntegerCell(Const AValue: Integer);
    Procedure WriteStringCell(Const AValue: String);
    Procedure WritePrefix;
    Procedure WriteSuffix;
    Procedure WriteTitle;
    Procedure WriteDataCell;
    Procedure Setdataset(Const value: Tdataset);

    Procedure SaveStream(aStream: TStream);
  Public
    Procedure SaveExclFile(FileName: String; WillWriteHead: Boolean);

    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  Published
    Property Dataset: TDataset Read FDataset Write SetDataset;

  End;

  TPRExcute = Class(TComponent)
  Private
    FTempStreams:array of TStream;
    SumPage, SumAll: Array[0..40] Of real;  //小计和合计用,最多40列单元格,否则统计汇总时要出错.
    FFileName: Tfilename;
    FdbGrid: TDBGrid;
    FSetData: TstringList;
    FEnableEdit: Boolean;
    FVarList: TList;    // 保存变量的名字和值的对照表
    FLineList: TList;   // 保存报表的设计信息（从文件中读入）
    FPrintPageList: TList; //保存要打印的某一页的行信息
    FOwnerCellList: TList;  // 保存每一页中合并后单元格前后的指针
    DataSourceList: TList;    // 保存数据集的指针和名称的对照
    FDatasourceList:TList;  // 保存数据集的指针和名称的对照
    Width: Integer;
    Height: Integer;
    // 定义换页加表头
    FNewTable: Boolean;
    // 定义打印多少行后重新加表头
    FVersionNo:integer;//版本号
    FAncientStyle:boolean;
    FDataLine:integer;
    FAddSpace:boolean;
    FPrintLine:boolean;//打印表格线(非套打)
    FDatasources:TStringList;

    FTablePerPage: Integer;

    FReportScale: Integer;
    FPageWidth: Integer;
    FPageHeight: Integer;

    FHeaderHeight: Integer;

    fAllPrint: Boolean;                 //是否打印全部记录，默认为全部

    FLeftMargin: Integer;               //2
    FRightMargin: Integer;
    FTopMargin: Integer;
    FBottomMargin: Integer;

    FLeftMargin1: Integer;
    FRightMargin1: Integer;
    FTopMargin1: Integer;
    FBottomMargin1: Integer;

    FPageCount: Integer;                // page count in print preview

    FFootNo: integer;
    FEditEpt: boolean;                  //表尾的第一行在整个页的第几行

    Procedure UpdateLines;
    Procedure UpdatePrintLines;
    Procedure PrintOnePage;
    Procedure LoadRptStream;
    Function GetDatasetName(strCellText: String): String;
    Function GetDataset(strCellText: String): TDataset;
    Function DatasetByName(strDatasetName: String): TDataset;
    Function GetVariable(sVariableName: String): String;
    Function GetFieldName(strCellText: String): String;
    Procedure SetRptFileName(Const Value: TFilename);

    Procedure Setdbgrid(Const Value: TDBGrid);
    Procedure LSetData(Const value: TstringList);

    Procedure SetRelate(FIDE, Tableopen: boolean; Description: String);
    Function LFindComponent(Owner: TComponent; Name: String): TComponent;
    //1022
    procedure SaveToStream(Stream:TStream;PageNumber,FPageAll: Integer;const APosition:Integer=0);
    procedure LoadFromStream(Stream:TStream;const APosition:Integer=0);

    procedure SaveTempStream(PageNumber, FPageAll: Integer);
    procedure LoadTempStream(Page:Integer);
    procedure DeleteTempStreams;
    //
    Function SetSumAll(CellFormat, CellText: String): String;
    Function SetSumPage(CellFormat, CellText: String): String;

    Procedure SetEnableEdit(Value: Boolean);
    Procedure SetEditept(Value: Boolean);
    Procedure SetNewCell(spyn: boolean; NewCell, ThisCell: TReportCell;
      TempDataset: TDataset);
  Protected
    Procedure IEditEpt; Virtual;       //  双击控件调用
    Procedure IPreview; Virtual;

  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure Define(strDatasetName: String; pDataSet: TDataSet); //Excute
    Procedure SetVariable(sVariableName, sVariableValue: String);
    Property AllPrint: boolean Read fAllPrint Write fAllPrint Default true;
    Procedure ResetContent;
    Procedure PrintPreview(bPreviewMode: Boolean);//true参数表示预览不显示非打印表格线
    Function RePreview: boolean;        //重新生成预览有关文件
    Function PrintSET(prfile: String): boolean; //纸张及边距设置，
    Procedure UpdatePage;               //
    Function PrintPrepare(bSaveTempStream: boolean; FPageAll: integer): integer;  //增加

    Procedure CreateNewLine;

    Procedure LoadFile(value: TFilename);
    Procedure Print(pYn: boolean);
    Procedure Resetself;
    Function CancelPrint: boolean;

    Procedure PreviewDbGrid(eptname,Title: String);
  Published
    Property ReportFile: TFilename Read FFileName Write SetRptFileName;
    Property PrintDBGrid: TDBGrid Read Fdbgrid Write Setdbgrid;
    Property EnableEdit: boolean Read FEnableEdit Write setEnableEdit;
    Property EditEpt: boolean Read FEditEpt Write setEditEpt;
    Property Datasources: TStringList Read FSetData Write LSetData; //
  End;

  TPREditor = Class(TComponentEditor)
  Public
    Procedure ExecuteVerb(Index: Integer); Override;
    Function GetVerb(Index: Integer): String; Override;
    Function GetVerbCount: Integer; Override;
  End;

  TCellTable = Class(TObject)
    PrevCell: TReportCell;
    ThisCell: TReportCell;
  End;

Procedure prDeviceMode;  //取得当前打印机的DeviceMode的结构成员
Function DeleteFiles(FilePath, FileMask: String): Boolean;
Procedure Register;

Var
  CXlsBof: Array[0..5] Of Word = ($809, 8, 0, $10, 0, 0);  //Excel文件头
  CXlsEof: Array[0..1] Of Word = ($0A, 00);                //Excel文件尾
  CXlsLabel: Array[0..5] Of Word = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: Array[0..4] Of Word = ($203, 14, 0, 0, 0);
  CXlsRk: Array[0..4] Of Word = ($27E, 10, 0, 0, 0);
  CXlsBlank: Array[0..4] Of Word = ($201, 6, 0, 0, $17);

  Adevice, Adriver, Aport: Array[0..255] Of char; //
  DeviceHandle: THandle;
  DevMode: PdeviceMode; //当前打印机结构成员，调用prdevixemode初始化

  FprPageNo: integer;                   //打印文件的纸张序号
  FprPageXy: integer;                   //打印文件的纸张纵横方向
  fpaperLength: integer;
  fpaperWidth: integer;

  cp_pgw, cp_pgh, scale: integer;

  Cpreviewedit: boolean;

  CellsWidth: Array Of Array Of integer;  // 存用户在预览时拖动表格后新的单元格宽度,
  iRow_SumAll: integer;                  //有合计的行在模板中是第几行.

  bPreviewStatus: Boolean;                   //代表是否处于预览状态

  CreportIde: boolean;
  cellline_d: TReportCell;              //用于保存选中单元格的属性
  isprint: byte;                        //用于是否已安装打印机
  CellSelected: TReportCell;     //用于显示Mouse位置的单元格属性

Implementation

{$R PReport.dcr}
Uses prPreview, prPreviewDBG,prProgress, PRDesigner, prBorder, prSplit, prColor, prIncline,
   prNewTable,prSetting;

Procedure prDeviceMode; //取得当前1打印机的DeviceMode的结构成员
Begin
  Printer.GetPrinter(Adevice, Adriver, Aport, DeviceHandle);
  If DeviceHandle = 0 Then
  Begin
    printer.PrinterIndex := printer.PrinterIndex;
    Printer.GetPrinter(Adevice, Adriver, Aport, DeviceHandle);
  End;
  If DeviceHandle = 0 Then
    Raise Exception.Create('Could Not Initialize TdeviceMode Structure')
  Else  DevMode := GlobalLock(DeviceHandle);
  {!!!}
  If Not DeviceHandle = 0 Then GlobalLock(DeviceHandle);
End;

Function DeleteFiles(FilePath, FileMask: String): Boolean;
Var
  Attributes: integer;
  DeleteFilesSearchRec: TSearchRec;
Begin
  Result := true;
  Try
    FindFirst(FilePath + '\' + FileMask, faAnyFile, DeleteFilesSearchRec);

    If Not (DeleteFilesSearchRec.Name = '') Then
    Begin
      Result := True;
      Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);
      FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
      DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);

      While FindNext(DeleteFilesSearchRec) = 0 Do
      Begin
        Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);

        FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
        DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);
      End;
    End;

    FindClose(DeleteFilesSearchRec);

  Except
    Result := false;
    Exit;
  End;
End;

Procedure Register;
Begin
  RegisterComponents('YS', [TPRClass]);
  RegisterComponents('YS', [TPRExcute]);
  RegisterComponents('YS', [TPRToExcel]);
  RegisterComponentEditor(TPRExcute, TPREditor);
End;

//TPRExcute
Procedure TPRExcute.IPreview;
Var
  i, HasDataNo: integer;
Begin
  DeleteTempStreams;//1022

  For I := DataSourceList.Count - 1 Downto 0 Do
    TDataSetItem(DataSourceList[I]).Free;
  DataSourceList.clear;
  If (Reportfile = '') Or (Datasources.Count = 0) Then
  Begin
    MessageDlg('ReportFile或Datasources属性未填列，不能预览。', mtInformation,
      [mbOk], 0);
    exit;
  End;

  reportfile := reportfile;
  Try
    For i := 0 To Datasources.Count - 1 Do
      SetRelate(true, true, Datasources[i]);   //参数设置
    HasDataNo := PrintPrepare(TRUE, i);
  Except
    MessageDlg('数据源错误，请检查数据集设置是否正确',
      mtInformation, [mbOk], 0);
    exit;
  End;
  Application.CreateForm(TfrmPreview, frmPreview);
  CreportIde := true;                   //处于IDE中调用

  frmPreview.PRClass1.enabled := Fenableedit;
  frmPreview.btnPrint.Enabled := false;
  frmPreview.sPreviewFile := ReportFile;
  frmPreview.PageCount := FPageCount;

  frmPreview.StatusBar1.Panels[0].Text := '第' +
    IntToStr(frmPreview.CurrentPage) + '/' + IntToStr(frmPreview.PageCount) +
    '页';
  frmPreview.sPreviewFile := ReportFile;
  frmPreview.tag := HasDataNo;

  prpreview.EnableBz := fenableedit;      //预览中是否允许编辑
  frmPreview.SetPreviewMode(true); //设置预览状态

  bPreviewStatus := true;  //代表处于预览状态,调用打印时以便区分
  frmPreview.ShowModal;
  bPreviewStatus := false;

  frmPreview.Free;
  DeleteTempStreams;
  For i := 0 To Datasources.Count - 1 Do
    SetRelate(true, false, Datasources[i]);    //关闭打开的数据库

  CreportIde := false;
End;
//设计报表
Procedure TPRExcute.IEditEpt;
var i:integer;
Begin
  Application.CreateForm(TfrmPRDesigner, frmPRDesigner);
  Application.CreateForm(TfrmBorder, frmBorder);
  Application.CreateForm(TColorform, Colorform);
  Application.CreateForm(TfrmIncline, frmIncline);
  Application.CreateForm(TfrmNewTable, frmNewTable);
  Application.CreateForm(TfrmSplit, frmSplit);
  Try
    If ReportFile <> '' Then
    Begin
      frmPRDesigner.PRClass1.LoadFromFile(reportfile);
      frmPRDesigner.Caption := reportfile;
      frmPRDesigner.TempFileName := reportfile;
      frmPRDesigner.SaveFileName := reportfile;
    End;
     frmPRDesigner.DSDefine:= Datasources; //传递定义数据
    frmPRDesigner.showmodal;
    frmPRDesigner.Free;
    frmBorder.Free;
    Colorform.free;
    frmIncline.free;
    frmNewTable.free;
    frmSplit.Free;
  Finally
  End;
End;

Procedure TPREditor.ExecuteVerb(index: integer);
Begin
  Case index Of
    0: TPRExcute(Component).IEditEpt;
    1: TPRExcute(Component).IPreview;
  End;
End;

Function TPREditor.GetVerb(Index: Integer): String;
Begin
  Case index Of
    0: result := 'IEditEpt4.0';
    1: result := 'IPreview';            // do priew
  End;
End;

Function TPREditor.GetVerbCount: Integer;
Begin
  Result := 2;
End;

Procedure TReportCell.SetLeftMargin(LeftMargin: Integer);
Begin
  // 修改左右预留的空白区域  目前只能是5。
  If (LeftMargin = FLeftMargin) Or
    (LeftMargin < 5) Or (LeftMargin > 5) Then  Exit;

  FLeftMargin := LeftMargin;
  CalcMinCellHeight;
End;

Procedure TReportCell.SetOwnerLine(OwnerLine: TReportLine);
Begin
  If OwnerLine <> Nil Then  FOwnerLine := OwnerLine;
End;

Procedure TReportCell.SetOwnerCell(Cell: TReportCell);
Begin
  FOwnerCell := Cell;
End;

Function TReportCell.GetOwnedCellCount: Integer;
Begin
  Result := FCellsList.Count;
End;

Procedure TReportCell.AddOwnedCell(Cell: TReportCell);
Var
  I: Integer;
  TempCellList: TList;
Begin
  If (Cell = Nil) Or (FCellsList.IndexOf(Cell) >= 0) Then
    Exit;

  Cell.OwnerCell := Self;
  FCellText := FCellText + Cell.CellText;
  Cell.CellText := '';

  FCellsList.Add(Cell);

  TempCellList := TList.Create;
  For I := 0 To Cell.FCellsList.Count - 1 Do
    TempCellList.Add(Cell.FCellsList[I]);

  Cell.RemoveAllOwnedCell();

  For I := 0 To TempCellList.Count - 1 Do
  Begin
    FCellsList.Add(TempCellList[I]);
    TReportCell(TempCellList[I]).OwnerCell := Self;
  End;
End;

Procedure TReportCell.RemoveAllOwnedCell;
Var
  I: Integer;
  Cell: TReportCell;