📄 main.pas
字号:
unit MAIN;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList, XPMenu, DB, ADODB, ActnMan, ActnCtrls,
ActnMenus, CustomizeDlg, shellapi;
type
TMainForm = class(TForm)
mmMainMenu: TMainMenu;
Window1: TMenuItem;
hlp_top: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowArrangeItem: TMenuItem;
hlp_topic: TMenuItem;
OpenDialog: TOpenDialog;
WindowMinimizeItem: TMenuItem;
ActionList1: TActionList;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
FileNew1: TAction;
FileSave1: TAction;
FileExit1: TAction;
FileOpen1: TAction;
FileSaveAs1: TAction;
WindowCascade1: TWindowCascade;
WindowTileHorizontal1: TWindowTileHorizontal;
WindowArrangeAll1: TWindowArrange;
WindowMinimizeAll1: TWindowMinimizeAll;
HelpAbout1: TAction;
FileClose1: TWindowClose;
WindowTileVertical1: TWindowTileVertical;
WindowTileItem2: TMenuItem;
sys_top: TMenuItem;
sys_branch: TMenuItem;
sys_manneger: TMenuItem;
sys_cpwd: TMenuItem;
N5: TMenuItem;
sys_default: TMenuItem;
N7: TMenuItem;
sys_run: TMenuItem;
N9: TMenuItem;
sys_repass: TMenuItem;
N11: TMenuItem;
sys_exit: TMenuItem;
mgood_top: TMenuItem;
mgood_label: TMenuItem;
mgood_spec: TMenuItem;
mgoods_find: TMenuItem;
N17: TMenuItem;
mgood_price: TMenuItem;
mstore_top: TMenuItem;
mgood_stoin: TMenuItem;
mgood_stoout: TMenuItem;
mgood_check: TMenuItem;
mgood_loss: TMenuItem;
N24: TMenuItem;
mgood_fstoin: TMenuItem;
mgood_fstoout: TMenuItem;
mgood_search: TMenuItem;
N28: TMenuItem;
mstore_pdreport: TMenuItem;
mgood_conver: TMenuItem;
N31: TMenuItem;
mstore_set: TMenuItem;
msale_top: TMenuItem;
msale_front: TMenuItem;
N35: TMenuItem;
msale_style: TMenuItem;
msale_detail: TMenuItem;
msale_saleno: TMenuItem;
msale_saler: TMenuItem;
msale_in: TMenuItem;
msale_time: TMenuItem;
N42: TMenuItem;
msale_month: TMenuItem;
N44: TMenuItem;
msale_extend: TMenuItem;
msale_set: TMenuItem;
mman_top: TMenuItem;
mman_change: TMenuItem;
mman_man: TMenuItem;
mman_search: TMenuItem;
m_assistant: TMenuItem;
m_dress: TMenuItem;
mass_sdress: TMenuItem;
mrepair_top: TMenuItem;
mrepair_back: TMenuItem;
N56: TMenuItem;
mrepair_delsale: TMenuItem;
mrepair_delst: TMenuItem;
N59: TMenuItem;
mreair_start: TMenuItem;
mrepair_update: TMenuItem;
mdata_top: TMenuItem;
mdata_recsend: TMenuItem;
N64: TMenuItem;
mdata_deal: TMenuItem;
N66: TMenuItem;
mdata_tran: TMenuItem;
N68: TMenuItem;
hlp_internet: TMenuItem;
N70: TMenuItem;
hlp_about: TMenuItem;
Image1: TImage;
ADOTable1: TADOTable;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
Too: TToolButton;
ToolButton6: TToolButton;
ImageList1: TImageList;
ToolButton5: TToolButton;
ToolButton8: TToolButton;
ToolButton7: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
StatusBar1: TStatusBar;
XPMenu1: TXPMenu;
N1: TMenuItem;
mrepair_day: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure sys_branchClick(Sender: TObject);
procedure mman_manClick(Sender: TObject);
procedure mman_searchClick(Sender: TObject);
procedure sys_runClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure msale_styleClick(Sender: TObject);
procedure msale_salenoClick(Sender: TObject);
procedure msale_salerClick(Sender: TObject);
procedure mgood_searchClick(Sender: TObject);
procedure sys_mannegerClick(Sender: TObject);
procedure sys_cpwdClick(Sender: TObject);
procedure sys_defaultClick(Sender: TObject);
procedure sys_repassClick(Sender: TObject);
procedure sys_exitClick(Sender: TObject);
procedure mgood_labelClick(Sender: TObject);
procedure mgood_specClick(Sender: TObject);
procedure mgoods_findClick(Sender: TObject);
procedure mgood_priceClick(Sender: TObject);
procedure mgood_stoinClick(Sender: TObject);
procedure mgood_stooutClick(Sender: TObject);
procedure mgood_checkClick(Sender: TObject);
procedure mgood_lossClick(Sender: TObject);
procedure mgood_fstoinClick(Sender: TObject);
procedure mgood_fstooutClick(Sender: TObject);
procedure mstore_pdreportClick(Sender: TObject);
procedure mgood_converClick(Sender: TObject);
procedure mstore_setClick(Sender: TObject);
procedure msale_extendClick(Sender: TObject);
procedure msale_frontClick(Sender: TObject);
procedure msale_detailClick(Sender: TObject);
procedure msale_inClick(Sender: TObject);
procedure msale_timeClick(Sender: TObject);
procedure msale_monthClick(Sender: TObject);
procedure msale_setClick(Sender: TObject);
procedure mman_changeClick(Sender: TObject);
procedure m_dressClick(Sender: TObject);
procedure mass_sdressClick(Sender: TObject);
procedure mrepair_backClick(Sender: TObject);
procedure mrepair_delsaleClick(Sender: TObject);
procedure mrepair_delstClick(Sender: TObject);
procedure mreair_startClick(Sender: TObject);
procedure mrepair_updateClick(Sender: TObject);
procedure mdata_recsendClick(Sender: TObject);
procedure mdata_dealClick(Sender: TObject);
procedure mdata_tranClick(Sender: TObject);
procedure hlp_internetClick(Sender: TObject);
procedure hlp_aboutClick(Sender: TObject);
procedure mrepair_dayClick(Sender: TObject);
private
{ Private declarations }
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
procedure FindMenuItems(Item: TMenuItem);//Node: TTreeNode;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
fst:string;
implementation
{$R *.dfm}
uses about, dbmRainbowMis, chHeadUnit, dfm_password, f_branch,
dfm_manrec, f_findman, dfm_tray, f_xsfx, dfm_saler, dfm_ssaleno,
f_stosearch, dfm_team, dfm_syspwd, f_default, dfm_repass, f_label,
f_specenter, dfm_sware, dfm_price, f_storein, f_manoeuvre, dfm_sstoin,
dfm_sstoout, dfm_check, f_loss, dfm_creatbd, dfm_loop, dfm_stoset,
dfm_saledetail, dfm_saleset, dfm_extend, dfm_money, dfm_time, dfm_smonth,
f_manchange, f_dress, dfm_dresslis, dfm_bavre, dfm_delstohst, f_update,
dfm_del, dfm_start, Main_F, dfm_receive, dfm_transpara, dfm_saldate;
procedure TMainForm.FormCreate(Sender: TObject);
begin
fst := ExtractFilePath(Application.ExeName);
dmRainbowMIS.tbltmenu.active:=true;
dmRainbowMIS.Atbltray.Active := true;
if FileExists(fst+'images\oemlogo.bmp') then
begin
image1.Picture.LoadFromFile(fst+'images\oemlogo.bmp');
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
GWL_WNDPROC));
SetWindowLong(ClientHandle,
GWL_WNDPROC, LongInt(FClientInstance));
end;
chHeadUnit.entertray(mainform,dmRainbowMIS.Atbltray) ;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
StatusBar1.Panels[1].Text :='现在用户:'+ g_uInfo.fuserid+' '+g_uInfo.fusername;
dmRainbowMIS.tbltmenu.indexfieldnames:='cmenuname';
if g_uInfo.fuserid<>'system' then
FindMenuItems(mmMainMenu.Items);
dmRainbowMIS.tbltmenu.active:=false;
end;
procedure TMainForm.ClientWndProc(var Message: TMessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,
0,
SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;
procedure Tmainform.FindMenuItems( Item: TMenuItem); //Node: TTreeNode;
var
nCnt: Integer;
dv:string;
begin
dv:=trim(item.Name) ;
if dmrainbowmis.tbltmenu.Locate('cmenuname',dv,[loPartialKey]) then
begin
if pos(vgro+'0',dmRainbowMIS.tbltmenu.fieldbyname('climit').asstring)>0 then
item.Enabled :=false
else
item.Enabled :=true;
if trim(dmrainbowmis.tbltmenu['cmenuind'])='2' then
item.Visible :=false;
end;
for nCnt := 0 to Item.Count - 1 do
begin
FindMenuItems(Item.Items[nCnt]);
end;
end;
procedure TMainForm.sys_branchClick(Sender: TObject);
begin
If Application.FindComponent('dfmbranch')=Nil Then
dfmbranch:=Tdfmbranch.Create(Application);
dfmbranch.Show;
end;
procedure TMainForm.mman_manClick(Sender: TObject);
begin
If Application.FindComponent('dfmmanrec')=Nil Then
dfmmanrec:=Tdfmmanrec.Create(Application);
dfmmanrec.Show;
end;
procedure TMainForm.mman_searchClick(Sender: TObject);
begin
If Application.FindComponent('dfmfindman')=Nil Then
dfmfindman:=Tdfmfindman.Create(Application);
dfmfindman.Show;
end;
procedure TMainForm.sys_runClick(Sender: TObject);
begin
If Application.FindComponent('dfmtray')=Nil Then
dfmtray:=Tdfmtray.Create(Application);
dfmtray.Show;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Application.MessageBox('你确信要退出系统吗?','系统提示',MB_ICONERROR + MB_OKCANCEL)
= IDOK then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -