printfrmform.pas

delphi开发的中国移动大客户管理系统,后台数据库为oracle

{
Author:
           ChenXiping On 2002/02/26
Modified:
           * 2002/02/26 created by chenxiping
Function:
           The Unit provides a Useful Procedure which named PrintDbGrid.
           It is defined like following:
           PrintDBGrid(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
           In Multi-tier system:
           qry:  clientdataset componert which contain data
           dbgd: dbgrid componert which show data to user
           HeaderTitle:the header title displaed in your print form
Usage:
          Step1.add
               Uses Print;
          2.call
               PrintDBGrid(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
Example:
               PrintDBGrid(cdsFault,dggdFault,'打印缺陷数据内容');
}
unit PrintFrmForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, OleCtrls, DB, DBTables, Grids, DBGrids,
  StdCtrls, Buttons, vcf1, AxCtrls;

type
  TPrintForm = class(TForm)
    pnlTools: TPanel;
    BtnPrint: TBitBtn;
    SbPrintGrid: TSpeedButton;
    BtnNarrow: TBitBtn;
    BtnWider: TBitBtn;
    BtnComeToMaxLengh: TBitBtn;
    CkShowPrint: TCheckBox;
    vcfPrint: TF1Book;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnPrintClick(Sender: TObject);
    procedure SbPrintGridClick(Sender: TObject);
    procedure BtnNarrowClick(Sender: TObject);
    procedure BtnWiderClick(Sender: TObject);
    procedure VcfPrintStartEdit(Sender: TObject;
      var EditString: WideString; var Cancel: Smallint);
  private
    lvTestString:string;
  public
        lvtmpFootTitle:string;
        needRecordBreak:boolean;
        //the following two have ths same procedure;
        procedure Print(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
        procedure Preview(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
  end;

procedure PrintDBGrid(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
procedure PrintDBGridOrSum(qry:TDataSet;dbgd:TComponent;HeaderTitle:string;FootTitle:string) ;

var
  PrintForm: TPrintForm;

implementation

{$R *.DFM}
uses
    ole2;

var
   //用户击右
   maxCharsInRow:array[0..20]of integer;

   //printTitleHeader,dbgdFontName:string;
   dbgdFontSize:integer;
   isPWin:boolean;
   totalRecords:integer;//used to record the total records in the dateset.
   fieldsInDataSet:integer;


procedure TPrintForm.Preview(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
begin
     print(qry,dbgd,HeaderTitle);
end;

procedure TPrintForm.FormCreate(Sender: TObject);
begin
     needRecordBreak:=true;

     with vcfPrint do
     begin
          sheet:=1;
          left:=0;
          top:=pnlTools.height;
          width:=PrintForm.clientWidth;
          height:=PrintForm.clientHeight-pnlTools.height;
          allowDelete:=false;
          showSelections:=1;//allways show selection
          ShowTabs:=0;//don;t show tabs.
          appName:='POMP';
     end;

     isPWin:=true;

end;

procedure TPrintForm.FormResize(Sender: TObject);
begin
     with vcfPrint do
     begin
          left:=0;
          top:=pnlTools.height;
          width:=PrintForm.clientWidth;
          height:=PrintForm.clientHeight-(pnlTools.height);
     end;
end;

function ReturnToCarriage(const fieldTxt:string):string;
var
   tmp:string;
   k:integer;
begin
     tmp:='';

     for k:=1 to Length(fieldTxt) do
     if (fieldTxt[k]=#13) then
        tmp:=tmp+#10+#13
     else
        tmp:=tmp+fieldTxt[k];

     result:=tmp;
end;

procedure fnGetValues(const fieldString:string;var resultString:string;
                    var resultLines,resultMaxChars:integer;const dc:integer);
var
   k:integer;
   charsOneLine:integer;//一行中的字符个数;
   tmpResultMaxChars:integer;//所有行中最多的字符;
   tmpResultString:string;
   tmpResultLines:integer;
begin
     charsOneLine:=0;
     tmpResultMaxChars:=1;
     tmpResultString:='';
     tmpResultLines:=1;
     for k:=1 to length(fieldString) do
     if fieldString[k]=#13 then
     begin
          tmpResultString:=tmpResultString+#13+#10;
          tmpResultLines:=tmpResultLines+1;
          if tmpResultMaxChars>charsOneLine then
             tmpResultMaxChars:=charsOneLine;
          charsOneLine:=0;
     end
     else
     begin
          charsOneLine:=charsOneLine+1;
          tmpResultString:=tmpResultString+fieldString[k];
     end;

     resultString:=tmpResultString;
     resultLines:=tmpResultLines;
     if tmpResultMaxChars>charsOneLine then
        resultMaxChars:=tmpResultMaxChars
     else
        resultMaxChars:=charsOneLine;
end;

procedure  TPrintForm.Print(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
const
     charWidthInVCF=399;
     rowGaps=150;//为使不同row间的字分开,每个格子的第一行的字符和格子的上横线
                //保留此间隔.
var
   fldLists:array[0..30]of string;
   maxCharsOneField:array[0..200]of integer;//VCF 同一个Col中饱含最多的字符数;

   DBGridTitleChars:array[0..30]of integer;//DBGrid 中行标题的宽度;
   maxLineOneRecord:integer;//VCF 同一个Row中饱含最多的行数;

   tmpChars:integer;
   tmpLines:integer;
   tmpString:string;

   fldCounts:integer;
   tmpMark:TBookMark;
   currentRow,i:integer;

   tmpSize:TSIZE;
   tmpHeight:integer;
begin
     fldCounts:=0;
     //printTitleHeader:=HeaderTitle;
     //vcfPrint.hdrWidth:=800;
     PrintForm.caption:=HeaderTitle;
     //get field name,grid title,field count from dbgd
    if (dbgd is TDBGrid) then
        with (dbgd as TDBGrid) do
        try
           for i:=0 to fieldCount-1 do
           begin
                fldLists[fldCounts]:=columns[i].FieldName;
                vcfPrint.colText[fldCounts+1]:=columns[i].Title.caption;
                maxCharsOneField[fldCounts]:=0;
                DBGridTitleChars[fldCounts]:=length(columns[i].Title.caption);
                fldCounts:=fldCounts+1;
           end;
           //dbgdFontName:=font.name;
           //dbgdFontSize:=font.size;
        except
           //exit;
           {MessageDLG(Format('与 grid:%s 相关的,列: %d 是空值!',[(dbgd as TDBGrid).name,i+1]),
                              mtError,[mbOK],0);
           abort;}
     end else
     begin
          MessageDLG('unknown DBGrid type',mtError,[mbOK],0);
          abort;
     end;

     if (dbgdFontSize<9) then
        dbgdFontSize:=9;
     vcfPrint.maxCol:=fldCounts;
     fieldsInDataSet:=fldCounts;
   //read content from qry datasource to the vcf :
     currentRow:=1;
    // vcfPrint.textRC[1,1]:=lvTestString;

     with qry do
     begin
          disableControls;
          tmpMark:=GetBookMark;
          //Added by chenxiping on 2002/07/02 accroding to wutongjin's opinion to improve print speed during large amount data transfer.
          last;          
          first;
          while not eof do
          begin
               maxLineOneRecord:=0;
               for i:=0 to fldCounts-1 do
               begin
                    fnGetValues(qry.fieldByName(fldLists[i]).asString,tmpString,
                              tmpLines,tmpChars,vcfPrint.Hwnd);
                    vcfPrint.textRC[currentRow,i+1]:=tmpString;
                    vcfPrint.SetSelection(currentRow,i+1,currentRow,i+1);
                    //remove a bug by cxp on 2002/04/22
                    //vcfPrint.setFont(dbgdFontName,dbgdFontSize,false,false,false,false,clBlack,false,false);
                    if maxCharsOneField[i]<tmpChars then
                    begin
                         maxCharsOneField[i]:=tmpChars;
                         maxCharsInRow[i]:=currentRow;
                    end;
                    if maxLineOneRecord<tmpLines then
                       maxLineOneRecord:=tmpLines;
               end;
               tmpHeight:=vcfPrint.RowHeight[currentRow]*(maxLineOnerecord)+rowGaps;
               vcfPrint.RowHeight[currentRow]:=tmpHeight;
               vcfPrint.sheet:=1;
               //不允许一行/列超过1/2屏幕:
               if vcfPrint.RowHeight[currentRow]>5000 then
                  vcfPrint.RowHeight[currentRow]:=2000;
               currentRow:=currentRow+1;
               next;
          end;

          enableControls;
          gotoBookMark(tmpMark);

          with vcfPrint do
          begin
               maxRow:=currentRow;
               totalRecords:=currentRow;
               //设置每列的宽度:
               for i:=0 to fldCounts-1 do
               begin
                    if DBGridTitleChars[i]<maxCharsOneField[i] then
                       ColWidth[i+1]:=maxCharsOneField[i]*charWidthInVCF
                    else
                       ColWidth[i+1]:=DBGridTitleChars[i]*charWidthInVCF;
                     //不允许一列超过1/2屏幕:
                    if ColWidth[i+1]>5000 then
                       ColWidth[i+1]:=4000;
               end;
               topRow:=1;
               leftCol:=1;
          end;
     end;
    try
      showModal;
    except
      Application.MessageBox('系统在执行过程中发生错误！','提示',MB_ICONINFORMATION);
      exit;
    end;
end;


procedure TPrintForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//     action:=caFree;
//ommitted by chenxiping on 2002/04/22
end;

procedure TPrintForm.BtnPrintClick(Sender: TObject);
var
   userSelectedArea:string;
   selCnt,selNo,pRow1, pCol1, pRow2, pCol2:integer;
   selectedCols:array[1..20] of integer;
   selectedColsHeader:array[1..20] of string;
begin
  try
     //the column user selected,if not selected, the col is -1:
     for selNo:=1 to  20 do
     begin
          selectedCols[selNo]:=-1;
          selectedColsHeader[selNo]:='';
     end;


     with vcfPrint do
     begin
        //cleare the secont page for print:
        //sheet:=2;
          maxRow:=totalRecords;
          setSelection(1,1,maxRow,maxCol);
        //  editClear(1);
        //  sheet:=1;
        //用户选择的列:
          userSelectedArea:=selection;
          selNo:=0;
          for selCnt:=0 to selectionCount-1 do
          begin
               GetSelection(selCnt,pRow1, pCol1, pRow2, pCol2);
               if (pRow2=(high(smallint)+1) div 2) or (pRow2=TotalRecords) then
               begin
                    selNo:=selNo+1;
                    selectedCols[selNo]:=pCol1;
                    selectedColsHeader[selNo]:=colText[pCol1];
               end;
          end;
          //暂时把打印字体放大
{          if upperCase(dbgdFontName)='FIXEDSYS' then
          begin
               setSelection(1,1,maxRow,maxCol);
               setFont(dbgdFontName,13,false,false,false,false,clBlack,false,false);
          end;}
          //如果用户没有选择/或选择的列为空时,则全部打印:
          if (selNo=0) then
          begin
               for selCnt:=1 to fieldsInDataSet do
               begin
                    selectedCols[selCnt]:=selCnt;
                    selectedColsHeader[selCnt]:=colText[selCnt];
               end;
               selNo:=maxCol;
          end;
          //printHeader:=printTitleHeader+'&12'; //14号字体
          printFooter:='第 &P 页 < 打印日期：'+'&D &T > '+'&8';
          printTopMargin:=0.8;
          printBottomMargin:=1.0;
          printGridLines:=(sbPrintGrid.down=true);
          PrintColHeading:=true;//使得行标题打印;
          try
            FilePageSetupDlg;
            FilePrint(ckShowPrint.checked);
          except
            Application.MessageBox('打印机初始化发生错误！','提示',MB_ICONINFORMATION);
            exit;
          end;
          selection:=userSelectedArea;
     end;
except
 //
end;
end;

procedure TPrintForm.SbPrintGridClick(Sender: TObject);
begin
     vcfPrint.showGridLines:=sbPrintGrid.down;
end;

procedure PrintDBGrid(qry:TDataSet;dbgd:TComponent;HeaderTitle:string) ;
begin
     if not qry.active then exit; //Added By Chenxipin on 2002/04/01:To Make Code Strong
     application.createForm(TPrintForm,PrintForm);
     PrintForm.lvTestString:=HeaderTitle;
     PrintForm.Print(qry,dbgd,HeaderTitle);
     PrintForm.Free;//added by chenxiping on 2002/04/22
end;

procedure PrintDBGridOrSum(qry:TDataSet;dbgd:TComponent;HeaderTitle:string;FootTitle:string) ;
begin
     application.createForm(TPrintForm,PrintForm);
     PrintForm.lvtmpFootTitle:=FootTitle;
     try
     PrintForm.Print(qry,dbgd,HeaderTitle);
     except
       //
     end;
end;

procedure TPrintForm.BtnNarrowClick(Sender: TObject);
begin
     with vcfPrint do
     begin
          colWidth[selStartCol]:=colWidth[selStartCol]-85;
          if colWidth[selStartCol]<0 then
             colWidth[selStartCol]:=100;
     end;
end;

procedure TPrintForm.BtnWiderClick(Sender: TObject);
begin
     with vcfPrint do
     begin
          colWidth[selStartCol]:=colWidth[selStartCol]+85;
     end;
end;

procedure TPrintForm.VcfPrintStartEdit(Sender: TObject;
  var EditString: WideString; var Cancel: Smallint);
begin
     beep;
     beep;
     cancel:=1;
end;

end.