Перемещение Image

[zih]

Копируется область экрана на форму. И нужно, чтобы при перемещении окна по рабочему столу, те координаты копирования рисунка смещались на столько же на сколько сместилось это окно.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm2 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Timer1Timer(Sender: TObject);
var
   hWindow: HWnd;
   r:       TRect;
 begin
   hWindow := FindWindow(nil, 'Новый текстовый документ-Блокнот');
   GetWindowRect(hWindow, r);
   begin
 label1.Caption:=IntToStr(r.Top);
 label2.Caption:=IntToStr(r.left);
   end;
end;



procedure TForm2.Timer2Timer(Sender: TObject);
 var
  dc:integer;
 bmp:TBitmap;
  i,k,j,n:integer;
   z:PByteArray;
  colors : array [0..255] of integer;
begin
 bmp := TBitmap.Create;
     Bmp.PixelFormat:=pf24bit;
    bmp.Width := image1.Width;
    bmp.Height := Image1.Height;
    DC:=GetDC(0);
 bitblt(bmp.Canvas.Handle,0,0,image1.Width,Image1.Height,DC,strtoint(label1.Caption)+474,strtoint(label2.Caption)+59,srccopy);
   image1.Picture.Assign(bmp);
     if not (Image1.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
        raise exception.create('Error, Format File not supported!');
      bmp.Free;
end;

end.

Красным выделил то, что не получается.

[volod3000]

Вот так будет работать как Вы хотите :

    Image1: TImage;
    procedure FormActivate(Sender: TObject);
  private
   Procedure WMMove(Var Message : TWMMove); message WM_Move;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
var
  dc:integer;
 bmp:TBitmap;
  i,k,j,n:integer;
   z:PByteArray;
  colors : array [0..255] of integer;
begin
 bmp := TBitmap.Create;
     Bmp.PixelFormat:=pf24bit;
    bmp.Width := image1.Width;
    bmp.Height := Image1.Height;
    DC:=GetDC(0);
 bitblt(bmp.Canvas.Handle,0,0,image1.Width,Image1.Height,DC,strtoint(intToStr(474)),strtoint(intToStr(59)),srccopy);
   image1.Picture.Assign(bmp);
     if not (Image1.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
        raise exception.create('Error, Format File not supported!');
      bmp.Free;
end;

Procedure TForm1.WMMove(Var Message : TWMMove);
 var
  dc:integer;
 bmp:TBitmap;
  i,k,j,n:integer;
   z:PByteArray;
  colors : array [0..255] of integer;
begin
 bmp := TBitmap.Create;
     Bmp.PixelFormat:=pf24bit;
    bmp.Width := image1.Width;
    bmp.Height := Image1.Height;
    DC:=GetDC(0);
 bitblt(bmp.Canvas.Handle,0,0,image1.Width,Image1.Height,DC,strtoint(intToStr(474)),strtoint(intToStr(59)),srccopy);
   image1.Picture.Assign(bmp);
     if not (Image1.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
        raise exception.create('Error, Format File not supported!');
      bmp.Free;
end;

[zih]

Я наверно все таки не правильно объяснил то что хотел. В общем в Image копируется область экрана с определенного окна например с Блокнота. И при перемещении за рамку этого блокнота надо чтобы эта область копирования так же сдигалась относительно смещения координат рамки этого Блокнота. Например Блокнот был в точках (0,0) на экране, оласть копирования была (474,59) - (верхняя левая точка копирования Image). После того как сдвинули за рамку этот блокнот, координаты его верхней левой точки стали 6,11. значит и область копирования должна сдвинуться на эти же координаты и стать 480,70. Спасибо за ответы заранее.

[volod3000]

Вам , наверное, подойдет принцип лупы, немного модифицировать его под Ваши нужды .

В прилагаемом архиве электронная лупа .

[zih]

Там, к сожалению, без объянений и не получается разобраться, может в моем коде просто поправите и все очень прошу.

[volod3000]

Попробуйте вот так определить координаты :

procedure TForm1.Timer1Timer(Sender: TObject);
var
   hWindow: DWORD;
   r      : TRect;

 begin
     if FindWindow('notepad',nil)<>0 then
        hWindow := FindWindow('notepad',nil);
        GetWindowRect(hWindow, &r);
   begin
        label1.Caption:=IntToStr(r.Top);
        label2.Caption:=IntToStr(r.left);
   end;
 end;

[zih]

С поиском координат у меня проблем не возникает. У меня возникает проблема в том чтобы облесть копирования тоже перемещалась, а у меня получается что она стоит на месте, хотя и указыввыю в ней на lable который меняются.

[volod3000]

Сообщение от zih

С поиском координат у меня проблем не возникает. У меня возникает проблема в том чтобы облесть копирования тоже перемещалась, а у меня получается что она стоит на месте, хотя и указыввыю в ней на lable который меняются.

Стоит на месте потому, что :
- Вы неправильно определили координаты

Вот так , вроде работает, правда корявенько, нужно подбирать значение
strtoint, и наверно не только его, но это уже другая песня.

procedure TForm1.FormCreate(Sender: TObject);
var
   hWindow: DWORD;
   r      : TRect;

 begin
     if FindWindow('notepad',nil)<>0 then
        hWindow := FindWindow('notepad',nil);
        GetWindowRect(hWindow, &r);
   begin
        label1.Caption:=IntToStr(r.Top);
        label2.Caption:=IntToStr(r.left);
   end;
 end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   hWindow: DWORD;
   r      : TRect;

 begin
     if FindWindow('notepad',nil)<>0 then
        hWindow := FindWindow('notepad',nil);
        GetWindowRect(hWindow, &r);
   begin
        label1.Caption:=IntToStr(r.Top);
        label2.Caption:=IntToStr(r.left);
   end;
 end;



procedure TForm1.Timer2Timer(Sender: TObject);
 var
  dc:integer;
 bmp:TBitmap;
  i,k,j,n:integer;
   z:PByteArray;
  colors : array [0..255] of integer;
begin
 bmp := TBitmap.Create;
     Bmp.PixelFormat:=pf24bit;
    bmp.Width := image1.Width;
    bmp.Height := Image1.Height;
    DC:=GetDC(0);
 bitblt(bmp.Canvas.Handle,0,0,image1.Width,Image1.Height,DC,strtoint(label1.Caption),strtoint(label2.Caption),srccopy);
   image1.Picture.Assign(bmp);
     if not (Image1.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
        raise exception.create('Error, Format File not supported!');
      bmp.Free;
end;

[zih]

Все тоже самое картинка копируется только из определенной области экрана а не смещается вместе со смещением окна

[volod3000]

Посмотрите вот это :

Могу скинуть весь проект.