unit2.pas

“汇华印刷v2.0”是在实践的基础上开发的一个全自动多功能信封打印系统

unit Unit2;

interface

uses
  Windows, Messages,Shellapi, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, Grids, DBGrids, Menus, StdCtrls, ppEndUsr, ppDB,
  ppDBPipe, ppDBBDE, ppParameter, ppBands, ppCtrls, ppPrnabl, ppClass,
  ppCache, ppComm, ppRelatv, ppProd, ppReport, RzButton, ExtCtrls, RzPanel,
  RzLabel, Mask, RzEdit, RzForms, ImgList, RzAnimtr, ComCtrls, ADODB,
  ToolWin;

type
  Tsj = class(TForm)
    Data1: TDataSource;
    DBGrid1: TDBGrid;
    t1: TTable;
    Label1: TLabel;
    MainMenu1: TMainMenu;
    N3: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    op: TOpenDialog;
    N4: TMenuItem;
    db1: TMenuItem;
    db2: TMenuItem;
    Label2: TLabel;
    gb: TDBGrid;
    e1: TEdit;
    e2: TEdit;
    c2: TComboBox;
    c4: TComboBox;
    c3: TComboBox;
    c1: TComboBox;
    me: TMemo;
    CheckBox1: TCheckBox;
    da2: TDataSource;
    sql: TQuery;
    ppr: TppReport;
    ppHeaderBand1: TppHeaderBand;
    ppDetailBand1: TppDetailBand;
    yb: TppDBText;
    dz: TppDBText;
    gs: TppDBText;
    s: TppLabel;
    xm: TppDBText;
    ppFooterBand1: TppFooterBand;
    ppPageStyle1: TppPageStyle;
    ppParameterList1: TppParameterList;
    ppb: TppBDEPipeline;
    ppd: TppDesigner;
    aa: TLabel;
    rz: TRzPanel;
    ak: TppLabel;
    l1: TListBox;
    ddd: TDatabase;
    cx: TRzButton;
    ImageList1: TImageList;
    qa: TAnimate;
    com: TComboBox;
    sjb: TLabel;
    N5: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    ImageList2: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    N1: TMenuItem;
    N2: TMenuItem;
    N13: TMenuItem;
    fzr: TppLabel;
    procedure db2Click(Sender: TObject);
    procedure db1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckBox1Click(Sender: TObject);
    procedure c1Change(Sender: TObject);
    procedure c2Change(Sender: TObject);
    procedure c3Change(Sender: TObject);
    procedure c4Change(Sender: TObject);
    procedure dyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ppbNext(Sender: TObject);
    procedure ppbFirst(Sender: TObject);
    procedure cxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N6Click(Sender: TObject);
    procedure dddLogin(Database: TDatabase; LoginParams: TStrings);
    procedure szClick(Sender: TObject);
    procedure cxClick(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure comChange(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  sj: Tsj;
  mypass:string;
implementation

uses Unit1, Unit3, Unit4, data, Unit5;

{$R *.dfm}
procedure Tsj.FormClose(Sender: TObject; var Action: TCloseAction);
begin
application.Terminate;
end;

procedure Tsj.N4Click(Sender: TObject);
begin
com.Visible:=false;
sjb.Visible:=false;
rz.Enabled:=false;
op.Filter:='DB数据|*.db';
session.DeleteAlias('bee');
if(op.Execute())
then
try
session.AddStandardAlias('bee',ExtractFilePath(ParamStr(0)),'Paradox');
t1.Close;
t1.DatabaseName:='bee';
t1.TableName:=op.FileName;
t1.Open;
t1.Active:=true;
label1.Caption:='当前的数据是'+op.FileName;
rz.Enabled:=true;
cx.Enabled:=false;
c3.Enabled:=false;
c4.Enabled:=false;
e2.Enabled:=false;
except
raise exception.Create('请打开一个数据库！');
end;
end;

procedure Tsj.db1Click(Sender: TObject);
begin
rz.Enabled:=false;
op.Filter:='ACCESS数据|*.mdb';
if(op.Execute())
then
try
with dog do
begin
  ADOConnection1.Close;
ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+
               op.FileName+';Jet OLEDB:Database Password='+
               mypass+';Persist Security Info=False';
    ADOConnection1.LoginPrompt:=false;
  ADOQuery1.Connection:=ADOConnection1;
  ADOTable1.Connection:=ADOConnection1;
  sjb.Visible:=true;
  com.Visible:=true;
  ADOConnection1.GetTableNames(com.Items);
   end;
label1.Caption:='当前的数据是'+op.FileName;
rz.Enabled:=true;
cx.Enabled:=false;
c3.Enabled:=false;
c4.Enabled:=false;
e2.Enabled:=false;
except
raise exception.Create('请打开一个数据库！');
end;
end;

procedure Tsj.db2Click(Sender: TObject);
begin
sjb.Visible:=false;
com.Visible:=false;
op.Filter:='foxpro数据|*.dbf';
session.DeleteAlias('bee');
if(op.Execute())
then
try
session.AddStandardAlias('bee',ExtractFilePath(ParamStr(0)),'dbase');
t1.Close;
t1.DatabaseName:='bee';
t1.TableName:=op.FileName;
t1.Open;
t1.Active:=true;
label1.Caption:='当前的数据是'+op.FileName;
rz.Enabled:=true;
c3.Enabled:=false;
c4.Enabled:=false;
e2.Enabled:=false;
except
raise exception.Create('请打开一个数据库！');
end;
end;

procedure Tsj.CheckBox1Click(Sender: TObject);
begin
if (checkbox1.Checked=true)
then
begin
c3.Enabled:=true;
c4.Enabled:=true;
e2.Enabled:=true;
if (c3.ItemIndex=-1)and(c4.ItemIndex=-1)
then
cx.Enabled:=false
else
cx.Enabled:=true;
end
else
begin
c3.Enabled:=false;
c4.Enabled:=false;
e2.Enabled:=false;
if((c1.ItemIndex<>-1)and(c2.ItemIndex<>-1))
then
cx.Enabled:=true;
end;
end;

procedure Tsj.c1Change(Sender: TObject);
begin
if((c1.ItemIndex<>-1)and(c2.ItemIndex<>-1))
then
cx.Enabled:=true;
end;

procedure Tsj.c2Change(Sender: TObject);
begin
if((c1.ItemIndex<>-1)and(c2.ItemIndex<>-1))
then
cx.Enabled:=true;
end;

procedure Tsj.c3Change(Sender: TObject);
begin
if((c3.ItemIndex>-1)and(c4.ItemIndex>-1))
then
cx.Enabled:=true;
end;

procedure Tsj.c4Change(Sender: TObject);
begin
 if((c3.ItemIndex<>-1)and(c4.ItemIndex<>-1))
then
cx.Enabled:=true;
end;

procedure Tsj.dyClick(Sender: TObject);
begin
ppr.PrintReport;
end;

procedure Tsj.FormCreate(Sender: TObject);
begin
main.Visible:=false;
sj.Width:=740;
sj.Height:=630;
l1.Items.LoadFromFile(ExtractFileDir(Application.Exename)+'\save.cj');
end;

procedure Tsj.N2Click(Sender: TObject);
begin
application.Terminate;
end;

procedure Tsj.Button1Click(Sender: TObject);
begin
application.Terminate;
end;

procedure Tsj.ppbNext(Sender: TObject);
var
str: string;
i:integer;
begin
case strtoint(option.kgin.Text) of
0: str:=' ';
1:str:='  ';
2: str:='   ';
3:str:='    ';
4:str:='     ';
end;
ak.Caption:='';
if(xm.Text='')then
fzr.Caption:=option.fzr2.Text
else
fzr.Caption:='';
for i:=1 to 6 do
ak.Caption:=ak.Caption+copy(yb.text,i,1)+str;
end;
procedure Tsj.ppbFirst(Sender: TObject);
var
str: string;
i:integer;
begin
case strtoint(option.kgin.Text) of
0: str:=' ';
1:str:='  ';
2: str:='   ';
3:str:='    ';
4:str:='     ';
end;
ak.Caption:='';
for i:=1 to 6 do
ak.Caption:=ak.Caption+copy(yb.text,i,1)+str;
end;

procedure Tsj.cxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
aa.Font.Color:=clred;
 aa.Caption:='正在搜索数据，请稍候...';
end;

procedure Tsj.N6Click(Sender: TObject);
begin
tj.Show;
end;

procedure Tsj.dddLogin(Database: TDatabase; LoginParams: TStrings);
begin
ddd.Params.Values['password']:='';
ddd.Params.Values['username']:='';
end;

procedure Tsj.szClick(Sender: TObject);
begin
ppd.Show;
end;

procedure Tsj.cxClick(Sender: TObject);
var
dg,temp:integer;
s1,s2,t1,t2,s,str:string;
label ack;
begin
s:='"';
if com.Visible=true then
begin
temp:=dog.ADOTable1.FieldCount;
str:=com.Text;
end
else
begin
temp:=sj.t1.FieldCount;
str:=s+sj.t1.TableName+s;
end;
if l1.Items.Count<5
then
begin
showmessage('请点按“数据/导入字段”，在“供查寻字段”中至有5个字段！');
aa.Caption:='';
exit;
end;
try
case c1.ItemIndex of
 0:
 s1:=l1.Items.Strings[0];
 1:
 s1:=l1.Items.Strings[3];
 2:
 s1:=l1.Items.Strings[2];
 3:
 s1:=l1.Items.Strings[1];
 4:
 s1:=l1.Items.Strings[4];
 5:
 s1:=l1.Items.Strings[5];
 end;
 case c3.ItemIndex of
 0:
 s2:=l1.Items.Strings[0];
 1:
 s2:=l1.Items.Strings[3];
 2:
 s2:=l1.Items.Strings[2];
 3:
 s2:=l1.Items.Strings[1];
 4:
 s2:=l1.Items.Strings[4];
 5:
 s2:=l1.Items.Strings[5];
 end;
 except
raise exception.Create('字段太少');
end;
 dg:=0;
while dg<temp do
begin
if(s1=dbgrid1.Fields[dg].FieldName)
then
goto ack;
dg:=dg+1;
end;
begin
aa.Caption:='';
showmessage('字段无效，先设置有效字段！');
tj.Show;
exit;
end;
ack:
qa.Active:=true;
me.Clear;
me.Width:=400;
me.Lines.Add('select * from '+str);
t1:='where '+s1+' '+'like'+' "%'+e1.Text+'%'+'"';
t2:='where '+s1+' '+'='+'"'+e1.Text+'"';
if(c2.ItemIndex=1)
then
me.Lines.Add(t1+';')
else
me.Lines.Add(t2+';');
begin
if(checkbox1.Checked=true)
then
begin
if(c4.ItemIndex=1)
then
begin
me.Clear;
me.Lines.Add('select * from '+str);
if(c2.ItemIndex=1)
then
me.Lines.Add(t1)
else
me.Lines.Add(t2);
me.Lines.Add('and '+s2+' '+'like'+' "%'+e2.Text+'%'+'"'+';')
end
else
begin
me.Clear;
me.Lines.Add('select * from '+str);
if(c2.ItemIndex=1)
then
me.Lines.Add(t1)
else
me.Lines.Add(t2);
me.Lines.Add('and '+s2+' '+'='+'"'+e2.Text+'"'+';');
end;
end;
if(com.Visible=false)then
begin
sql.DatabaseName:='bee';
sql.Close;
sql.SQL.Assign(me.lines);
sql.Open;
end
else
begin
dog.ADOQuery1.Close;
dog.ADOQuery1.SQL.Assign(me.Lines);
dog.ADOQuery1.Open;
end;
if com.Visible=true then
da2.DataSet:=dog.ADOQuery1
else
da2.DataSet:=sql;
gb.DataSource:=da2;
aa.Font.Color:=clblue;
aa.Caption:='搜索到的数据:';
qa.Active:=false;
end;
yb.DataField:=l1.Items.Strings[0];
dz.DataField:=l1.Items.Strings[1];
xm.DataField:=l1.Items.Strings[3];
gs.DataField:=l1.Items.Strings[2];
end;

procedure Tsj.N9Click(Sender: TObject);
begin
about.Show;
sj.Visible:=false;
end;

procedure Tsj.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=#27
then
application.Terminate;
end;

procedure Tsj.comChange(Sender: TObject);
begin
with dog do
begin
    adotable1.Active:=false;
  adotable1.TableName:=com.Text;
  adotable1.Active:=true;
  dbgrid1.DataSource:=kk;
 end;
end;
procedure Tsj.N11Click(Sender: TObject);
begin
if(sj.gb.FieldCount<>0)then
sj.ppd.Show
else
showmessage('请先查寻好数据再设置！');
end;

procedure Tsj.N12Click(Sender: TObject);
begin
if(sj.gb.FieldCount<>0)then
begin
ppr.PrintReport;
end
else
showmessage('没有数据可打印！');
end;

procedure Tsj.N14Click(Sender: TObject);
begin
option.Show;
sj.Enabled:=false;
end;

procedure Tsj.N10Click(Sender: TObject);
begin
Application.HelpFile:=ExtractFilePath(ParamStr(0))+'help\'+'信封打印HHDY.HLP';
Application.HelpCommand(HELP_CONTENTS,0);
end;

end.