環境は、XP SP3, TurboDelphi(無償版)です。
コード補完で悩んでいます。
以下を参考にしました。
https://www.petitmonte.com/bbs/answers?question_id=7498
判らない点は、
1.生成したリストボックスの消し方が判らない、
2.リストボックスへの文字列の代入が判らない、
と言う点で悩んでいます。
久々の質問ですが、ご教示よろしくお願いします。
以下が、ソースです。
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
Listmnu: integer;
begin
if key = char(46) then begin
with form1.GroupBox1 do begin
left := mx;
Color := form1.RichEdit1.Color;
top := my;
height := 202;
width := 202;
visible := true;
tag := 1;
end;
Listmnu := CreateWindowW(
'listbox',
nil,
WS_CHILD
or ES_MULTILINE
or WS_VISIBLE,
mx, //Left mouseMoveから代入
my, //Top
200, //Width
200, //Height
Handle, //親ウィンドウ
0,
0,
nil
);
if key = char(27) then
//フォントのセット
if (Listmnu <> 0) then begin
SendMessageW(Listmnu, WM_SETFONT, WPARAM(GetStockObject(DEFAULT_GUI_FONT)), 0);
end;
end;
end;
単にTListBoxを動的生成するのではだめ?
あさん、ありがとうございます。
思い切り、忘れてました(笑)。
最も単純な方法で、1,2は難なく達成しました。
現在は、そのリストの元となる文字列を切り出す方法で悩んでいます。
https://www.petitmonte.com/bbs/answers?question_id=3328
上記を参考に色々試していますが、
記号や空白でリストアップの文字列を切り出せずにいます。
やっぱり、一文字ずつ検索をかけてチェックするしかないのでしょうか?
文字列検索はそれなりにアルゴリズムがありますので、
速度を重視するなら目的を絞らなくてはなりません。
それでも、基本的な文字列検索の原理を知っておかないと取っ掛かりすらつかめないかと思います。
ちなみにどんなアルゴリズムでも一文字ずつ検索ですよ。
前スレで標準関数で2,3行でとありますが、
その意気込みであれば正規表現が最適だと思います。
monaaさん、アドバイスありがとうございます。
一応、気合いで下記の状態まで書いてみました。
現状では、メモから、全ての単語をリストアップする仕様まで、
書いてみました。が、一行目までしか正常動作せず…。
何が原因でしょうか??
ご教示よろしくお願いしますm(__)m。
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
fs,fa,s:string;
i,i1,ans1,loop:integer;
sar:array[0..50] of string;
sset:array[0..14] of string;
begin
sset[0] := '.';
sset[1] := ',';
sset[2] := '[';
sset[3] := ']';
sset[4] := '+';
sset[5] := '-';
sset[6] := '/';
sset[7] := ' ';
sset[8] := '^';
sset[9] := '\';
sset[10] := '!';
sset[11] := '&';
sset[12] := '%';
sset[13] := '#';
sset[14] := '|';
with form1.listbox1 do begin
if key = char(46) then begin
panel1.Visible := true;
form1.ActiveControl := edit1;
items.Clear;
panel1.left := mx;
panel1.top := my;
tag := 1;
i1 := 0;
loop := 0;
listbox1.Items.Add('');
end;
if panel1.visible = true then begin
i := 0;
while 14 > loop do begin
s := sset[loop];
while form1.RichEdit1.Lines.Count > i do begin
i1 := 0;
ans1 := ansipos(sset[loop],form1.RichEdit1.Lines[i]);
if ans1 <> -1 then begin
fs := form1.RichEdit1.Lines[i];
while ans1 > i1 do begin
sar[i1] := fs[i1];
listbox1.Items[i] := listbox1.Items[i] + sar[i1];
i1 := i1 + 1;
end;
//listbox1.Items[i] := fs;
tag := 0;
s := '';
end;
i := i + 1;
end;
loop := loop + 1;
end;
end;
if (key = char(27)) or (key = char(13)) then begin
items.Clear;
panel1.visible := false;
exit;
end;
end;
end;
ごめ、読めないです。
日本語訳お願いします。
ご指摘ありがとうございます。
すいません、整理したら、きちんと動きました(汗)。
取り敢えず、単語は無条件で登録する状態にしてあります。
ここから、検索をかけて、絞り込む仕様にする予定です。
何とか、なりそうです。
以下が、そのコードです。
リストは、パネルにエディットコントロール、リストボックスを置いて、
即席で作り込みました。
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
fs,s:string;
i,i1,ans1,loop:integer;
sary:array[0..50] of string;
sset:array[0..14] of string;
begin
sset[0] := '.';
sset[1] := ',';
sset[2] := '[';
sset[3] := ']';
sset[4] := '+';
sset[5] := '-';
sset[6] := '/';
sset[7] := ' ';
sset[8] := '^';
sset[9] := '\';
sset[10] := '!';
sset[11] := '&';
sset[12] := '%';
sset[13] := '#';
sset[14] := '|';
//リストボックスを表示
with form1.listbox1 do begin
if key = char(46) then begin
panel1.Visible := true;
form1.ActiveControl := edit1;
items.Clear;
panel1.left := mx;//マウス座標を代入
panel1.top := my;
tag := 1;
end;
//もし、リストボックスが表示されたなら
if panel1.visible = true then begin
loop := 0;
//単語区切り文字を検出して、単語切り取りポイントを記録
while 14 > loop do begin
i := 0;
listbox1.Items.Add('');
//メモを一行ずつ、AnsiPosで検索
while form1.RichEdit1.Lines.Count > i do begin
i1 := 0;
ans1 := ansipos(sset[loop],form1.RichEdit1.Lines[i]);
//ヒットした単語を全て登録
if ans1 <> -1 then begin
fs := form1.RichEdit1.Lines[i];
//リストに登録
while ans1 > i1 do begin
sary[i1] := fs[i1];
listbox1.Items[i] := listbox1.Items[i] + sary[i1];
i1 := i1 + 1;
end;
tag := 0;
s := '';
end;
i := i + 1;
end;
loop := loop + 1;
end;
end;
//もし、リターンキー又はエスケープが押されたならば、キャンセル
if (key = char(27)) or (key = char(13)) then begin
items.Clear;
panel1.visible := false;
exit;
end;
end;
end;
しっかり完動するようにしてあります。
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.
monnaさん、ポップアップリストビュー、わざわざありがとうございますm(__)m。
色々と参考にしてみます。
こちらでも、まだバグありですが、何とか動作確認までいけました。
試作で作った即席コード補完です。
色々と勉強になった次第です^^。
以下、こちらの試作版ソースです。
リッチエディット、パネル上にラインエディットとリストボックスを配置し、
マウスカーソル位置にパネルが「.」で出現します。
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
fs,s,findItem:string;
i,i1,i2,ans1,ans2,loop:integer;
sary:array[0..50] of string;
sset:array[0..14] of string;
begin
sset[0] := '.';
sset[1] := ',';
sset[2] := '[';
sset[3] := ']';
sset[4] := '+';
sset[5] := '-';
sset[6] := '/';
sset[7] := ' ';
sset[8] := '^';
sset[9] := '\';
sset[10] := '!';
sset[11] := '&';
sset[12] := '%';
sset[13] := '#';
sset[14] := '|';
//リストボックスを表示
with form1.listbox1 do begin
if key = char(46) then begin
panel1.Visible := true;
form1.ActiveControl := edit1;
items.Clear;
panel1.left := mx;//マウス座標を代入
panel1.top := my;
tag := 1;
end;
//もし、リストボックスが表示されたなら
if panel1.visible = true then begin
listbox1.Items.Clear;
loop := 0;
//単語区切り文字を検出して、単語切り取りポイントを記録
while 14 > loop do begin
i := 0;
//メモを一行ずつ、AnsiPosで検索
while form1.RichEdit1.Lines.Count > i do begin
i1 := 0;
ans1 := ansipos(sset[loop],form1.RichEdit1.Lines[i]);
//ヒットした単語を全て登録
if ans1 <> -1 then begin
fs := form1.RichEdit1.Lines[i];
//リストに登録
//単語を抽出、結合
findItem := '';
while ans1 > i1 do begin
sary[i1] := fs[i1];
findItem := findItem + sary[i1];
i1 := i1 + 1;
end;
i1 := 0;
//もし、リストが重複してなければ登録
if -1 = form1.ListBox1.Items.IndexOf(findItem) then begin
listbox1.Items.Add('');//一覧表示後、再登録している。初期化の必要あり
while ans1 > i1 do begin
sary[i1] := fs[i1];
listbox1.Items[i] := listbox1.Items[i] + sary[i1];
if -1 <> ansipos(edit1.Text,form1.RichEdit1.Lines[i]) then begin
//ここに、検索アルゴリズムを加える。
//
end else begin
end;
i1 := i1 + 1;
end;
end;
tag := 0;
s := '';
end;
i := i + 1;
end;
loop := loop + 1;
end;
end;
//もし、リターンキー又はエスケープが押されたならば、キャンセル
if (key = char(27)) or (key = char(13)) then begin
items.Clear;
panel1.visible := false;
exit;
end;
end;
listbox1.Items.SaveToFile( ExtractFilePath( Paramstr(0) ) + 'list.txt' );
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
i,i1:integer;
begin
i := 0;
listbox1.Items.LoadFromFile( ExtractFilePath( Paramstr(0) ) + 'list.txt' );
while listbox1.Items.Count > i do begin
i1 := ansipos(key,listbox1.Items[i]);
if i1 <> 0 then begin
i := i + 1;
end else begin
listbox1.Items.Delete(i);
end;
//if key = char(8) then
end;
if (key = char(27)) or (key = char(13)) then begin
listbox1.items.Clear;
panel1.visible := false;
exit;
end;
end;
ツイート | ![]() |