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

📄 mainunit.pas

📁 一个售楼系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
Unit MainUnit;

Interface

Uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ActnMan, ActnCtrls, ActnMenus, ToolWin, ComCtrls, ActnList,
   XPStyleActnCtrls, Registry, DB, ADODB, StdCtrls, Buttons, jpeg,
   ExtCtrls, AAFont, AACtrls;

Type
   TMainForm = Class(TForm)
      ActionManager1: TActionManager;
      A1: TAction;
      A2: TAction;
      A3: TAction;
      A4: TAction;
      A5: TAction;
      A2_1: TAction;
      A2_2: TAction;
      A2_3: TAction;
      A2_4: TAction;
      A3_1: TAction;
      A3_2: TAction;
      A3_3: TAction;
      A3_4: TAction;
      A3_5: TAction;
      A3_6: TAction;
      A3_7: TAction;
      A3_B1: TAction;
      A4_1: TAction;
      A4_2: TAction;
      A4_3: TAction;
      A4_4: TAction;
      A4_5: TAction;
      A4_1_1: TAction;
      A4_1_2: TAction;
      A4_1_3: TAction;
      A4_1_4: TAction;
      A4_1_5: TAction;
      A4_1_6: TAction;
      A4_1_7: TAction;
      A1_1: TAction;
      A1_2: TAction;
      A1_3: TAction;
      A1_4: TAction;
      A1_5: TAction;
      A1_6: TAction;
      A1_7: TAction;
      A1_8: TAction;
      A1_9: TAction;
      A1_B1: TAction;
      A1_7_1: TAction;
      A1_7_2: TAction;
      A1_7_3: TAction;
      A1_7_4: TAction;
      A1_7_5: TAction;
      A1_7_6: TAction;
      A1_7_7: TAction;
      A1_7_8: TAction;
      A1_7_7_1: TAction;
      A1_7_7_2: TAction;
      CoolBar1: TCoolBar;
      ActionMainMenuBar1: TActionMainMenuBar;
      ADOQuery1: TADOQuery;
      DataSource1: TDataSource;
      AALabel9: TAALabel;
      Image2: TImage;
      AALabel1: TAALabel;
      AALabel2: TAALabel;
      AALabel11: TAALabel;
      AALabel3: TAALabel;
      Image1: TImage;
      A_H: TAction;
      A4_6: TAction;
      Procedure CloseWins;
      Procedure A1Execute(Sender: TObject);
      Procedure A5Execute(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
      Procedure A3_7Execute(Sender: TObject);
      Procedure A3_4Execute(Sender: TObject);
      Procedure A3_5Execute(Sender: TObject);
      Procedure A3_2Execute(Sender: TObject);
      Procedure A3_3Execute(Sender: TObject);
      Procedure A1_2Execute(Sender: TObject);
      Procedure A1_3Execute(Sender: TObject);
      Procedure A1_4Execute(Sender: TObject);
      Procedure A1_5Execute(Sender: TObject);
      Procedure A1_6Execute(Sender: TObject);
      Procedure A1_9Execute(Sender: TObject);
      Procedure A1_8Execute(Sender: TObject);
      Procedure A1_7_1Execute(Sender: TObject);
      Procedure A1_7_7_2Execute(Sender: TObject);
      Procedure A1_1Execute(Sender: TObject);
      Procedure A4_5Execute(Sender: TObject);
      Procedure A3_1Execute(Sender: TObject);
      Procedure A2_2Execute(Sender: TObject);
      Procedure A4_1_1Execute(Sender: TObject);
      Procedure A4_3Execute(Sender: TObject);
      Procedure A4_2Execute(Sender: TObject);
      Procedure A4_4Execute(Sender: TObject);
      Procedure A_HExecute(Sender: TObject);
      Procedure A4_6Execute(Sender: TObject);
   Private
    { Private declarations }
   Public
    { Public declarations }
   End;

Var
   MainForm         : TMainForm;
   sunitFilter      : String;

Implementation
Uses DM, SoftReg, Login, LoginInfo, CompactDB, RestoreDB, UserOparet,
   CoVIEWUnit, ViewWorkerUnit, ViewCasterUnit, VIEWItemUnit,
   ViewHouseUnit, VIEWLicenceUnit, ViewRutOnRecordUnit, ViewUnitUnit,
   ViewLesseeUnit, ListSellCaseUnit, SearchByHourseUnit, CalMoney,
   PrintContractUnit, SearchBySellUniT, SearchSellOnlyUnit,
   SearchByTimeUnit, SearchByInfringeUnit, SearchByHistoryUnit, HTMLHelp_Decl;
{$R *.dfm}

Procedure TMainForm.A1Execute(Sender: TObject);
Begin
//显示CHM帮助文件
End;

Procedure TMainForm.A5Execute(Sender: TObject);
Begin
   If Assigned(RegSoftForm) Then Begin
      SetWindowPos(RegSoftForm.Handle, 0, 0, 0, 0, 0, swp_nomove +
         swp_nosize);
      Exit;
   End;
   RegSoftForm := TRegSoftForm.create(self);
   RegSoftForm.ShowModal;
End;

Procedure TMainForm.FormCreate(Sender: TObject);
Const
   RunNo            : integer = 60;
Var
   i                : integer;
   bem:Boolean;
   V:Variant ;
Begin
   sTnames := TStringlist.create;
   DM.DataModule2.ADOConnection1.GetTableNames(sTnames);

   screen.MenuFont.Size := 10;
   REG := TRegistry.create;
   REG.RootKey := HKEY_LOCAL_MACHINE;
   REG.OpenKey('SOFTWARE\ABICO', true);
   If REG.ValueExists('Plays') Then BEGIN
      i := REG.ReadInteger('Plays')

   END   Else
      i := RunNo;

   If i <> 2005 Then Begin   //未注册
      If i > RunNo Then i := 1;
      A5.Enabled := true;
      If (i > 0) Then Begin
         Application.MessageBox(pchar('你还未注册本软件 !你还可以使用本软件'
            +
            IntToStr(i) + '次'), '非正式用户提示!', MB_ICONINFORMATION
            +  mb_OK + MB_SYSTEMMODAL);
         REG.WriteInteger('Plays', i - 1);

 
      End
      Else Begin
         A1.Enabled := false;
         A2.Enabled := false;
         A3.Enabled := false;
         A4.Enabled := false;

         Application.MessageBox('你的使用期限已到,请尽快向安邦公司注册!'
            +  #13 +
            '请在进入软件主窗口后,打开“系统相关”-“软件注册”' + #13
            +
            '把注册码对话框中的“机器码11”用EMAIL发送到:2238889@163.com'
            , '非正式用户提示!', MB_ICONERROR + mb_OK +  MB_SYSTEMMODAL);
      End;
   End Else Begin
      A5.Enabled := false;
   End;
      
   REG.Free;
   If i > 0 Then Begin
      LoginForm := tloginform.create(self);
      LoginForm.ShowModal;
   End  Else
      A5Execute(self);                  // REG WIN

End;

Procedure TMainForm.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
   If Application.MessageBox('是否退出程序?', '退出确认',
      MB_ICONQUESTION + mb_yesno) = mrNo Then Begin
      Action := canone;
      Exit;
   End;
   With ADOQuery1 Do Begin
      sql.Text := 'select * from 登入信息表 ';
      open;
      If recordcount = 0 Then Exit;
      last;
      edit;
      fieldbyname('退出日期时间').Text := DateTimeToStr(Now);
      post;

   End;
   sTnames.Free;
End;

Procedure TMainForm.A3_7Execute(Sender: TObject);
Begin
   If currusername = 'ADMIN' Then Begin
      ViewLoginForm := TViewLoginForm.create(self);
      ViewLoginForm.ShowModal;
   End
   Else
      Application.MessageBox('你不是超级用户,无权查看用户登入日志!',
         '警告信息', mb_yesno + MB_ICONERROR);
End;

Procedure TMainForm.A3_4Execute(Sender: TObject);
Begin
   If Application.MessageBox('备份数据库前需要关闭所有操作窗口!是否关闭?',
      '询问信息', mb_yesno + MB_ICONQUESTION) = mrNo Then
      Exit;

   CloseWins;
   Application.ProcessMessages;
   CompactDBForm := tCompactDBForm.create(self);
   CompactDBForm.ShowModal;
End;

Procedure TMainForm.A3_5Execute(Sender: TObject);
Begin
//
   If Application.MessageBox('备份数据库前需要关闭所有操作窗口!是否关闭?',
      '询问信息', mb_yesno + MB_ICONQUESTION) = mrNo Then
      Exit;

   CloseWins;
   Application.ProcessMessages;
   RestoreDBForm := tRestoreDBForm.create(self);
   RestoreDBForm.ShowModal;
End;

Procedure TMainForm.CloseWins;
Begin
//  If Assigned(form) Then form.Close;
End;

Procedure TMainForm.A3_2Execute(Sender: TObject);
Var
   adotemp          : TADOQuery;
   i                : integer;
   sTnames          : TStringlist;
Begin
   If currusername <> 'ADMIN' Then Begin
      Application.MessageBox('你不是超级用户,无法对数据库进行初始化!',
         '警告信息', mb_OK + MB_ICONERROR);
      Exit;
   End;

   If Application.MessageBox('即将初始化本数据库系统。' + #13 +
      '其结果是清空数据库中内容,!' + #13 +
      '建议你先备份数据库。' + #13 +
      '是否开始初始化?', '询问信息', mb_yesno + MB_ICONQUESTION) = mrNo Then
      Exit;
   sTnames := TStringlist.create;
   adotemp := TADOQuery.create(self);
   With adotemp Do Begin
      connection := DM.DataModule2.ADOConnection1;
      DM.DataModule2.ADOConnection1.GetTableNames(sTnames);
      For i := 0 To sTnames.Count - 1 Do Begin
         If (sTnames[i] = '用户登入表') Or
            (sTnames[i] = '登入信息表') Then Continue;

         sql.Text := 'delete * from ' + sTnames[i];
         ExecSQL;
      End;
      Free;
   End;
   sTnames.Free;
   Application.MessageBox('初始化数据库完毕。' + #13 +
      '数据库内容已被清空!', '提示信息', MB_ICONINFORMATION);

End;

Procedure TMainForm.A3_3Execute(Sender: TObject);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -