fmyinputbox.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit fMyInputBox;

interface

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

type Taoc = array of Char;

function MyInputBox(const ACaption, APrompt, ADefault, AMask: string;
  disallowedChars: array of Char): String; forward;
function InputComment(const ACaption, APrompt, ADefault: string): String; forward;
function InputPassword(const ACaption, APrompt, ADefault: string;
  pwdChar: Char): String; forward;

type
  TfrmMIB = class(TForm)
    lblDescr: TLabel;
    cmdOK: TButton;
    cmdCancel: TButton;
    txtResult: TMaskEdit;
    txtLarge: TMemo;
    procedure txtResultKeyPress(Sender: TObject; var Key: Char);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure cmdOKClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FdissChars: array of char;
    FstrDissChars: String;
    FCancled: Boolean;
  public
    { Public declarations }
  end;


var
  frmMIB: TfrmMIB;

implementation

{$R *.dfm}

uses
 gnugettext, defFldrs;

{ TfrmMIB }

function MyInputBox(const ACaption, APrompt, ADefault,
  AMask: string; disallowedChars: array of Char): String;
var i: Integer;
begin
  with frmMIB do begin
    FstrDissChars := '';
    SetLength(FdissChars, Length(disallowedChars));
    for i := 0 to High(disallowedChars) do begin
      FdissChars[i] := disallowedChars[i];
      if i <> High(disallowedChars) then
        FstrDissChars := FstrDissChars + disallowedChars[i] + ','
      else FstrDissChars := FstrDissChars + disallowedChars[i];
    end;

    Caption := ACaption;
    lblDescr.Caption := APrompt;
    txtResult.EditMask := AMask;
    txtResult.Text := ADefault;
    txtResult.Visible := True;
    txtResult.PasswordChar := #0;
    ShowModal;
    if FCancled then Result := ADefault
    else Result := txtResult.Text;
    FdissChars := nil;
  end;
end;

function InputComment(const ACaption, APrompt, ADefault: string): String;
begin
  with frmMIB do begin
    Caption := ACaption;
    lblDescr.Caption := APrompt;
    txtLarge.Text := ADefault;
    txtLarge.Visible := True;
    ShowModal;
    if FCancled then Result := ADefault
    else Result := txtLarge.Text;
  end;
end;

function InputPassword(const ACaption, APrompt, ADefault: string; pwdChar: Char): String;
begin
  with frmMIB do begin
    Caption := ACaption;
    lblDescr.Caption := APrompt;
    txtResult.EditMask := '';
    txtResult.Text := ADefault;
    txtResult.PasswordChar := pwdChar;
    txtResult.Visible := True;
    ShowModal;
    if FCancled then Result := ADefault
    else Result := txtResult.Text;
  end;
end;

procedure TfrmMIB.txtResultKeyPress(Sender: TObject; var Key: Char);
var i: Integer;
begin
  if Key = #13 then begin cmdOKClick(Self); exit; end;
  for i := 0 to High(FdissChars) do begin
    if Key = FdissChars[i] then begin
      MessageDlg(Format(_('Use of following characters is disallowed:' +
        #13#10 + '%s'), [FstrDissChars]), mtError, [mbOK], 0);
      Key := #0;
      break;
    end;
  end;

end;

procedure TfrmMIB.cmdCancelClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmMIB.FormShow(Sender: TObject);
begin
  //translate me
  TranslateComponent(Self);

  FCancled := True;
  Self.SetFocus;
end;

procedure TfrmMIB.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
  if msg.CharCode = 27 then begin
    Self.Close;
    Handled := True;
  end;
end;

procedure TfrmMIB.cmdOKClick(Sender: TObject);
begin
  FCancled := False;
  Self.Close;
end;

procedure TfrmMIB.FormActivate(Sender: TObject);
begin
  if txtResult.Visible then Self.txtResult.SetFocus
  else if txtLarge.Visible then Self.txtLarge.SetFocus;

  Application.ProcessMessages;
end;

procedure TfrmMIB.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  txtLarge.Visible := False;
  txtResult.Visible := False;
end;

procedure TfrmMIB.FormCreate(Sender: TObject);
var t, l: Integer;
begin
  //center form
  t := (Screen.Height div 2) - (Self.Height div 2);
  l := (Screen.Width div 2) - (Self.Width div 2);

  Self.Top := t;
  Self.Left := l;
end;

end.