.InputQueryのポップアップ位置

解決

かめ 2009-09-08 23:02:00 No: 35613

.InputQueryのポップアップ位置を任意に変えたいのですが、方法が解りません。
Dialogs.ShowMessagePos()に相当する物を探しましたが、見つかりません。
ご存じの方は教えて下さい。

Fusa 2009-09-09 11:07:10 No: 35614

http://leed.issp.u-tokyo.ac.jp/~takeuchi/delphi/browse.cgi?index=051863&back=http%3A%2F%2Fleed.issp.u-tokyo.ac.jp%2F~takeuchi%2Fdelphi%2Farticle%2F051%2F051863.html

ここを読むと、難しそうですね。

OpenDialogならばできるようですが

OpenDialog の表示位置
http://www2.big.or.jp/~osamu/Delphi/delphi-browse.cgi?index=012600
http://www2.big.or.jp/~osamu/Delphi/delphi-browse.cgi?index=017797

自作した方がよさそうです。

かめ 2009-09-09 15:41:18 No: 35615

WindowsAPIのラッパーかなと思っていたんですが、VCLだったんですね。
ソース見たら数十行の関数でした。これを元にInputQueryPos()作りたいと思います。
出来ないと解ってスッキリしました。ありがとうございました。

かめ 2009-09-09 16:27:30 No: 35616

// マウスカーソル近くにポップアップするInputQuery
// ものぐさユーザー対応版

function InputQueryNear(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  pt : TPoint;

  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;

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);
      Position := poDefaultPosOnly; // poScreenCenter;

      // 位置補正
      GetCursorPos(pt);
      if Screen.Width < (pt.x+Width) then pt.x := (Screen.Width-Width-10);
      if Screen.Height < (pt.y+Height) then pt.y := (Screen.Height-Height-10);
      Left := pt.X;
      Top := pt.Y;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'OK';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := 'Cancel';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

ものぐさユーザ 2009-09-09 21:37:46 No: 35617

どうせ"ものぐさ"ならば、コード量も少ない方が…
procedure WMApp(var Msg: TMessage); message WM_APP;
.....
procedure TForm1.WMApp(var Msg: TMessage);
var
  hW: HWND;
  R: TRect;
  x, y: Integer;
  P: TPoint;
begin
  hW := FindWindow('TForm', nil);
  if hW = 0 then exit;
  GetCursorPos(P);
  x := P.X;  // 任意
  y := P.Y;  // 任意
  // はみ出したら位置補正
  GetWindowRect(hW, R);
  if Screen.Width < (x+R.Right-R.Left) then x := (Screen.Width-R.Right+R.Left);
  if Screen.Height < (y+R.Bottom-R.Top) then y := (Screen.Height-R.Bottom+R.Top);
  // 位置セット
  SetWindowPos(hW, 0, x, y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  DefStr: string;
begin
  PostMessage(Handle, WM_APP, 0, 0);
  DefStr := 'ほげほげ';
  InputQuery('Input Box', '文字入力', DefStr);
end;