RSS订阅 | 匿名投稿
您的位置:网站首页 > 图像 > 正文

delphi 取控件下的图象

作者:admin 来源: 日期:2018/3/5 12:37:23 人气: 标签:

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.
 

读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址:
下一篇:没有资料