main.pas
来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 502 行
PAS
502 行
{*******************************************************}
{ }
{ 牛仔布信息系统 }
{ }
{ 版权所有 (C) 2006 前进牛仔布有限公司 }
{ }
{单元名称：main.pas }
{建立信息：由 管理员 于 2006-10-7 2:17:23 }
{工程名称：JeansIM }
{*******************************************************}
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, RzStatus, ExtCtrls, RzPanel, ImgList, ActnList, AppEvnts,
CustomMDIBackGround, XPMenu, RzGroupBar, DBGridEh;
type
TfrmMain = class(TForm)
mmMain: TMainMenu;
miSystem: TMenuItem;
miSell: TMenuItem;
miStorge: TMenuItem;
miQuality: TMenuItem;
miBaseData: TMenuItem;
N7: TMenuItem;
miProduce: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
RzStatusBar1: TRzStatusBar;
RzStatusPane1: TRzStatusPane;
actlMain: TActionList;
actClose: TAction;
N26: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
N38: TMenuItem;
miStock: TMenuItem;
miReport: TMenuItem;
ImglNav: TImageList;
actTest: TAction;
MDIBackGround1: TMDIBackGround;
actTempLock: TAction;
N59: TMenuItem;
N60: TMenuItem;
N61: TMenuItem;
N62: TMenuItem;
N63: TMenuItem;
N64: TMenuItem;
N65: TMenuItem;
N43: TMenuItem;
N44: TMenuItem;
N45: TMenuItem;
N46: TMenuItem;
N47: TMenuItem;
N48: TMenuItem;
N49: TMenuItem;
N52: TMenuItem;
N53: TMenuItem;
N66: TMenuItem;
N3: TMenuItem;
N25: TMenuItem;
Timer1: TTimer;
N39: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
N55: TMenuItem;
N56: TMenuItem;
N57: TMenuItem;
N58: TMenuItem;
actChangePassword: TAction;
N50: TMenuItem;
N51: TMenuItem;
XPMenu1: TXPMenu;
spEmpName: TRzStatusPane;
RzStatusPane2: TRzStatusPane;
RzStatusPane3: TRzStatusPane;
N67: TMenuItem;
N68: TMenuItem;
N69: TMenuItem;
N70: TMenuItem;
N71: TMenuItem;
actQuote: TAction;
miSQL: TMenuItem;
actSQL: TAction;
actSysLog: TAction;
actBase_FKFW: TAction;
actBase_YLLX: TAction;
actBase_YSMC: TAction;
actBase_CPZZ: TAction;
N73: TMenuItem;
N74: TMenuItem;
actUserManager: TAction;
N78: TMenuItem;
N79: TMenuItem;
N80: TMenuItem;
N81: TMenuItem;
actBase_Power: TAction;
N82: TMenuItem;
N83: TMenuItem;
N84: TMenuItem;
N86: TMenuItem;
N87: TMenuItem;
N1: TMenuItem;
N88: TMenuItem;
N89: TMenuItem;
N90: TMenuItem;
N91: TMenuItem;
actBase_PowerLx: TAction;
N92: TMenuItem;
actBase_Computer: TAction;
N2: TMenuItem;
actBase_WinName: TAction;
N4: TMenuItem;
N5: TMenuItem;
N8: TMenuItem;
actBase_Report: TAction;
N42: TMenuItem;
N27: TMenuItem;
actBase_Stocker: TAction;
actBase_YLFG: TAction;
actCraftInput: TAction;
actBase_YLDM: TAction;
actBase_YLSYFW: TAction;
N75: TMenuItem;
N76: TMenuItem;
actBase_HCLPrice: TAction;
actChangeSysTime: TAction;
N72: TMenuItem;
N85: TMenuItem;
actAddUpdateFile: TAction;
actCheckCraft: TAction;
N37: TMenuItem;
N94: TMenuItem;
N95: TMenuItem;
N96: TMenuItem;
N97: TMenuItem;
N98: TMenuItem;
N99: TMenuItem;
actSendMessage: TAction;
N6: TMenuItem;
N77: TMenuItem;
miFast: TMenuItem;
test1: TMenuItem;
N54: TMenuItem;
N93: TMenuItem;
N100: TMenuItem;
N101: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure actCloseExecute(Sender: TObject);
procedure actTestExecute(Sender: TObject);
procedure actTempLockExecute(Sender: TObject);
procedure actOrderInputExecute(Sender: TObject);
procedure actChangePasswordExecute(Sender: TObject);
procedure actQuoteExecute(Sender: TObject);
procedure actSQLExecute(Sender: TObject);
procedure actSysLogExecute(Sender: TObject);
procedure actBase_FKFWExecute(Sender: TObject);
procedure actBase_YLLXExecute(Sender: TObject);
procedure actBase_YSMCExecute(Sender: TObject);
procedure actBase_CPZZExecute(Sender: TObject);
procedure actUserManagerExecute(Sender: TObject);
procedure actBase_PowerExecute(Sender: TObject);
procedure actBase_PowerLxExecute(Sender: TObject);
procedure actBase_ComputerExecute(Sender: TObject);
procedure actBase_WinNameExecute(Sender: TObject);
procedure actBase_ReportExecute(Sender: TObject);
procedure actBase_StockerExecute(Sender: TObject);
procedure actBase_YLFGExecute(Sender: TObject);
procedure actCraftInputExecute(Sender: TObject);
procedure actBase_YLDMExecute(Sender: TObject);
procedure actBase_YLSYFWExecute(Sender: TObject);
procedure actBase_HCLPriceExecute(Sender: TObject);
procedure actAddUpdateFileExecute(Sender: TObject);
procedure actCheckCraftExecute(Sender: TObject);
procedure actSendMessageExecute(Sender: TObject);
private
{ Private declarations }
procedure onSystemTimeChange(var Msg: TMsg); Message WM_TIMECHANGE;
procedure PowerSet;
procedure OpenWindows(Sender: TObject; FormClass: TClass; PARA1, PARA2: String);
public
{ Public declarations }
function GetAction_Name(_Name: String):TAction; //按名字取动作
end;
var
frmMain: TfrmMain;
implementation
uses MyPublic, Test, TempLock, PersonInfo, dm32, ChangePassword, Quote,
SQLControl, SysLog, BasicData, UserManager, BasePower, yldm,
CraftInput, AddUpdateFile, SendMess, dmc32, Basic, CraftCheck,
QuoteFind;
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
//初始化系统状态
spEmpName.Caption := CurrentUser.EmpName;
//设置系统权限
PowerSet;
//打开一些常用基础库
OpenDataSet(dmc.qryYldm, 'SELECT * FROM MATERIAL WHERE SHBZ ='+ IntToStr(SHBZ_OK));
end;
procedure TfrmMain.actCloseExecute(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
DeleteFile(AppPath+'JEANS.LOG');
end;
procedure TfrmMain.actTestExecute(Sender: TObject);
begin
RecordUsedMenu(actTest);
OpenWindows(Sender, TfrmTest, '', '');
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
var lii_Info: TLastInputInfo;
begin
//自动锁定系统
lii_Info.cbSize := SizeOf(lii_Info);
GetLastInputInfo(lii_Info);
if ((GetTickCount - lii_Info.dwTime)/1000 > CurrentUser.LockTime) and not SysLock then
begin
SysLock := True;
actTempLockExecute(nil);
end;
end;
procedure TfrmMain.actTempLockExecute(Sender: TObject);
begin
//临时锁定
ShowWindows(Sender, TfrmSysLock, '', '');
end;
procedure TfrmMain.actOrderInputExecute(Sender: TObject);
begin
//订单输入
end;
procedure TfrmMain.onSystemTimeChange(var Msg: TMsg);
var lb_power: Boolean;
begin
try
lb_power := actChangeSysTime.Enabled;
if not lb_Power then
begin
actChangeSysTime.Enabled := True;
SynchroLocalTime;
ShowMess('提示','对不起，你没有权限修改系统时间！',MB_OK);
end;
finally
actChangeSysTime.Enabled := lb_Power;
end;
end;
procedure TfrmMain.actChangePasswordExecute(Sender: TObject);
begin
//修改密码
ShowWindows(Sender, TfrmChangePassword, '', '');
end;
procedure TfrmMain.actQuoteExecute(Sender: TObject);
begin
//报价资料管理
RecordUsedMenu(actQuote);
OpenWindows(Sender, TfrmQuoteFind, '', '');
end;
function TfrmMain.GetAction_Name(_Name: String): TAction; //按名字取动作
var li_Count: Integer;
begin
for li_Count :=0 to Self.ComponentCount-1 do
if (Self.Components[li_Count] is TAction) then
if (Self.Components[li_Count] as TAction).Name = _Name then
begin
Result := (Self.Components[li_Count] as TAction);
Break;
end;
end;
procedure TfrmMain.actSQLExecute(Sender: TObject);
begin
//SQL控制台
RecordUsedMenu(actSQL);
OpenWindows(Sender, TfrmSQL, '', '');
end;
procedure TfrmMain.actSysLogExecute(Sender: TObject);
begin
//系统日志
RecordUsedMenu(actSysLog);
OpenWindows(Sender, TfrmSysLog, '', '');
end;
procedure TfrmMain.actBase_FKFWExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_FKFW);
OpenWindows(Sender, TfrmBaseData, 'BASE_FKFW', actBase_FKFW.Caption);
end;
procedure TfrmMain.actBase_YLLXExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_YLLX);
OpenWindows(Sender, TfrmBaseData, 'BASE_YLLX', actBase_YLLX.Caption);
end;
procedure TfrmMain.actBase_YSMCExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_YSMC);
OpenWindows(Sender, TfrmBaseData, 'BASE_YSMC', actBase_YSMC.Caption);
end;
procedure TfrmMain.actBase_CPZZExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_CPZZ);
OpenWindows(Sender, TfrmBaseData, 'BASE_CPZZ', actBase_CPZZ.Caption);
end;
procedure TfrmMain.actUserManagerExecute(Sender: TObject);
begin
//用户型权限管理
RecordUsedMenu(actUserManager);
OpenWindows(Sender, TfrmUserManager, '', '');
end;
procedure TfrmMain.actBase_PowerExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_Power);
OpenWindows(Sender, TfrmBasePower, 'BASE_POWER', '');
end;
procedure TfrmMain.actBase_PowerLxExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_PowerLX);
OpenWindows(Sender, TfrmBaseData, 'BASE_POWERLX', actBase_PowerLX.Caption);
end;
procedure TfrmMain.actBase_ComputerExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_Computer);
OpenWindows(Sender, TfrmBaseData, 'BASE_COMPUTER', actBase_Computer.Caption);
end;
procedure TfrmMain.actBase_WinNameExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_WinName);
OpenWindows(Sender, TfrmBaseData, 'BASE_WINNAME', actBase_WinName.Caption);
end;
procedure TfrmMain.actBase_ReportExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_Report);
OpenWindows(Sender, TfrmBaseData, 'BASE_REPNAME', actBase_Report.Caption);
end;
procedure TfrmMain.actBase_StockerExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_Stocker);
OpenWindows(Sender, TfrmBaseData, 'BASE_STOCKER', actBase_Stocker.Caption);
end;
procedure TfrmMain.actBase_YLFGExecute(Sender: TObject);
begin
RecordUsedMenu(actBase_YLFG);
OpenWindows(Sender, TfrmBaseData, 'BASE_YLSTYLE', actBase_YLFG.Caption);
end;
procedure TfrmMain.actCraftInputExecute(Sender: TObject);
begin
//工艺输入
RecordUsedMenu(actCraftInput);
OpenWindows(Sender, TfrmCraftInput, '', '');
end;
procedure TfrmMain.actBase_YLDMExecute(Sender: TObject);
begin
//原料代码管理
RecordUsedMenu(actBase_YLDM);
OpenWindows(Sender, TfrmYLDM, '', '');
end;
procedure TfrmMain.actBase_YLSYFWExecute(Sender: TObject);
begin
//原料使用范围
RecordUsedMenu(actBase_YLSYFW);
OpenWindows(Sender, TfrmBaseData, 'BASE_YLSYFW', actBase_YLSYFW.Caption);
end;
procedure TfrmMain.actBase_HCLPriceExecute(Sender: TObject);
begin
//后处理价格
RecordUsedMenu(actBase_HCLPrice);
OpenWindows(Sender, TfrmBaseData, 'BASE_HCLPRICE', actBase_HCLPrice.Caption);
end;
procedure TfrmMain.actCheckCraftExecute(Sender: TObject);
begin
//审核工艺
//RecordUsedMenu(actCheckCraft);
//OpenWindows(Sender, TfrmCraftCheck, '', '');
end;
procedure TfrmMain.actAddUpdateFileExecute(Sender: TObject);
begin
//添加升级文件
ShowWindows(Sender, TfrmAddUpdateFile, '', '');
end;
procedure TfrmMain.actSendMessageExecute(Sender: TObject);
begin
//发送消息
ShowWindows(Sender, TfrmSendMess, '', '');
end;
procedure TfrmMain.OpenWindows(Sender: TObject; FormClass: TClass; PARA1, PARA2: String);
var li_Count, li_windows: Integer;
Instance: TComponent;
begin
if frmMain.MDIChildCount > 1 then
begin
ShowMess('提示','请先关闭当前打开的工作窗口', MB_OK);
Exit;
end;
//发现窗口，则显示
li_windows := 0;
_Para1 := Para1;
_Para2 := Para2;
try
Instance := TFormClass(FormClass).Create(Self);
except
On E: Exception do
ShowMess('系统错误','生成所需要的功能窗口失败，具体为：'+ E.message, MB_ICONERROR);
end;
end;
procedure TfrmMain.PowerSet; //权限设置
var i: integer;
begin
//保留特殊用户
if UpperCase(CurrentUser.UserCode) = 'SYSTEM' then Exit;
for i:=0 to mmMain.Items.Count-1 do
if mmMain.Items.Items[i].Tag = 1 then //特别的主菜单
if CurrentUser.ShowPower = POWER_HIDE then
mmMain.Items.Items[i].Visible := GetRC('USERPOWER', 'USERCODE='''+ CurrentUser.UserCode+''' AND DJ=1 AND '+
'ACTNAME= ''' + mmMain.Items.Items[i].Name + '''') = 1
else
mmMain.Items.Items[i].Enabled := GetRC('USERPOWER', 'USERCODE='''+ CurrentUser.UserCode+''' AND DJ=1 AND '+
'ACTNAME= ''' + mmMain.Items.Items[i].Name + '''') = 1;
for i:=0 to actlMain.ActionCount-1 do
if not (actlMain.Actions[i].Tag = POWER_TY) then
if CurrentUser.ShowPower = POWER_HIDE then
TAction(actlMain.Actions[i]).Enabled := GetRC('USERPOWER', 'USERCODE='''+ CurrentUser.UserCode+''' AND DJ=2 AND '+
'ACTNAME=''' + actlMain.Actions[i].Name + '''') = 1;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?