delphi 取控件下的图象

本文整理自网络，侵删。

 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg;
 
type
  TForm1 = class(TForm)
    pnl1: TPanel;
    pnl2: TPanel;
    img1: TImage;
    img2: TImage;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.btn1Click(Sender: TObject);
   var
    DC : HDC;
    SaveIndex : HDC;
    Position: TPoint;
    Control : TWinControl ;
    Buf : TBitmap;
    w:integer;
begin
    Buf := TBitmap.Create();
    Buf.PixelFormat := pfDevice;
    Buf.Width := btn1.Width;
    Buf.Height := btn1.Height;
 
     Control:= btn1;
   if Control.Parent <> nil then
    begin
{$R-}
        DC := Buf.Canvas.Handle;
        SaveIndex := SaveDC(DC);
        GetViewportOrgEx(DC, Position);
        SetViewportOrgEx(DC, Position.X - Control.Left, Position.Y - Control.Top, nil);
        IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
        Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
        Control.Parent.Perform(WM_PAINT, DC, 0);
        RestoreDC(DC, SaveIndex);
         w:=Buf.Width;
        self.img1.Picture.Graphic:=Buf;
{$R+}
    end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    self.btn1.Parent:=self.pnl1;
end;
 
end.
 
 

相关阅读 >>

Delphi 简单播放mp3

Delphi 为 service application 添加描述文本的方法

Delphi 显示提示信息xxx 是/否

Delphi整理二（object pascal语言）

Delphi复制文件时，如何显示进度条

Delphi 从字符串提取字符串

Delphi 坐标截图如何实现

Delphi unknown picture file extension (.jpg) 错误提示

Delphi new 为指针分配内存空间

Delphi 判断一个颜色是否是亮色

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » delphi 取控件下的图象