unit1.pas

发票套打功能

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, unit2, jpeg, Buttons,
  TrayBarIcon, LabelButton, ADODB, registry, ShellAPI ;

type
  TForm1 = class(TForm)
    palUp: TPanel;
    palLeftUp: TPanel;
    imgGrayLeftUp: TImage;
    imgColorLeftUp: TImage;
    imgLeftUp: TImage;
    imgSysIcon: TImage;
    imgLeftUp1: TImage;
    palRightUp: TPanel;
    imgGrayRightUp: TImage;
    imgRestoreButton: TImage;
    imgMaxButton: TImage;
    imgRightUp: TImage;
    imgCloseButton: TImage;
    imgMinButton: TImage;
    imgSizeButton: TImage;
    imgColorRightUp: TImage;
    imgRightUp1: TImage;
    palUpMid: TPanel;
    imgColorMenubar: TImage;
    imgGrayCaption: TImage;
    imgGrayMenuBar: TImage;
    imgCaption: TImage;
    lbCaption: TLabel;
    imgColorCaption: TImage;
    CoolBarMenu: TCoolBar;
    ToolBarMenu: TToolBar;
    palDown: TPanel;
    imgLeftDown: TImage;
    imgRightDown: TImage;
    imgDownMin: TImage;
    palLeft: TPanel;
    imgLeft: TImage;
    palRight: TPanel;
    imgRight: TImage;
    palClient: TPanel;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ComboBox1: TComboBox;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    LabelBtn1: TLabelBtn;
    LabelBtn2: TLabelBtn;
    LabelBtn3: TLabelBtn;
    Label4: TLabel;
    procedure imgCloseButtonClick(Sender: TObject);
    procedure imgCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgCaptionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgSizeButtonClick(Sender: TObject);
    procedure imgMinButtonClick(Sender: TObject);
    procedure lbCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lbCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbCaptionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure LabelBtn1Click(Sender: TObject);
    procedure LabelBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LabelBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    //移动窗体
    canmove:boolean;
    curPoint:TPoint;
    oldPoint:TPoint;
    Canvas:TCanvas;
    {读入数据库}
    procedure DRSJK();
    { Private declarations }
  public
    { Public declarations }
  end;
TCheckThread=class(TThread)
public
protected
  procedure Execute; override;
end;
var
  Form1: TForm1;
  CheckUsePass: TCheckThread ;
implementation
uses unit4, Unit3, unit6, TimerDlg;
{$R *.dfm}
procedure TCheckThread.Execute;
begin

end ;
procedure TForm1.imgCloseButtonClick(Sender: TObject);
begin
  close  ;
end;

procedure TForm1.imgCaptionMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft)and(ssLeft in Shift)then
  begin
    canmove:=true;
    Canvas:=TCanvas.Create;
    with Canvas do
    begin
      pen.Style :=psdot;
      brush.Style :=bsClear;
      pen.Width :=2;
      Pen.Mode :=pmNotXor;
      Handle :=GetDC(0);
      Rectangle(left,top,Left+width,top+height);
      curPoint.X :=X;
      curPoint.Y :=Y;
      oldPoint.X :=Left;
      oldPoint.Y :=Top;
    end;        //end with
  end;  //end if
end;
procedure TForm1.imgCaptionMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    oldPoint.x :=Left +X-curPoint.x;
    oldPoint.y :=Top +Y-curPoint.y;
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
  end;
end;
procedure TForm1.imgCaptionMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    Left :=oldPoint.x;
    Top :=oldPoint.y;
    Free;
  end;
  canmove:=not canmove;
end;


procedure TForm1.imgSizeButtonClick(Sender: TObject);
begin
  application.messagebox(pchar('因为限制,不能最大化 ！ '),pchar('提示')  ,MB_ICONINFORMATION);
end;

procedure TForm1.imgMinButtonClick(Sender: TObject);
begin
  if Application.MainForm =self then
    Application.Minimize
  else
    DefWindowProc(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure TForm1.lbCaptionMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft)and(ssLeft in Shift)then
  begin
    canmove:=true;
    Canvas:=TCanvas.Create;
    with Canvas do
    begin
      pen.Style :=psdot;
      brush.Style :=bsClear;
      pen.Width :=2;
      Pen.Mode :=pmNotXor;
      Handle :=GetDC(0);
      Rectangle(left,top,Left+width,top+height);
      curPoint.X :=X;
      curPoint.Y :=Y;
      oldPoint.X :=Left;
      oldPoint.Y :=Top;
    end;        //end with
  end;  //end if
end;

procedure TForm1.lbCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    oldPoint.x :=Left +X-curPoint.x;
    oldPoint.y :=Top +Y-curPoint.y;
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
  end;
end;
procedure TForm1.lbCaptionMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not canmove then exit;
  with Canvas do
  begin
    Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
    Left :=oldPoint.x;
    Top :=oldPoint.y;
    Free;
  end;
  canmove:=not canmove;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  close ;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   edit2.SetFocus ;
   //当前时间日期
   StatusBar1.Panels[1].Text := timetostr(time()) ;
   StatusBar1.Panels[3].Text := datetostr(date());
   with CustomerData do
   begin
      //打开的表名
      UsePass.Close ;
      UsePass.TableName :='Admin' ;
      UsePass.open;
      UsePass.First ;
      while not UsePass.eof  do
      begin
       combobox1.Items.Add( UsePass.fieldbyname('用户名').AsString) ;
       UsePass.Next ;
      end;
   end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
     form1.Height := 349  ;
     GroupBox1.Visible := True ;
  end
  else
  begin
     form1.Height := 260 ;
     GroupBox1.Visible := false ;     
  end;
