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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: 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;

{/codecitation}

Добавить комментарий