📄 userunit.pas
字号:
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 + -