Tips (1541)

Tip Bewertung (10):

// I borrowed the code from InputQuery and
// added the stuff to center the InputQuery
// form on top of another form instead of
// positioning it in the middle of the screen.


// Dieser Code positioniert die Input Box in die
// Mitte der Form und nicht in die Mitte des
// Bildschirms.

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function MyInputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean; overload;
const  
  SMsgDlgOK = 'OK';
  SMsgDlgCancel = 'Cancel';
var
  x, y, w, h: Integer;
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form   := TForm.Create(Application);
  with Form do
    try
      Canvas.Font  := Font;
      DialogUnits  := GetAveCharSize(Canvas);
      BorderStyle  := bsDialog;
      Caption      := ACaption;
      ClientWidth  := MulDiv(180, DialogUnits.X, 4);
      ClientHeight := MulDiv(63, DialogUnits.Y, 8);

      // center Horzontally
      w := (Form1.Width - Form.Width) div 2;
      X := Form1.Left + W;
      if x < 0 then
        x := 0
      else if x + w > Screen.Width then x := Screen.Width - Form.Width;
      Form.Left := X;

      // center vertically
      h := (Form1.Height - Form.Height) div 2;
      y := Form1.Top + h;
      if y < 0 then
        y := 0
      else if y + h > Screen.Height then y := Screen.Height - Form.Height; 
      Form.Left := X;
      Form.Top  := Y;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent   := Form;
        AutoSize := True;
        Left     := MulDiv(8, DialogUnits.X, 4);
        Top      := MulDiv(8, DialogUnits.Y, 8);
        Caption  := APrompt;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent    := Form;
        Left      := Prompt.Left;
        Top       := MulDiv(19, DialogUnits.Y, 8);
        Width     := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text      := Value;
        SelectAll;
      end;
      ButtonTop    := MulDiv(41, DialogUnits.Y, 8);
      ButtonWidth  := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent      := Form;
        Caption     := SMsgDlgOK;
        ModalResult := mrOk;
        default     := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent      := Form;
        Caption     := SMsgDlgCancel;
        ModalResult := mrCancel;
        Cancel      := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;

      if ShowModal = mrOk then
      begin
        Value  := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  str: string;
begin
  if MyInputQuery('Question', 'Whats your name ?', str) then
    label1.Caption := str;
end;