setupformunit.pas

好用得程序

unit SetupFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Registry;

type
  TSetupForm = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    SB_selectpath: TSpeedButton;
    Label9: TLabel;
    e_allname: TEdit;
    e_name: TEdit;
    E_tel: TEdit;
    E_address: TEdit;
    LE_datapath: TEdit;
    SB_about: TSpeedButton;
    SB_CLOSE: TSpeedButton;
    SB_save: TSpeedButton;
    SB_stop: TSpeedButton;
    Bevel_BUTTON: TBevel;
    RB_user: TRadioButton;
    RB_auto: TRadioButton;
    e_backupdays: TEdit;
    L_days: TLabel;
    procedure SB_stopClick(Sender: TObject);
    procedure SB_CLOSEClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure SB_saveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SB_selectpathClick(Sender: TObject);
    procedure SB_aboutClick(Sender: TObject);
    procedure e_allnameChange(Sender: TObject);
    procedure e_allnameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    B_save: boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SetupForm: TSetupForm;

implementation

{$R *.dfm}
uses MainUnit, SelectDirUnit, AboutUnit;

procedure TSetupForm.SB_stopClick(Sender: TObject);
var
  reg: TRegistry;
begin
  inherited;
  reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    reg.DeleteKey(S_RegTree);
  finally
    reg.CloseKey;
    reg.free;
  end;
  halt;
end;

procedure TSetupForm.SB_CLOSEClick(Sender: TObject);
begin
  self.Close;
end;

procedure TSetupForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  if sb_save.Enabled then
    sb_save.Click;
  if not B_save then canclose := false;
end;

procedure TSetupForm.FormCreate(Sender: TObject);
var TheBitmap: TBitmap;
begin
  inherited;
  self.Caption := application.Title + ' - 系统设置';
  TheBitmap := TBitmap.Create;
  TheBitmap.Height := application.icon.Height + 2;
  TheBitmap.Width := application.icon.Width + 2;
  TheBitmap.Canvas.Draw(0, 0, application.Icon);
  sb_about.Glyph := thebitmap;
  B_save := true;
end;

procedure TSetupForm.SB_saveClick(Sender: TObject);
var
  reg: TRegistry;
begin
  B_save := false;
  if messagedlg('确定要保存以上所有资料吗？', mtconfirmation, [mbyes, mbno], 0) = mrno then
  begin
    B_save := true;
    exit;
  end;
  if trim(e_allname.Text) = '' then
  begin
    messagedlg('公司名称不能为空，请检查后重新输入。', mtwarning, [mbok], 0);
    e_allname.SetFocus;
    exit;
  end;
  if trim(e_name.Text) = '' then
  begin
    messagedlg('负责人姓名不能为空，请检查后重新输入。', mtwarning, [mbok], 0);
    e_name.SetFocus;
    exit;
  end;
  if (not DirectoryExists(trim(LE_datapath.Text))) and (trim(LE_datapath.Text) <> '【系统默认】') then
  begin
    messagedlg('指定数据库目录不存在，请检查后重新输入。', mtwarning, [mbok], 0);
    LE_datapath.SetFocus;
    exit;
  end;

  reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if (Reg.OpenKey(S_RegTree, False)) = False then
    begin
      Reg.CreateKey(S_RegTree);
    end;
    Reg.OpenKey(S_RegTree, True);
    //读取窗体控件中的公司基本信息到注册表中
    Reg.WriteString('username', trim(E_name.text));
    Reg.WriteString('coname', trim(E_allname.text));
    Reg.WriteString('cotel', trim(E_tel.text));
    Reg.WriteString('address', trim(E_address.text));
    Reg.WriteString('DataPath', trim(LE_datapath.text));
    if rb_auto.Checked then
      reg.Writestring('autosave', '1')
    else
      reg.writestring('autosave', '0');
    Reg.WriteString('savedays', trim(e_backupdays.text));

    Reg.CloseKey;
    sb_save.Enabled := false;
    with MainForm do
    begin
      S_name := trim(E_allname.text);
      S_username := trim(E_name.text);
      S_cotel := trim(E_tel.text);
      S_address := trim(E_address.text);
      CPXSGL := trim(le_datapath.Text);
      if CPXSGL = '【系统默认】' then
      begin
        CPXSGL := ExtractFileDir(Application.ExeName);
        if (StrLen(PChar(CPXSGL)) <> 3) then
          CPXSGL := CPXSGL + '\DATA\'
        else
          CPXSGL := CPXSGL + 'DATA\';
      end;
      if rb_auto.Checked then
        S_autosave := '1'
      else
        S_autosave := '0';
      S_savedays := trim(e_backupdays.text);
    end;
    messagedlg('系统设置数据信息保存完毕！', mtwarning, [mbok], 0);
    MainForm.Caption := Application.Title + ' - ' + S_name + '【' + CPXSGL + '】';
    B_save := true;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  self.Close;
end;

procedure TSetupForm.FormShow(Sender: TObject);
var
  reg: TRegistry;
begin
  inherited;
  reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if (Reg.OpenKey(S_RegTree, False)) = False then
    begin
      Reg.CreateKey(S_RegTree);
    end;
    Reg.OpenKey(S_RegTree, True);
    E_allname.text := reg.ReadString('Coname');
    e_name.text := reg.ReadString('Username');
    E_tel.text := reg.ReadString('Cotel');
    E_address.text := reg.ReadString('Address');
    LE_datapath.Text := reg.ReadString('DataPath');
    if LE_datapath.Text = '' then LE_datapath.Text := '【系统默认】';
    if reg.Readstring('autosave') = '1' then
      rb_auto.Checked := true
    else
      rb_user.Checked := true;
    e_backupdays.text := Reg.readString('savedays');
    if trim(e_backupdays.text) = '' then
      e_backupdays.text := '10';
    Reg.CloseKey;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  sb_save.Enabled := false;

end;

procedure TSetupForm.SB_selectpathClick(Sender: TObject);
begin
  Application.CreateForm(TSelectDir, SelectDir);
  SelectDir.DriveComboBox1.Text := ExtractFileDrive(LE_datapath.Text);
  if (FileExists(LE_datapath.Text)) then
    SelectDir.DirectoryListBox1.Directory := LE_datapath.Text;
  if (SelectDir.ShowModal = mrOK) then
    LE_datapath.Text := SelectDir.DirectoryListBox1.Directory; //Frm_select_dir.Label2.Caption;
  SelectDir.free;
end;

procedure TSetupForm.SB_aboutClick(Sender: TObject);
begin
  Application.CreateForm(TAboutForm, AboutForm);
  AboutForm.showmodal;
  AboutForm.free;
end;

procedure TSetupForm.e_allnameChange(Sender: TObject);
begin
  sb_save.Enabled := true;
end;

procedure TSetupForm.e_allnameKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = 13) or (key = 40) then { 判断是按执行键}
  begin
    key := 0;
    perform(WM_NEXTDLGCTL, 0, 0); {移动到下一个控件}
  end;
end;

end.