u_rpt_gridprn.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit U_RPT_GRIDPRN;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   QuickRpt, ExtCtrls, printers, Qrctrls, Grids, StdCtrls;

type
   TF_RPT_GRIDPRN = class(TForm)
      QuickRep1: TQuickRep;
      COLBAND: TQRBand;
      PageHeaderBand1: TQRBand;
      PageFooterBand1: TQRBand;
      DEBAND: TQRBand;
      LB_DATE: TQRLabel;
      LB_DATE1: TQRLabel;
      LB_PAGE: TQRLabel;
      LB_PAGE1: TQRSysData;
      QR_TITLE: TQRLabel;
      QRLabel1: TQRLabel;
      QRSysData1: TQRSysData;
      procedure colselecth(pn_col: Tpanel; sggrid: TStringGrid; i, j: integer; m_bz: boolean = false);
      procedure QuickRep1BeforePrint(Sender: TCustomQuickRep;
         var PrintReport: Boolean);
      procedure QuickRep1NeedData(Sender: TObject; var MoreData: Boolean);
      procedure FormCreate(Sender: TObject);
      procedure QuickRep1AfterPrint(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_RPT_GRIDPRN: TF_RPT_GRIDPRN;

implementation
uses pub_program;
var
   qrlbl: array[0..32] of tqrlabel;
   col_cou, curr_row, m_diff: integer;
   str_list: TStringList;
   m_str: string;

   {$R *.DFM}

procedure TF_RPT_GRIDPRN.colselecth(pn_col: Tpanel; sggrid: TStringGrid; i, j: integer; m_bz: boolean = false);
var
   k, l, new_col: integer;
   s, s1: string;
begin
   new_col := 0;
   with sggrid do
      for l := 0 to ColCount - 1 do
         begin
            s1 := getstr(cells[l + colcount, 0]);
            if s1 = '1' then
               begin
                  s := s + 'col' + inttostr(new_col) + ':' + trim(sggrid.cells[l, 0]) + '*';
                  inc(new_col);
               end;
         end;
   str_list.Add(s);
   col_cou := new_col;

   if m_bz then
      begin
         with sggrid do
            for k := 1 to rowcount - 1 do
               if cells[colcount, k] = '1' then
                  begin
                     s := '';
                     new_col := 0;
                     for l := 0 to ColCount - 1 do
                        begin
                           s1 := getstr(cells[l + colcount, 0]);
                           if s1 = '1' then
                              begin
                                 s := s + 'col' + inttostr(new_col) + ':' + cells[l, k] + '*';
                                 inc(new_col);
                              end;
                        end;
                     str_list.Add(s);
                  end;
      end
   else
      with str_list do
         for k := i to j do
            begin
               s := '';
               new_col := 0;
               for l := 0 to sggrid.ColCount - 1 do
                  begin
                     s1 := getstr(sggrid.cells[l + sggrid.colcount, 0]);
                     if s1 = '1' then
                        begin
                           s := s + 'col' + inttostr(new_col) + ':' + sggrid.cells[l, k] + '*';
                           inc(new_col);
                        end;
                  end;
               str_list.Add(s);
            end;
end;

procedure TF_RPT_GRIDPRN.QuickRep1BeforePrint(Sender: TCustomQuickRep;
   var PrintReport: Boolean);
var
   qrshape: tqrshape;
   qrlabel: tqrlabel;
   i, j, k, col_wid: integer;
begin
   curr_row := 1;
   lb_date1.Caption := gstr_pubdate;
   qr_title.Caption := analy_str('caption', m_str);
   col_cou := strtoint(analy_str('col_num', m_str));
   col_wid := 0;
   for i := 0 to col_cou - 1 do
      inc(col_wid, col_width[i]);

   case m_diff of
      0: j := round((1040 - col_wid) / 2);
      1: j := round((800 - col_wid) / 2);
      else
         j := 0;
   end;
   j := j + 8;
   lb_date.Left := lb_date.Left + j;
   lb_date1.Left := lb_date1.Left + j;
   //lb_date2.Left := lb_date2.Left + j;
   //lb_date3.Left := lb_date3.Left + j;
   lb_page.Left := lb_page.Left - j;
   lb_page1.Left := lb_page1.Left - j;

   for i := 0 to col_cou do
      begin
         qrshape := Tqrshape.Create(self);
         with qrshape do
            begin
               parent := colband;
               Height := 25;
               top := 29;
               width := col_width[i] + 1;
               left := j;
            end;
         qrshape := Tqrshape.Create(self);
         with qrshape do
            begin
               parent := deband;
               Height := 25;
               top := -2;
               width := col_width[i] + 1;
               left := j;
            end;
         qrlabel := Tqrlabel.Create(self);
         with qrlabel do
            begin
               parent := colband;
               top := 33;
               caption := analy_str('col' + inttostr(i), str_list[0]);
               k := (col_width[i] - round(length(caption) * 6.4)) div 2 + 1;
               left := j + k;
               transparent := true;
            end;
         qrlbl[i] := Tqrlabel.Create(self);
         with qrlbl[i] do
            begin
               parent := Deband;
               top := 2;
               left := j + 5;
               transparent := true;
            end;
         j := j + col_width[i];
      end;
end;

procedure TF_RPT_GRIDPRN.QuickRep1NeedData(Sender: TObject;
   var MoreData: Boolean);
var
   i: integer;
begin
   if curr_row < str_list.Count then
      begin
         for i := 0 to col_cou - 1 do
            qrlbl[i].Caption := analy_str('col' + inttostr(i), str_list[curr_row]);
         moredata := true;
         inc(curr_row);
      end
   else
      moredata := false;
end;

procedure TF_RPT_GRIDPRN.FormCreate(Sender: TObject);
begin
   m_str := tran_str;
   m_diff := g_diff;
   str_list := TStringList.Create;
   if m_diff = 0 then
      quickrep1.Page.Orientation := poLandscape
   else
      quickrep1.Page.Orientation := poPortrait;
end;

procedure TF_RPT_GRIDPRN.QuickRep1AfterPrint(Sender: TObject);
begin
   str_list.Free;
end;

procedure TF_RPT_GRIDPRN.FormClose(Sender: TObject;
   var Action: TCloseAction);
begin
   action := cafree;
end;

end.