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

📄 userunit.pas

📁 三层的通用架构
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit UserUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ImgList, ToolWin, Buttons,
  ActnList, Menus;

type
  TUserForm = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Panel5: TPanel;
    Panel4: TPanel;
    Splitter2: TSplitter;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    Panel3: TPanel;
    UserList: TTreeView;
    UserGroupList: TTreeView;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    CheckBox2: TCheckBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Edit4: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    CheckBox3: TCheckBox;
    Label4: TLabel;
    Edit5: TEdit;
    Label5: TLabel;
    Edit6: TEdit;
    UpDown1: TUpDown;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    Panel11: TPanel;
    Panel12: TPanel;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    Panel13: TPanel;
    Panel14: TPanel;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    CheckBox15: TCheckBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel4: TBevel;
    Bevel3: TBevel;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    ActionList1: TActionList;
    NewUserGroup: TAction;
    NewUser: TAction;
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    T1: TMenuItem;
    G1: TMenuItem;
    U1: TMenuItem;
    N1: TMenuItem;
    ExitUserManager: TAction;
    X1: TMenuItem;
    N2: TMenuItem;
    DeleteUserGroup: TAction;
    DeleteUser: TAction;
    MoveUserTo: TAction;
    SetOpen: TAction;
    SetDB: TAction;
    O1: TMenuItem;
    B1: TMenuItem;
    M1: TMenuItem;
    D1: TMenuItem;
    T2: TMenuItem;
    N3: TMenuItem;
    StatusBar1: TStatusBar;
    PopupMenu1: TPopupMenu;
    G2: TMenuItem;
    U2: TMenuItem;
    N4: TMenuItem;
    M2: TMenuItem;
    N5: TMenuItem;
    T3: TMenuItem;
    N6: TMenuItem;
    Button4: TButton;
    SetLoginTimes: TAction;
    N7: TMenuItem;
    G3: TMenuItem;
    SetCOM: TAction;
    N8: TMenuItem;
    COMC1: TMenuItem;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure Panel1Resize(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure UserGroupListChange(Sender: TObject; Node: TTreeNode);
    procedure UserGroupListChanging(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure UserListChange(Sender: TObject; Node: TTreeNode);
    procedure UserGroupListEnter(Sender: TObject);
    procedure Edit3Enter(Sender: TObject);
    procedure Edit2Exit(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Edit6KeyPress(Sender: TObject; var Key: Char);
    procedure NewUserGroupExecute(Sender: TObject);
    procedure NewUserGroupUpdate(Sender: TObject);
    procedure NewUserExecute(Sender: TObject);
    procedure NewUserUpdate(Sender: TObject);
    procedure ExitUserManagerExecute(Sender: TObject);
    procedure DeleteUserGroupExecute(Sender: TObject);
    procedure DeleteUserGroupUpdate(Sender: TObject);
    procedure DeleteUserExecute(Sender: TObject);
    procedure DeleteUserUpdate(Sender: TObject);
    procedure MoveUserToExecute(Sender: TObject);
    procedure SetOpenExecute(Sender: TObject);
    procedure SetOpenUpdate(Sender: TObject);
    procedure SetDBExecute(Sender: TObject);
    procedure SetDBUpdate(Sender: TObject);
    procedure UserGroupListContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure UserListContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure UserGroupListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure UserGroupListDragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure UserListStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure SetLoginTimesExecute(Sender: TObject);
    procedure SetLoginTimesUpdate(Sender: TObject);
    procedure UserListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure UserGroupListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SetCOMExecute(Sender: TObject);
  private
    { Private declarations }
    FName, FSave: string;
    FGroupNode, FUserNode: TTreeNode;
    procedure WMNcActivate(var Msg: TMessage); message WM_NCACTIVATE;
    procedure SaveCurrent;
  public
    { Public declarations }
    UserRealName: string;
  end;

var
  UserForm: TUserForm;

implementation

uses
  MainUnit, SetStringUnit, DBParaUnit, UserItemUnit, LoginTimesUnit, SetCOMUnit;

{$R *.dfm}

procedure TUserForm.WMNcActivate(var Msg: TMessage);
begin
  if not LongBool(Msg.WParam) then
  begin
    Edit2Exit(nil);
    Msg.Result := 1;
  end;
  inherited;
end;

procedure TUserForm.FormCreate(Sender: TObject);
begin
  Icon.Assign(Application.Icon);
  FName := '';
  FSave := '';
  FGroupNode := nil;
  FUserNode := nil;
end;

procedure TUserForm.FormShow(Sender: TObject);
begin
  TheMainForm.SetUserGroupList;
end;

procedure TUserForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveCurrent;
  Action := caFree;
  UserForm := nil;
end;

procedure TUserForm.Splitter1CanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  if (NewSize <= TSplitter(Sender).MinSize) then
    Accept := False;
  if Accept and (Sender = Splitter1) and (NewSize > 268) then
    Accept := False;
end;

procedure TUserForm.Panel1Resize(Sender: TObject);
begin
  Button1.Left := TPanel(Sender).Width - Button1.Width - 24;
  if Button1.Left < 24 then
    Button1.Left := (TPanel(Sender).Width - Button1.Width) div 2;
end;

procedure TUserForm.FormResize(Sender: TObject);
begin
  if ClientHeight > Panel1.Height + StatusBar1.Height then
    Panel2.Height := ClientHeight - Panel1.Height - StatusBar1.Height
  else
    Panel2.Height := 0;
end;

procedure TUserForm.UserGroupListChange(Sender: TObject; Node: TTreeNode);
begin
  if TTreeView(Sender).Selected <> nil then
    TheMainForm.SetUserList(TTreeView(Sender).Selected.Text)
  else
    UserList.Items.Clear;
  if (TTreeView(Sender).Focused) and (TTreeView(Sender).Selected <> nil) then
  begin
    FName := TTreeView(Sender).Selected.Text;
    TheMainForm.InitNameAllows(FName);
  end;
  FUserNode := nil;
end;

procedure TUserForm.SaveCurrent;
begin
  if (FName <> '') and (FName <> FSave) and (UserGroupList.Selected <> nil) then
  begin
    TheMainForm.SetNameAllows(FName);
    FSave := FName;
    if (UserList.Selected <> nil) and (UserList.Selected.Text = FName) then
      if CheckBox2.Checked then
        UserList.Selected.ImageIndex := 4
      else
        UserList.Selected.ImageIndex := 2;
  end;
end;

procedure TUserForm.UserGroupListChanging(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
  SaveCurrent;
end;

procedure TUserForm.UserListChange(Sender: TObject; Node: TTreeNode);
begin
  if (TTreeView(Sender).Focused) and (TTreeView(Sender).Selected <> nil) then
  begin
    FName := TTreeView(Sender).Selected.Text;
    TheMainForm.InitNameAllows(FName);
    if CheckBox2.Checked then
      TTreeView(Sender).Selected.ImageIndex := 4
    else
      TTreeView(Sender).Selected.ImageIndex := 2;
  end;
end;

procedure TUserForm.UserGroupListEnter(Sender: TObject);
begin
  if (TTreeView(Sender).Selected <> nil) and (TTreeView(Sender).Selected.Text <> FName) then
  begin
    SaveCurrent;
    FName := TTreeView(Sender).Selected.Text;
    TheMainForm.InitNameAllows(FName);
    if Sender = UserList then
      if CheckBox2.Checked then
        TTreeView(Sender).Selected.ImageIndex := 4
      else
        TTreeView(Sender).Selected.ImageIndex := 2;
  end;
  if TTreeView(Sender).Items.Count > 0 then
  begin
    UserGroupList.TabStop := False;
    UserList.TabStop := False;
    TTreeView(Sender).TabStop := True;
  end;
  FGroupNode := nil;
  FUserNode := nil;
end;

procedure TUserForm.Edit3Enter(Sender: TObject);
begin
  if Edit2.MaxLength = 0 then
  begin
    Edit2.MaxLength := 16;
    Edit2.Text := TheMainForm.ProcessPassword('Edit2', Edit2.Text, True);
  end;
  Edit2.SetFocus;
  TEdit(Sender).Visible := False;
end;

procedure TUserForm.Edit2Exit(Sender: TObject);
begin
  Edit3.Visible := True;
  if Edit2.MaxLength = 16 then
  begin
    Edit2.MaxLength := 0;
    Edit2.Text := TheMainForm.ProcessPassword('Edit2', Edit2.Text);

⌨️ 快捷键说明

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