Delphi给其他进程的RichEdit中添加格式化文本

时间：2011/9/3 16:26:12 点击：

　　核心提示：{*参数说明： hTarget: 目标RichEdit的句柄sText: 要添加的文字内容clrText: 字体的颜色*}procedure SetRichEditContent(hTarget: T...

{*
参数说明：

    hTarget: 目标RichEdit的句柄
    sText: 要添加的文字内容
    clrText: 字体的颜色
*}

procedure SetRichEditContent(hTarget: THandle; sText: String; clrTxt: TColor = $FF);
var
cr : CHARRANGE;
cf : CHARFORMAT2;
hProc: THandle;
lpFmt: Pointer;
lpRgn: Pointer;

dwBytesWrite: DWORD;
begin
if (not IsWindow(hTarget)) then exit;

GetWindowThreadProcessId(hTarget, hProc);
if (0 = hProc) then
begin
    Application.MessageBox(PChar('获取进程句柄失败:' + IntToStr(GetLastError)),
                           '提示', MB_OK + MB_ICONINFORMATION);
    exit;
end;

hProc:= OpenProcess(PROCESS_ALL_ACCESS, FALSE, hProc);
if (0 = hProc) then
begin
    Application.MessageBox(PChar('打开进程失败:' + IntToStr(GetLastError)),
                           '提示', MB_OK + MB_ICONINFORMATION);
    exit;
end;

ZeroMemory(@cf, sizeof(CHARFORMAT2));

cf.cbSize         := sizeof(CHARFORMAT2);
cf.crTextColor    := clrTxt;                // 字体颜色
cf.yHeight        := 20 * 10;               // 字体大小
cf.dwMask         := CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_PROTECTED;
cf.dwEffects      := 0;
cf.bCharSet       := 0;
cf.bPitchAndFamily:= 0;
cf.szFaceName     := '宋体';

// 这里可以设置插入的位置, -1, -1表示在尾部添加文字
cr.cpMin:= -1;
cr.cpMax:= -1;

lpFmt:= VirtualAllocEx(hProc, nil, sizeof(cf), MEM_COMMIT, PAGE_READWRITE);
lpRgn:= VirtualAllocEx(hProc, nil, SizeOf(cr), MEM_COMMIT, PAGE_READWRITE);

WriteProcessMemory(hProc, lpFmt, @cf, sizeof(cf), dwBytesWrite);
WriteProcessMemory(hProc, lpRgn, @cr, sizeof(cr), dwBytesWrite);

SendMessage(hTarget, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(lpFmt));
SendMessage(hTarget, EM_EXSETSEL, 0, LPARAM(lpRgn));

clipboard.AsText:= sText;
SendMessage(hTarget, WM_PASTE, 0, 0);

VirtualFreeEx(hProc, lpFmt, sizeof(cf), MEM_RELEASE);
VirtualFreeEx(hProc, lpRgn, sizeof(cr), MEM_RELEASE);

CloseHandle(hProc);
end;