📄 mainform.pas
字号:
unit mainform;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, ImgList, Menus, Shellapi, StdCtrls, Db, DBTables, jpeg, ExtCtrls,
Grids, DBGrids, XPMenu, fcStatusBar;
const
CM_RESTORE = WM_USER + $1000;
type
TSysForm = class(TForm)
MainMenu: TMainMenu;
meufile: TMenuItem;
Meudhzx: TMenuItem;
N4: TMenuItem;
meukfzx: TMenuItem;
N5: TMenuItem;
meuswzx: TMenuItem;
N6: TMenuItem;
meujlcx: TMenuItem;
N7: TMenuItem;
meuexit: TMenuItem;
meuEdit: TMenuItem;
Undo1: TMenuItem;
Repeatcommand1: TMenuItem;
N3: TMenuItem;
Cut1: TMenuItem;
Copy1: TMenuItem;
Paste1: TMenuItem;
PasteSpecial1: TMenuItem;
A1: TMenuItem;
N2: TMenuItem;
L1: TMenuItem;
meuTool: TMenuItem;
meuInit: TMenuItem;
meusydwxx: TMenuItem;
meukhzlxx: TMenuItem;
meubmml: TMenuItem;
meuygml: TMenuItem;
meufwlxml: TMenuItem;
meukhlxml: TMenuItem;
N8: TMenuItem;
meuyhzczx: TMenuItem;
meuyhcssz: TMenuItem;
meuWindow: TMenuItem;
mnuWindowTool: TMenuItem;
mnuWindowstatus: TMenuItem;
N9: TMenuItem;
D1: TMenuItem;
S1: TMenuItem;
C1: TMenuItem;
P1: TMenuItem;
meuHelp: TMenuItem;
Contents1: TMenuItem;
N1: TMenuItem;
MnuAbout: TMenuItem;
ImageList: TImageList;
fwxxglDb: TDatabase;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
E1: TMenuItem;
N19: TMenuItem;
czyqxQuery: TQuery;
XPMenu1: TXPMenu;
mainStatusBar: TfcStatusBar;
Menufwdjb: TMenuItem;
C2: TMenuItem;
N10: TMenuItem;
B1: TMenuItem;
C3: TMenuItem;
D2: TMenuItem;
E2: TMenuItem;
fwltjMenu: TMenuItem;
procedure ToolButton8Click(Sender: TObject);
procedure meuexitClick(Sender: TObject);
procedure meusydwxxClick(Sender: TObject);
procedure mnuWindowToolClick(Sender: TObject);
procedure mnuWindowstatusClick(Sender: TObject);
procedure meubmmlClick(Sender: TObject);
procedure meukhzlxxClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure meuygmlClick(Sender: TObject);
procedure D1Click(Sender: TObject);
procedure S1Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure P1Click(Sender: TObject);
procedure Q1Click(Sender: TObject);
procedure A2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure meuyhcsszClick(Sender: TObject);
procedure meuyhzczxClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure MnuAboutClick(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure meufwlxmlClick(Sender: TObject);
procedure MenufwdjbClick(Sender: TObject);
procedure Contents1Click(Sender: TObject);
procedure fwltjMenuClick(Sender: TObject);
procedure Undo1Click(Sender: TObject);
private
{ Private declarations }
function GetExePath: string; //取得系统路径函数
public
{ Public declarations }
function GetCzyqx(Tczybh: string; Tqxbh: string; Tqxjb: string): string; //取得操作员权限函数
//Tczybh 操作员编号,Tqxbh 权限编号,Tqxjb 权限级别
function StrLike(str1: string; Str2: string): Boolean; //判断一个字符串是否在另一个字符串中的函数
procedure CreateParams(var Params: TCreateParams); override;
procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
end;
var
SysForm: TSysForm;
sys_czyqx: string; //操作员权限
sys_czyxm: string; //操作员姓名
sys_czybh: string; //操作员编号
sys_path: string; //系统所在路径
sys_date: string; //系统日期
LoginFlag: Boolean;
sys_bmpath, sys_report: string; //系统图片所在路径
selectdate1, selectdate2: TDateTime; //此两个变量为全局使用,目的是从一个时间选择模块中得到选择的时间
selecttext1, selecttext2, selecttext3, selecttext4: string; //此四个变量为全局使用,目的是从一个选择模块中得到选择的内容
selectboolean: Boolean; //为全局使用,目的是从一个选择模块中得到是否进行了选择
implementation
uses Desktop, sydwxx, bmmlgl, khzlxx, ygdagl, login, startface, dhsl, scpgd,
xtcssz, yhzczx, yhgnqxsz, fwdjb, fwrbb, about, ghczy, ghkl, ghxtsj,
fwlxml, khhfb, fwltj, tjxz, bxpzlr;
{$R *.DFM}
// ============================参见 ST.DPR ==
// Override Default RegisterClass Parameters
// =========================================
procedure TSysForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := 'StoreSystemfwxxglxt';
end;
// ===============================================
// Handle CM_RESTORE Message (Restore Application)
// ===============================================
procedure TSysForm.RestoreRequest(var message: TMessage);
begin
if IsIconic(Application.Handle) = TRUE then
Application.Restore
else
Application.BringToFront;
end;
// ===============================================
procedure TSysForm.ToolButton8Click(Sender: TObject);
begin
Close;
end;
procedure TSysForm.meuexitClick(Sender: TObject);
begin
Close;
end;
procedure TSysForm.meusydwxxClick(Sender: TObject);
var
SydwChild: Tsydxxform;
begin
SydwChild := Tsydxxform.Create(Application);
SydwChild.Show;
end;
procedure TSysForm.mnuWindowToolClick(Sender: TObject);
begin
mnuWindowTool.Checked := not mnuWindowTool.Checked;
desktopform.mainToolBar.Visible := mnuWindowTool.Checked;
desktopform.mainCoolBar.Visible := mnuWindowTool.Checked;
end;
procedure TSysForm.mnuWindowstatusClick(Sender: TObject);
begin
mnuWindowstatus.checked := not mnuWindowstatus.checked;
mainstatusbar.visible := mnuWindowstatus.checked;
end;
procedure TSysForm.meubmmlClick(Sender: TObject);
begin
if Bmmlform = nil then Bmmlform := Tbmmlform.Create(SysForm);
Bmmlform.Show;
end;
procedure TSysForm.meukhzlxxClick(Sender: TObject);
begin
if frmkhzl = nil then frmkhzl := Tfrmkhzl.Create(SysForm);
frmkhzl.show;
end;
procedure TSysForm.FormCreate(Sender: TObject);
begin
try
fwxxgldb.LoginPrompt := False;
fwxxgldb.Close;
fwxxgldb.DatabaseName := 'fwxxgl';
fwxxgldb.Params.Values['ODBC DSN'] := 'fwxxgl_ODBC';
fwxxgldb.Params.Values['DriverName'] := 'Microsoft Access Driver (*.mdb)';
fwxxgldb.Params.Values['OPEN MODE'] := 'READ/WRITE';
fwxxgldb.Params.Values['User Name'] := 'admin';
fwxxgldb.Params.Values['Password'] := '000000';
fwxxgldb.Open;
except
MessageBox(handle, '数据库联接失败,请检查系统配置或网线和服务器是否正常。', pchar('提示信息'), mb_IconWarning + mb_OK);
Application.Terminate;
end;
loginform := Tloginform.Create(Application);
Splashform.Hide;
Splashform.Free;
loginform.SHOWMODAL;
if LoginFlag = True then
begin
mainstatusbar.Panels[1].text := '操作员:' + sys_czyxm;
mainstatusbar.Panels[4].text := sys_date;
end
else
begin
Application.Terminate;
end;
end;
procedure TSysForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MessageBox(handle, '确定要退出本系统吗?', pchar('提示信息'), mb_IconQuestion + mb_YesNo) = mrNO then
begin
Action := caNone
end
else
begin
Action := caFree;
fwxxgldb.Connected := False;
fwxxgldb.Close;
end;
end;
procedure TSysForm.meuygmlClick(Sender: TObject);
begin
if frmygdagl = nil then frmygdagl := Tfrmygdagl.Create(SysForm);
frmygdagl.Show;
end;
procedure TSysForm.D1Click(Sender: TObject);
begin
Cascade;
end;
procedure TSysForm.S1Click(Sender: TObject);
begin
TileMode := tbHorizontal;
Tile;
end;
procedure TSysForm.C1Click(Sender: TObject);
begin
TileMode := tbVertical;
Tile;
end;
procedure TSysForm.P1Click(Sender: TObject);
begin
ArrangeIcons;
end;
procedure TSysForm.Q1Click(Sender: TObject);
begin
ActiveMDIChild.Close;
end;
procedure TSysForm.A2Click(Sender: TObject);
var i: Integer;
begin
for i := MDIChildCount - 1 downto 0 do MDIChildren[i].Close;
end;
procedure TSysForm.FormActivate(Sender: TObject);
begin
if desktopform = nil then desktopform := Tdesktopform.Create(sysform);
desktopform.Show;
desktopform.mainToolBar.Visible := mnuWindowTool.Checked;
desktopform.mainCoolBar.Visible := mnuWindowTool.Checked;
end;
procedure TSysForm.N13Click(Sender: TObject);
begin
if frmdhsl = nil then frmdhsl := Tfrmdhsl.Create(sysform);
frmdhsl.show;
end;
procedure TSysForm.meuyhcsszClick(Sender: TObject);
begin
if frmxtcssz = nil then frmxtcssz := Tfrmxtcssz.Create(SysForm);
frmxtcssz.Show;
end;
procedure TSysForm.meuyhzczxClick(Sender: TObject);
begin
if frmyhzczx = nil then frmyhzczx := Tfrmyhzczx.Create(sysform);
frmyhzczx.show;
end;
procedure TSysForm.FormShow(Sender: TObject);
begin
sys_path := GetExePath;
sys_bmpath := GetExePath + 'Graphics\';
sys_report := GetExePath + 'Reports\';
Mainstatusbar.Panels[0].Width := Inttostr(Self.width - 340);
end;
procedure TSysForm.N12Click(Sender: TObject);
var
lsbl_cxlj: string;
begin
lsbl_cxlj := sys_path + 'Calendar.exe';
ShellExecute(handle, 'open', Pchar(lsbl_cxlj), '', '', sw_shownormal);
end;
procedure TSysForm.N11Click(Sender: TObject);
var
lsbl_cxlj: string;
begin
lsbl_cxlj := sys_path + 'Calc.exe';
ShellExecute(handle, 'open', Pchar(lsbl_cxlj), '', '', sw_shownormal);
end;
function TSysForm.GetExePath: string;
var
lsbl_x, lsbl_y: integer;
begin
lsbl_y := 0;
Result := Application.ExeName;
for lsbl_x := 1 to length(Result) do
if Result[lsbl_x] = '\' then
lsbl_y := lsbl_x;
Result := copy(Result, 1, lsbl_y);
end;
function TSysForm.GetCzyqx(Tczybh: string; Tqxbh: string; Tqxjb: string): string;
var
lsbl_czqx: string;
lsbl_length: string;
begin
lsbl_czqx := '';
czyqxQuery.Close;
czyqxQuery.SQL.Clear;
if Trim(Tczybh) <> '' then
begin
if Trim(Tqxbh) = '' then
begin
czyqxQuery.SQL.Add('Select czy_sfxz from czyqxk');
czyqxQuery.SQL.Add('where czy_bh=:lsbl_czybh and czy_qxjb=:lsbl_qxjb');
czyqxQuery.ParamByName('lsbl_czybh').AsString := Tczybh;
czyqxQuery.ParamByName('lsbl_qxjb').AsString := Tqxjb;
end
else
begin
lsbl_length := inttostr(Length(Tqxbh));
czyqxQuery.SQL.Add('Select czy_sfxz from czyqxk');
czyqxQuery.SQL.Add('where czy_bh=:lsbl_czybh and Left(czy_qxxmbh,' + lsbl_length + ')=:lsbl_qxbh and czy_qxjb=:lsbl_qxjb');
czyqxQuery.ParamByName('lsbl_czybh').AsString := Tczybh;
czyqxQuery.ParamByName('lsbl_qxbh').AsString := Tqxbh;
czyqxQuery.ParamByName('lsbl_qxjb').AsString := Tqxjb;
end;
czyqxQuery.Prepare;
czyqxQuery.Open;
with czyqxQuery do
begin
First;
while not eof do
begin
if FieldValues['czy_sfxz'] = True then
begin
lsbl_czqx := lsbl_czqx + '1';
end
else
begin
lsbl_czqx := lsbl_czqx + '0';
end;
next;
end;
end;
czyqxQuery.Close;
result := lsbl_czqx;
end
else
begin
Result := '';
end;
end;
procedure TSysForm.MnuAboutClick(Sender: TObject);
begin
frmabout := Tfrmabout.Create(Self);
frmabout.Showmodal;
end;
function TsysForm.StrLike(str1: string; Str2: string): Boolean;
begin
if Pos(str1, str2) <> 0 then
result := True
else
result := False
end;
procedure TSysForm.N16Click(Sender: TObject);
begin
frmghczy := Tfrmghczy.Create(Self);
frmghczy.showmodal;
end;
procedure TSysForm.N17Click(Sender: TObject);
begin
frmghkl := Tfrmghkl.Create(Self);
frmghkl.showmodal;
end;
procedure TSysForm.N18Click(Sender: TObject);
begin
frmghxtrq := Tfrmghxtrq.Create(Self);
frmghxtrq.showmodal;
end;
procedure TSysForm.FormResize(Sender: TObject);
begin
Mainstatusbar.Panels[0].Width := Inttostr(Self.width - 340);
Desktopform.Top := 0;
Desktopform.Left := 0;
Desktopform.Height := self.Height - 69;
Desktopform.Width := self.Width - 12;
end;
procedure TSysForm.meufwlxmlClick(Sender: TObject);
begin
if frmfwlxml = nil then frmfwlxml := Tfrmfwlxml.Create(SysForm);
frmfwlxml.Show;
end;
procedure TSysForm.MenufwdjbClick(Sender: TObject);
begin
if frmfwdjb = nil then frmfwdjb := Tfrmfwdjb.Create(SysForm);
frmfwdjb.Show;
end;
procedure TSysForm.Contents1Click(Sender: TObject);
begin
if frmkhhfb = nil then frmkhhfb := Tfrmkhhfb.Create(SysForm);
frmkhhfb.Show;
end;
procedure TSysForm.fwltjMenuClick(Sender: TObject);
begin
selectboolean := False;
selecttext1 := '';
selecttext2 := '';
if frmtjxz = nil then frmtjxz := Tfrmtjxz.Create(Sysform);
frmtjxz.DateTP1.Date := Now;
frmtjxz.DateTP2.Date := Now;
frmtjxz.ShowModal;
if selectboolean = True then
begin
if frmfwltj = nil then
begin
frmfwltj := Tfrmfwltj.Create(SysForm);
fwltj_date1 := selectdate1;
fwltj_date2 := selectdate2;
fwltj_bmbh := selecttext1 + '%';
fwltj_bmmc := selecttext2;
frmfwltj.Label5.Caption := Datetostr(fwltj_date1) + ' 至 ' + Datetostr(fwltj_date2);
if fwltj_bmmc <> '' then
begin
frmfwltj.Label3.Visible := True;
frmfwltj.Label4.Visible := True;
frmfwltj.Label4.Caption := fwltj_bmmc;
end;
frmfwltj.Show;
frmfwltj.Update;
frmfwltj.datatj();
end;
end;
end;
procedure TSysForm.Undo1Click(Sender: TObject);
begin
if frmbxpzlr = nil then frmbxpzlr := Tfrmbxpzlr.Create(SysForm);
frmbxpzlr.show;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -