📄 personalset.pas
字号:
unit PersonalSet;
interface
uses
Windows, Messages, SysUtils, Registry, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Base, StdCtrls, Buttons, ExtCtrls, ComCtrls;
type
TfrmPersonalSet = class(TfrmBase)
Panel1: TPanel;
btnOK: TBitBtn;
btnCancel: TBitBtn;
btnApp: TBitBtn;
PageControl1: TPageControl;
tsLogo: TTabSheet;
tsInterface: TTabSheet;
TabSheet3: TTabSheet;
chkStandard: TCheckBox;
lblBillCaption: TLabel;
Label1: TLabel;
rgSpec: TRadioGroup;
cbUIColor: TColorBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
cbUIFontColor: TColorBox;
Label5: TLabel;
cbUIFontSize: TComboBox;
Label6: TLabel;
Label7: TLabel;
GroupBox1: TGroupBox;
edtMainGroup: TEdit;
Label8: TLabel;
Label9: TLabel;
edtMainTop: TEdit;
Label10: TLabel;
Label11: TLabel;
edtModuleRight: TEdit;
edtModuleLeft: TEdit;
btnDefault: TButton;
odPic: TOpenDialog;
sbMainGroup: TSpeedButton;
sbMainTop: TSpeedButton;
sbModuleLeft: TSpeedButton;
sbModuleRight: TSpeedButton;
procedure btnCancelClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnAppClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure chkStandardClick(Sender: TObject);
procedure rgSpecClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure InitalByRegValue;
procedure btnDefaultClick(Sender: TObject);
procedure cbUIColorChange(Sender: TObject);
procedure sbMainGroupClick(Sender: TObject);
procedure sbMainTopClick(Sender: TObject);
procedure sbModuleLeftClick(Sender: TObject);
procedure sbModuleRightClick(Sender: TObject); //根据注册表信息初始化窗体;
private
strAppPath: string; //相对路径
Reg: TRegistry;
strRegPath: string; //本系统注册表的公共路径
strDeskTop: string; //启动登录的工作桌面
strUIColor: string; //界面背景颜色
strUIFontColor: string; //字体颜色
strUIFontSize: string; //字体大小
strUIMainGroup: string; //图片
strUIMainTop: string;
strUIModuleLeft: string;
strUIModuleRight: string;
{ Private declarations }
public
{ Public declarations }
end;
var
frmPersonalSet : TfrmPersonalSet;
implementation
{$R *.dfm}
procedure TfrmPersonalSet.InitalByRegValue;
begin
//
if (strDeskTop = '') or (strDeskTop = 'Standard') then
chkStandard.Checked := True
else
rgSpec.ItemIndex := StrtoInt(copy(strDeskTop, 1, 1));
if strUIColor = '' then
cbUIColor.Selected := stringtocolor('clBtnFace')
else
cbUIColor.Selected := stringtocolor(strUIColor);
if strUIFontColor = '' then
cbUIColor.Selected := stringtocolor('clBlack')
else
cbUIFontColor.Selected := stringtocolor(strUIFontColor);
if strUIFontSize = '' then
cbUIFontSize.text := '9'
else
cbUIFontSize.text := strUIFontSize;
if strUIMainGroup = '' then
edtMainGroup.text := strAppPath + 'MainGroup.bmp'
else
edtMainGroup.text := strUIMainGroup;
if strUIMainTop = '' then
edtMainTop.text := strAppPath + 'MainTop.bmp'
else
edtMainTop.text := strUIMainTop;
if strUIModuleLeft = '' then
edtModuleLeft.text := strAppPath + 'ModuleLeft.bmp'
else
edtModuleLeft.text := strUIModuleLeft;
if strUIModuleRight = '' then
edtModuleRight.text := strAppPath + 'ModuleRight.bmp'
else
edtModuleRight.text := strUIModuleRight;
end;
procedure TfrmPersonalSet.btnCancelClick(Sender: TObject);
begin
inherited;
self.Close;
end;
procedure TfrmPersonalSet.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
inherited;
Reg.Free;
frmPersonalSet := nil;
end;
procedure TfrmPersonalSet.btnAppClick(Sender: TObject);
begin
inherited;
//
Reg.OpenKey(strRegPath + 'Logo', True);
Reg.WriteString('DeskTop', strDeskTop);
Reg.OpenKey(strRegPath + 'Interface', True);
Reg.WriteString('UIColor', colortostring(cbUIColor.Selected));
Reg.WriteString('UIFontColor', colortostring(cbUIFontColor.Selected));
Reg.WriteString('UIFontSize', cbUIFontSize.text);
Reg.WriteString('UIMainGroup', edtMainGroup.text);
Reg.WriteString('UIMainTop', edtMainTop.text);
Reg.WriteString('UIModuleLeft', edtModuleLeft.text);
Reg.WriteString('UIModuleRight', edtModuleRight.text);
{将当前版本注册到注册表}
Reg.OpenKey('\Software\LeadSoft\MRP\', True);
Reg.WriteString('CurVersion', 'MRP1.0');
{当前版本的安装信息}
Reg.OpenKey('\Software\LeadSoft\MRP\1.0\', True);
Reg.WriteString('AppPath', strAppPath);
Reg.WriteString('AppName', Application.ExeName);
Reg.CloseKey;
btnApp.Enabled := false;
end;
procedure TfrmPersonalSet.btnOKClick(Sender: TObject);
begin
inherited;
btnAppClick(Sender);
btnCancelClick(Sender);
end;
procedure TfrmPersonalSet.chkStandardClick(Sender: TObject);
begin
inherited;
btnApp.Enabled := True;
if chkStandard.Checked = True then
begin
rgSpec.Enabled := false;
strDeskTop := 'Standard';
end
else
begin
rgSpec.Enabled := True;
rgSpecClick(Sender);
end;
end;
procedure TfrmPersonalSet.rgSpecClick(Sender: TObject);
begin
inherited;
case rgSpec.ItemIndex of
0: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'system';
1: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'Leader';
2: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'Purchase';
3: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'Storage';
4: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'PMC';
5: strDeskTop := InttoStr(rgSpec.ItemIndex) + 'Produce';
end;
btnApp.Enabled := True;
end;
procedure TfrmPersonalSet.FormCreate(Sender: TObject);
begin
inherited;
strRegPath := '\Software\LeadSoft\MRP\1.0\PersonalSet\';
strAppPath := ExtractFilePath(Application.ExeName);
odPic.InitialDir := strAppPath;
Reg := TRegistry.create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey(strRegPath + 'Logo', True);
strDeskTop := Reg.ReadString('DeskTop');
Reg.OpenKey(strRegPath + 'Interface', True);
strUIColor := Reg.ReadString('UIColor');
strUIFontColor := Reg.ReadString('UIFontColor');
strUIFontSize := Reg.ReadString('UIFontSize');
strUIMainGroup := Reg.ReadString('UIMainGroup');
strUIMainTop := Reg.ReadString('UIMainTop');
strUIModuleLeft := Reg.ReadString('UIModuleLeft');
strUIModuleRight := Reg.ReadString('UIModuleRight');
InitalByRegValue;
btnApp.Enabled := false;
end;
procedure TfrmPersonalSet.btnDefaultClick(Sender: TObject);
begin
inherited;
chkStandard.Checked := True;
cbUIColor.Selected := stringtocolor('clBtnFace');
cbUIFontColor.Selected := stringtocolor('clBlack');
cbUIFontSize.text := '9';
edtMainGroup.text := strAppPath + 'MainGroup.bmp';
edtMainTop.text := strAppPath + 'MainTop.bmp';
edtModuleLeft.text := strAppPath + 'ModuleLeft.bmp';
edtModuleRight.text := strAppPath + 'ModuleRight.bmp';
btnApp.Enabled := True;
end;
procedure TfrmPersonalSet.cbUIColorChange(Sender: TObject);
begin
inherited;
btnApp.Enabled := True;
end;
procedure TfrmPersonalSet.sbMainGroupClick(Sender: TObject);
begin
inherited;
if odPic.Execute then
begin
edtMainGroup.text := odPic.FileName;
end;
end;
procedure TfrmPersonalSet.sbMainTopClick(Sender: TObject);
begin
inherited;
if odPic.Execute then
begin
edtMainTop.text := odPic.FileName;
end;
end;
procedure TfrmPersonalSet.sbModuleLeftClick(Sender: TObject);
begin
inherited;
if odPic.Execute then
begin
edtModuleLeft.text := odPic.FileName;
end;
end;
procedure TfrmPersonalSet.sbModuleRightClick(Sender: TObject);
begin
inherited;
if odPic.Execute then
begin
edtModuleRight.text := odPic.FileName;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -