optdlg.pas

国外著名恢复软件Drive_Rescue 公布的早期源码 版本是1.8 delphi6环境开发的。

unit optdlg;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, ComCtrls, Dialogs;

type
  TOptions = class
  public
    DebugLevel : byte;

    UseINT13          : Boolean;
    UseINT13EXT       : Boolean;
    UseINT25          : boolean;
    EnableWinErrorMsg : boolean;
    EnableCache       : boolean;
    FileListFont      : TFONT;
    LostDefaultSize   : longword;
    DeletedCharAnsi   : string;
    DeletedCharMultibyte: string;
    DeletedUseMultiByte: boolean;
    FindLostFiles     : boolean;

    UseSystemIcons: boolean;

    constructor Create;
    destructor Destroy; override;
    function Execute : Boolean;

    procedure ReadOptions;
    procedure SaveOptions;
  end;


  TOptionsDialog = class(TForm)
    OKBtn: TButton;
    CancelBtn: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ButtonSave: TButton;
    GroupBoxPhysical9X: TGroupBox;
    CheckBoxUserINT13: TCheckBox;
    CheckBoxUserINT13EXT: TCheckBox;
    GroupBoxLogical9X: TGroupBox;
    CheckBoxUserINT25: TCheckBox;
    CheckBoxEnableWinErrorMsg: TCheckBox;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    FontDialog1: TFontDialog;
    Label1: TLabel;
    ButtonSelectFont: TButton;
    PanelSample: TPanel;
    Label2: TLabel;
    EditFont: TEdit;
    CheckBoxEnableCache: TCheckBox;
    TabSheet3: TTabSheet;
    GroupBox3: TGroupBox;
    EditDeletedCharAnsi: TEdit;
    EditDeletedCharMultibyte: TEdit;
    RadioButtonCharAnsi: TRadioButton;
    RadioButtonCharMultibyte: TRadioButton;
    GroupBox2: TGroupBox;
    EditLostDefaultSize: TEdit;
    Label3: TLabel;
    CheckBoxFindLostFiles: TCheckBox;
    Label4: TLabel;
    procedure ButtonSelectFontClick(Sender: TObject);
    procedure ButtonSaveClick(Sender: TObject);
  private
    { Private declarations }
    FcurrOptions : TOptions;
    procedure TransferOptions;
  public
    { Public declarations }
  end;

var
  OptionsDialog: TOptionsDialog;

implementation

uses main, helpers, registry;

{$R *.dfm}


constructor TOptions.Create;
begin

  // default settings...
  DebugLevel := debugHigh;
  UseSystemIcons := FALSE;

  UseINT13          := TRUE;
  UseINT13EXT       := TRUE;
  UseINT25          := TRUE;
  EnableCache       := TRUE;
  EnableWinErrorMsg := TRUE;
  FileListFont      := TFont.create;
  LostDefaultSize   := 1474560;
  DeletedCharAnsi   := '_';
  DeletedCharMultibyte:='__';
  DeletedUseMultibyte:=FALSE;
  FindLostFiles     := TRUE;
  //FileListFont.assign(MainForm.TreeView.font);
end;

destructor TOptions.Destroy;
begin
  //
end;


function TOptions.Execute : Boolean;
var
   Dlg : TOptionsDialog;
begin
   Dlg := TOptionsDialog.Create(Application.MainForm);
   try
      Dlg.FcurrOptions := self;

      Dlg.CheckBoxUserINT13.checked    := UseINT13;
      Dlg.CheckBoxUserINT13EXT.checked := UseINT13EXT;
      Dlg.CheckBoxUserINT25.Checked    := UseINT25;
      Dlg.CheckBoxEnableWinErrorMsg.checked := EnableWinErrorMsg;
      Dlg.CheckboxEnableCache.checked  := EnableCache;
      Dlg.PanelSample.Font.assign(FileListFont);
      Dlg.EditFont.text := FileListFont.name;
      Dlg.EditLostDefaultSize.text := IntToStr(LostDefaultSize);
      Dlg.EditDeletedCharAnsi.text := DeletedCharAnsi;
      Dlg.EditDeletedCharMultibyte.text := DeletedCharMultibyte;
      if DeletedUseMultiByte then Dlg.RadioButtonCharMultiByte.Checked:=TRUE
        else Dlg.RadioButtonCharAnsi.Checked:=TRUE;
      Dlg.CheckBoxFindLostFiles.checked := FindLostFiles;

      if IsWinNT then
      begin
        Dlg.GroupBoxPhysical9X.enabled:=FALSE;
        Dlg.GroupBoxLogical9X.enabled:=FALSE;
      end;

      if Dlg.ShowModal = mrOK then
      begin
        Dlg.TransferOptions;

        Result := True;
      end
      else
      begin
         Result := False;
      end;
   finally
      Dlg.Free;
   end;
