setsizefrm.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

unit SetSizeFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TSetSizeForm = class(TForm)
    PromptLabel: TLabel;
    ValueEdit: TEdit;
    OkButton: TButton;
    CancelButton: TButton;
    procedure OkButtonClick(Sender: TObject);
    procedure CanclButtonClick(Sender: TObject);
  private
    { Private declarations }
    function CheckValid: Boolean;

  public
    { Public declarations }
    procedure SetData(Value: Integer);
    procedure GetData(var Value: Integer);

  end;

var
  SetSizeForm: TSetSizeForm;

function ShowSetSizeForm(var Value: Integer; Caption, Msg: string): Boolean;

implementation

uses Global, Misc;

{$R *.DFM}

function ShowSetSizeForm(var Value: Integer; Caption, Msg: string): Boolean;
var
  Frm: TSetSizeForm;
begin
  Frm := TSetSizeForm.Create(Application);
  Frm.SetData(Value);
  Frm.Caption := Caption;
  Frm.PromptLabel.Caption := Msg;
  Result := (Frm.ShowModal = mrOk);
  Frm.GetData(Value);
  Frm.Free;
end;

function TSetSizeForm.CheckValid: Boolean;
var
  Value, R: Integer;
begin
  Result := True;
  if not IsInt(ValueEdit.Text) then
  begin
    MsgBox('输入值不正确，请重新输入！');
    ValueEdit.SelectAll;
    ValueEdit.SetFocus;
    Result := False;
  end else
  begin
    Value := StrToInt(ValueEdit.Text);
    if Value <= 0 then
    begin
      MsgBox('输入值必须大于0，请重新输入！');
      ValueEdit.SelectAll;
      ValueEdit.SetFocus;
      Result := False;
    end
    else if Value >= WarningFileSize then
    begin
      R := MsgBox('您输入的值太大，如果您的电脑虚拟内存不够，将会导致内存溢出错误！' + #13 + '确定吗？',
        MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2);
      if R = ID_NO then Result := False;
    end;
  end;
end;

procedure TSetSizeForm.SetData(Value: Integer);
begin
  ValueEdit.Text := IntToStr(Value);
end;

procedure TSetSizeForm.GetData(var Value: Integer);
begin
  Value := StrToIntDef(ValueEdit.Text, 0);
end;

procedure TSetSizeForm.OkButtonClick(Sender: TObject);
begin
  if not CheckValid then Exit;
  ModalResult := mrOk;
end;

procedure TSetSizeForm.CanclButtonClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

end.