TMemo

windxnet 2007-06-29 05:31:24

我向在TMemo里添加若干行，希望可由有不同的颜色（背景色或字体颜色）？如何实现？

...全文

145 6 打赏收藏转发到动态举报

写回复

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

cczlp 2007-07-02

打赏
举报

回复

没什么好方法, 将就用吧

windxnet 2007-07-02

打赏
举报

回复

唉，我知道了，但是有点麻烦，不知道大家还有没有更好的办法。

下面时我写的一个小函数：

void RichEditAdd(TRichEdit *RE, AnsiString Text, TColor Color)
{
static int SelBegin = 0;

RE->Lines->Add(Text);
RE->SelStart = SelBegin;
RE->SelLength = Text.Length();
RE->SelAttributes->Color = Color;

SelBegin += Text.Length() + 2;

RE->SelStart = RE->Text.Length();
}

littlefish0101 2007-06-30

打赏
举报

回复

我也不知道期待中......

windxnet 2007-06-30

打赏
举报

回复

RichEdit怎么作？

我来看看CB 2007-06-29

打赏
举报

回复

对

编译失败 2007-06-29

打赏
举报

回复

用RichEdit

Delphi开发过程中，往往需要在TMemo中逐行读取数据，本实例是回答网友问题的源码。上传方便实施TMemo逐行读取数据的同行下载参考。

这是早上传的发现有问题不能在Delphi Xe5中运行但能在Delphi7中运行我想删除它也没权限 http://download.csdn.net/detail/teststudio/6404077 所以重传下 Delphi TMemo字符串的查找完全实现已经完全的解决Delphi TMemo的查找对话框和替换对话框功能的所有功能查看 GIF http://images.cnblogs.com/cnblogs_com/xe2011/524919/o_TFindDialog.gif

Delphi 7.0 获取Memo控件中字符的可见行数，没讲时在Memo控件中随便粘贴入一些字符，单击窗口中的“检测可见行数”按钮，即可得到该文本框控件中字符的行数，将这一系列执行命令集成在delphi的按钮监听事件中，编写如下代码即可：　　function LinesVisible(Memo: TMemo): integer; 　　Var 　　 OldFont : HFont; 　　 Hand : THandle; 　　 TM : TTextMetric; 　　 Rect : TRect; 　　 tempint : integer; 　　begin 　　 Hand := GetDC(Memo.Handle); 　　 try 　　 GetTextMetrics(Hand, TM); 　　 Memo.Perform(EM_GETRECT, 0, longint(@Rect)); 　　 tempint := (Rect.Bottom - Rect.Top) div Memo.Font.Height div -1; 　　 finally 　　 ReleaseDC(Memo.Handle, Hand); 　　 end; 　　 Result := tempint; 　　end; 　　　　procedure TForm1.BitBtn1Click(Sender: TObject); 　　begin 　　 bitbtn1.Caption:='可见[' IntToStr(LinesVisible(Memo1)) ']行'; 　　end; 　　程序运行效果请参见截图所示，完整源码请下载。

DELPHI文本整理器样式像记事本 // 字符串处理功能 unit StringFunctions; interface uses Windows, Messages, SysUtils, Variants, Classes, Forms, Dialogs, StdCtrls, Commctrl; type TStringFunction = class(TObject) private function IsUpper(ch: char): boolean; function IsLower(ch: char): boolean; function ToUpper(ch: char): char; function ToLower(ch: char): char; public procedure ReplaceSelText(Edit: TCustomEdit; const s: String); procedure UpperSelText(Edit: TCustomEdit); procedure LowerSelText(Edit: TCustomEdit); function UpperFistLetter(Memo: TMemo): string; procedure ClearBlankLine(Memo: TMemo); procedure ClearBlankSpace(Memo: TMemo); procedure ClearNum(Memo: TMemo); procedure ClearLetter(Memo: TMemo); procedure InsertNumber(Memo: TMemo); procedure InsertComment(Memo: TMemo); procedure BatchReplaceString(Memo: TMemo); procedure JustOneLine(Memo: TMemo); procedure ReLine(Memo: TMemo; n: Integer); procedure TextToHtml(sTextFile, sHtmlFile: string); function Proper(const s: string): string; function CNWordsCount(text: string): Integer; function ENWordsCount(text: string): Integer; end; var StrFunction: TStringFunction; implementation // 让代码设置Memo后可以让memo在Ctrl+Z撤销有效 procedure TStringFunction.ReplaceSelText(Edit: TCustomEdit; const s: String); begin SendMessage(Edit.Handle, EM_REPLACESEL, 1, LPARAM(PChar(s))); // Edit.Perform(EM_REPLACESEL, 1, LPARAM(PChar(s))); end; // Edit显示行号 // ------------------------------------------------------------------------------ // 去除空行 // Memo1.Text := StringReplace(Memo1.Text, #13#10#13#10, #13#10, [rfReplaceAll]); { //无法撤销 //空行的去掉 //本行只有空格的也去掉 //全选 //复制到剪切板上 } procedure TStringFunction.ClearBlankLine(Memo: TMemo); var i: Integer; list: TStringList; begin with Memo do begin if Lines.Count > 0 then begin list := TStringList.Create; for i := 0 to Lines.Count - 1 do if (Trim(Lines[i]) <> '') then list.Add(Lines[i]); SelectAll; ReplaceSelText(Memo, list.text); list.Free; end; end; end; // 去除空格 // 将空格替换为空 procedure TStringFunction.ClearBlankSpace(Memo: TMemo); var s: string; begin s := StringReplace(Memo.Lines.text, ' ', '', [rfReplaceAll]); Memo.SelectAll; ReplaceSelText(Memo, s); end; // 去除一字符串中的所有的数字 procedure TStringFunction.ClearNum(Memo: TMemo); var str: string; i: Integer; begin str := '1234567890'; for i := 0 to Length(str) do Memo.text := StringReplace(Memo.Lines.text, str[i], '', [rfReplaceAll]); { rfReplaceAll TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase); } end; // 去除一字符串中的所有的字母 procedure TStringFunction.ClearLetter(Memo: TMemo); var str: string; i: Integer; begin str := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; for i := 0 to Length(str) do Memo.text := StringReplace(Memo.Lines.text, str[i], '', [rfReplaceAll]); end; // 批量替换关键字 procedure TStringFunction.BatchReplaceString(Memo: TMemo); var i: Integer; begin for i := 0 to Length(Memo.Lines.text) do Memo.text := StringReplace(Memo.Lines.text, Memo.Lines[i], '', [rfReplaceAll]); ClearBlankSpace(Memo); end; // ------------------------------------------------------------------------------ // 全角转半角 // 符号有哪些 procedure ConvertQtoB; begin end; // 半角转换全角 procedure ConvertBtoQ; begin end; { 转换选中的文本大写 } procedure TStringFunction.UpperSelText(Edit: TCustomEdit); var x, y: Integer; begin With Edit do begin x := SelStart; y := SelLength; if SelText <> '' then begin ReplaceSelText(Edit, UpperCase(SelText)); SelStart := x; SelLength := y; end else begin Edit.SelectAll; ReplaceSelText(Edit, UpperCase(Edit.text)); end; end; end; { 转换选中的文本小写 } procedure TStringFunction.LowerSelText(Edit: TCustomEdit); var x, y: Integer; begin With Edit do begin x := SelStart; y := SelLength; if SelText <> '' then begin ReplaceSelText(Edit, LowerCase(SelText)); SelStart := x; SelLength := y; end else begin Edit.SelectAll; ReplaceSelText(Edit, LowerCase(Edit.text)); end; end; end; { 判断字符是否是大写字符 } function TStringFunction.IsUpper(ch: char): boolean; begin Result := ch in ['A' .. 'Z']; end; { 判断字符是否是小写字符 } function TStringFunction.IsLower(ch: char): boolean; begin Result := ch in ['a' .. 'z']; end; { 转换为大写字符 } function TStringFunction.ToUpper(ch: char): char; begin Result := chr(ord(ch) and $DF); end; { 转换为小写字符 } function TStringFunction.ToLower(ch: char): char; begin Result := chr(ord(ch) or $20); end; { Capitalizes First Letter Of Every Word In S 单语首字母大写 } function TStringFunction.Proper(const s: string): string; var i: Integer; CapitalizeNextLetter: boolean; begin Result := LowerCase(s); CapitalizeNextLetter := True; for i := 1 to Length(Result) do begin if CapitalizeNextLetter and IsLower(Result[i]) then Result[i] := ToUpper(Result[i]); CapitalizeNextLetter := Result[i] = ' '; end; end; { Memo选中的首字母大写 } function TStringFunction.UpperFistLetter(Memo: TMemo): string; var i, j: Integer; begin with Memo do begin i := SelStart; j := SelLength; // SelText := Proper(SelText); ReplaceSelText(Memo, Proper(SelText)); SelStart := i; SelLength := j; end; end; // ------------------------------------------------------------------------------ procedure TStringFunction.InsertNumber(Memo: TMemo); var i: Integer; str: String; begin for i := 0 to Memo.Lines.Count do begin str := Format('%.4d. %s', [i, Memo.Lines[i]]); Memo.Lines[i] := str; Application.ProcessMessages; end; end; // 注释和取消注释 // 获得选中的文本的起始行和结束行 procedure TStringFunction.InsertComment(Memo: TMemo); var str: string; x, y: Integer; begin str := Memo.SelText; x := Memo.SelStart; y := Memo.SelLength; if str = '' then Exit; // Memo.SetSelText('//' +str); Memo.SelText := '//' + str; Memo.SelStart := x + 2; Memo.SelLength := y + 2; end; // ------------------------------------------------------------------------------ // 合并成一行 procedure TStringFunction.JustOneLine(Memo: TMemo); var s: string; i: Integer; begin for i := 0 to Memo.Lines.Count - 1 do s := s + Memo.Lines[i]; Memo.SelectAll; ReplaceSelText(Memo, s); end; // ------------------------------------------------------------------------------ // 重新分行 { var n: Integer; begin n := StrToInt(InputBox('重新分行', '每行几个字符', '8')); ReLine(Memo1, n); end; } procedure TStringFunction.ReLine(Memo: TMemo; n: Integer); var s: string; i, j, k: Integer; L: TStringList; begin L := TStringList.Create; j := 1; for k := 0 to Memo.Lines.Count - 1 do s := s + Memo.Lines[k]; if Trim(s) <> '' then begin for i := 0 to (Length(s) div n) do // 几行 begin j := j + n; L.Add(Copy(s, j - n, n)); // COPY 的第一位不是0是1 // 每行的字符 end; end; Memo.SelectAll; ReplaceSelText(Memo, L.text); L.Free; end; // ------------------------------------------------------------------------------ // 获得汉字字符个数 function TStringFunction.CNWordsCount(text: string): Integer; var i, sum, c: Integer; begin Result := 0; c := 0; sum := Length(text); if sum = 0 then Exit; for i := 0 to sum do begin if ord(text[i]) >= 127 then begin Inc(c); end; end; Result := c; end; // 获得非汉字字符个数 function TStringFunction.ENWordsCount(text: string): Integer; var i, sum, e: Integer; begin Result := 0; e := 0; sum := Length(text); if sum = 0 then Exit; for i := 0 to sum do begin if (ord(text[i]) >= 33) and (ord(text[i]) <= 126) then begin Inc(e); end; end; Result := e; end; { TextToHtml('C:\1.txt','c:\2.htm'); } procedure TStringFunction.TextToHtml(sTextFile, sHtmlFile: string); var aText: TStringList; aHtml: TStringList; i: Integer; begin aText := TStringList.Create; try aText.LoadFromFile(sTextFile); aHtml := TStringList.Create; try aHtml.Clear; aHtml.Add(''); aHtml.Add(''); for i := 0 to aText.Count - 1 do aHtml.Add(aText.Strings[i] + '
'); aHtml.Add(''); aHtml.Add(''); aHtml.SaveToFile(sHtmlFile); finally aHtml.Free; end; finally aText.Free; end; end; Initialization StrFunction := TStringFunction.Create; Finalization StrFunction.Free; end.

在memo中实现文字颜色设定，关键词高亮显示

VCL组件使用和开发

604

社区成员

13,460

社区内容

发帖

与我相关

我的任务

社区管理员

加入社区

近7日
近30日
至今

加载中

查看更多榜单

社区公告

暂无公告

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

+ 用AI写文章