Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年10月07日] [更新 2014年11月21日]　Delphi サンプルプログラム集
126_コード補完ウィンドウもどき
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
126_PopUpFormTest.zip　[2,758 KB]　2014年11月21日版 (EXE 同梱)






コード補完ウィンドウもどきのオーバラップなウィンドウ


Delphi のコード補完ウィンドウような機能をテストしたプログラムですが，実際には，単に項目選択用の別フォームを表示するだけのものです．

アプリケーションで，別のフォーム (画面) を表示して設定することはよくありますが，コード補完ウィンドウはポップアップメニューを表示して選択するような感じとなっています．
このようなオーバラップして表示するウィンドウのことをポップアップウィンドウとも言います．

本ページのサンプルは，ポップアップメニューに相当するフォームをキー操作で表示するだけですが，ウィンドウ生成時にフォームのスタイルを変更したり，選択操作の仕様を変更することにより，いろいろな場面で利用可能になるかも知れません．

[127] [15_オーバーラップなウィンドウ] のサンプルは，ポップアップ表示したウィンドウを前面に表示したまま，親フォームにフォーカス移動できます．この方が，どちらかと言えばコード補完ウィンドウに近いかも知れません．
[164_TCalendar を使用した日付ピッカーコンポーネント] もポップアップウィンドウを使用したサンプルです．コンポーネントの内部でフォームを生成して，そのフォームにボタン等のコントロールを配置して表示します．






01_オーバラップなウィンドウを表示


実際のサンプルです．オーバラップなウィンドウを開いている時に，他のアプリケーションがアクティブになって，このプログラムが非アクティブになったらオーバラップなウィンドウを閉じるようにしています．
オーバラップなウインドウを表示している間も，TEditにフォーカス移動して入力ができます．
本サンプルでは，オーバラップなウインドウを表示いる最中にメインフォームを移動しても，オーバラップなウィンドウは移動しません．


図1
設計時画面
  • 下の オーバラップして表示するフォームには TListbox を配置
図2
実行画面
  • Edit1 上 で [Ctrl] + [Space] で表示
  • [Enter] またはダブルクリックで閉じる
  • [ESC] でも閉じるが，選択文字列は挿入しない
  • ウィンドウはリサイズ可能
図3
追加入力
    既入力の最後の位置にウィンドウを表示
図4
追加入力終了

リスト1
メインフォームのユニットのコード 
unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation

uses PopUpFormUnit;

{$R *.dfm}

//=============================================================================
//  OnKeyPressイベント
//  コード補完ウィンドウもどきを[Ctrl]+[Space]で表示
//  OnKeyDownで処理すると，[Space]キー入力が有効となってしまう
//=============================================================================
procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  APos1 : TPoint;
  APos2 : TPoint;