end;

procedure TOptions.ReadOptions;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_CURRENT_USER;
      if OpenKey(sRegKey, False) then
      begin
        try
          try
            useINT13          := ReadBool('UseINT13');
            useINT13EXT       := ReadBool('UseINT13EXT');
            useINT25          := ReadBool('UseINT25');
            enableWinErrorMsg := ReadBool('EnableWinErrorMsg');
            enableCache       := ReadBool('EnableCache');
            FileListFont.name := ReadString('FileListFontName');
            FileListFont.size := ReadInteger('FileListFontSize');
            FileListFont.Color:= ReadInteger('FileListFontColor');
            FileListFont.Height:=ReadInteger('FileListFontHeight');
            FileListFont.PixelsPerInch:=ReadInteger('FileListFontPixelsPerInch');
            LostDefaultSize   := ReadInteger('LostDefaultSize');
            DeletedCharAnsi   := ReadString('DeletedCharAnsi');
            DeletedCharMultibyte := ReadString('DeletedCharMultibyte');
            DeletedUseMultiByte := ReadBool('DeletedUseMultiByte');
            FindLostFiles       := ReadBool('FindLostFiles');


          except
            // if exception occurs show error msg and use default params...
            on E:Exception do
            begin
              MessageDlg('Could not read from registry: '+ E.Message, mtError, [mbOK], 0);
            end;
          end;
        finally
          // finally close key...
          CloseKey;
        end;
      end;
    end;
  finally
    // finally free registry object...
    Reg.Free;
  end;
end;

procedure TOptions.SaveOptions;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_CURRENT_USER;
      OpenKey(sRegKey, true);
      try
        try
          WriteBool('UseINT13', useINT13);
          WriteBool('UseINT13EXT', useINT13EXT);
          WriteBool('UseINT25', useINT25);
          WriteBool('EnableWinErrorMsg', enableWinErrorMsg);
          WriteBool('EnableCache', enableCache);
          WriteString('FileListFontName', FileListFont.name);
          WriteInteger('FileListFontSize', FileListFont.size);
          WriteInteger('FileListFontColor', FileListFont.Color);
          WriteInteger('FileListFontHeight', FileListFont.Height);
          WriteInteger('FileListFontPixelsPerInch', FileListFont.PixelsPerInch);
          WriteInteger('LostDefaultSize', LostDefaultSize);
          WriteString('DeletedCharAnsi', DeletedCharAnsi);          
          WriteString('DeletedCharMultibyte', DeletedCharMultibyte);
          WriteBool('DeletedUseMultiByte', DeletedUseMultibyte);
          WriteBool('FindLostFiles', FindLostFiles);          
        except
          // if exception occurs show error msg and do not save...
          on E:Exception do
          begin
            MessageDlg('Could not write to registry: '+ E.Message, mtError, [mbOK], 0);
          end;
        end;
      finally
        // finally close key...
        CloseKey;
      end;
    end;
  finally
    // finally free registry object...  
    Reg.Free;
  end;
end;


procedure TOptionsDialog.TransferOptions;
var
  code: integer;
begin
  with FcurrOptions do
  begin
    UseINT13     := CheckBoxUserINT13.checked;
    UseINT13EXT  := CheckBoxUserINT13EXT.checked;
    UseINT25     := CheckBoxUserINT25.Checked;
    EnableWinErrorMsg := CheckBoxEnableWinErrorMsg.checked;
    EnableCache  := CheckboxEnableCache.checked;
    FileListFont.assign(PanelSample.Font);
    val(EditLostDefaultSize.text, LostDefaultSize, code);
    DeletedCharAnsi := EditDeletedCharAnsi.text;
    DeletedCharMultibyte := EditDeletedCharMultibyte.text;
    DeletedUseMultibyte := RadioButtonCharMultiByte.Checked;
    FindLostFiles := CheckBoxFindLostFiles.checked;
  end;
end;



procedure TOptionsDialog.ButtonSelectFontClick(Sender: TObject);
begin
  FontDialog1.Options := [fdLimitSize];
  FontDialog1.MaxFontSize := 14;
  FontDialog1.MinFontSize := 8;
  FontDialog1.Font.assign(PanelSample.font);
  if FontDialog1.Execute then
  begin
    EditFont.text:=FontDialog1.Font.name;
    PanelSample.Font.assign(FontDialog1.Font);
  end;
end;

procedure TOptionsDialog.ButtonSaveClick(Sender: TObject);
var
  dlgres: integer;
begin
  dlgRes:=MessageDlg('If you save the options any lost or deleted data'+
   #13'on the system drive may be overwritten!'+#13#13
    +'Are you sure to proceed?', mtWarning, [mbyes, mbno], 0);
  if dlgRes = mrYes then
  begin
    TransferOptions;
    FcurrOptions.SaveOptions;
  end;
end;

end.