was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1547)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

29 Visitors Online


 
...ein Bild in ein TRxRichEdit einfügen?
Autor: Thomas Stutz
[ Tip ausdrucken ]  

Tip Bewertung (36):  
     




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;

 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners