新規フォームをアクティブにせずに表示するには (ID:35819)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ListBox 一個で済むものであれば・・・

type
  TPopupList=class(TListBox)
  private
    FCursorIndex: Integer;
  public
    constructor Create(AOwner: TComponent); override;
  protected
    procedure CreateWnd; override;
    procedure CreateParams(var Params:TCreateParams);override;
    procedure Click; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  end;

constructor TPopupList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Height := ItemHeight * 6 + BorderWidth * 2;
end;

procedure TPopupList.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW;
end;

procedure TPopupList.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;

procedure TPopupList.Click;
begin
  inherited Click;
  Hide;
end;

procedure TPopupList.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  newIdx: Integer;
begin
  newIdx := ItemAtPos(Point(X,Y), True);

if (newIdx <> FCursorIndex) then begin
    Itemindex := newIdx;
    FCursorIndex := newIdx;
    Repaint;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  pl:TPopupList;
  p:TPoint;
  itm: TListItem;
begin
  p := ClientToScreen(Point(Button1.Left + Button1.Width, Button1.Top + Button1.Height));
  pl := TPopupList.Create(Self);
  pl.Parent := Self;
  pl.Items.Assign(Memo1.Lines);
  pl.OnClick := ListBoxClick;
  pl.Left := p.X;
  pl.Top := p.Y;
  pl.Show;
end;
procedure TForm1.ListBoxClick(Sender: TObject);
begin
  if Sender is TListBox then begin
    if TListBox(Sender).ItemIndex >= 0 then
      Edit1.Text := TListBox(Sender).Items[TListBox(Sender).ItemIndex]
    else
      Edit1.Text := '未選択';
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る