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

📄 personalset.pas

📁 产品信息系统!关于产品基础信息的系统!功能强大!
💻 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 + -