⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 我觉得是很好的一个程序是关于房产中介的管理系统包跨哦出租出售求租求售的
💻 ~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 + -