📄 main.~pas
字号:
unit Main;
interface
uses Windows,SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList, jpeg;
type
TMainForm = class(TForm)
mmMain: TMainMenu;
m_State: TMenuItem;
m_state_1: TMenuItem;
StatusBar: TStatusBar;
tlbMain: TToolBar;
ilMainMenu: TImageList;
m_operation: TMenuItem;
m_operation_Lend: TMenuItem;
m_operation_Sale: TMenuItem;
m_system: TMenuItem;
m_system_ChanageUser: TMenuItem;
m_system_UserChgpwd: TMenuItem;
m_system_spear2: TMenuItem;
m_help_spear1: TMenuItem;
m_state_2: TMenuItem;
btnLendDetail: TToolButton;
btnSaleDetail: TToolButton;
btnQuerySale: TToolButton;
Image1: TImage;
btnExitSystem: TToolButton;
ToolButton10: TToolButton;
ToolButton13: TToolButton;
btnQueryLend: TToolButton;
m_system_sysset: TMenuItem;
m_operation_split1: TMenuItem;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem18: TMenuItem;
MenuItem19: TMenuItem;
MenuItem20: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
MenuItem23: TMenuItem;
MenuItem24: TMenuItem;
MenuItem25: TMenuItem;
MenuItem26: TMenuItem;
MenuItem27: TMenuItem;
MenuItem28: TMenuItem;
MenuItem29: TMenuItem;
MenuItem30: TMenuItem;
MenuItem31: TMenuItem;
MenuItem32: TMenuItem;
MenuItem33: TMenuItem;
MenuItem34: TMenuItem;
MenuItem35: TMenuItem;
MenuItem36: TMenuItem;
MenuItem37: TMenuItem;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
m_operation_QueryLend: TMenuItem;
m_system_UserPower: TMenuItem;
m_operation_QuerySale: TMenuItem;
m_ExitSys: TMenuItem;
m_split2: TMenuItem;
m_state_3: TMenuItem;
//
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure m_system_ChanageUserClick(Sender: TObject);
procedure m_operation_LendClick(Sender: TObject);
procedure m_operation_SaleClick(Sender: TObject);
procedure m_system_UserListClick(Sender: TObject);
procedure m_system_UserChgpwdClick(Sender: TObject);
procedure m_operation_QueryLendClick(Sender: TObject);
procedure m_system_UserPowerClick(Sender: TObject);
procedure m_system_syssetClick(Sender: TObject);
procedure m_ExitSysClick(Sender: TObject);
procedure m_operation_QuerySaleClick(Sender: TObject);
private
{ Private declarations }
// MDI图片背景
FClientInstance,
FPrevClientPRoc:TFarProc;
// MDI图片背景
procedure ClientWndProc(VAR Message:TMessage);
//
public
{ Public declarations }
function f_InitUserMenu():Boolean; //按登录用户权限初始化菜单
end;
procedure RunForm(InstanceClass: TComponentClass; var Reference);
var
MainForm: TMainForm;
implementation
uses base, Common, DataBase, login,
ChangeUser, UserChgPwd,
LendDetail,QueryLend,
UserPower,
SysSet, SaleDetail, QuerySale;
{$R *.DFM}
// 体改变大小时强制重画
procedure TMainForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE,Word(Active),0);
end;
{-------------------------------------------
按登录用户权限初始化菜单
-------------------------------------------}
function TMainForm.f_InitUserMenu():Boolean;
begin
//业务登记
m_operation_Lend.Enabled :=true;
m_operation_Sale.Enabled :=true;
btnLendDetail.Enabled :=true;
btnSaleDetail.Enabled :=true;
//统计报表
m_state_1.Enabled :=false;
m_state_2.Enabled :=false;
m_state_3.Enabled :=false;
//系统维护
m_system_UserPower.Enabled :=false;
m_system_sysset.Enabled :=false;
//
if gs_login_userlevel='超级用户' then
begin
m_state_1.Enabled :=true;
m_state_2.Enabled :=true;
m_state_3.Enabled :=true;
m_system_UserPower.Enabled :=true;
m_system_sysset.Enabled :=true;
end
else if gs_login_userlevel='管理员' then
begin
m_state_1.Enabled :=true;
m_state_2.Enabled :=true;
m_state_3.Enabled :=true;
end
else
begin // 客户
m_operation_Lend.Enabled :=false;
m_operation_Sale.Enabled :=false;
btnLendDetail.Enabled :=false;
btnSaleDetail.Enabled :=false;
end;
//
Result:=True;
end;
{-------------------------------------------
打开窗口
-------------------------------------------}
procedure RunForm(InstanceClass: TComponentClass; var Reference);
begin
if TComponent(Reference) = nil then
begin
application.CreateForm(instanceClass,Reference);
TForm(Reference).show;
end;
TForm(Reference).BringToFront;
end;
{-------------------------------------------
实现在窗口背景显示图片
-------------------------------------------}
procedure TMainForm.ClientWndProc(VAR Message:TMessage);
VAR
MyDC:hDC;
Ro,Co:Word;
Begin
With Message do
begin
case Msg of
WM_ERASEBKGND:
begin
MyDC:=TWMEraseBkGnd(Message).DC;
FOR Ro:=0 To ClientHeight DIV Image1.Picture.Height DO
For Co:=0 To ClientWidth Div Image1.Picture.width Do
BitBlt(MYDC,Co*Image1.Picture.Width,Ro*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 ;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FClientInstance:=MakeObjectInstance(ClientWndProc);
FPrevClientProc:=Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,LongInt(FclientInstance));
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
//
end;
procedure TMainForm.m_system_ChanageUserClick(Sender: TObject);
begin
frm_login:=Tfrm_login.Create(self);
Try
frm_login.Caption:='更换操作员';
frm_login.ShowModal;
// 为用户配置主菜单
MainForm.f_InitUserMenu;
//
MainForm.StatusBar.Panels[1].text :='操作员:'+gs_Login_UserName;
Finally
frm_login.Free;
End;
end;
procedure TMainForm.m_operation_LendClick(Sender: TObject);
begin
Frm_LendDetail:=TFrm_LendDetail.Create(self);
Try
Frm_LendDetail.ParmEditorMode := 'ADD';
Frm_LendDetail.ShowModal;
Finally
Frm_LendDetail.Free;
End;
end;
procedure TMainForm.m_operation_SaleClick(Sender: TObject);
begin
Frm_SaleDetail:=TFrm_SaleDetail.Create(self);
Try
Frm_SaleDetail.ParmEditorMode := 'ADD';
Frm_SaleDetail.ShowModal;
Finally
Frm_SaleDetail.Free;
End;
end;
procedure TMainForm.m_system_UserListClick(Sender: TObject);
begin
runform(Tfrm_UserPower,Frm_UserPower);
end;
procedure TMainForm.m_system_UserChgpwdClick(Sender: TObject);
begin
Frm_UserChgPwd:=Tfrm_UserChgPwd.Create(self);
Try
Frm_UserChgPwd.ShowModal;
Finally
Frm_UserChgPwd.Free;
End;
end;
procedure TMainForm.m_operation_QueryLendClick(Sender: TObject);
begin
runform(Tfrm_QueryLend,frm_QueryLend);
end;
procedure TMainForm.m_system_UserPowerClick(Sender: TObject);
begin
runform(Tfrm_UserPower,Frm_UserPower);
end;
procedure TMainForm.m_system_syssetClick(Sender: TObject);
begin
Frm_SysSet:=TFrm_SysSet.Create(self);
Try
Frm_SysSet.ShowModal;
Finally
Frm_SysSet.Free;
End;
end;
procedure TMainForm.m_ExitSysClick(Sender: TObject);
begin
if MessageBox(handle,'确认退出本系统吗?','提示',MB_OKCANCEL)=IDOK then
Application.Terminate;
end;
procedure TMainForm.m_operation_QuerySaleClick(Sender: TObject);
begin
runform(Tfrm_QuerySale,frm_QuerySale);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -