TMemo控件中关于字符串选定的问题？在线等

xwxyh 2006-01-16 01:59:58
我想在TMemo控件中单击鼠标，查找鼠标单击位置是否在[和]之间，如果在则选中[和]之间的内容，于是写了以下代码（注：两个查找函数是正确的），可是问题出现了，如果TMemo控件中的内容是手动从键盘输入的，则能正确执行，如果是从别的TMemo控件中复制过来的，则不能正确执行，主要是选择的位置出现了随机偏差，何故？100分奉上，敬请高手解答！
procedure TForm1.TimeEditMemoClick(Sender: TObject);
var //测试中...
startPos,endPos,i:integer;
begin
if TimeEditMemo.Text='' then exit;
i:=TimeEditMemo.SelStart;
startPos:=FastPosBackNoCase(TimeEditMemo.Lines.Text,'[',Length(TimeEditMemo.Lines.Text),Length('['),TimeEditMemo.SelStart);
endPos:=FastPosNoCase(TimeEditMemo.Lines.Text,']',Length(TimeEditMemo.Lines.Text),Length(']'),i);
//showmessage(inttostr(startPos)+' '+inttostr(endPos));

TimeEditMemo.SelStart:=startPos-1;
TimeEditMemo.SelLength:=endPos-startPos+1;
//ShowMessage(inttostr(TimeEditMemo.CaretPos.Y));
//ShowMessage(inttostr(TimeEditMemo.CaretPos.X));
end;



从别的TMemo控件中复制代码如下：
procedure TForm1.RightToLeftButtonClick(Sender: TObject);
begin
TimeEditMemo.Lines.Clear;
TimeEditMemo.Lines.AddStrings(LyricMemo.Lines);
LyricMemo.Clear;
TimeEditMemo.SelStart:=0;
TimeEditMemo.SelLength:=0;
end;
...全文
231 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
charles1975 2006-01-17
  • 打赏
  • 举报
 回复
我明天上班再看看!
xwxyh 2006-01-17
  • 打赏
  • 举报
 回复
妈的，通过发送消息终于解决了问题
//单击Memo，自动选中时间标签或标识标签，如果有的话
procedure TForm1.TimeEditMemoClick(Sender: TObject);
//测试中... 通过发送消息模拟键盘按钮SHIFT+方向键 实现选定内容
//终于搞定了一些未知错误
var
CurrPos:TPoint;
str:string;
i,l,startPos,endPos:integer;
finded:bool;
KeyState: TKeyboardState;
OldCtrl: byte;
begin
if TimeEditMemo.Text='' then exit;
CurrPos:=TimeEditMemo.CaretPos;
startPos:=-1;endPos:=-1;
finded:=false;
str:=TimeEditMemo.Lines.Strings[CurrPos.Y];
//showmessage(str);
for i:=0 to CurrPos.X do
begin
if str[CurrPos.X-i]=']' then exit;
if str[CurrPos.X-i]='[' then
begin
startPos:=CurrPos.X-i;//找到左[符号
for l:=CurrPos.X+1 to Length(str) do
begin
if str[l]='[' then exit;
if str[l]=']' then
begin
endPos:=l; //找到右]符号
finded:=true;
break;
end;
end;
break;//可别漏了此语句哟
end;
end;
//找到后通过模拟键盘SHIFT+->的方式实现选中内容
if finded then
begin
for i:=0 to CurrPos.X-startPos do
SendMessage(TimeEditMemo.Handle,WM_KEYDOWN,VK_LEFT,0);//发送消息移动光标
GetKeyboardState(KeyState);
OldCtrl := KeyState[VK_SHIFT];
KeyState[VK_SHIFT]:=$80;
SetKeyboardState(KeyState);//按下SHIFT键
for i:=0 to endPos-startPos do
SendMessage(TimeEditMemo.Handle,WM_KEYDOWN,VK_RIGHT,0);
KeyState[VK_SHIFT]:=OldCtrl;
SetKeyboardState(KeyState); //恢复SHIFT键状态
end;
end;
感谢各位回复者
飞天揽月 2006-01-16
  • 打赏
  • 举报
 回复
汗。。。。
才子鸣 2006-01-16
  • 打赏
  • 举报
 回复
吓人...
xwxyh 2006-01-16
  • 打赏
  • 举报
 回复
function BMPosNoCase(const aSource, aFind: Pointer; const aSourceLen, aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;
var
LastPos: Pointer;
begin
LastPos := Pointer(Integer(aSource) + aSourceLen - 1);
asm
push ESI
push EDI
push EBX

mov EAX, aFindLen
mov ESI, aSource
lea ESI, ESI + EAX - 1
std
mov EDX, GUpcaseLUT

@@comparetext:
cmp ESI, LastPos
jg @@NotFound
mov EAX, aFindLen
mov EDI, aFind
push ESI //Remember where we are
mov ECX, EAX
lea EDI, EDI + EAX - 1
xor EAX, EAX
@@CompareNext:
mov al, [ESI]
mov bl, [EDX + EAX]
mov al, [EDI]
cmp bl, [EDX + EAX]
jne @@LookAhead
lea ESI, ESI - 1
lea EDI, EDI - 1
dec ECX
jz @@Found
jmp @@CompareNext

@@LookAhead:
//Look up the char in our Jump Table
pop ESI
mov EBX, JumpTable
mov al, [ESI]
mov al, [EDX + EAX]
mov EAX, [EBX + EAX * 4]
lea ESI, ESI + EAX
jmp @@CompareText

@@NotFound:
mov Result, 0
jmp @@TheEnd
@@Found:
pop EDI //We are just popping, we don't need the value
inc ESI
mov Result, ESI
@@TheEnd:
cld
pop EBX
pop EDI
pop ESI
end;
end;


//NOTE : FastCharPos and FastCharPosNoCase do not require you to pass the length
// of the string, this was only done in FastPos and FastPosNoCase because
// they are used by FastReplace many times over, thus saving a LENGTH()
// operation each time. I can't see you using these two routines for the
// same purposes so I didn't do that this time !
function FastCharPos(const aSource : string; const C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
//If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
Assert(StartPos > 0);

Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
asm
PUSH EDI //Preserve this register

mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos
mov AL, C //and which char we want
@Loop:
cmp Al, [EDI] //compare it against the SourceString
jz @Found
inc EDI
dec ECX
jnz @Loop
jmp @NotFound
@Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
inc EDI
mov Result, EDI
@NotFound:

POP EDI
end;
end;

function FastCharPosNoCase(const aSource : string; C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
if StartPos < 0 then StartPos := 0;

asm
PUSH EDI //Preserve this register
PUSH EBX
mov EDX, GUpcaseLUT

mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos

xor EBX, EBX
mov BL, C
mov AL, [EDX+EBX]
@Loop:
mov BL, [EDI]
inc EDI
cmp Al, [EDX+EBX]
jz @Found
dec ECX
jnz @Loop
jmp @NotFound
@Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
mov Result, EDI
@NotFound:

POP EBX
POP EDI
end;
end;

//The first thing to note here is that I am passing the SourceLength and FindLength
//As neither Source or Find will alter at any point during FastReplace there is
//no need to call the LENGTH subroutine each time !
function FastPos(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
var
JumpTable: TBMJumpTable;
begin
//If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
Assert(StartPos > 0);
if aFindLen < 1 then begin
Result := 0;
exit;
end;
if aFindLen > aSourceLen then begin
Result := 0;
exit;
end;

MakeBMTable(PChar(aFindString), aFindLen, JumpTable);
Result := Integer(BMPos(PChar(aSourceString) + (StartPos - 1), PChar(aFindString),aSourceLen - (StartPos-1), aFindLen, JumpTable));
if Result > 0 then
Result := Result - Integer(@aSourceString[1]) +1;
end;

function FastPosNoCase(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
var
JumpTable: TBMJumpTable;
begin
//If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
Assert(StartPos > 0);
if aFindLen < 1 then begin
Result := 0;
exit;
end;
if aFindLen > aSourceLen then begin
Result := 0;
exit;
end;

xwxyh 2006-01-16
  • 打赏
  • 举报
 回复
implementation

const
cDeltaSize = 1.5;

var
GUpcaseTable : array[0..255] of char;
GUpcaseLUT: Pointer;

//MakeBMJumpTable takes a FindString and makes a JumpTable
procedure MakeBMTable(Buffer: PChar; BufferLen: Integer; var JumpTable: TBMJumpTable);
begin
if BufferLen = 0 then raise Exception.Create('BufferLen is 0');
asm
push EDI
push ESI

mov EDI, JumpTable
mov EAX, BufferLen
mov ECX, $100
REPNE STOSD

mov ECX, BufferLen
mov EDI, JumpTable
mov ESI, Buffer
dec ECX
xor EAX, EAX
@@loop:
mov AL, [ESI]
lea ESI, ESI + 1
mov [EDI + EAX * 4], ECX
dec ECX
jg @@loop

pop ESI
pop EDI
end;
end;

procedure MakeBMTableNoCase(Buffer: PChar; BufferLen: Integer; var JumpTable: TBMJumpTable);
begin
if BufferLen = 0 then raise Exception.Create('BufferLen is 0');
asm
push EDI
push ESI

mov EDI, JumpTable
mov EAX, BufferLen
mov ECX, $100
REPNE STOSD

mov EDX, GUpcaseLUT
mov ECX, BufferLen
mov EDI, JumpTable
mov ESI, Buffer
dec ECX
xor EAX, EAX
@@loop:
mov AL, [ESI]
lea ESI, ESI + 1
mov AL, [EDX + EAX]
mov [EDI + EAX * 4], ECX
dec ECX
jg @@loop

pop ESI
pop EDI
end;
end;

function BMPos(const aSource, aFind: Pointer; const aSourceLen, aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;
var
LastPos: Pointer;
begin
LastPos := Pointer(Integer(aSource) + aSourceLen - 1);
asm
push ESI
push EDI
push EBX

mov EAX, aFindLen
mov ESI, aSource
lea ESI, ESI + EAX - 1
std
mov EBX, JumpTable

@@comparetext:
cmp ESI, LastPos
jg @@NotFound
mov EAX, aFindLen
mov EDI, aFind
mov ECX, EAX
push ESI //Remember where we are
lea EDI, EDI + EAX - 1
xor EAX, EAX
@@CompareNext:
mov al, [ESI]
cmp al, [EDI]
jne @@LookAhead
lea ESI, ESI - 1
lea EDI, EDI - 1
dec ECX
jz @@Found
jmp @@CompareNext

@@LookAhead:
//Look up the char in our Jump Table
pop ESI
mov al, [ESI]
mov EAX, [EBX + EAX * 4]
lea ESI, ESI + EAX
jmp @@CompareText

@@NotFound:
mov Result, 0
jmp @@TheEnd
@@Found:
pop EDI //We are just popping, we don't need the value
inc ESI
mov Result, ESI
@@TheEnd:
cld
pop EBX
pop EDI
pop ESI
end;
end;

xwxyh 2006-01-16
  • 打赏
  • 举报
 回复
问题确实存在，如果编辑框中的内容是从键盘上手动输入的，则正确，如果是从别的TMemo中复制过来的（用代码实现），则出现错误！
unit FastStrings;

interface

uses
{$IFNDEF LINUX}
Windows,
{$ENDIF}
SysUtils;

//This TYPE declaration will become apparent later
type
TBMJumpTable = array[0..255] of Integer;
TFastPosProc = function (const aSource, aFind: Pointer; const aSourceLen, aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;
TFastPosIndexProc = function (const aSourceString, aFindString: string; const aSourceLen, aFindLen, StartPos: Integer; var JumpTable: TBMJumpTable): Integer;
TFastTagReplaceProc = procedure (var Tag: string; const UserData: Integer);


//Boyer-Moore routines
procedure MakeBMTable(Buffer: PChar; BufferLen: Integer; var JumpTable: TBMJumpTable);
procedure MakeBMTableNoCase(Buffer: PChar; BufferLen: Integer; var JumpTable: TBMJumpTable);
function BMPos(const aSource, aFind: Pointer; const aSourceLen, aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;
function BMPosNoCase(const aSource, aFind: Pointer; const aSourceLen, aFindLen: Integer; var JumpTable: TBMJumpTable): Pointer;

function FastAnsiReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
procedure FastCharMove(const Source; var Dest; Count : Integer);
function FastCharPos(const aSource : string; const C: Char; StartPos : Integer): Integer;
function FastCharPosNoCase(const aSource : string; C: Char; StartPos : Integer): Integer;
function FastPos(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosNoCase(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosBack(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastPosBackNoCase(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
function FastReplace(const aSourceString : string; const aFindString, aReplaceString : string;
CaseSensitive : Boolean = False) : string;
function FastTagReplace(const SourceString, TagStart, TagEnd: string;
FastTagReplaceProc: TFastTagReplaceProc; const UserData: Integer): string;
function SmartPos(const SearchStr,SourceStr : string;
const CaseSensitive : Boolean = TRUE;
const StartPos : Integer = 1;
const ForwardSearch : Boolean = TRUE) : Integer;


charles1975 2006-01-16
  • 打赏
  • 举报
 回复
测试后没有问题。
var //²âÊÔÖÐ...
startPos,endPos,i:integer;
begin
if TimeEditMemo.Text='' then exit;
i:=TimeEditMemo.SelStart;
// startPos:=FastPosBackNoCase(TimeEditMemo.Lines.Text,'[',Length(TimeEditMemo.Lines.Text),Length('['),TimeEditMemo.SelStart);
// endPos:=FastPosNoCase(TimeEditMemo.Lines.Text,']',Length(TimeEditMemo.Lines.Text),Length(']'),i);
startPos:=1;
endPos:=length(TimeEditMemo.Text);
//showmessage(inttostr(startPos)+' '+inttostr(endPos));

TimeEditMemo.SelStart:=startPos-1;
TimeEditMemo.SelLength:=endPos-startPos+1;
//ShowMessage(inttostr(TimeEditMemo.CaretPos.Y));
//ShowMessage(inttostr(TimeEditMemo.CaretPos.X));
end;
请帖出FastPosNoCase的过程。
xwxyh 2006-01-16
  • 打赏
  • 举报
 回复
高手在哪里？
Delphi开发技巧之－VCL
ListView 排序 Stringgrid内使用回车键代替Tab键 TListBox内显示分栏 TListBox每一行显示交互的颜色 TMemo内光标位置根据鼠标移动 TMemo自动卷动 TRichEdit卷到特定位置 TRxRichEdit内插入图像 TStringGrid中插入、删除一行 TStringGrid保存和装载 TTreeview控件显示粗体节点 TWebBrowser中调用“查找”对话框 为Listview栏添加双击事件 为工具栏的TToolButton设置新的索引 仅通过Classname创建和管理任意窗体 从RichEdit取Rtf格式 从TListBox中拖放项目到TRichEdit 从一个TRichedit复制格式Rtf文本到其它 使用CustomSort方法排序TListView 使用DBGrid字段队列同步列标题队列 使用Interfaces和TInterfaceList 使用TRichEdit存储大于64K数据 使用代码移动StringGrid的行和列 使用圆形角显示控件 使用类名显示窗体 保存 装载TCheckListbox值 保存和装载TListView 保存和装载TTreeView 允许TDBGrid栏调整大小但防止移动 克隆控件 克隆窗体 列出控件的所有属性和事件 创建可编辑ListBox 删除Listbox的所有选定项目 删除stringlist中重复项目 删除TStringGrid中的列 动画窗体 取ComboBox List句柄 取TListview内所有选定项目 取TShellListView中选定文件的路径 取列举值的名称 在combobox中实现autocomplete 在DBGrid中使用回车键改变到下一个段 在listbox内列出所有目录、文件和驱动器 在Listbox内显示水平滚动条 在memo中实现UNDO 在RichEdit内搜索文本并选择它 在StringGrid内使用Combobox作为编辑器 在StringGrid单元中画不同颜色 在TComboBox中显示栏 在TComboBox内绘制位图 在TDateTimePicker内显示星期几 在TFileListBox内显示多列 在TListBox中创建彩色项目 在TListBox内拖拽 在TListbox内绘制位图 在TListview内执行二进制搜索 在TListView内拖拽多个项目 在TListView列中创建进度条 在TMemo内查看和编辑MS-DOS文本 在TPageControl拖拽Tabs 在TPrintDialog上放置定制控件 在TRichEdit内使用上标和下标 在TRichEdit内使用超链接 在TRichEdit内文本使用不同的下划线样式 在TRichedit内设置段落行距 在TStringGrid内删除一行 在TStringGrid实现OnColumnClick事件 在自己的控件显示信息 复制Listbox项目到剪贴板 失效TTreeview的tooltips 定制TDateTimePicker的格式 居中控件 屏蔽在EditBox内按回车键的都都声 强制在TEdit内输入 排序StringGrid 搜索和替换RichEdit中文本 搜索和选定TListBox的项目 改变TDBGrid的DefaultRowHeight 改变TRichEdit内选定文本的背景颜色 改变TStringGrid内选定单元的颜色 改变标准对话框 改变状态栏字体样式 改变窗体上所有控件的属性 改变进度条颜色 根据StringGrid列内容自动调整大小 根据列排序TStringGrid 检查Stringgrid中指定单元示范选定 检查TMemo能否取消操作 检查TreeView是否完全展开或折叠 检查TStringGrid是否有滚动条 添加接口对象到list 清空StringGrid的所有单元 移动listbox项目 移动TListView项目 移动TRichEdit内光标到指定位置 聚焦TDBGrid某些单元 自动打开TDateTimePicker 自定义Memo边界 获取TRichEdit中鼠标指针下面的字 访问TRadioGroup的控件 调整TComboBox下拉列表的宽度 转换Editbox的首字符为大写 转换TEdit中每个词的首字母为大写 输出TStringGrid到TListView 运行时创建TButtons队列 运行时创建控件 运行时创建菜单项 运行时替换控件 返回TTreeView内字符串路径 防止在TEdit内剪贴、复制、粘贴 防止用户调整TListView栏大小 限制TEdit的输入 隐藏TListView滚动条 隐藏最小化MDI子窗口 颜色Combo Box 验证TEdit中输入的是数字
VCL组件之编辑控件
VCL组件之编辑控件 Note 以后将用两种方式提及组件，以组件的名称或定义组件的VCL类的名称。可以说“Label组件用于……”或说“TLabel用于……”，这两种方式谈到的是同一组件。 编辑控件（Edit Control） Delphi共有5个编辑控件组件，Edit、Memo、MaskEdit、RichEdit（该控件不是标准Windows控件）和SpinEdit（数字编辑
转载VCL组件之编辑控件
VCL组件之编辑控件 Note 以后将用两种方式提及组件，以组件的名称或定义组件的VCL类的名称。可以说“Label组件用于……”或说“TLabel用于……”，这两种方式谈到的是同一组件。 编辑控件（Edit Control） Delphi共有5个编辑控件组件，Edit、Memo、MaskEdit、RichEdit（该控件不是标准Windows控件）和SpinEdit（数字...
inno setup介绍（转）
1、Inno Setup 是什么？Inno Setup 是一个免费的 Windows 安装程序制作软件。第一次发表是在 1997 年，Inno Setup 今天在功能设置和稳定性上的竞争力可能已经超过一些商业的安装程序制作软件。关键功能:★ 支持现在所有正在使用的 32 位 Windows 版本: Windows 95，98，2000，Server 2003，XP，Me，NT 4.0 (不需要
60个BCB（C++Build）初学者 应用实例
1.怎样在C＋＋Builder中创建使用DLL 2.用C++Bulider在WIN.INI中保存信息 3.如何在C＋＋Builder中检测硬件 4.C++Builder如何响应消息及自定义消息 5.利用C++ Builder开发动画DLL 6.用C++ Builder 3制作屏幕保护程序 7.TCP/IP头格式 8.UDP 9.判断windows的Desktop及其它目录 10用
Delphi

5,388

社区成员

262,730

社区内容

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章