RichEdit的奥妙
一、如何得知当前行号 用RichEdit（或者memo）控件制作文本编辑器时，通过访问lines�count属性可以得到总行数，但是若想知道光标当前所在行的行号就麻烦了，因为delphi没有提供这个属性。要实现这个编辑器必备功能，就须调用em_ LineFromChar。请试试下面的程序。 先在窗口中布置一个RichEdit或者memo（命名为editor），以及一个button。在button的onclick事件中写入下列代码。 var CurrentLine:Integer; begin CurrentLine:=Editor�Perform(em_ LineFromChar,SFFFF,0); Application�MessageBox(PChar(′当前行号是′＋IntToStr(CurrentLine)),′消息′,mb_ iconinformation); end; 需要注意的是，第一行的行号为零。 二、如何撤消操作（undo） 对于memo来说，实现undo是不需编程的，只要让popupmenu属性为空，运行时就能用鼠标右键激活一个常用操作菜单，其中包括撤消、剪切、复制、粘贴、删除和全选六项。 但可惜的是，这一招对于功能强大的RichEdit控件居然行不通，害得我们还要自己设计一个popupmemu。当你用CutToClipBoard等语句轻松而顺利地完成了“剪切”等功能，接着便会无奈地发现，竟找不到undo或cancel之类的语句来执行“撤消”。 这时你需要这样处理： RichEdit1�Perform(EM_UNDO,0,0); 另外还应检查是否允许撤消，从而开启或关闭弹出菜单中的“撤消”项： Undo1�Enabled:=RichEdit�Perform(EM_CANUNDO,0,0)<>0; 以上程序在Delphi3中调试通过
JEDI JVCL组件安装
JVCL组件是一套开源的VCL组件库，目前最新的版本是3.0，但其自带的Install.bat安装时从目前看存在一些问题,无法完成正常安装，下面是我在Delphi 7上安装时的提示，说是找不到system.pas，由于懒得找具体原因，就直接打开项目包文件进行安装。 build.exe found. Pretest: ok Using d7 for build process. MAKE Version 5.2 Copyright (c) 1987, 1998 Inprise Corp. MAKE Version 5.2 Copyright (c) 1987, 1998 Inprise Corp. Borland Delphi for Win32 compiler version 18.0 Copyright (c) 1983,2005 Borland Software Corporation JediInstaller.dpr(1) Fatal: F2063 Could not compile used unit 'System.pas' ** error 1 ** deleting ..inJediInstaller.exe ** error 1 ** deleting installer Press ENTER to continue 在安装的时候，注意要先安装JCL，我试图直接安装JVCL，提示找不到文件，先安装JCL后再安装就不存在这个问题。安装到组件面板上的安装包以D结尾，可以Install，以R结尾的只要编译就可以了。 安装完成后，需要在搜索路径中加入JCLSource、JCLSourceCommon、JCLSourceWindows、JVCLRun、JVCLCommon目录到搜索路径中。
XE2安装JVCL
XE2安装JVCL 1. 下载： 要分别下载JCL和JVCL安装包，不可以图省事不下载前者。 http://sourceforge.net/projects/jcl/files/JCL%20Releases/JCL%202.4%20Build%204571/jcl-2.4.1.4571.zip/download http://sourceforge.net/projects/jvcl/files/JVCL%20Help%20Files/JVCL%203.41%20Help/jvcl-3.41-pdfhelp.zip/download 2. 安装JVCL 必须先安装JCL。虽然JVCL压缩包本身包含JCL，但那个可以废弃（改个名字），另外下载JCL，然后编译 E:Editor_goodPython_IDEComposantsjclinstallJCLInstall.dpr 然后编译： E:Editor_goodPython_IDEComposantsjvclinstallJVCLInstallJVCLInstall.dpr 编译成功后，关掉所有Delphi进行安装 如果遇到编译问题，则修改（屏蔽两句话）： jvcldevtoolsPackagesGeneratorGenerateDefines.pas uses //{$IFDEF HAS_UNIT_TYPES} //System.Types, //{$ENDIF HAS_UNIT_TYPES} SysUtils, JclStrings; --------------------------- 3. 加入路径： JCLSource JCLSourceCommon JCLSourceWindows JVCLRun JVCLCommon 目录到搜索路径中。 备注，不清楚install.bat有什么用处，留待下次研究。
delphi 2009 调用Msftedit.dll，重写Richedit，能更好地支持RTF,特别是画表格
delphi 2009 调用Msftedit.dll，重写Richedit，能更好地支持RTF,特别是画表格 画表格的具体思路分析 4个步骤： 1 指定类名称 RichEdit50W var FMoudlEdit:THandle; const RichEdit41ModuleName = 'Msftedit.dll'; RichEdit41ClassName = 'RichEdit50W'; 2 从TCustomRichEdit继承 TRichEdit41=class(TCustomRichEdit) private protected procedure CreateParams(var Params: TCreateParams);override; public 3 重些CreateParams procedure TRichEdit41.CreateParams(var Params: TCreateParams); begin if FMoudlEdit = 0 then begin FMoudlEdit := LoadLibrary(RichEdit41ModuleName); if FMoudlEdit <= HINSTANCE_ERROR then FMoudlEdit := 0; end; inherited CreateParams(Params); CreateSubClass(Params, RichEdit41ClassName); with Params do begin // end; end; 4 释放 finalization if FMoudlEdit <> 0 then FreeLibrary(FMoudlEdit);
delphi RichEdit控件中插入GIF动画表情
在UDP即时通讯软件中实现类似于QQ的动画表情，在richEdit控件中插入gif动画表情。 发送的时候将表情转为命令，接收之后，再将命令转换为相应的动画表情。 需要引用一个QQ的DLL，文件在附件中。将此DLL导入到DELPHI中。 unit URichEdit; interface uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ActiveX, ComCtrls, RxRichEd, OleServer, ImageOleLib_TLB, coconst, UConst, Dialogs; const REO_CP_SELECTION = ULONG(-1); REO_BELOWBASELINE = $00000002; REO_RESIZABLE = $00000001; REO_STATIC = $40000000; EM_GETOLEINTERFACE = WM_USER + 60; IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); IID_IOleObject: TGUID = (D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); type _ReObject = record cbStruct: DWORD; { Size of structure } cp: ULONG; { Character position of Object } clsid: TCLSID; { Class ID of Object } pOleObj: IOleObject; { Ole Object interface } pstg: IStorage; { Associated storage interface } pOleSite: IOleClientSite; { Associated Client Site interface } sizel: TSize; { Size of Object (may be 0,0) } dvAspect: Longint; { Display aspect to use } dwFlags: DWORD; { Object status flags } dwUser: DWORD; { Dword for user憇 use } end; TReObject = _ReObject; TCharRange = record {Copy From RichEdit.pas} cpMin: Integer; cpMax: Integer; end; TFormatRange = record hdc: Integer; hdcTarget: Integer; rectRegion: TRect; rectPage: TRect; chrg: TCharRange; end; IRichEditOle = interface(System.IUnknown) ['{00020d00-0000-0000-c000-000000000046}'] function GetClientSite(out ClientSite: IOleClientSite): HResult; stdcall; function GetObjectCount: HResult; stdcall; function GetLinkCount: HResult; stdcall; function GetObject(iob: Longint; out ReObject: TReObject; dwFlags: DWORD): HResult; stdcall; function InsertObject(var ReObject: TReObject): HResult; stdcall; function ConvertObject(iob: Longint; rclsidNew: TIID; lpstrUserTypeNew: LPCSTR): HResult; stdcall; function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall; function SetHostNames(lpstrContainerApp: LPCSTR; lpstrContainerObj: LPCSTR): HResult; stdcall; function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall; function SetDvaspect(iob: Longint; dvAspect: DWORD): HResult; stdcall; function HandsOffStorage(iob: Longint): HResult; stdcall; function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall; function InPlaceDeactivate: HResult; stdcall; function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; function GetClipboardData(var chrg: TCharRange; reco: DWORD; out dataObj: IDataObject): HResult; stdcall; function ImportDataObject(dataObj: IDataObject; cf: TClipFormat; hMetaPict: HGLOBAL): HResult; stdcall; end; procedure InsertGif(re: TRxRichEdit; sFileName: string; dwUser: integer); function GetGif (re: TRxRichEdit): TList; function ConvertMsgToCmd (re: TRxRichEdit): string; procedure ConvertMsgToFace (re: TRxRichEdit; strMsg: string); implementation //*************************************************** //名称：InsertGif //功能：插入图片 //输入：re：RichEdit控件；sFileName：要插入的文件名； // dwUser：（标识，随机数，暂时用文件名【索引】代替） //输出： //返回： //*************************************************** procedure InsertGif(re: TRxRichEdit; sFileName: string; dwUser: integer); type tagSize = TSize; var FRTF: IRichEditOle; FLockBytes: ILockBytes; FStorage: ISTORAGE; FClientSite: IOLECLIENTSITE; m_lpObject: IOleObject; m_lpAnimator: TGifAnimator; i_GifAnimator: IGifAnimator; reobject: TReObject; clsid: TGuid; sizel: tagSize; Rect: TRect; begin try if CreateILockBytesOnHGlobal(0, True, FLockBytes) <> S_OK then begin //showmessage('Error to create Global Heap'); exit; end; //???????????? if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, FStorage) <> S_OK then begin //Showmessage('Error to create storage'); exit; end; //??RichEdit??? Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF)); if FRTF.GetClientSite(FClientSite) <> S_OK then begin //ShowMessage('Error to get ClentSite'); Exit; end; CoInitializeEx(nil, COINIT_APARTMENTTHREADED); m_lpAnimator := TGifAnimator.Create(re); i_GifAnimator := m_lpAnimator.ControlInterface; i_GifAnimator.LoadFromFile(sFileName); i_GifAnimator.QueryInterface(IID_IOleObject, m_lpObject); OleSetContainedObject(m_lpObject, True); FillChar(ReObject, SizeOf(ReObject), 0); ReObject.cbStruct := SizeOf(ReObject); m_lpObject.GetUserClassID(clsid); ReObject.clsid := clsid; reobject.cp := REO_CP_SELECTION; //content, but not static reobject.dvaspect := DVASPECT_CONTENT; //goes in the same line of text line reobject.dwFlags := REO_BELOWBASELINE; //REO_RESIZABLE | reobject.dwUser := 0; //the very object reobject.poleobj := m_lpObject; //client site contain the object reobject.polesite := FClientSite; //the storage reobject.pstg := FStorage; sizel.cx := 0; sizel.cy := 0; reobject.sizel := sizel; //Sel all text re.SelText := ''; re.SelLength := 0; re.SelStart := re.SelStart; reobject.dwUser := dwUser; //Insert after the line of text FRTF.InsertObject(reobject); SendMessage(re.Handle, EM_SCROLLCARET, 0, 0); //VARIANT_BOOL ret; //do frame changing m_lpAnimator.TriggerFrameChange(); //show it m_lpObject.DoVerb(OLEIVERB_UIACTIVATE, nil, FClientSite, 0, re.Handle, Rect); // m_lpObject.DoVerb( m_lpObject.DoVerb(OLEIVERB_SHOW, nil, FClientSite, 0, re.Handle, Rect); //redraw the window to show animation RedrawWindow(re.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ERASENOW or RDW_ALLCHILDREN); finally FRTF := nil; FClientSite := nil; FStorage := nil; end; end; //*************************************************** //名称：GetGif //功能：分析控件内容，取得控件中的图片对象 //输入：re：RichEdit控件； //输出： //返回：取得的对象列表（图片索引、图片位置） //*************************************************** function GetGif (re: TRxRichEdit): TList; type tagSize = TSize; var i: integer; FRTF: IRichEditOle; ReObject: TReObject; lstGif: TList; slstRow: TStringList; begin lstGif := TList.Create; Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF)); for i := 0 to FRTF.GetObjectCount - 1 do begin slstRow := TStringList.Create; FillChar(ReObject, SizeOf(ReObject), 0); ReObject.cbStruct := SizeOf(ReObject); FRTF.GetObject (Longint (i), ReObject, REO_BELOWBASELINE); slstRow.Add (IntToStr (ReObject.dwUser)); slstRow.Add (IntToStr (ReObject.cp)); lstGif.Add (slstRow); end; Result := lstGif; end; //*************************************************** //名称：ConvertMsgToCmd //功能：分析控件内容，将表情替换成相应的命令 //输入：re：RichEdit控件； //输出： //返回：转换之后的消息内容 //*************************************************** function ConvertMsgToCmd (re: TRxRichEdit): string; var i: integer; lstGif: TList; strMsg: WideString; slstRow, slstMsg: TStringList; begin //分解消息文本内容，将所有内容分隔之后放到列表中 slstMsg := TStringList.Create; strMsg := re.Text; for i := 1 to Length (strMsg) do begin slstMsg.Add (strMsg[i]); end; //取得表情，将表情替换成命令 lstGif := GetGif (re); for i := lstGif.Count - 1 downto 0 do begin slstRow := TStringList (lstGif.Items[i]); slstMsg.Insert (StrToInt (slstRow.Strings[1]), m_arrFace[StrToInt (slstRow.Strings[0]), 1]); slstRow.Free; end; lstGif.Free; strMsg := StringReplace (slstMsg.Text, #13#10, '', [rfReplaceAll]); slstMsg.Free; Result := strMsg; end; //*************************************************** //名称：ConvertMsgToFace //功能：分析消息内容，将命令换成相应的表情 //输入：re：RichEdit控件；strMsg：消息内容； //输出： //返回： //*************************************************** procedure ConvertMsgToFace (re: TRxRichEdit; strMsg: string); var i, nFind: integer; strPath: string; strMessage: WideString; begin if StrPos (PChar (strMsg), '/') = nil then begin exit; end; strMessage := strMsg; strPath := ExtractFilePath (ParamStr (0)) + SYSSET_CHAT_FACEPATH; for i := 0 to Length (m_arrFace) - 1 do begin nFind := Pos (PChar (m_arrFace[i, 1]), strMessage); if nFind = 0 then continue else begin re.SelStart := nFind - 2; re.SelLength := Length (m_arrFace[i, 1]); InsertGif (re, strPath + m_arrFace[i, 0], i); end; end; end; end.
delphi 调用Msftedit.dll，重写Richedit，支持RTF画表格
delphi 2009 调用Msftedit.dll，重写Richedit，能更好地支持RTF,特别是画表格 画表格的具体思路分析 4个步骤： 1 指定类名称 RichEdit50W var FMoudlEdit:THandle; const RichEdit41ModuleName = 'Msftedit.dll'; RichEdit41ClassName = 'RichEdit50W'; 2 从TCustomRichEdit继承 TRichEdit41=class(TCustomRichEdit) private protected procedure CreateParams(var Params: TCreateParams);override; public 3 重些CreateParams procedure TRichEdit41.CreateParams(var Params: TCreateParams); begin if FMoudlEdit = 0 then begin FMoudlEdit := LoadLibrary(RichEdit41ModuleName); if FMoudlEdit <= HINSTANCE_ERROR then FMoudlEdit := 0; end; inherited CreateParams(Params); CreateSubClass(Params, RichEdit41ClassName); with Params do begin // end; end; 4 释放 finalization if FMoudlEdit <> 0 then FreeLibrary(FMoudlEdit);
richedit画表格的具体分析
Richedit支持画表格，要依靠msftedit.dll，参考 delphi 2009 调用Msftedit.dll，重写Richedit，能更好地支持RTF,特别是画表格 画表格，实质上是构造RTF格式的文档，RTF文档的构造<下面紫色部分>就按照RTF的格式书写，每构造好一部分后就放入StringStream里，TStringStream.WriteString。全部构造好后，导入到 richedit 组件中显示出来就可以了，TCustomRichEdit.Lines.LoadFromStream。 其实画一个表格就3步， 第一步，写RTF格式的文件头； 第二步，定义表格的一行，包括行和每个单元格的位置、大小和样式； 第三步，把内容写进去。 下面详细列出RTF的每一部分，参照上面的三步： 1 RTF文件头,可以找一个rtf文件分离出来，都是{}对。rtfto~ rtfto，为了方便，分割一下。依次写入到Stream里。rtfto规定了字体和语言，可自行修改。 rtfto='{ tf1ansiansicpg936deff0deflang2052deflangfe2052deftab420{fonttbl{f0fnilfcharset134 Sun;}{f1fromanfprq2fcharset0 Times New Roman;}}'; rtfto='{*generator Msftedit 5.41.15.1507;}'; .... 2 行和本行单元格定义。行定义rtfbiaogehang1~3，1后面加上行高。各单元格的定义rtfbiaogecell1~9，cellx403是单元格位置。其他样式包括行的边界和间距等，以及单元格的垂直方向对齐方式，边界和宽度。 rtfbiaogehang1=' rowd rgaph10 rleft-40 rqc rrh'; rtfbiaogehang2=' rbrdrlrdrsrdrw10 rbrdrtrdrsrdrw10 rbrdrrrdrsrdrw10 rbrdrbrdrsrdrww10 '; rtfbiaogehang3=' rpaddl10 rpaddr10 rpaddfl3 rpaddfr3'; rtfbiaogecell1='clvertalcclbrdrlrdrw10rdrsclbrdrtrdrw10rdrsclbrdrrrdrw10rdrsclbrdrbrdrw10rdrs cellx403'; rtfbiaogecell2='clvertalcclbrdrlrdrw10rdrsclbrdrtrdrw10rdrsclbrdrrrdrw10rdrsclbrdrbrdrw10rdrs cellx1395'; 3 写入内容 开头 pardintbl owidctlpar 中间 对每一列，都使用 对齐方式+内容的BigEndianUnicode+cell 的方式 结束 ow 其中对齐方式包括qc qj ql qr，不用解释了吧，用WPS/WORD的人都知道。 BigEndianUnicode的处理，为了处理4字节汉字的显示，字符统一bigEndian编码<如：{卸 ?}> for i := 0 to Length(aString)-1 do result:=result+'{u'+inttostr(ord(aString[i+1]))+' ?}'; 使用这种方式写入内容纯粹是为了程序简单，并不是固定的，而这样可能多写入很多RTF代码，造成庞大的RTF文件：即多了很多格式显示指令，2字节汉字也使用了长编码。如果表格不是很多内容，目前的电脑配置基础上，运行起来是没感觉的。 一个表格，顺利诞生。
用流方式存取
保存： var Str: string; temStream: TMemoryStream; begin temStream := TMemoryStream.Create; RichEdit1.Lines.SaveToStream(temStream); str := 'select * from Table1'; AdoQuery1.Close; AdoQuery1.SQL.Clear; AdoQuery1.SQL.Add(str); AdoQuery1.Open; AdoQuery1.Append; AdoQuery1.FieldByName('ID').AsInteger:= 3; TBlobField(AdoQuery1.FieldByName('RichEditText')).LoadFromStream(temStream); AdoQuery1.Post; temStream.Free; 读取: var Str: string; temStream: TMemoryStream; begin temStream := TMemoryStream.Create; str := 'select * from Table1 '; AdoQuery1.Close; AdoQuery1.SQL.Clear; AdoQuery1.SQL.Add(str); AdoQuery1.Open; TBlobField(AdoQuery1.FieldByName('RichEditText')).SaveToStream(temStream); temStream.Seek(0,0); RichEdit1.Lines.LoadFromStream(temStream); temStream.Free;