?? 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;
{讀入數(shù)據(jù)庫}
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 ;
//當(dāng)前時間日期
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('你并沒有配置數(shù)據(jù)庫，請正確配置，否則將無法完成操作 ！ '),pchar('提示') ,MB_ICONINFORMATION);
exit ;
end;
s:=Edit1.Text;
adolinkreg:=treginifile.Create('');
with adolinkreg do
try
begin
RootKey:=HKEY_LOCAL_MACHINE;
DeleteValue('software\地稅局發(fā)票打印系統(tǒng)2005\') ;
openkey('software\地稅局發(fā)票打印系統(tǒng)2005\',true);
writestring('ADODATA','adolink',s);
writestring('軟件信息','adolink','2005年2月完成，聯(lián)系方式 QQ:280534828 E-mail:yangkaer@2299.com');
SetDlgAutoClose(8000, Sender = LabelBtn2);
MessageBox(Handle, PChar(' 保存數(shù)據(jù)庫配置成功！ ！' +
#13#10 + ' '+
#13#10 + '本程序?qū)⒃?8 秒鐘后自動關(guān)閉' + #13#10 +
'建議關(guān)閉程序，重新啟動程序 ' + #13#10 +
'就可以方便的數(shù)據(jù)快速連接 '), //or MB_OKCANCEL
'定時自動關(guān)閉本程序',MB_ICONINFORMATION or MB_OKCANCEL );
//application.messagebox(pchar(' 保存數(shù)據(jù)庫配置成功！ ！建議關(guān)閉程序，重新啟動程序，本程序?qū)⒃谝韵聲r間關(guān)閉 '),pchar('管理員－歡迎提出意見') ,MB_ICONINFORMATION);
{讀入數(shù)據(jù)庫}
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 ;
{讀入數(shù)據(jù)庫}
DRSJK ;
end;
procedure TForm1.LabelBtn3Click(Sender: TObject);
begin
edit1.Text := '' ;
end;
{讀入數(shù)據(jù)庫}
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\地稅局發(fā)票打印系統(tǒng)2005\adodata') then
begin
openkey('software\地稅局發(fā)票打印系統(tǒng)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數(shù)據(jù)庫連接尚未配置! 你必須進(jìn)行配置后才能進(jìn)行相應(yīng)的操作，否則無法使用本程序 ！ '),pchar('管理員－提示') ,MB_ICONINFORMATION);
edit1.Text:='';
exit;
end;
end
else
application.messagebox(pchar(' ADO數(shù)據(jù)庫連接尚未配置! 你必須進(jìn)行配置后才能進(jìn)行相應(yīng)的操作，否則無法使用本程序 ！ '),pchar('管理員－提示') ,MB_ICONINFORMATION);
CheckBox1.Checked := true ;
exit;
except
begin
application.messagebox(pchar('讀取注冊表出現(xiàn)異常錯誤！'),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
//發(fā)票號碼
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
//設(shè)置管理員標(biāo)志
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('請檢查你是否正確配置了數(shù)據(jù)庫 ！ '),pchar('系統(tǒng)管理員－－提示') ,MB_ICONINFORMATION);
end;
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -