在RxRichEdit里面添加图片，怎么改变添加图片的大小呢？

Question

我想在RxRichEdit里面添加图片，想让添加的图片如果大小超过了Rxrichedit 的大小，就把图片的Width和Height的设置成跟Rxrichedit大小一样，用的Timage,发现更大大小没什么用，下面的代码是声明为TPicture，代码如下：procedure TForm1.btn1Click(Sender: TObject);
var
  aBitmap:TPicture;
  aclipboard:TClipboard ;
begin
   aBitmap:=Tpicture.Create ;
 // aBitmap:=TImage.Create(Self);
  aBitmap.LoadFromFile('D:\Startbild.bmp');
//  aBitmap.LoadFromFile() ;
 // aBitmap.Width :=RxRichEdit1.Width ;
  //aBitmap.Height :=RxRichEdit1.Height ;
//  aBitmap.AutoSize:=true ;
  aclipboard:=TClipboard.Create ;
  aclipboard.Assign(aBitmap);
  RxRichEdit1.PasteFromClipboard ;end;如上所示，我该怎么改变添加图片的大小，以适应Rxrichedit的大小呢

Answer 1

试试下列代码：procedure TForm1.btn1Click(Sender: TObject);
var Image:TImage;
    aclipboard:TClipboard;
begin
  Image:=TImage.Create(self);
  try
    Image.Picture.Bitmap.LoadFromFile('D:\Startbild.bmp');
    Image.AutoSize:=true;
    if (Image.Width>RxRichEdit1.Width)or(Image.Height>RxRichEdit1.Height) then begin
      Image.AutoSize:=false;
      Image.Stretch:=true;
      Image.Width:=RxRichEdit1.Width;
      Image.Height:=RxRichEdit1.Height;
    end;
    aclipboard:=TClipboard.Create ;
    try
      aclipboard.Assign(Image);
      RxRichEdit1.PasteFromClipboard ;
    finally
      aclipboard.Free;
    end;
  finally
    Image.Free;
  end;
end;

Answer 2

经校验，上面的代码错了，勘正如下(windows_xp + delphi7 编译运行通过)：procedure TForm1.btn1Click(Sender: TObject);
var Image:TImage;
    bmp:TBitmap;
    aclipboard:TClipboard;
begin
  Image:=TImage.Create(self);
  try
    Image.Picture.Bitmap.LoadFromFile('D:\Startbild.bmp');
    Image.AutoSize:=true;
    bmp:=TBitMap.Create;
    try
      if (Image.Width>RxRichEdit1.Width)or(Image.Height>RxRichEdit1.Height) then begin
        bmp.Width:=RxRichEdit1.Width;
        bmp.Height:=RxRichEdit1.Height ;
      end
      else begin
        bmp.Width:=Image.Width;
        bmp.Height:=Image.Height ;
      end;
      bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,Image.Picture.Bitmap);
      aclipboard:=TClipboard.Create ;
      try
        aclipboard.Assign(bmp);
        RxRichEdit1.PasteFromClipboard ;
      finally
        aclipboard.Free;
      end;
    finally
      bmp.Free;
    end;
  finally
    Image.Free;
  end;
end;

Answer 3

RxRichEdit是不能实現的,不能从RxRichEdit出发，而是从你的图片入手，比如插入图片前先調整图片大小

Answer 4

楼上思路完全正确。
为除符合LZ要求外，还保证按原图的长宽比添加到RxRichEdit，可以这么做：
procedure TForm1.btn1Click(Sender: TObject);
var Image:TImage;
    bmp:TBitmap;
    aclipboard:TClipboard;
    x,y,h:integer;
  function GetBitmapSize(var x1,y1:integer;x2,y2:integer):boolean;
  var k:Extended;
  begin
    Result:=false;
    k:=x1 / y1;  //原图的宽长比
    if k<=0 then exit;
    while x1>x2 do dec(x1);
    if x1<1 then exit;
    y1:=trunc(x1 / k);
    while y1>y2 do dec(y1);
    if y1<1 then exit;
    x1:=trunc(y1 * k );
    Result:=true;
  end;
begin
  if not OpenDialog1.Execute then exit;
  Image:=TImage.Create(self);
  try
    Image.Picture.Bitmap.LoadFromFile(OpenDialog1.FileName);
    Image.AutoSize:=true;
    bmp:=TBitMap.Create;
    try
      x:=Image.Width;//图片原始宽度
      y:=Image.Height;//图片原始高度
      h:=0;
      if RxRichEdit1.BorderStyle=bsSingle then h:=8;   //有边框时，有效高度-8
      if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height-h) then exit;
      //让待复制的图片小于、等于RxRichEdit1尺寸，并保持原有长宽比：
      bmp.Width:=x;
      bmp.Height:=y;
      //将图片按自动拉伸方式画到bmp的画布上：
      bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,Image.Picture.Bitmap);
      aclipboard:=TClipboard.Create ;
      try
        aclipboard.Assign(bmp);//复制到剪贴板
        RxRichEdit1.PasteFromClipboard ;//粘贴到RxRichEdit1
      finally
        aclipboard.Free;
      end;
    finally
      bmp.Free;
    end;
  finally
    Image.Free;
  end;
end;

Answer 5

谢谢gzzai的热心帮助，我现在的方法和你差不多，但是有个地方不一样，如果用你的方法只能插入BMP，我在下面做了改动：
 
 bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,Image.Picture.Graphic);这样BMP和JPG都可以插入，但是我当我插入PNG图片的时候，发现只能插入部分，会漏掉了一部分，我引用pngImage，不知道这个问题怎么解决呢？如果我把这个PNG图片插入到WORD里面，然后我直接复制WORD里面的图片通过Ctrl+V复制到rxRichedit，发现可以显示全部，好奇怪啊，不知道为什么

Answer 6

procedure TForm1.Button1Click(Sender: TObject);
var Image:TImage;
    bmp,ibmp:TBitmap;
    aclipboard:TClipboard;
    x,y,h:integer;
  function GetImage(img: TImage): boolean;
  var ms:TMemoryStream;
      OpenDialog: TOpenDialog;
      jpg:TJPEGImage;
      Buffer:Word;
  begin
    Result:=false;
    OpenDialog:=TOpenDialog.Create(self);
    try
      OpenDialog.Filter:='*.bmp;*.png;*.jpg|*.bmp;*.png;*.jpg';
      if OpenDialog.Execute then
      begin
        Result:=false;
        ms:=TMemoryStream.Create;
        try
          ms.LoadFromFile(OpenDialog.FileName);
          if ms.Size>0 then begin
            ms.Position := 0;
            ms.ReadBuffer(Buffer,2);
            if Buffer=$4D42 then begin //是BMP格式
              img.Picture.Bitmap.LoadFromFile(OpenDialog.FileName);
              Result:=true;
            end
            else if Buffer=$D8FF then begin //是JPG格式
              jpg:=TJPEGImage.Create;
              try
                jpg.LoadFromFile(OpenDialog.FileName);
                img.Picture.Bitmap.Assign(jpg);
                Result:=true;
              finally
                jpg.Free;
              end;
            end
            else if Buffer=$5089 then begin //PNG 格式
              img.Picture.LoadFromFile(OpenDialog.FileName);
              Result:=true;
            end;
          end;
        finally
          ms.Free;
        end;
      end;
    finally
      OpenDialog.Free;
    end;
  end;
  function GetBitmapSize(var x1,y1:integer;x2,y2:integer):boolean;
  var k:Extended;
  begin
    Result:=false;
    k:=x1 / y1;  //原图的宽长比
    if k<=0 then exit;
    if x1>x2 then x1:=x2;
    if x1<1 then exit;
    y1:=trunc(x1 / k);
    if y1>y2 then y1:=y2;
    if y1<1 then exit;
    x1:=trunc(y1 * k );
    Result:=true;
  end;
begin
  Image:=TImage.Create(self);
  try
    if not GetImage(Image) then raise Exception.Create('操作无效。');
    Image.AutoSize:=true;
    x:=Image.Width;//图片原始宽度
    y:=Image.Height;//图片原始高度
    ibmp:=TBitmap.Create;
    try
      ibmp.Width:=x;
      ibmp.Height:=y;
      ibmp.Canvas.StretchDraw(ibmp.Canvas.ClipRect,Image.Picture.Graphic);
      bmp:=TBitMap.Create;
      try
        h:=0;
        if RxRichEdit1.BorderStyle=bsSingle then h:=8;   //有边框时，有效高度-8
        if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height-h) then exit;
        //让待复制的图片小于、等于RxRichEdit1尺寸，并保持原有长宽比：
        bmp.Width:=x;
        bmp.Height:=y;
        //将图片按自动拉伸方式画到bmp的画布上：
        bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,ibmp);
        aclipboard:=TClipboard.Create ;
        try
          aclipboard.Assign(bmp);//复制到剪贴板
          RxRichEdit1.PasteFromClipboard ;//粘贴到RxRichEdit1
        finally
          aclipboard.Free;
        end;
      finally
        bmp.Free;
      end;
    finally
      ibmp.Free;
    end;
  finally
    Image.Free;
  end;
end;

Answer 7

        if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height-h) then exit;改为：
        if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height-h) then
           raise Exception.Create('无效尺寸。');

Answer 8

太感动gzzai，我晚上好好研究你的代码做下试验啊，再告诉你又什么问题啊，呵呵

Answer 9

下面是两张图片的三种格式，发现JPG和BMP都没问题，而PNG插入有问题下面是我的代码：   function TForm1.GetImage(aImage: TImage): Boolean;
var
  ms:TMemoryStream ;
  OpenDialog:TOpenDialog;
  Jpg:TJPEGImage;
  Buffer:Word ;
begin
  Result:=false ;
  OpenDialog:=TOpenDialog.Create(self);
  try
    OpenDialog.Filter :='*.bmp;*.png;*.jpg|*.bmp;*.png;*.jpg';
    if OpenDialog.Execute then
    begin
      Result :=false ;
      ms:=TMemoryStream.Create ;
      try
        ms.LoadFromFile(OpenDialog.FileName);
        if ms.Size >0 then
        begin
           ms.Position:=0;
           ms.ReadBuffer(Buffer,2);
           if Buffer =$4D42 then   //BMP¸ñʽ
           begin
              aImage.Picture.Bitmap.LoadFromFile(OpenDialog.FileName);
              Result :=true ;
           end
           else if Buffer =$D8FF then  //JPG¸ñʽ
           begin
             Jpg:=TjpegImage.Create ;
             try
               Jpg.LoadFromFile(OpenDialog.FileName);
               aImage.Picture.Assign(Jpg);
               Result :=true ;
             finally
               Jpg.Free ;
             end;
           end
           else if Buffer =$5089 then    //PNG¸ñʽ
           begin
              aImage.Picture.LoadFromFile(OpenDialog.FileName );
              Result :=true ;
           end;        end;
      finally
          ms.Free ;
      end;
    end;
  finally
    OpenDialog.Free ;
  end ;
end;procedure TForm1.RzButton1Click(Sender: TObject);
var
  aImage:TImage;
  bmp:TBitmap;
  aClipboard:TClipboard ;
  x,y,h:Integer ;  function GetBitmapSize(var x_Width,y_height:Integer;Rich_width,Rich_Height:Integer):Boolean ;
  var
    K:Extended;
  begin
    Result :=false ;
    K:=x_Width / y_height;//ԭͼµÄ¿í/¸ß ±È
    if k<0 then Exit ;
    if x_Width <1 then Exit ;
   //  while x_Width>Rich_width do Dec (x_Width ,1);
   if  x_Width >Rich_width then  x_Width:=Rich_width ;
   y_height:=Trunc(x_Width / k);
    if y_height >Rich_Height  then   y_height :=Rich_Height ;
    if y_height <1 then y_height :=0;
    x_Width :=Trunc(y_height*k); 
    Result :=true ;  end;
begin
  aImage:=TImage.Create(Self);
  try
   if not GetImage(aImage) then raise Exception.Create('²Ù×÷ÎÞЧ!') ;
   { if not Opendlg1.Execute then exit ;
    aImage.Picture.LoadFromFile(Opendlg1.FileName);   }
    aImage.AutoSize :=true ;
    x:=aImage.Width ;  //ͼƬԭʼ¿í¶È
    y:=aImage.Height ;   //ͼƬԭʼ¸ß¶È
    h:=0;
    bmp:=TBitmap.Create ;
   // if RxRichEdit1.BorderStyle=bsSingle then h:=8;//Óб߿òʱ£¬ÓÐЧ¿í¶È-8
    if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height ) then exit ;
    //±£³ÖÔ­ÓÐͼƬ¿í¶È±È
    bmp.Width :=x;
    bmp.Height :=y;
    bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect,aImage.Picture.Graphic );
    aClipboard:=TClipboard.Create ;
    try
      aClipboard.Assign(bmp);
      RxRichEdit1.PasteFromClipboard ;
    finally
      aClipboard.Free ;
    end;
  finally
    bmp.Free ;
  end;
  aImage.Free ;
end;如过用下面的方法，插入PNG，也是可以，我们常用的操作，不就是image直接插入图片吗，而不是要自己写代码去分析它属于哪个类型图片，我觉得是image自己会处理分析图片格式  //if not GetImage(aImage) then raise Exception.Create('²Ù×÷ÎÞЧ!') ;
    if not Opendlg1.Execute then exit ;
    aImage.Picture.LoadFromFile(Opendlg1.FileName);

Answer 10

可否将你的png发来让我测试，因为我最后给出的代码，在我这里三种图片均能正常。我是个较懒的人，也很希望如此弄。但是，可能我的人品出了问题，除bmp格式，没法用仁兄的方法打开其他格式，提示“Unknown picture file extension(.png)”或“Unknown picture file extension(.jpg)”，我在delphi6、7、2010下测试均如此，莫非你使用的不是TImage？

Answer 11

上面三张图片顺序是:png、bmp、jpg

Answer 12

大哥你也这么晚睡觉啊，和我一样啊下面这张是PNG格式的
然后你那个粘帖字适应大小怎么搞的呢？应该算是怎么样判断Ctrl+V这个过程，然后再判断粘帖的内容是不是图片吧？

Answer 13

你还未答我关于图片文件加载的问题哦：
  if not Opendlg1.Execute then exit ;
    aImage.Picture.LoadFromFile(Opendlg1.FileName);
难道我真的缺品.下面是将你的图片加入的截图，没你说的现象：

Answer 14

整个单元如下：unit Unit1;interfaceuses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RxRichEd, ExtCtrls;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    procedure Button1Click(Sender: TObject);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Clipbrd,pngimage,jpeg;
var Button1:TButton;
    RxRichEdit1:TRxRichEdit;{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var Image:TImage;
    bmp,ibmp:TBitmap;
    aclipboard:TClipboard;
    x,y,h:integer;
  function GetImage(img: TImage): boolean;
  var ms:TMemoryStream;
      OpenDialog: TOpenDialog;
      jpg:TJPEGImage;
      Buffer:Word;
  begin
    Result:=false;
    OpenDialog:=TOpenDialog.Create(self);
    try
      OpenDialog.Filter:='*.bmp;*.png;*.jpg|*.bmp;*.png;*.jpg';
      if OpenDialog.Execute then
      begin
        Result:=false;
        ms:=TMemoryStream.Create;
        try
          ms.LoadFromFile(OpenDialog.FileName);
          if ms.Size>0 then begin
            ms.Position := 0;
            ms.ReadBuffer(Buffer,2);
            if Buffer=$4D42 then begin //是BMP格式
              img.Picture.Bitmap.LoadFromFile(OpenDialog.FileName);
              Result:=true;
            end
            else if Buffer=$D8FF then begin //是JPG格式
              jpg:=TJPEGImage.Create;
              try
                jpg.LoadFromFile(OpenDialog.FileName);
                img.Picture.Bitmap.Assign(jpg);
                Result:=true;
              finally
                jpg.Free;
              end;
            end
            else if Buffer=$5089 then begin //PNG 格式
              img.Picture.LoadFromFile(OpenDialog.FileName);
              Result:=true;
            end;
          end;
        finally
          ms.Free;
        end;
      end;
    finally
      OpenDialog.Free;
    end;
  end;
  function GetBitmapSize(var x1,y1:integer;x2,y2:integer):boolean;
  var k:Extended;
  begin
    Result:=false;
    k:=x1 / y1;  //原图的宽长比
    if k<=0 then exit;
    if x1>x2 then x1:=x2;
    if x1<1 then exit;
    y1:=trunc(x1 / k);
    if y1>y2 then y1:=y2;
    if y1<1 then exit;
    x1:=trunc(y1 * k );
    Result:=true;
  end;
begin
  Image:=TImage.Create(self);
  try
    if not GetImage(Image) then raise Exception.Create('操作无效。');
    Image.AutoSize:=true;
    x:=Image.Width;//图片原始宽度
    y:=Image.Height;//图片原始高度
    ibmp:=TBitmap.Create;
    try
      ibmp.Width:=x;
      ibmp.Height:=y;
      ibmp.Canvas.StretchDraw(ibmp.Canvas.ClipRect,Image.Picture.Graphic);
      bmp:=TBitMap.Create;
      try
        h:=0;
        if RxRichEdit1.BorderStyle=bsSingle then h:=8;   //有边框时，有效高度-8
        if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height-h) then
           raise Exception.Create('无效尺寸。');
        //让待复制的图片小于、等于RxRichEdit1尺寸，并保持原有长宽比：
        bmp.Width:=x;
        bmp.Height:=y;
        //将图片按自动拉伸方式画到bmp的画布上：
        bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,ibmp);
        aclipboard:=TClipboard.Create ;
        try
          aclipboard.Assign(bmp);//复制到剪贴板
          RxRichEdit1.PasteFromClipboard ;//粘贴到RxRichEdit1
        finally
          aclipboard.Free;
        end;
      finally
        bmp.Free;
      end;
    finally
      ibmp.Free;
    end;
  finally
    Image.Free;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  with Form1 do begin
    Height:= 256;
    Width:= 340;
    Position:= poScreenCenter;
    Caption:='粘贴自适应图片';
    RxRichEdit1:=TRxRichEdit.Create(self);
    try
      RxRichEdit1.Parent:=Form1;
      RxRichEdit1.Align:=alTop;
      RxRichEdit1.Height:=Height - 80;
    except
      freeAndNil(RxRichEdit1);
    end;
    Button1:=TButton.Create(self);
    try
      Button1.Parent:=Form1;
      Button1.Top:=Height - 70;
      Button1.Left:=Width div 2 - 38;
      Button1.Caption:='加入';
      Button1.OnClick:=Button1Click;
    except
      freeAndNil(Button1);
    end;
  end;
end;procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if RxRichEdit1<>nil then RxRichEdit1.Free;
  if Button1<>nil then Button1.Free;
end;end.

Answer 15

大哥我发现我们俩程序不一样的地方，我为什么PNG不能显示全部，你使用bmp和ibmp两次画布，而我只使用了一次画图，具体语句啊，如下，当我从Image复制到图片后，我就直接赋值给clipbrd而你是通过另外一个BMP转了一次，就出现我那种PNG显示不全的现象，这是为什么呢？我的代码如下：    //if not GetImage(aImage) then raise Exception.Create('²Ù×÷ÎÞЧ!') ;
    if not Opendlg1.Execute then exit ;
    aImage.Picture.LoadFromFile(Opendlg1.FileName);
    aImage.AutoSize :=true ;
    x:=aImage.Width ;  //图片原始宽度
    y:=aImage.Height ;   //图片原始高度
    h:=0;
    bmp:=TBitmap.Create ;
   // if RxRichEdit1.BorderStyle=bsSingle then h:=8;//有效边框时，宽度-8
    if not GetBitmapSize(x,y,RxRichEdit1.Width,RxRichEdit1.Height ) then exit ;
    //保持原有宽度比
    bmp.Width :=x;
    bmp.Height :=y;
    bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect,aImage.Picture.Graphic );
    aClipboard:=TClipboard.Create ;
    try
      aClipboard.Assign(bmp);
      RxRichEdit1.PasteFromClipboard ;
    finally
      aClipboard.Free ;
    end;
  finally
    bmp.Free ;
  end;
你说你那个为什么不行，    if not Opendlg1.Execute then exit ;
    aImage.Picture.LoadFromFile(Opendlg1.FileName);我看了一下我的引用单元，  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Clipbrd, RzButton, StdCtrls, RxRichEd, ExtCtrls,jpeg,pngimage;多了一个Variants类型，Variants我记得是可以自动判断数据类型的吧，是不？我刚才在你的程序添加了variants单元，就不报你说的那个错了啊，你试试看哦，呵呵

Answer 16