end;

procedure TForm1.LabelBtn1Click(Sender: TObject);
begin
  edit1.Text := PromptDataSource(Handle, edit1.Text);
end;

procedure TForm1.LabelBtn2Click(Sender: TObject);
var
  s:string;
  ADOlinkreg:treginifile;
begin
  if edit1.Text = '' then
  begin
   application.messagebox(pchar('你并没有配置数据库，请正确配置，否则将无法完成操作   ！   '),pchar('提示')  ,MB_ICONINFORMATION);
   exit ;
  end;
  s:=Edit1.Text;
  adolinkreg:=treginifile.Create('');
  with adolinkreg do
  try
    begin
      RootKey:=HKEY_LOCAL_MACHINE;
      DeleteValue('software\地税局发票打印系统2005\') ;
      openkey('software\地税局发票打印系统2005\',true);
      writestring('ADODATA','adolink',s);
      writestring('软件信息','adolink','2005年2月完成，联系方式 QQ:280534828 E-mail:[e-mail]');
  SetDlgAutoClose(8000, Sender = LabelBtn2);
  MessageBox(Handle, PChar(' 保存数据库配置成功！   ！' +
    #13#10 + ' '+
    #13#10 + '本程序将在 8 秒钟后自动关闭' + #13#10 +
    '建议关闭程序，重新启动程序   ' + #13#10 +
    '就可以方便的数据快速连接  '),  //or MB_OKCANCEL
    '定时自动关闭本程序',MB_ICONINFORMATION or MB_OKCANCEL );
    //application.messagebox(pchar(' 保存数据库配置成功！  ！建议关闭程序，重新启动程序，本程序将在以下时间关闭    '),pchar('管理员－欢迎提出意见')  ,MB_ICONINFORMATION);
      {读入数据库}
      DRSJK ;
      CheckBox1.Checked := false ;
      ShellExecute(handle,'Open',PChar(Application.ExeName),'','', SW_SHOWNORMAL);
      free;
      Close ;
     end;
  except
    begin
     application.messagebox(pchar(' 保存配置文件出错，并查检你的注册表是否存在或者损坏 ！  ！   '),pchar('提示')  ,MB_ICONINFORMATION);
     free;
  end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := false ;
  {读入数据库}
  DRSJK ;
end;


procedure TForm1.LabelBtn3Click(Sender: TObject);
begin
  edit1.Text := '' ;
end;

{读入数据库}
procedure TForm1.DRSJK();
var
   i:integer;
   t:string;
   ADOlinkreg:TRegistry ;
begin
   adolinkreg:=TRegistry.Create ;
   with adolinkreg do
   begin
    try
     RootKey:=HKEY_LOCAL_MACHINE;
     if  keyexists('software\地税局发票打印系统2005\adodata') then
       begin
        openkey('software\地税局发票打印系统2005\adodata',false);
        t:=readstring('adolink');
          if t<>'' then
            begin
               CheckBox1.Checked := false ;
               edit1.Text:=t;
               CustomerData.ADOConnection1.ConnectionString := t ;
               CustomerData.XY.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + extractfilepath(application.exename) + '\Data\XY.mdb;Persist Security Info=False';
               exit ;
               free;
            end
           else
             begin
                application.messagebox(pchar(' ADO数据库连接尚未配置! 你必须进行配置后才能进行相应的操作，否则无法使用本程序 ！   '),pchar('管理员－提示')  ,MB_ICONINFORMATION);
                edit1.Text:='';
                exit;
             end;
       end
    else
      application.messagebox(pchar(' ADO数据库连接尚未配置! 你必须进行配置后才能进行相应的操作，否则无法使用本程序 ！   '),pchar('管理员－提示')  ,MB_ICONINFORMATION);
      CheckBox1.Checked := true ;
      exit;
   except
     begin
      application.messagebox(pchar('读取注册表出现异常错误！'),pchar('提示')  ,MB_ICONINFORMATION);
      free;
     end;
   end;
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  //CheckUsePass :=TCheckThread.Create(True);
  //CheckUsePass.Resume ;
try
   with CustomerData do
   begin
      //打开的表名
      UsePass.TableName :='Admin' ;
      UsePass.open;
      UsePass.First ;
      while not UsePass.eof  do
      begin
     //发票号码
        if  (UsePass.fieldbyname('用户名').AsString = form1.ComboBox1.Text) And (UsePass.fieldbyname('密码').AsString = form1.edit2.Text) then
        begin
           form1.label3.Caption :='' ;
           if  (UsePass.fieldbyname('用户名').AsString = form1.combobox1.Text) And (UsePass.fieldbyname('密码').AsString = form1.edit2.Text) and (UsePass.fieldbyname('管理员').AsString ='Yes') then
           begin
             //设置管理员标志
             form1.label3.Caption :='管理员' ;
           end;
           form1.Hide ;
           form4.Show ;
           form4.Edit17.Text := form1.combobox1.Text ;
           UsePass.Close ;
           UsePass.Free ;
           exit ;
        end;
       UsePass.Next ;
       end;
   end;
   application.messagebox(pchar('密码错误，请正确输入密码   ！   '),pchar('提示')  ,MB_ICONINFORMATION);
except
   application.messagebox(pchar('请检查你是否正确配置了数据库  ！   '),pchar('系统管理员－－提示')  ,MB_ICONINFORMATION);
end;
end;

end.