begin
  if (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0 then begin
    if Key = #32 then begin
      Key := #0;
      //現在のキャレット位置を取得
      GetCaretPos(APos1);

      //それをスクリーン座標値に変換
      APos2 := Self.ClientToScreen(APos1);
      PopUpForm.Top  := APos2.Y + Edit1.Top + Abs(Edit1.Height);
      PopUpForm.Left := APos2.X + Edit1.Left;
      PopUpForm.Show;
    end;
  end;
end;

end.


リスト2
オーバラップなウィンドウのコード		 
unit PopUpFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TPopUpForm = class(TForm)
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
  public
    { Public 宣言 }
  end;

var
  PopUpForm: TPopUpForm;

implementation

uses MainFormUnit;

{$R *.dfm}

//=============================================================================
//  このフォームをコード補完ウィンドウのように，オーバラップ表示する
//  ウインドウスタイルは好みに応じて変更する
//
//  WS_POPUPはタイトルバーや枠を持たず，クライアント領域だけのウインドウ
//=============================================================================
procedure TPopUpForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  //このフォームはキャプションバーなしとする
  Params.Style := WS_THICKFRAME or WS_POPUP or WS_BORDER;
  //このフォームは最前面表示とする
  //これがなくても動作に支障はない
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
  //影付きとする
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

//=============================================================================
//  フォームを表示する時の処理
//=============================================================================
procedure TPopUpForm.FormShow(Sender: TObject);
begin
  //テスト用文字列の作成
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;
  ListBox1.Items.Add('東京都');
  ListBox1.Items.Add('大阪府');
  ListBox1.Items.Add('京都府');
  ListBox1.Items.Add('兵庫県');
  ListBox1.Items.Add('西脇市');

  if ListBox1.Items.Count > 0 then begin
    ListBox1.ItemIndex := 0;
  end;
  ListBox1.Items.EndUpdate;
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント
//  [ESC]で閉じる
//  [Enter]で閉じる(リストの項目のダブルクリックと同じ動作とする)
//=============================================================================
procedure TPopUpForm.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then begin
    Close;
  end else
  if (Key = VK_RETURN) then begin
    ListBox1DblClick(nil);
  end;
end;

//=============================================================================
//  ListBox1のOnDblClickイベント
//  選択中の項目をダブルクリックしたら閉じる
//=============================================================================
procedure TPopUpForm.ListBox1DblClick(Sender: TObject);
var
  AIndex : Integer;
begin
  if ListBox1.ItemIndex >= 0 then begin
    AIndex := ListBox1.ItemIndex;
    MainForm.Edit1.Text := MainForm.Edit1.Text + ListBox1.Items[AIndex];
    MainForm.Edit1.SelStart := Length(MainForm.Edit1.Text);
  end;
  Close;
end;

//=============================================================================
//  他のアプリがアクティブになったら閉じる
//  このフォームを表示したフォームも非アクティブにする
//=============================================================================
procedure TPopUpForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    PostMessage(MainForm.Handle, WM_NCACTIVATE, 0, 0);
    Close;
  end;
end;

end.



02_親フォームをアクティブ表示状態でポップアップウィンドウを表示


これ以降のサンプルは，正確な意味でのオーバラップウインドウではありません．単なるポップアップウインドウとなっています．

上のサンプルでは，オーバラップなウィンドウを表示すると，メインフォームが，非アクティブな状態になります．そこで，本サンプルでは，現在，入力中のフォームを視覚的に明確にするために，アクティブと同じ状態にします．つまり「偽アクティブ」にします．
この動作は，親フォームに WM_NCACTIVATE メッセージを送信することにより実現しています．他のアプリがアクティブになったら，表示したポップアップなウインドウを閉じて，親フォームも非アクティブな状態にします．これには，WM_ACTIVATEAPP メッセージを捕捉して検出しています．

上のサンプルでは，メインフォームの Edit1 にフォーカス移動しても，ポップアップしたウィンドウは閉じませんでした．本サンプルでは閉じてしまいます．コード補完ウィンドウのような機能にするには，閉じない条件の処理が必要です．コード補完ウィンドウでは，入力中の行で文字をタイプしても閉じませんが，他の場所をクリックすると閉じます．動作仕様の確認が必要でしょう．



図5
実行画面
  • [Ctrl] + [Space] でウィンドウを表示
  • メインフォームがアクティブな状態
  • 実際にアクティブなのはオーバラップウィンドウ
  • つまり「偽アクティブ」
  • ダブルクリックまたは [Enter], [ESC] で閉じる

リスト3
メインフォームのユニットのコード		 
unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation

uses PopUpFormUnit;

{$R *.dfm}

//=============================================================================
//  OnKeyPressイベント
//  オーバラップウィンドウを[Ctrl]+[Space]で表示
//  OnKeyDownで処理すると，[Space]キー入力が有効となってしまう
//=============================================================================
procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  APos1 : TPoint;
  APos2 : TPoint;
begin
  if (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0 then begin
    if Key = #32 then begin
      Key := #0;
      //現在のキャレット位置を取得
      GetCaretPos(APos1);

      //それをスクリーン座標値に変換
      APos2 := Self.ClientToScreen(APos1);
      PopUpForm.Top  := APos2.Y + Edit1.Top + Abs(Edit1.Height);
      PopUpForm.Left := APos2.X + Edit1.Left;
      PopUpForm.Show;
    end;
  end;
end;

end.


リスト4
変更したポップアップウィンドウのコード		 
unit PopUpFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TPopUpForm = class(TForm)
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1DblClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
  public
    { Public 宣言 }
  end;

var
  PopUpForm: TPopUpForm;

implementation

uses MainFormUnit;

{$R *.dfm}

//=============================================================================
//  このフォームをコード補完ウィンドウのように，オーバラップ表示する
//  ウインドウスタイルは好みに応じて変更する
//
//  WS_POPUPはタイトルバーや枠を持たず，クライアント領域だけのウインドウ
//=============================================================================
procedure TPopUpForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  //このフォームはキャプションバーなしとする
  Params.Style := WS_THICKFRAME or WS_POPUP or WS_BORDER or WS_OVERLAPPED;
  //このフォームは最前面表示とする
  //これがなくても動作に支障はない
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
  //影付きとする
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

//=============================================================================
//  フォームを表示する時の処理
//=============================================================================
procedure TPopUpForm.FormShow(Sender: TObject);
begin
  ListBox1.BorderStyle := bsNone;
  ListBox1.BevelKind   := bkFlat;

  //テスト用文字列の作成
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;
  ListBox1.Items.Add('東京都');
  ListBox1.Items.Add('大阪府');
  ListBox1.Items.Add('京都府');
  ListBox1.Items.Add('兵庫県');
  ListBox1.Items.Add('西脇市');

  if ListBox1.Items.Count > 0 then begin
    ListBox1.ItemIndex := 0;
  end;
  ListBox1.Items.EndUpdate;

  //このフォームを表示したフォームを疑似的にアクティブにする
  PostMessage(MainForm.Handle, WM_NCACTIVATE, 1, 0);
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント
//  [ESC]で閉じる
//  [Enter]で閉じる(リストの項目のダブルクリックと同じ動作とする)
//=============================================================================
procedure TPopUpForm.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then begin
    Close;
  end else
  if (Key = VK_RETURN) then begin
    ListBox1DblClick(nil);
  end;
end;

//=============================================================================
//  ListBox1のOnDblClickイベント
//  選択中の項目をダブルクリックしたら閉じる
//=============================================================================
procedure TPopUpForm.ListBox1DblClick(Sender: TObject);
var
  AIndex : Integer;
begin
  if ListBox1.ItemIndex >= 0 then begin
    AIndex := ListBox1.ItemIndex;
    MainForm.Edit1.Text := MainForm.Edit1.Text + ListBox1.Items[AIndex];
    MainForm.Edit1.SelStart := Length(MainForm.Edit1.Text);
  end;
  Close;
end;

//=============================================================================
//  非アクティブになったら閉じる
//  Edit1にフォーカス移動しても閉じるので，コード補完ウィンドウとは言えない
//  何か閉じないようにする条件の処理が必要
//=============================================================================
procedure TPopUpForm.FormDeactivate(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  他のアプリがアクティブになったら閉じる
//  このフォームを表示したフォームも非アクティブにする
//=============================================================================
procedure TPopUpForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    PostMessage(MainForm.Handle, WM_NCACTIVATE, 0, 0);
    Close;
  end;
end;

end.



03_ポップアップウィンドウのデザインと選択方式を変更


上の 2 つのサンプルは，オーバラップなウィンドウで選択した文字列を，メインフォームの Edit1 に入力済みの文字列の後に挿入しています．
コード補完ウィンドウのように，任意の位置に選択テキスト，文字列を挿入するものでした．

本サンプルは，メインフォームの Edit1 と ポップアップなウィンドウと合わせて，TComboBox のような動作仕様としたものです．起動時に指定した項目を Edit1 に表示し，選択中の項目も Edit に常に表示します．また，選択した文字列だけをメインフォームの Edit1 に入力します．
上のサンプルから修正したのはポップアップ表示するフォーム側のコードだけです．

このサンプルのポップアップウィンドウは，リサイズはできないようにしています．リサイズ用の枠はありません．リサイズ用の枠がないウィンドウはリサイズできないのが，Windows の作法です．


図6
実行画面
  • [Ctrl] + [Space] でウインドウを表示
  • 選択した項目の文字列だけを Edit1 にセット
  • ダブルクリックまたは [Enter],[ESC] で閉じる

リスト5
メインフォームのユニットのコード		 
unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation

uses PopUpFormUnit;

{$R *.dfm}

//=============================================================================
//  OnKeyPressイベント
//  オーバラップウィンドウを[Ctrl]+[Space]で表示
//  OnKeyDownで処理すると，[Space]キー入力が有効となってしまう
//=============================================================================
procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  APos1 : TPoint;
  APos2 : TPoint;
begin
  if (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0 then begin
    if Key = #32 then begin
      Key := #0;
      //現在のキャレット位置を取得
      GetCaretPos(APos1);

      //それをスクリーン座標値に変換
      APos2 := Self.ClientToScreen(APos1);
      PopUpForm.Top  := APos2.Y + Edit1.Top + Abs(Edit1.Height);
      PopUpForm.Left := APos2.X + Edit1.Left;
      PopUpForm.Show;
    end;
  end;
end;

end.


リスト6
変更したオーバラップなウィンドウのコード		 
unit PopUpFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TPopUpForm = class(TForm)
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMShowingchanged(var Message: TMessage);
      message CM_SHOWINGCHANGED;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
  public
    { Public 宣言 }
  end;

var
  PopUpForm: TPopUpForm;

implementation

uses MainFormUnit;

{$R *.dfm}

//=============================================================================
//  このフォームをコード補完ウィンドウのように，オーバーラップ表示する
//  ウインドウスタイルは好みに応じて変更する
//
//  WS_POPUPはタイトルバーやリサイズ枠を持たず，クライアント領域だけのウインドウ
//=============================================================================
procedure TPopUpForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  //このフォームはキャプションバーなしとしてWS_THICKFRAMEも除外
  Params.Style := WS_POPUP or WS_BORDER;
  //このフォームは最前面表示とする
  //これがなくても動作に支障はない
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
  //影付きとする
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

//=============================================================================
//  フォームを表示する時の処理
//=============================================================================
procedure TPopUpForm.FormShow(Sender: TObject);
begin
  ListBox1.BorderStyle := bsNone;
  ListBox1.BevelKind   := bkFlat;

  //テスト用文字列の作成
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;
  ListBox1.Items.Add('東京都');
  ListBox1.Items.Add('埼玉県');
  ListBox1.Items.Add('神奈川県');
  ListBox1.Items.Add('群馬県');
  ListBox1.Items.Add('栃木県');
  ListBox1.Items.Add('茨城県');
  ListBox1.Items.Add('千葉県');
  ListBox1.Items.Add('長野県');
  ListBox1.Items.Add('山梨県');
  ListBox1.Items.Add('岐阜県');
  ListBox1.Items.Add('新潟県');
  ListBox1.Items.Add('福島県');
  ListBox1.Items.Add('山形県');
  ListBox1.Items.Add('岩手県');
  ListBox1.Items.Add('青森県');
  ListBox1.Items.Add('沖縄県');
  ListBox1.Items.Add('京都府');
  ListBox1.Items.Add('大阪府');

  if ListBox1.Items.Count > 0 then begin
    if MainForm.Edit1.Text <> '' then begin
      ListBox1.ItemIndex := ListBox1.Items.IndexOf(MainForm.Edit1.Text);
    end else begin
      ListBox1.ItemIndex := 0;
    end;
  end;
  ListBox1.Items.EndUpdate;

  //このフォームを表示したフォームを疑似的にアクティブにする
  PostMessage(MainForm.Handle, WM_NCACTIVATE, 1, 0);
end;

//=============================================================================
//  CM_SHOWINGCHANGEDメッセージ処理
//  フォームが表示されたらListBox1にフォーカス移動
//=============================================================================
procedure TPopUpForm.CMShowingchanged(var Message: TMessage);
begin
  inherited;

  if Visible then begin
    ListBox1.SetFocus;
  end;
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント
//  [ESC]で閉じる
//  [Enter]で閉じる(リストの項目のダブルクリックと同じ動作とする)
//=============================================================================
procedure TPopUpForm.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then begin
    Close;
  end else
  if (Key = VK_RETURN) then begin
    ListBox1DblClick(nil);
  end;
end;

//=============================================================================
//  ListBox1のOnDblClickイベント
//  選択中の項目をダブルクリックしたら閉じる
//=============================================================================
procedure TPopUpForm.ListBox1DblClick(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex >= 0 then begin
    MainForm.Edit1.SelStart := Length(MainForm.Edit1.Text);
  end;
  Close;
end;

//=============================================================================
//  ListBox1のOnClickイベント
//  選択中の項目をメインフォームのEditに表示する
//=============================================================================
procedure TPopUpForm.ListBox1Click(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex >= 0 then begin
    MainForm.Edit1.Text := ListBox1.Items[AIndex];
  end;
end;

//=============================================================================
//  非アクティブになったら閉じる
//=============================================================================
procedure TPopUpForm.FormDeactivate(Sender: TObject);
begin
  ListBox1DblClick(nil);
end;

//=============================================================================
//  他のアプリがアクティブになったら閉じる
//  このフォームを表示したフォームも非アクティブにする
//=============================================================================
procedure TPopUpForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    PostMessage(MainForm.Handle, WM_NCACTIVATE, 0, 0);
    Close;
  end;
end;

end.



04_ポップアップウィンドウのコードを汎用的にする


ここまでのサンプルでは，オーバラップな，あるいはポップアップウインドウのコードにメインフォームのユニットを uses していました．
この方法だと，他のフォームから表示する時に変更が必要となります．そこで，本サンプルでは，別のフォームからも表示できるような，汎用的なコードにしてみました．

ポップアップウインドウをコンポーネントのように利用します．フォーム自身をコンポーネントにすることはできません．そこで，ポップアップウインドウ内のイベントのコードを呼出側のフォームのコードに記述します．
この方法は，実行時にコンポーネントを (動的に) 生成し，そのコンポーネントのイベントを利用する方法と同じです．したがって，呼出側で設定したイベントは，ポップアップフォーム内で設定しても無効となり，機能しません．

本サンプルでは，ポップアップ表示するフォームをプロジェクトに追加して使用しています．プロジェクトに追加しないで使用するには，実行時にそのフォームを生成する必要があります．



図7
実行画面
  • [Ctrl] + [Space] でウインドウを表示
  • 選択した項目の文字列だけを Edit1 にセット
  • ダブルクリックまたは [Enter],[ESC] で閉じる

リスト7
メインフォームのユニットのコード		 
unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private 宣言 }
    procedure OnPopUpFormListBox1DblClickEvent(Sender: TObject);
    procedure OnPopUpFormListBox1ClickEvent(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation

uses PopUpFormUnit;

{$R *.dfm}

//=============================================================================
//  OnKeyPressイベント
//  オーバラップウィンドウを[Ctrl]+[Space]で表示
//  OnKeyDownで処理すると，[Space]キー入力が有効となってしまう
//=============================================================================
procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  APos1 : TPoint;
  APos2 : TPoint;
begin
  if (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0 then begin
    if Key = #32 then begin
      Key := #0;

      //表示位置をスクリーン座標値に変換
      APos2 := Self.ClientToScreen(Point(Edit1.Left, Edit1.Top + Edit1.Height));
      PopUpForm.Top  := APos2.Y;
      PopUpForm.Left := APos2.X;

      //PopUpForm内のコントロールのイベントを設定
      PopUpForm.ListBox1.OnDblClick := OnPopUpFormListBox1DblClickEvent;
      PopUpForm.ListBox1.OnClick    := OnPopUpFormListBox1ClickEvent;

      //PopUpFormのListBox1のリストを作成する
      //リストの項目が固定ならば，PopUpForm内で設定してもよい
      with PopUpForm.ListBox1 do begin
        BorderStyle := bsNone;
        BevelKind   := bkFlat;
        //テスト用文字列の作成
        Items.BeginUpdate;
        Items.Clear;
        Items.Add('東京都');
        Items.Add('埼玉県');
        Items.Add('神奈川県');
        Items.Add('群馬県');
        Items.Add('栃木県');
        Items.Add('茨城県');
        Items.Add('千葉県');
        Items.Add('長野県');
        Items.Add('山梨県');
        Items.Add('岐阜県');
        Items.Add('新潟県');
        Items.Add('福島県');
        Items.Add('山形県');
        Items.Add('岩手県');
        Items.Add('青森県');
        Items.Add('沖縄県');
        Items.Add('京都府');
        Items.Add('大阪府');
        if Items.Count > 0 then begin
          if Edit1.Text <> '' then begin
            ItemIndex := Items.IndexOf(Edit1.Text);
          end else begin
            ItemIndex := 0;
          end;
        end;
        Items.EndUpdate;
      end;

      //PopUpFormを表示
      PopUpForm.Show;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  PopUpFormのListBox1をクリックした時のイベント処理
//  このイベントを設定しているので，PopUpForm内でListBox1のイベントコードを
//  実行しても無効となる
//-----------------------------------------------------------------------------
procedure TMainForm.OnPopUpFormListBox1ClickEvent(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := PopUpForm.ListBox1.ItemIndex;
  if AIndex >= 0 then begin
    Edit1.Text := PopUpForm.ListBox1.Items[AIndex];
  end;
end;

//-----------------------------------------------------------------------------
//  PopUpFormのListBox1をダブルクリックした時のイベント処理
//  このイベントを設定しているので，PopUpForm内でListBox1のイベントコードを
//  実行しても無効となる
//-----------------------------------------------------------------------------
procedure TMainForm.OnPopUpFormListBox1DblClickEvent(Sender: TObject);
var
  AIndex : Integer;
begin
  AIndex := PopUpForm.ListBox1.ItemIndex;
  if AIndex >= 0 then begin
    Edit1.SelStart := Length(Edit1.Text);
  end;
  PopUpForm.Close;
end;

end.

リスト8
変更したオーバラップなウィンドウのコード
メインフォームのユニットは使用していない		 
unit PopUpFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TPopUpForm = class(TForm)
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDeactivate(Sender: TObject);
  private
    { Private 宣言 }
    FhActivePrevForm : HWND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMShowingchanged(var Message: TMessage);
      message CM_SHOWINGCHANGED;
    procedure WMActivateApp(var Message: TWMActivateApp);
      message WM_ACTIVATEAPP;
  public
    { Public 宣言 }
  end;

var
  PopUpForm: TPopUpForm;

implementation

{$R *.dfm}

//=============================================================================
//  このフォームをコード補完ウィンドウのように，オーバーラップ表示する
//  ウインドウスタイルは好みに応じて変更する
//
//  WS_POPUPはタイトルバーやリサイズ枠を持たず，クライアント領域だけのウインドウ
//=============================================================================
procedure TPopUpForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  //このフォームはキャプションバーなしとしてWS_THICKFRAMEも除外
  Params.Style := WS_POPUP or WS_BORDER;
  //このフォームは最前面表示とする
  //これがなくても動作に支障はない
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
  //影付きとする
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

//=============================================================================
//  フォームを表示する時の処理
//=============================================================================
procedure TPopUpForm.FormShow(Sender: TObject);
begin
  //直前にアクティブだったフォームのハンドルを取得
  FhActivePrevForm := Application.ActiveFormHandle;

  //このフォームを表示したフォームを疑似的にアクティブにする
  if FhActivePrevForm <> 0 then begin
    PostMessage(FhActivePrevForm, WM_NCACTIVATE, 1, 0);
  end;
end;

//=============================================================================
//  CM_SHOWINGCHANGEDメッセージ処理
//  フォームが表示されたらListBox1にフォーカス移動
//=============================================================================
procedure TPopUpForm.CMShowingchanged(var Message: TMessage);
begin
  inherited;

  if Visible then begin
    ListBox1.SetFocus;
  end;
end;

//=============================================================================
//  ListBox1のOnKeyDownイベント
//  [ESC]で閉じる
//  [Enter]で閉じる(リストの項目のダブルクリックと同じ動作とする)
//=============================================================================
procedure TPopUpForm.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then begin
    Close;
  end else
  if (Key = VK_RETURN) then begin
    Close;
  end;
end;

//=============================================================================
//  非アクティブになったら閉じる
//=============================================================================
procedure TPopUpForm.FormDeactivate(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  他のアプリがアクティブになったら閉じる
//  このフォームを表示したフォームも非アクティブにする
//=============================================================================
procedure TPopUpForm.WMActivateApp(var Message: TWMActivateApp);
begin
  inherited;
  if Visible then begin
    if FhActivePrevForm <> 0 then begin
      PostMessage(FhActivePrevForm, WM_NCACTIVATE, 0, 0);
    end;
    Close;
  end;
end;

end.



05_ポップアップウィンドウの選択行の背景色を変更する


TListBox の選択行の背景色を変更するには，TListBox の DrawItem イベントを実装します．DrawItem イベントを実装すると，背景色もテキストの描画も全て自前での処理になります．

このサンプルでは，TListBox のテキストの行間を調整するために，ポップアップウィンドウを使用する側のプログラムで以下のコードを実行しています．Style プロパティの値を lbOwnerDrawFixed にすると，行の高さである ItemHeight の値が有効になることを利用しています．

 

    // Item の描画高さ (行間) を変更するために Style の値を変更
    LHeight := Trunc(PopUpForm.ListBox1.Canvas.TextHeight('Hg') * 1.4);
    PopUpForm.ListBox1.Style := lbOwnerDrawFixed;
    PopUpForm.ListBox1.ItemHeight := LHeight;


図8
カスタム描画した TListBox
  • 選択中の行の背景色を変更
  • [Ctrl] + [Space] でウインドウを表示
  • 選択した項目の文字列だけを Edit1 にセット
  • ダブルクリックまたは [Enter],[ESC] で閉じる
図9
フォーカスの枠線を表示ない場合
  • フォーカスの枠線を，背景を塗り潰した色で重ね描画した結果

リスト9
ポップアップウィンドウの TListBox で選択行の背景色を変更		 
//=============================================================================
//  TListBox の OnDropListDrawItem イベント処理
//
//  DrawItem イベントを使用する場合は，全ての描画を自前で処理する必要がある
//  たたじフォーカスの枠線は描画してくれる (非表示状態にすることも可能)
//=============================================================================
procedure TPopUpForm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  LRect    : TRect;
  LFormat  : TTextFormat;
  LItemText : string;
begin
  if odSelected in State then begin
    ListBox1.Canvas.Brush.Color := $00FFD2A6;
  end else begin
    ListBox1.Canvas.Brush.Color := ListBox1.Color;
  end;
  ListBox1.Canvas.FillRect(Rect);

  LRect := Rect;
  LRect.Left := LRect.Left + 5;
  LFormat    := [tfLeft, tfVerticalCenter, tfSingleLine];
  LItemText  := ListBox1.Items[Index];
  ListBox1.Canvas.Font.Color := clBlack;
  ListBox1.Canvas.TextRect(LRect, LItemText, LFormat);

  // 以下を実行するとフォーカスの枠線を非表示と同じ状態にできる
  if odFocused in State then begin
//    ListBox1.Canvas.DrawFocusRect(Rect);
  end;
end;