u_web_gridprn.pas

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

unit U_WEB_GRIDPRN;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Grids, ExtCtrls, TFlatButtonUnit, TFlatEditUnit;

type
   TF_WEB_GRIDPRN = class(TForm)
      PN_COL: TPanel;
      Panel3: TPanel;
      CHB_1: TCheckBox;
      CHB_2: TCheckBox;
      CHB_3: TCheckBox;
      CHB_4: TCheckBox;
      CHB_5: TCheckBox;
      CHB_6: TCheckBox;
      CHB_7: TCheckBox;
      CHB_8: TCheckBox;
      CHB_9: TCheckBox;
      CHB_10: TCheckBox;
      CHB_11: TCheckBox;
      CHB_12: TCheckBox;
      CHB_13: TCheckBox;
      CHB_14: TCheckBox;
      CHB_15: TCheckBox;
      CHB_16: TCheckBox;
      CHB_17: TCheckBox;
      CHB_18: TCheckBox;
      CHB_19: TCheckBox;
      CHB_20: TCheckBox;
      CHB_21: TCheckBox;
      CHB_22: TCheckBox;
      CHB_23: TCheckBox;
      CHB_24: TCheckBox;
      CHB_25: TCheckBox;
      CHB_26: TCheckBox;
      CHB_27: TCheckBox;
      CHB_28: TCheckBox;
      CHB_29: TCheckBox;
      CHB_30: TCheckBox;
      LB_ARRANGE: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      CheckBox1: TCheckBox;
      CheckBox2: TCheckBox;
      CheckBox3: TCheckBox;
      CheckBox4: TCheckBox;
      CheckBox5: TCheckBox;
      CheckBox6: TCheckBox;
      CheckBox7: TCheckBox;
      CheckBox8: TCheckBox;
      CheckBox9: TCheckBox;
      CheckBox10: TCheckBox;
      CheckBox11: TCheckBox;
      CheckBox12: TCheckBox;
      CheckBox13: TCheckBox;
      CheckBox14: TCheckBox;
      CheckBox15: TCheckBox;
      CheckBox16: TCheckBox;
      CheckBox17: TCheckBox;
      CheckBox18: TCheckBox;
      CheckBox19: TCheckBox;
      CheckBox20: TCheckBox;
      CheckBox21: TCheckBox;
      CheckBox22: TCheckBox;
      CheckBox23: TCheckBox;
      CheckBox24: TCheckBox;
      CheckBox25: TCheckBox;
      CheckBox26: TCheckBox;
      CheckBox27: TCheckBox;
      CheckBox28: TCheckBox;
      CheckBox29: TCheckBox;
      CheckBox30: TCheckBox;
      SG_JL: TStringGrid;
      CHB_LOCA: TCheckBox;
      BN_PRN: TFlatButton;
      BN_ALL: TFlatButton;
      BN_NOR: TFlatButton;
      BN_BACK: TFlatButton;
      ED_BEG: TFlatEdit;
      ED_END: TFlatEdit;
      BN_CUST: TFlatButton;
      Image1: TImage;
      function Cal_Width: boolean;
      procedure colselecth(sggrid: TStringGrid; m_bzl: integer = 0);
      procedure Only_length;
      procedure FormCreate(Sender: TObject);
      procedure ED_ENDKeyPress(Sender: TObject; var Key: Char);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure BN_PRNClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure BN_BACKClick(Sender: TObject);
      procedure BN_ALLClick(Sender: TObject);
      procedure BN_NORClick(Sender: TObject);
      procedure CHB_LOCAClick(Sender: TObject);
      procedure CHB_1Click(Sender: TObject);
      procedure BN_CUSTClick(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_WEB_GRIDPRN: TF_WEB_GRIDPRN;

implementation
uses Pub_program, Xlconst, comobj, U_RPT_GRIDPRN, ncp;
var
   m_str: string;
   m_colcount, m_rowcount: integer;

   {$R *.DFM}

procedure TF_WEB_GRIDPRN.colselecth(sggrid: TStringGrid; m_bzl: integer = 0);
var
   i, j, k, l, old_colcou: integer;
   s: string;
begin
   with sg_jl do
      begin
         old_colcou := 60;
         rowcount := m_rowcount;
         colcount := 60;

         k := 0;
         for i := 0 to old_colcou - 1 do
            begin
               l := sggrid.ColWidths[i];
               if l > 0 then
                  begin
                     ColWidths[k] := l;
                     for j := 0 to rowcount - 1 do
                        cells[k, j] := sggrid.Cells[i, j];
                     inc(k);
                  end;
            end;
         colcount := k;

         chb_loca.Checked := false;
         chb_loca.visible := m_bzl > 0;
         if m_bzl > 0 then
            for i := 1 to rowcount - 1 do
               begin
                  s := sggrid.cells[sggrid.colcount + m_bzl, i];
                  cells[colcount, i] := s;
                  if (not chb_loca.Checked) and (s = '1') then
                     chb_loca.Checked := true;
               end;

         for i := 0 to colcount - 1 do
            begin
               tcheckbox(pn_col.Controls[i]).caption := trim(Cells[i, 0]);
               tcheckbox(pn_col.Controls[i]).checked := true;
            end;
      end;
end;

procedure TF_WEB_GRIDPRN.FormCreate(Sender: TObject);
var
   i: integer;
begin
   g_bsel := false;
   m_str := tran_str;
   tncp.create(self);
   m_colcount := strtoint(analy_str('colcount', m_str));
   m_rowcount := strtoint(analy_str('rowcount', m_str));
   if m_colcount < 1 then
      begin
         MessageDlg(nodata_msg, mtinformation, [mbok], 0);
         close;
      end;

   for i := m_colcount to pn_col.ControlCount - 1 do
      tcheckbox(pn_col.Controls[i]).visible := false;

   height := tcheckbox(pn_col.Controls[m_colcount - 1]).top + 100;
   ed_beg.Text := '1';
   ed_end.Text := inttostr(m_rowcount - 1);
end;

procedure TF_WEB_GRIDPRN.Only_length;
var
   i, j, col_num: integer;
begin
   col_num := 70;
   j := 0;
   with sg_jl do
      for i := 0 to colcount - 1 do
         begin
            j := j + ColWidths[i];
            if j > 1300 then
               begin
                  col_num := i;
                  break;
               end;
         end;
   if col_num < m_colcount then
      for i := col_num to m_colcount - 1 do
         tcheckbox(pn_col.Controls[i]).checked := false;
end;

procedure TF_WEB_GRIDPRN.ED_ENDKeyPress(Sender: TObject; var Key: Char);
begin
   key := only_num(key);
end;

procedure TF_WEB_GRIDPRN.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   case key of
      VK_ESCAPE: close;
      VK_F3: bn_prnclick(sender);
      VK_F4: bn_allclick(sender);
      VK_F5: bn_norclick(sender);
      VK_RETURN, VK_DOWN:
         Perform(WM_NEXTDLGCTL, 0, 0);
      VK_UP:
         Perform(WM_NEXTDLGCTL, 1, 0);
   end;
end;

function TF_WEB_GRIDPRN.Cal_Width: boolean;
var
   i, j, col_num: integer;
   chb_col: TCheckBox;
begin
   j := 0;
   col_num := 0;
   with sg_jl do
      for i := 0 to colcount - 1 do
         begin
            chb_col := tcheckbox(pn_col.Controls[i]);
            if chb_col.visible and chb_col.checked then
               begin
                  j := j + ColWidths[i];
                  inc(col_num);
               end;
         end;
   result := j > 1300;
end;

procedure TF_WEB_GRIDPRN.BN_PRNClick(Sender: TObject);
var
   i, j, col_num, m_diff: integer;
   rate: double;
   chb_col: TCheckBox;
begin
   j := 0;
   col_num := 0;
   for i := 0 to 59 do
      col_width[i] := 0;
   with sg_jl do
      for i := 0 to colcount - 1 do
         begin
            chb_col := tcheckbox(pn_col.Controls[i]);
            if chb_col.visible and chb_col.checked then
               begin
                  col_width[col_num] := ColWidths[i];
                  Cells[colcount + i, 0] := '1';
                  j := j + ColWidths[i];
                  inc(col_num);
               end
            else
               Cells[colcount + i, 0] := '0';
         end;
   if j > 1300 then
      begin
         MessageDlg(iif(m_lang = 1, '您所要打印的数据超宽, 请重新选定打印列!', 'THE DATA IS TOO WIDTH TO PRINT,PLEASE SELECT AGAIN!'), mtinformation, [mbok], 0);
         abort;
      end;

   if j > 800 then
      begin
         rate := 1020.00 / j;
         m_diff := 0;
      end
   else
      begin
         rate := 780.00 / j;
         m_diff := 1;
      end;
   for i := 0 to col_num - 1 do
      col_width[i] := round(col_width[i] * rate);

   if not chb_loca.Checked then
      begin

         i := strtoint(getstr(ed_beg.text));
         j := strtoint(getstr(ed_end.text));

         if i * j = 0 then
            begin
               MessageDlg(lb_arrange.caption + null_zero_msg, mtinformation, [mbok], 0);
               ed_beg.SetFocus;
               abort;
            end;
         if j < i then
            begin
               MessageDlg(iif(m_lang = 1, '"打印结束行" 不能小於 "打印起始行"!', 'THE BEG LINE NO MUST <= THE END LINE NO'), mtinformation, [mbok], 0);
               ed_end.SetFocus;
               abort;
            end;
      end;
   tran_str := 'caption:' + analy_str('caption', m_str) + '*col_num:' + inttostr(col_num) + '*';
   g_diff := m_diff;
   F_RPT_GRIDPRN := tF_RPT_GRIDPRN.create(self);
   F_RPT_GRIDPRN.colselecth(pn_col, sg_jl, i, j, chb_loca.Checked);
   F_RPT_GRIDPRN.QuickRep1.Preview;
   F_RPT_GRIDPRN.close;
end;

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

procedure TF_WEB_GRIDPRN.BN_BACKClick(Sender: TObject);
begin
   close;
end;

procedure TF_WEB_GRIDPRN.BN_ALLClick(Sender: TObject);
var
   i: integer;
begin
   for i := 0 to pn_col.ControlCount - 1 do
      if tcheckbox(pn_col.Controls[i]).visible then
         tcheckbox(pn_col.Controls[i]).checked := true;
end;

procedure TF_WEB_GRIDPRN.BN_NORClick(Sender: TObject);
var
   i, item: integer;
begin
   item := 0;
   for i := 0 to pn_col.ControlCount - 1 do
      if tcheckbox(pn_col.Controls[i]).visible then
         if not tcheckbox(pn_col.Controls[i]).checked then
            begin
               item := i;
               break;
            end;
   for i := item to pn_col.ControlCount - 1 do
      if tcheckbox(pn_col.Controls[i]).visible then
         tcheckbox(pn_col.Controls[i]).checked := false;
end;

procedure TF_WEB_GRIDPRN.CHB_LOCAClick(Sender: TObject);
begin
   if chb_loca.Checked then
      begin
         ed_beg.Enabled := false;
         ed_end.Enabled := false;
         ed_beg.colorFlat := $00E9ECED;
         ed_end.colorFlat := $00E9ECED;
      end
   else
      begin
         ed_beg.Enabled := true;
         ed_end.Enabled := true;
         ed_beg.colorFlat := clwhite;
         ed_end.colorFlat := clwhite;
      end;
end;

procedure TF_WEB_GRIDPRN.CHB_1Click(Sender: TObject);
begin
   image1.Visible := cal_width;
end;

procedure TF_WEB_GRIDPRN.BN_CUSTClick(Sender: TObject);
var
   i, j, k: integer;
   vare, sheet, title, range: Variant;
   title_name, title_time, sheet_name, s: string;
   num_flag: array[1..120] of boolean;
begin
   if not check_sg(sg_jl) then
      begin
         MessageDlg(nodata_msg, mtinformation, [mbok], 0);
         Exit;
      end;
   BN_ALLClick(Sender);
   for i := 1 to 120 do
      num_flag[i] := true;
   title_time := iif(m_lang = 1, '打印时间:', 'PRN DATE:') + datetostr(now, 1);
   //s := analy_str('caption', m_str);
   title_name := clear_name(analy_str('caption', m_str));
   if length(title_name) > 30 then
      title_name := copy(title_name, 1, 30);
   sheet_name := analy_str('caption', m_str);
   try
      vare := CreateOleObject('excel.application');
      vare.visible := true;
      vare.workbooks.add(xlWBatWorkSheet);
      sheet := vare.WorkBooks[1].Worksheets[1];
      //range := sheet.range['A1:J1'];
      //range.merge;
      //range.horizontalalignment := 3;
      range := sheet.range['A3:J3'];
      range.horizontalalignment := 3;

      title := sheet.rows;
      title.rows[1].font.name := iif(m_lang = 1, '楷体', 'ARIAL');
      title.rows[1].font.Size := 18;
      title.Rows[1].Font.Bold := True;
      title.Rows[1].Font.Color := clBlue;
      title.rows[2].font.name := 'ARIAL';
      title.rows[2].font.Size := 12;
      title.Rows[2].Font.Bold := True;
      title.Rows[2].Font.Color := clBlue;
      sheet.cells[1, 1] := sheet_name;
      sheet.cells[2, 1] := title_time;
      with sg_jl do
         begin
            case m_colcount of
               1..26: s := 'A4:' + chr(m_colcount + 64) + inttostr(rowcount + 4);
               27..52: s := 'A4:A' + chr(m_colcount + 64 - 26) + inttostr(rowcount + 4);
               53..78: s := 'A4:B' + chr(m_colcount + 64 - 52) + inttostr(rowcount + 4);
               79..104: s := 'A4:C' + chr(m_colcount + 64 - 78) + inttostr(rowcount + 4);
            end;
            range := sheet.range[s];
            range.horizontalalignment := 4;
            for j := 0 to ColCount - 1 do
               begin
                  vare.ActiveSheet.cells[1, j + 1].select;
                  k := round(colwidths[j] / 7) + 1;
                  vare.Selection.ColumnWidth := k; //iif(k < 7, k, k - 2);
                  s := cells[j, 0];
                  if (j < 120) and ((pos('号', s) > 0) or (pos('NO', s) > 0)) then
                     num_flag[j + 1] := false;
               end;
            vare.ActiveSheet.cells[1, 1].select;
            for i := 0 to RowCount - 1 do
               begin
                  title.Rows[i + 3].Font.name := 'ARIAL';
                  title.rows[i + 3].font.Size := 11;
                  k := colcount - 1;
                  for j := colcount - 1 downto 1 do
                     if cells[j, 0] <> '' then
                        begin
                           k := j;
                           break;
                        end;
                  for j := 0 to k do
                     Sheet.Cells[i + 3, j + 1] := iif(num_flag[j + 1], cells[j, i], chr(127) + cells[j, i]);
               end;
         end;
   except
      MessageDlg(inst_excel, mtinformation, [mbok], 0);
   end;
end;

end.