prn_dbgrid.pas

rave代码打印dbgrid ,并且加入页面的选择

unit prn_dbgrid;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, RpDefine, RpBase, RpSystem, DB, ADODB, StdCtrls,
  Buttons, ComCtrls,printers,Winspool, RpRave,RvClass,Math;

type
  Tprn_dbgrid_frm = class(TForm)
    ADOQ_p: TADOQuery;
    RvSystem1: TRvSystem;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    cb_printers: TComboBox;
    cb_papers: TComboBox;
    cb_fx: TComboBox;
    Label4: TLabel;
    procedure RvSystem1Print(Sender: TObject);
    procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure RvSystem1PrintFooter(Sender: TObject);
    procedure GetPrinterPaperList(AList: TStrings);
    procedure RvSystem1PrintHeader(Sender: TObject);
    procedure RvSystem1BeforePrint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    s_title,s_cnt:string;
      ADevice,ADriver,APort,ATemp:Array[0..255]   Of   Char;  //pDevice : pChar;
      DeviceHandle:THandle;
      PDevMode:PDeviceMode;
  end;

var
  prn_dbgrid_frm: Tprn_dbgrid_frm;

function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
function DBGridRecordSize(mColumn: TColumn): Boolean;

implementation

uses datam;

{$R *.dfm}