果然是我的人品问题：我在 aImage.Picture. 这“点”之后加了东西造成，跟引用单元无关。代码更正如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RxRichEd, ExtCtrls;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    procedure Button1Click(Sender: TObject);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Clipbrd,pngimage,jpeg;
var Button1:TButton;
    RxRichEdit1:TRxRichEdit;{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var Image:TImage;
    bmp,ibmp:TBitmap;
    aclipboard:TClipboard;
    x,y,h,w:integer;
    OpenDialog: TOpenDialog;
  function GetBitmapSize(var x1,y1:integer;x2,y2:integer):boolean;
  var k:Extended;
  begin
    Result:=false;
    k:=x1 / y1;  //原图的宽长比
    if k<=0 then exit;
    if x1>x2 then x1:=x2;
    if x1<1 then exit;
    y1:=trunc(x1 / k);
    if y1>y2 then y1:=y2;
    if y1<1 then exit;
    x1:=trunc(y1 * k );
    Result:=true;
  end;
begin
  Image:=TImage.Create(self);
  try
    OpenDialog:=TOpenDialog.Create(self);
    try
      OpenDialog.Filter:='*.bmp;*.png;*.jpg|*.bmp;*.png;*.jpg';
      if OpenDialog.Execute then begin
        Image.Picture.LoadFromFile(OpenDialog.FileName);
        Image.AutoSize:=true;
        x:=Image.Width;//图片原始宽度
        y:=Image.Height;//图片原始高度
        ibmp:=TBitmap.Create;
        try
          ibmp.Width:=x;
          ibmp.Height:=y;
          ibmp.Canvas.StretchDraw(ibmp.Canvas.ClipRect,Image.Picture.Graphic);
          bmp:=TBitMap.Create;
          try
            h:=0;
            w:=0;
            if RxRichEdit1.BorderStyle=bsSingle then begin
              h:=8;   //有边框时，有效高度-8
              w:=8;   //有边框时，有效宽度-8
            end;
            if not GetBitmapSize(x,y,RxRichEdit1.Width-w,RxRichEdit1.Height-h) then
               raise Exception.Create('无效尺寸。');
            //让待复制的图片小于、等于RxRichEdit1尺寸，并保持原有长宽比：
            bmp.Width:=x;
            bmp.Height:=y;
            //将图片按自动拉伸方式画到bmp的画布上：
            bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,ibmp);
            aclipboard:=TClipboard.Create ;
            try
              aclipboard.Assign(bmp);//复制到剪贴板
              RxRichEdit1.PasteFromClipboard ;//粘贴到RxRichEdit1
            finally
              aclipboard.Free;
            end;
          finally
            bmp.Free;
          end;
        finally
          ibmp.Free;
        end;
      end;
    finally
      OpenDialog.Free;
    end;
  finally
    Image.Free;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  with Form1 do begin
    Height:= 256;
    Width:= 340;
    Position:= poScreenCenter;
    Caption:='粘贴自适应图片';
    RxRichEdit1:=TRxRichEdit.Create(self);
    try
      RxRichEdit1.Parent:=Form1;
      RxRichEdit1.Align:=alTop;
      RxRichEdit1.Height:=Height - 80;
    except
      freeAndNil(RxRichEdit1);
    end;
    Button1:=TButton.Create(self);
    try
      Button1.Parent:=Form1;
      Button1.Top:=Height - 70;
      Button1.Left:=Width div 2 - 38;
      Button1.Caption:='加入';
      Button1.OnClick:=Button1Click;
    except
      freeAndNil(Button1);
    end;
  end;
end;procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if RxRichEdit1<>nil then RxRichEdit1.Free;
  if Button1<>nil then Button1.Free;
end;end.

Answer 17

严谨一点，按钮事件该是这样：
procedure TForm1.Button1Click(Sender: TObject);
var Image:TImage;
    bmp,ibmp:TBitmap;
    aclipboard:TClipboard;
    x,y,h,w:integer;
    OpenDialog: TOpenDialog;
  function GetBitmapSize(var x1,y1:integer;x2,y2:integer):boolean;
  var k:Extended;
  begin
    Result:=false;
    k:=x1 / y1;  //原图的宽长比
    if k<=0 then exit;
    if x1>x2 then x1:=x2;
    if x1<1 then exit;
    y1:=trunc(x1 / k);
    if y1>y2 then y1:=y2;
    if y1<1 then exit;
    x1:=trunc(y1 * k );
    Result:=true;
  end;
