コード補完の実装を実現するには？ (ID:43269)

名前

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

本文

しっかり完動するようにしてあります。
Delphiのコード補完と同じように動作します。
Ctrl+スペースでポップアップします
一応ソースとバイナリのzipも置いておきます。
（リモート操作冤罪事件後なのでバイナリのクリックは覚悟して下さい）
http://studio-fe.hiroishi.org/files/popuplistview.zip

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.StdCtrls,
  UListFrame, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
  private
    FDelimitter:string;
    FDelimitter_Min:Integer;
    FDelimitter_Max:Integer;
    FDelimitter_Len:Integer;

FListFrame:TListFrame;
    FKeywordList:TStringList;
    procedure init;
    procedure GetKeywords(aText:string; aKeywordList:TStringList);
    procedure ShowListFrame(aPos:TPoint);
    procedure FListFrame_OnValue(Sender: TObject);
    procedure WMNcActivate(var msg:TWMNCActivate); message WM_NCACTIVATE;
  public
  end;

const
  delimitter = '.,[]+-/ ^\!&%#|'+#$D#$A; //区切り文字

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SortDelimitterStr(var aText:string);
  function Compare(item1,item2:Pointer):Integer;
  begin
    Result := Integer(item1)-Integer(item2);
  end;
var
  i,len: Integer;
  aList:TList;
begin
  aList := TList.Create;
  len := Length(aText);
  aList.Count := len;
  for i := 1 to len do
    aList.List[i-1]:=Pointer(aText[i]);
  aList.Sort(@Compare);
  for i := 1 to len do
    aText[i] := Char(aList.List[i-1]);
  aList.Free;
end;

//ポップアップされたリストビューをクリックした時のイベント
procedure TForm1.FListFrame_OnValue(Sender: TObject);
begin
  FListFrame.Hide;
  Memo1.SelText := FListFrame.Keyword;
end;

//テキストからキーワードを取得
//デリミッタで挟まれた文字を取得
procedure TForm1.GetKeywords(aText:string; aKeywordList:TStringList);
  function Find(cc:Integer):Boolean;
  var
    p: Integer;
  begin
    Result := True;
    if (FDelimitter_Min<=cc) and (cc<=FDelimitter_Max) then
      for p := 1 to FDelimitter_Len do
        if cc=Integer(FDelimitter[p]) then
          Exit;
    Result := False;
  end;
var
  i,aP,aLen: Integer;
begin
  aKeywordList.Clear;
  aLen := Length(aText);
  aP := 1;
  for i := 1 to aLen do
  begin
    if Find(Integer(aText[i])) then
    begin
      if i<>aP then
        aKeywordList.Add(Copy(aText, aP, i-aP));
      aP := i+1;
    end;
  end;
  if aP <= aLen then
    aKeywordList.Add(Copy(aText, aP, aLen-aP+1));
end;

procedure TForm1.init;
begin
  if FListFrame=nil then
  begin
    //初期化
    FDelimitter := delimitter;
    SortDelimitterStr(FDelimitter);  //デリミッタのソート(検索を早くするため)
    FDelimitter_Len:=Length(FDelimitter);
    FDelimitter_Min:=Integer(FDelimitter[1]);
    FDelimitter_Max:=Integer(FDelimitter[FDelimitter_Len]);
    SortDelimitterStr(FDelimitter);
    //リストビューに並べるキーワードリスト、重複を避けるためソートしてある。
    FKeywordList := TStringList.Create;
    FKeywordList.Clear;
    FKeywordList.Sorted := True;
    FKeywordList.Duplicates := dupIgnore;
    FListFrame := TListFrame.Create(Self);
    FListFrame.fOwnerHandle := Handle;
    FListFrame.OnValue := FListFrame_OnValue;
  end;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
var
  aPos:TPoint;
begin
  //Ctrl + Spaceでリスビューをポップアップ
  if (GetKeyState(VK_CONTROL) < 0) and
     (Key = Char(VK_SPACE)) then
  begin
    GetCaretPos(aPos);
    aPos.Y := aPos.Y + Abs(Memo1.Font.Height);
    aPos := Memo1.ClientToScreen(aPos);
    ShowListFrame(aPos);
    Key := #0;
  end;
end;

procedure TForm1.ShowListFrame(aPos:TPoint);
begin
  //リストビューをポップアップ
  init;
  GetKeywords(Memo1.Text, FKeywordList);
  FListFrame.SetItems(FKeywordList);
  FListFrame.SetBounds(aPos.X,aPos.Y,FListFrame.Width,FListFrame.Height);
  FListFrame.Show;
end;

procedure TForm1.WMNcActivate(var msg: TWMNCActivate);
var
  wInfo :TWindowInfo;
begin
  //子ウィンドウにフォーカスを奪われる対策
  if FListFrame<>nil then
  begin
    wInfo.cbSize :=Sizeof(TWindowInfo);
    GetWindowInfo(FListFrame.Handle, wInfo);
    if wInfo.dwStyle and WS_VISIBLE <> 0 then
      msg.Active := True;
  end;
  inherited;
end;

end.

//-----------------------------------------------------------
unit UListFrame;

interface

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

type
  TListFrame = class(TForm)
    MainMenu1: TMainMenu;
    NHidden: TMenuItem;
    NEsc: TMenuItem;
    ListView1: TListView;
    procedure NEscClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure ListView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListView1Click(Sender: TObject);
  private
    fOnValue: TNotifyEvent;
    { Private 宣言 }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMNcActivate(var msg:TWMNCActivate); message WM_NCACTIVATE;
    function GetKeyword: string;
  public
    { Public 宣言 }
    fOwnerHandle:THandle;
    procedure SetItems(aStrList:TStringList);
    property Keyword:string read GetKeyword;
    property OnValue:TNotifyEvent read fOnValue write fOnValue;
  end;

var
  ListFrame: TListFrame;

implementation

{$R *.dfm}

{ TListFrame }

procedure TListFrame.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_THICKFRAME;
  Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
end;

procedure TListFrame.FormDeactivate(Sender: TObject);
begin
  Hide;
  SendMessage(fOwnerHandle, WM_SETFOCUS, 0,0);
end;

function TListFrame.GetKeyword: string;
begin
  if ListView1.ItemIndex >= 0 then
    Result := ListView1.Items[ListView1.ItemIndex].Caption else
    Result := '';
end;

procedure TListFrame.ListView1Click(Sender: TObject);
begin
  if Assigned(fOnValue) then
    fOnValue(Self);
end;

procedure TListFrame.ListView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
  if Assigned(fOnValue) then
    fOnValue(Self);
end;

procedure TListFrame.NEscClick(Sender: TObject);
begin
  Hide;
end;

procedure TListFrame.SetItems(aStrList: TStringList);
var
  i:Integer;
  aItem:TListItem;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  for i := 0 to aStrList.Count-1 do
  begin
    aItem := ListView1.Items.Add;
    aItem.Caption := aStrList.Strings[i];
  end;
  ListView1.Items.EndUpdate;
end;

procedure TListFrame.WMNcActivate(var msg: TWMNCActivate);
begin
  if msg.Active = False then
  begin
    inherited;
    Hide;
  end else begin
    msg.Active := False;
    inherited;
  end;
end;

end.

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

戻る