Центрирование InputQuery диалога над формой

Delphi , Программа и Интерфейс , Диалоги и Фреймы

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

// 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;

Статья Центрирование InputQuery диалога над формой раздела Программа и Интерфейс Диалоги и Фреймы может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Диалоги и Фреймы ::