大家来看看这怎么办？灌水也加分。。。。。。。。。。。

有的richedit支持，我以前也试过
有的不支持，
可能是版本不一榇的原因

uses
  RichEdit; // Stream Callback function
type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD;
  stdcall;   TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end; // RichEdit Type
type
  TMyRichEdit = TRxRichEdit; // EditStreamInCallback callback function
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
  // by P. Below
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0;
    if dataAvail <= cb then
    begin
      pcb := read(pbBuff^, dataAvail);
      if pcb <> dataAvail then
        Result := UINT(E_FAIL);
    end
    else
    begin
      pcb := read(pbBuff^, cb);
      if pcb <> cb then
        Result := UINT(E_FAIL);
    end;
  end;
end; // Insert Stream into RichEdit
procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
  // by P. Below
var
  EditStream: TEditStream;
begin
  with EditStream do
  begin
    dwCookie := Longint(SourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end; // Convert Bitmap to RTF Code
function BitmapToRTF(pict: TBitmap): string;
// by D3k
var
  bi, bb, rtf: string;
  bis, bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
  GetDIBSizes(pict.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
  rtf := '{\rtf1 {\pict\dibitmap ';
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do
  begin
    achar := Format('%x', [Integer(bi[bis])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := Format('%x', [Integer(bb[bbs])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  rtf := rtf + hexpict + ' }}';
  Result := rtf;
end;
// Example to insert image from Image1 into RxRichEdit1
procedure TForm1.Button1Click(Sender: TObject);
var
  SS: TStringStream;
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  BMP := Image1.Picture.Bitmap;
  SS  := TStringStream.Create(BitmapToRTF(BMP));
  try
    PutRTFSelection(RxRichEdit1, SS);
  finally
    SS.Free;
  end;
end;

****************************************
下面的代码可以不调用那个InsertObject的对话框而直接插入一张图片：
var
  Bmp:TBitmap;
begin
  if not OpenPictureDialog1.Execute then exit;
  Bmp:=TBitmap.Create;
  Bmp.LoadFromFile(OpenPictureDialog1.FileName);
  Clipboard.Assign(BMP);
  RxRichEdit201.PasteFromClipboard;
  Bmp.Free;
end;
**************************************
： TechnoFantasy(www.applevb.com)
RichEdit中，插入图片
代码:procedure proPrintRTFWithBMP(strCaption,strPic,strTitle:string;rtf:TRichEdit);
{strText为要打印的文本 strCaption为打印标题 strPic为图像文件目录
strTitle为要显示在图像右侧的图像标题}
var
  FRTF:IRichEditOle;
  FOLE:IOLEObject;
  formatEtc:tagFORMATETC;
  FStorage :ISTORAGE;
  FClientSite:IOLECLIENTSITE;
  FLockBytes:ILockBytes;
  ReObject:TReObject;
  xt:TGuid;
  FTemp:IUnknown;
  strTemp:string;
  bCreateNew:boolean;
  ABMP:TBitmap;
  Ajpeg:TJpegImage;
  i:Longint;
begin
//    rtfTemp:=TRichEdit.Create(frmPrintFrame);
    try
{        with  rtfTemp do
        begin
            Parent := frmPrintFrame;
            width:=200;
            height:=200;
            visible:=false;
            Text := strText;
        end;  }        //图片文件不存在，直接打印文本并退出
        if not fileexists(strPic)then
        begin
            PrintRichEdit(strCaption,rtf);
            exit;
        end;        abmp:=TBitmap.Create;
        ajpeg:= TJpegImage.Create;
        try
            if ExtractFileExt(strPic)='.jpg' then
            begin
                bCreateNew:=true;
                ajpeg.LoadFromFile(strPic);
                abmp.Assign(ajpeg);
                strTemp:=ExtractFilePath(strPic)+'0099www.bmp';
                abmp.SaveToFile(strTemp);
                for i:=1 to 30000 do
                    application.ProcessMessages;
            end
            else
                strTemp:= strPic;
        finally
            abmp.Free;
            ajpeg.free;
            abmp:=nil;
            ajpeg:=nil;
        end;        sendmessage(rtf.handle,EM_GETOLEINTERFACE,0,LongInt(@FRTF));
        if not assigned(FRTF)then
        begin
            showmessage('Error to get Richedit OLE interface');
            exit;
        end;        //建立一个可以访问全局内存的Byte数组 FLockBytes
        //返回ILockBytes接口
        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;

        formatEtc.cfFormat := 0;
        FormatEtc.ptd := nil;
        FormatEtc.dwAspect := DVASPECT_CONTENT;
        FormatEtc.lindex := -1;
        FormatEtc.tymed := TYMED_NULL;        FRTF.GetClientSite(FClientSite);        //从文件中创建一个OLE对象
        if OleCreateFromFile(GUID_NULL,PWideChar(WideString(strTemp)),IID_IUnknown,0,@formatEtc,
            FClientSite,FStorage,FOLE)<>S_OK then
        begin
            showmessage('Error');
            exit;
        end;        //现在的FOLE还是一个IUnKnown接口，将其转换为一个 IOleObject接口
        FTemp:=FOLE;
        FTemp.QueryInterface(IID_IOleObject, FOle);
        OleSetContainedObject(FOle, TRUE);
        //step 2
        reobject.cbStruct := sizeof(TReObject);
        FOLE.GetUserClassID(xt);
        ReObject.clsid := xt;
        reobject.cp := ULong(REO_CP_SELECTION);
        reobject.dvaspect := DVASPECT_CONTENT;
        reobject.dwFlags := ULong(REO_RESIZABLE) or ULong(REO_BELOWBASELINE);
        reobject.dwUser := 0;
        reobject.poleobj := FOle;
        reobject.polesite := FClientSite;
        reobject.pstg := FStorage;
        reobject.sizel.cx := 0;
        reobject.sizel.cy := 0;        FRTF.InsertObject(reobject);        PrintRichEdit(strCaption,rtf);
    finally
        if bCreateNew then
            Deletefile(strTemp);
        FRTF:=nil;
        FOLE:=nil;
    end;
end;
上面的代码是一个在RTF控件当前位置插入图像并打印的，你运行上面的代码需要首先引用
ActiveX, ComObj, RichEdit, Jpeg
并且将PrintRichEdit(strCaption,rtf);去掉

以下的结构是需要手工加入的：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's use             }
  end;
  TReObject = _ReObject;  type
  IRichEditOle = interface(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;Type TCharRange=record
    cpMin:integer;
    cpMax:integer;
End;Type TFormatRange=record
    hdc : Integer;
    hdcTarget:integer;
    rectRegion:trect;
    rectPage:trect;
    chrg : TCharRange;
End;
************************************
以下不通过剪切板而直接在Richedit中插入一张图片：
var
  frmMain: TfrmMain; implementation {$R *.DFM}
{$R Smiley.res} uses
  RichEdit; type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD;
  stdcall;   TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end; type
  TMyRichEdit = TRxRichEdit; // EditStreamInCallback callback function function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0;
    if dataAvail <= cb then
    begin
      pcb := read(pbBuff^, dataAvail);
      if pcb <> dataAvail then
        Result := UINT(E_FAIL);
    end
    else
    begin
      pcb := read(pbBuff^, cb);
      if pcb <> cb then
        Result := UINT(E_FAIL);
    end;
  end;
end; // Insert Stream into RichEdit procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
var
  EditStream: TEditStream;
begin
  with EditStream do
  begin
    dwCookie := Longint(SourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
end; // Load a smiley image from resource function GetSmileyCode(ASimily: string): string;
var
  dHandle: THandle;
  pData, pTemp: PChar;
  Size: Longint;
begin
  pData := nil;
  dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);
  if dHandle <> 0 then
  begin
    Size := SizeofResource(hInstance, dHandle);
    dhandle := LoadResource(hInstance, dHandle);
    if dHandle <> 0 then
      try
        pData := LockResource(dHandle);
        if pData <> nil then
          try
            if pData[Size - 1] = #0 then
            begin
              Result := StrPas(pTemp);
            end
            else
            begin
              pTemp := StrAlloc(Size + 1);
              try
                StrMove(pTemp, pData, Size);
                pTemp[Size] := #0;
                Result := StrPas(pTemp);
              finally
                StrDispose(pTemp);
              end;
            end;
          finally
            UnlockResource(dHandle);
          end;
      finally
        FreeResource(dHandle);
      end;
  end;
end; procedure InsertSmiley(ASmiley: string);
var
  ms: TMemoryStream;
  s: string;
begin
  ms := TMemoryStream.Create;
  try
    s := GetSmileyCode(ASmiley);
    if s <> '' then
    begin
      ms.Seek(0, soFromEnd);
      ms.Write(PChar(s)^, Length(s));
      ms.Position := 0;
      PutRTFSelection(frmMain.RXRichedit1, ms);
    end;
  finally
    ms.Free;
  end;
end; procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
  InsertSmiley('Smiley1');
end; procedure TfrmMain.SpeedButton2Click(Sender: TObject);
begin
  InsertSmiley('Smiley2');
end; // Replace a :-) or :-( with a corresponding smiley procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);
var
sCode, SmileyName: string;   procedure RemoveText(RichEdit: TMyRichEdit);
  begin
    with RichEdit do
    begin
      SelStart := SelStart - 2;
      SelLength := 2;
      SelText :=  '';
    end;
  end; begin
If (Key = ')') or (Key = '(')  then
begin
   sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;
   SmileyName := '';
   if sCode = ':-)'  then SmileyName := 'Smiley1';
   if sCode = ':-('  then SmileyName := 'Smiley2';
   if SmileyName <> '' then
   begin
     Key := #0;
     RemoveText(RxRichEdit1);
     InsertSmiley('Smiley1');
   end;
end;
end;

to :xzhifei(星级饭桶·飞)
好像不行，我测试过，那个TRXRichEdit是更改过的控件吧？

unit InsRich;
interface
uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ActiveX,ComCtrls;
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's 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;
  function InsertBitmap(Editor: TRichEdit; BmpFile: String): Boolean;implementationfunction InsertBitmap(Editor: TRichEdit; BmpFile: String): Boolean;
var
  FRTF: IRichEditOle;
  FOle: IOleObject;
  FormatEtc: tagFormatETC;
  FStorage: ISTORAGE;
  FClientSite: IOleClientSite;
  FLockBytes: ILockBytes;
  ReObject: TReObject;
  xt: TGuid;
  FTemp: IUnknown;
begin
  Result:=false;
  if not FileExists(BmpFile) then Exit;
  try
    SendMessage(Editor.Handle, em_GetOleInterFace, 0, LongInt(@FRTF));
    if not Assigned(FRTF) then Exit;
    if CreateILockBytesOnHGlobal(0,true,FLockBytes)<>S_OK then Exit;
    if StgCreateDocfileOnILockBytes(FLockBytes,STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE,0,FStorage)<>S_OK then Exit;
    FormatEtc.cfFormat:=0;
    FormatEtc.ptd:=nil;
    FormatEtc.dwAspect:=DVASPECT_CONTENT;
    FormatEtc.lindex:=-1;
    FormatEtc.tymed:=TYMED_NULL;
    FRTF.GetClientSite(FClientSite);
    //从文件中创建一个Ole对象
    if OleCreateFromFile(GUID_NULL,PWideChar(WideString(BmpFile)),IID_IUnknown,0,@FormatEtc,FClientSite,FStorage,FOle)<>S_OK then Exit;
    FTemp:=FOle;
    FTemp.QueryInterface(IID_IOleObject, FOle);
    OleSetContainedObject(FOle, true);
    ReObject.cbStruct:=SizeOf(TReObject);
    FOle.GetUserClassID(xt);
    ReObject.clsid:=xt;
    ReObject.cp:=ULong(REO_CP_SELECTION);
    ReObject.dvaspect:=DVASPECT_CONTENT;
    ReObject.dwFlags:=ULong(REO_STATIC) or ULong(REO_BELOWBASELINE);
    ReObject.dwUser:=0;
    ReObject.pOleObj:=FOle;
    ReObject.pOleSite:=FClientSite;
    ReObject.pstg:=FStorage;
    ReObject.sizel.cx:=0;
    ReObject.sizel.cy:=0;
    FRTF.InsertObject(ReObject);
  finally
    FRTF:=nil;
    FOle:=nil;
  end;
  Result:=true;
end;
end.

to :xzhifei(星级饭桶·飞)
不能拖动，如拖动就没了！帮我搞定分绝对加，绝不失言。

用RichView系列控件，它上的可以不能拖动。

看样子学好Delphi还是很难
郁闷。。

调试易

大家来看看这怎么办？灌水也加分。。。。。。。。。。。

解决方案 »