re2bmpf.pas

来自「很多 delphi 精彩小例子。供大家参考。」· PAS 代码 · 共 60 行

unit RE2BMPF;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var newBitmap: TBitmap;
    ScreenDC: HDC;
    REOrg: TPoint;
begin
newBitmap:=TBitmap.Create;
try
    Image1.Picture.Graphic:=newBitmap;
    Image1.Picture.Graphic.Width:=RichEdit1.ClientWidth;
    Image1.Picture.Graphic.Height:=RichEdit1.ClientHeight;
    REOrg:=RichEdit1.ClientToScreen(Point(0,0));
    ScreenDC:=GetDC(0);
    try
        BitBlt(Image1.Picture.Bitmap.Canvas.Handle,0,0,RichEdit1.ClientWidth,RichEdit1.ClientHeight,ScreenDC,REOrg.X, REOrg.Y, SRCCOPY);
    finally
        ReleaseDC(0, ScreenDC);
    end;
finally
    newBitmap.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
    Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;

end.