function DBGridRecordSize(mColumn: TColumn): Boolean;
{ 返回记录数据网格列显示最大宽度是否成功 }
begin
  Result := False;
  if not Assigned(mColumn.Field) then Exit;
  mColumn.Field.Tag := Max(mColumn.Field.Tag,
    TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
  Result := True;
end; { DBGridRecordSize }

function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
{ 返回数据网格自动适应宽度是否成功 }
var
  I: Integer;
begin
  Result := False;
  if not Assigned(mDBGrid) then Exit;
  if not Assigned(mDBGrid.DataSource) then Exit;
  if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
  if not mDBGrid.DataSource.DataSet.Active then Exit;
  for I := 0 to mDBGrid.Columns.Count - 1 do begin
    if not mDBGrid.Columns[I].Visible then Continue;
    if Assigned(mDBGrid.Columns[I].Field) then
      mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag,
        mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset
    else mDBGrid.Columns[I].Width :=
      mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
    mDBGrid.Refresh;
  end;
  Result := True;
end; { DBGridAutoSize }
///////源代码结束


procedure SetPaperSize(X, Y: Integer);
// 这段代码绝对可用。单位是0.1mm
// A4时 Printer.Pagewidth:=1440；  A5时 Printer.Pagewidth:=1049；
// B5时 Printer.Pagewidth:=1290；  16K时 Printer.Pagewidth:=1035；
// lq1600宽行打印机这个值宽度最大为42cm左右, 长度大约2m。
{Question:
How can I change the papersize of my print job?
Answer:
One way to change printer settings at the start
of a print job is to change the printer's devicemode
structure.
See: TDEVMODE in the Delphi 1.02 help file or DEVMODE
in the Delphi 2.01 help file for other settings you can
change (providing the print driver supports the change).
The following example, contains code to change the papersize and
the paper bin that is uses:}
var
  Device: array[0..255] of char;
  Driver: array[0..255] of char;
  Port: array[0..255] of char;
  hDMode: THandle;
  PDMode: PDEVMODE;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(Device, Driver, Port, hDMode);
  if hDMode <> 0 then
  begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then
    begin
      if (x = 0) or (y = 0) then
      begin
        {Set to legal}
        pDMode^.dmFields := pDMode^.dmFields or dm_PaperSize;
        {pDMode^.dmPaperSize := DMPAPER_LEGAL; changed by wulianmin}
        pDMode^.dmPaperSize := DMPAPER_FANFOLD_US;
      end
      else
      begin
        {Set to custom size}
        pDMode^.dmFields := pDMode^.dmFields or
          DM_PAPERSIZE or
          DM_PAPERWIDTH or
          DM_PAPERLENGTH;
              // [blue]  [red]//dmPaperSize的值为何在不同的打印机上要用不同的值？大家有没有通用的方法可设置不同型号的打印机？
             pDMode^.dmPaperSize := DMPAPER_USER;//一般打印机
        pDMode^.dmPaperSize := 512;//hp LaserJet 1010
        pDMode^.dmPaperSize := 32767;//AGFA-AccutSet 800  [/red]  [/blue]      pDMode^.dmPaperWidth := x {SomeValueInTenthsOfAMillimeter};
        pDMode^.dmPaperLength := y {SomeValueInTenthsOfAMillimeter};
      end;
      {Set the bin to use}
      pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;
      pDMode^.dmDefaultSource := DMBIN_MANUAL;

      GlobalUnlock(hDMode);
    end;
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
  //以下开始打印
end;

procedure Tprn_dbgrid_frm.GetPrinterPaperList(AList: TStrings);
//1、通用的设置纸张大小，可以使用“用户自定义”啊：

//pDMode^.dmPaperSize := DMPAPER_USER;
var
  I, nRet: Integer;
  nMode: THandle;
  aName, aPort, aDriver: array [0..79] of Char;
  aPaperNames: array of array[0..63] of Char;
  aPapers: array of Word;
begin
  Assert(AList <> nil);

  Printer.GetPrinter(aName, aDriver, aPort, nMode);
  nRet := WinSpool.DeviceCapabilitiesA(aName, aPort, DC_PAPERS, nil, nil);
  if nRet < 0 then Exit;
  SetLength(aPaperNames, nRet);
  SetLength(aPapers, nRet);
  WinSpool.DeviceCapabilities(aName, aPort, DC_PAPERNAMES, @aPaperNames[0], nil);
  WinSpool.DeviceCapabilities(aName, aPort, DC_PAPERS, @aPapers[0], nil);

  cb_papers.Clear;
  with AList do
  begin
    Clear;
    for I := 0 to nRet - 1 do
      if aPaperNames[I]<>'' then
      
     cb_papers.Items.AddObject(aPaperNames[I], TObject(aPapers[I]))
    //AddObject(aPaperNames[I], TObject(aPapers[I]));
  end;
end;


procedure Tprn_dbgrid_frm.WMSysCommand;
begin
  if (Msg.CmdType = SC_MINIMIZE) or
     (Msg.CmdType = SC_MAXIMIZE) then
          exit else          if (Msg.CmdType = SC_CLOSE) then
         begin
           ADOQ_p.Close;
           inherited;
         end else
  inherited;
end;

procedure Tprn_dbgrid_frm.BitBtn1Click(Sender: TObject);
var
  ADevice, ADriver, APort: String;
  ADeviceMode: THandle;
  DevMode: PDeviceMode;
begin
 SetLength(ADevice, 255);
 SetLength(ADriver, 255);
 SetLength(APort, 255);

  //If ADeviceMode is zero, a printer driver is not loaded. Therefore,
  // setting PrinterIndex forces the driver to load.
 if ADeviceMode = 0 then
 begin
   Printer.PrinterIndex := Printer.PrinterIndex;
   Printer.GetPrinter(PChar(ADevice), PChar(ADriver), PChar(APort), ADeviceMode);
 end;

 if ADeviceMode <> 0 then
 begin
   DevMode := GlobalLock(ADeviceMode);
   try
     DevMode^.dmFields := DevMode^.dmFields or DM_ORIENTATION;
     DevMode^.dmCopies := DMORIENT_LANDSCAPE;//横向打印
     //DMORIENT_PORTRAIT//竖向打印
   finally
     GlobalUnlock(ADeviceMode);
   end;
 end
 else
   raise Exception.Create('Could not set printer copies');


  //if cb_fx.ItemIndex=0 then
   // begin
    //  RvSystem1.SystemPrinter.Orientation:=torientation(poPortrait);
      //RvSystem1.SystemPreview.PagesWide:=2;
      RvSystem1.Execute;
   // end
  //else
    //begin
    //  RvSystem1.SystemPrinter.Orientation:=torientation(poLandScape);
      //RvSystem1.SystemPreview.PagesWide:=3;
    //  RvSystem1.Execute;
   // end;

end;

procedure Tprn_dbgrid_frm.FormCreate(Sender: TObject);
var
  S : TStrings;
  i:integer;
begin
   if printer.Printers.Count<1 then
     application.MessageBox('本机未安装打印机,显示可能会异常!', '提示', mb_iconinformation + mb_defbutton1);
   cb_printers.Clear;
   cb_printers.Items:=printer.Printers;

  S := TStringList.Create;
  for i := 0 to printer.Printers.Count - 1 do
     S.Add(printer.Printers.Strings[i]);
  if s.Count>0 then
  
  GetPrinterPaperList(s);
end;

procedure Tprn_dbgrid_frm.RvSystem1BeforePrint(Sender: TObject);
begin

  with (Sender as TBaseReport) do
  begin

    MarginLeft:=0.2;
    MarginRight:=0.2;
    MarginTop:=0.5;
    MarginBottom:=1;
    SelectPaper(trim(cb_papers.Text));
  end;
end;

procedure Tprn_dbgrid_frm.RvSystem1Print(Sender: TObject);
var i,i_linecnt,j:integer;
    pageCount:integer;                   //总页数
    TitleWidth,t:double;
    PointX,PointY:integer;
    ScreenX:integer;
    ScaleX:Real;
    DoHeader:   boolean;
begin
  PointX:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSX)/2.54);
  PointY:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSX)/2.54);
  ScaleX:=PointX/ScreenX;
  pageCount:=ADOQ_p.FieldCount   div   9;

  with (Sender as TBaseReport) do
  begin
    ClearTabs;
    ADOQ_p.First;

    for j:=0 to DBGrid1.Columns.Count-1 do
      begin
        if DBgrid1.Columns.Items[j].Visible then
          begin
            TitleWidth:=DBgrid1.Columns.Items[j].Width/ScaleX;
            if i=0 then
              SetTab(0, pjcenter, TitleWidth, 0, BOXLINEALL, 0)
            else
              SetTab(NA, pjcenter, TitleWidth, 0, BOXLINEALL, 0);
          end;
      end;
    DoHeader:=true;

    while not ADOQ_p.Eof do
      begin
        If   LinesLeft   <=   0   then   begin
          NewPage;
          DoHeader   :=   true;
        end;
        If   DoHeader   then   begin
            for j:=0 to DBGrid1.Columns.Count-1 do
              begin
                if DBgrid1.Columns.Items[j].Visible then
                  begin
                    Bold := True;
                    PrintTab(DBGrid1.Columns[j].Title.Caption);
                    Bold := false;
                  end;
              end;
                  DoHeader   :=   false;   
        end;   {   if   }
        NewLine;
        for i:=0 to DBGrid1.Columns.Count-1 do
          begin
            if DBgrid1.Columns.Items[i].Visible then
              PrintTab(ADOQ_p.FieldByname(DBgrid1.Columns.Items[i].FieldName).AsString);
          end;
          // NewLine;
        ADOQ_p.next;
      end;

    end;
end;

procedure Tprn_dbgrid_frm.RvSystem1PrintFooter(Sender: TObject);
begin
   With Sender as TBaseReport do begin
     MarginBottom := 0.5;
     //PrintFooter('页 ' + Macro(midCurrentPage)  + ' of ' + Macro(midTotalPages), pjleft);
     NewLine;
     PrintLeft('页 ' + Macro(midCurrentPage)  + ' of ' + Macro(midTotalPages), 0.5);
     Printright('日期: '+DateToStr(Date),pagewidth-0.5);//日期
     MarginBottom := 0.75;
     end; {with}
end;

procedure Tprn_dbgrid_frm.RvSystem1PrintHeader(Sender: TObject);
begin
   With Sender as TBaseReport do begin
           // NewLine;
            SetFont('Arial', 15);
            //NewLine;
            Bold := True;
            PrintLeft('(永记造漆)', 0.2);
            NewLine;
            Underline := true;//下划线
            PrintCenter(s_title, pagewidth/2);
            Underline := false;//下划线
            Bold := false;
            SetFont('Arial', 10);
            NewLine;
            Printright('共'+s_cnt+'条', pagewidth-0.5);
            NewLine;
   end;

end;

end.