echmpubfunc.pas

帮助编写程序

unit EchmPubfunc;

interface

uses
  SysUtils, JPEG, Graphics, ComCtrls;

  function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
  procedure InsertBitmap(const Bitmap: TBitmap; const RichEdit:TRichEdit);
  procedure InsertBitmapIntoRichEdit(const GraphicFileName: string; const RichEdit: TRichEdit);
  procedure InsertTableRichEdit(NumRows,NumCols:Integer;TableAttrs,CellAttrs: string;RichEdit: TRichEdit);

implementation

function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
var
 bi, bb: string;
 bis, bbs: Cardinal;
 achar: string[2];
 Buffer: string;
 I: Integer;
type
 PWord = ^Word;
begin
 GetDIBSizes(Bitmap.Handle, bis, bbs);
 SetLength(bi, bis);
 SetLength(bb, bbs);
 GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^);
 SetLength(Buffer, (Length(bb) + Length(bi)) * 2);
 i := 1;
 for bis := 1 to Length(bi) do
 begin
  achar := IntToHex(Integer(bi[bis]), 2);
  PWord(@Buffer[i])^ := PWord(@achar[1])^;
  inc(i, 2);
 end;
 for bbs := 1 to Length(bb) do
 begin
  achar := IntToHex(Integer(bb[bbs]), 2);
  PWord(@Buffer[i])^ := PWord(@achar[1])^;
  inc(i, 2);
 end;
 Result := '{tf1 {pictdibitmap ' + Buffer + ' }}';
end;

procedure InsertBitmap(const Bitmap: TBitmap; const RichEdit:TRichEdit);
begin
 RichEdit.SelText := ConvertBitmapToRTF(Bitmap);
 RichEdit.SelLength := 0;
 RichEdit.SelStart := RichEdit.SelStart + 1;
end;

procedure InsertBitmapIntoRichEdit(const GraphicFileName: string; const RichEdit: TRichEdit);// overload;
var
 Bitmap: TBitmap;
 Graphic: TPicture;
begin
 Graphic := TPicture.Create;
 try
 Graphic.LoadFromFile(GraphicFileName);
 if Graphic.Graphic is TBitmap then
 Bitmap := Graphic.Bitmap
 else begin
  Bitmap := TBitmap.Create;
  Bitmap.Assign(Graphic.Graphic);
 end;
 InsertBitmap(Bitmap, RichEdit);
 finally
  if Bitmap <> Graphic.Bitmap then
     FreeAndNil(Bitmap);
     FreeAndNil(Graphic);
end;

end; 
 
procedure InsertTableRichEdit(NumRows,NumCols:Integer;TableAttrs,CellAttrs: string;RichEdit: TRichEdit);
var
TableStr: string;
R,C:integer;
begin
TableStr := TableAttrs + '<table border="2" cellpadding="2" cellspacing="4" width="100%">';
 for R:=0 to NumRows do
 begin
  TableStr := TableStr + '<tr>';
  for C:=0 to NumCols do
  begin
   TableStr := TableStr + '<td width="50%">　</td>';
  end;
  TableStr := TableStr + '<tr>';
 end;
TableStr := TableStr + '</table>';

 RichEdit.SelText := TableStr+CellAttrs;
 RichEdit.SelLength := 0;
 RichEdit.SelStart := RichEdit.SelStart + 1;
end;


end.