begin
  OpenDialog:=TOpenDialog.Create(self);
  try
    OpenDialog.Filter:='*.bmp;*.png;*.jpg|*.bmp;*.png;*.jpg';
    if OpenDialog.Execute then begin
      Image:=TImage.Create(self);
      try
        Image.Picture.LoadFromFile(OpenDialog.FileName);
        Image.AutoSize:=true;
        x:=Image.Width;//图片原始宽度
        y:=Image.Height;//图片原始高度
        ibmp:=TBitmap.Create;
        try
          ibmp.Width:=x;
          ibmp.Height:=y;
          ibmp.Canvas.StretchDraw(ibmp.Canvas.ClipRect,Image.Picture.Graphic);
          bmp:=TBitMap.Create;
          try
            h:=0;
            w:=0;
            if RxRichEdit1.BorderStyle=bsSingle then begin
              h:=8;   //有边框时，有效高度-8
              w:=8;   //有边框时，有效宽度-8
            end;
            if not GetBitmapSize(x,y,RxRichEdit1.Width-w,RxRichEdit1.Height-h) then
               raise Exception.Create('无效尺寸。');
            //让待复制的图片小于、等于RxRichEdit1尺寸，并保持原有长宽比：
            bmp.Width:=x;
            bmp.Height:=y;
            //将图片按自动拉伸方式画到bmp的画布上：
            bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect,ibmp);
            aclipboard:=TClipboard.Create ;
            try
              aclipboard.Assign(bmp);//复制到剪贴板
              RxRichEdit1.PasteFromClipboard ;//粘贴到RxRichEdit1
            finally
              aclipboard.Free;
            end;
          finally
            bmp.Free;
          end;
        finally
          ibmp.Free;
        end;
      finally
        Image.Free;
      end;
    end;
  finally
    OpenDialog.Free;
  end;
end;

Answer 18

那是pngimage单元的bug，若要不使用bmp和ibmp两次画布，得修改pngimage的源码：
......
  StretchBlt(BufferDC, 0, 0, Header.Width, Header.height, DC, Rect.Left,
    Rect.Top, Header.Width, Header.Height, SRCCOPY);//我这里的是4376行
......从源码可见，它并没按的图尺寸拉伸。

Answer 19

StretchBlt函数定义剪贴如下：
StretchBlt 
   函数从源矩形中复制一个位图到目标矩形，必要时按目前目标设备设置的模式进行图像的拉伸或压缩以满足目标矩形的尺寸。原型：BOOL StretchBlt(    HDC hdcDest,     int nXOriginDest, int nYOriginDest,  int nWidthDest, int nHeighDest,     HDC hdcSrc,     int nXOriginSrc,   int nYOriginSrc,   int nWidthSrc,   int nHeightSrc,     DWORD dwRop)；参数：hdcDest：指向目标设备环境的句柄。nXOriginDest、nYOriginDest：指定目标矩形左上角的X轴和Y轴坐标，按逻辑单位表示。nWidthDest、nHeightDest：指定目标矩形的宽度和高度，按逻辑单位表示。hdcSrc：指向源设备环境的句柄。nXOriginSrc、nYOriginSrc：指向源矩形区域左上角的X轴和Y轴坐标，按逻辑单位表示。nWidthSrc、nHeightSrc：指定源矩形的宽度和高度，按逻辑单位表示。dwRop：指定要进行的光栅操作。光栅操作码定义了系统如何在输出操作中组合颜色，这些操作包括画刷、源位图和目标位图等对象。参考 BitBlt 可了解常用的光栅操作码列表。在Windows CE 1.0和1.01版中，参数dwRop只支持SRCCOPY 和 SRCINVERT 。返回值：如果函数执行成功，那么返回值为非零，如果函数执行失败，那么返回值为零。若想获得更多的错误信息，请调用GetLastError函数

Answer 20

更正23楼如下：那是pngimage单元的bug，若要不使用bmp和ibmp两次画布，得修改pngimage的源码：unit pngimage;
......
  StretchBlt(DC, Rect.Left, Rect.Top, Header.Width, Header.Height, BufferDC,
    0, 0, Header.Width, Header.Height, SRCCOPY);//单元中的4482行
......从源码4482行代码可见，它并没按的图尺寸（Rect.Right-Rect.Left, Rect.Bottom-Rect.Top）拉伸，而是按源图尺寸（Header.Width, Header.Height）复制。