1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

procedure TMain.Screenshot;
var DesktopHandle: HDC;
    ShotTargetBitmap : TBitmap;
begin
 if not Assigned(SynchP.TargetBmp) then
    Exit;
  Shottargetbitmap := TBitmap.Create;
  try
    ShotTargetbitmap.Width := SynchP.Bounds.Right - SynchP.Bounds.Left;
    ShotTargetbitmap.Height := SynchP.Bounds.Bottom - SynchP.Bounds.Top;
    SynchP.TargetBmp.Width := SynchP.Rechts - SynchP.Links;
    SynchP.TargetBmp.Height := SynchP.Unten - SynchP.Oben;
    DesktopHandle := GetDC(0);
    try
      BitBlt(ShotTargetBitmap.Canvas.Handle, 0 ,0, SynchP.bounds.Right-SynchP.bounds.left,
        SynchP.bounds.Bottom - SynchP.bounds.top, DesktopHandle, SynchP.bounds.Left,
        SynchP.bounds.Top,SRCCOPY);
      BitBlt(SynchP.TargetBmp.Canvas.Handle, 0, 0, SynchP.Rechts, SynchP.Unten,
        ShotTargetBitmap.Canvas.Handle, SynchP.Links, SynchP.Oben, SRCCOPY);
    finally
      ReleaseDC(0, DesktopHandle);
    end;
  finally
    FreeAndNil(ShotTargetBitmap);
  end;
end;

procedure TMain.ScreenshotSynched(Bounds2:TRect; Links2, Rechts2, Oben2,
                                         Unten2 : Integer; var Bmp : TBitmap);
begin
  with SynchP do
  begin
    Bounds := Bounds2;
    Links := Links2;
    Rechts := Rechts2;
    Oben := Oben2;
    Unten := Unten2;
  end;
  SYNCHRONIZE(ScreenShot);
  Bmp.Assign(SynchP.TargetBmp);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

type
  TScreenShot = class
  private
    FBitmap: HBITMAP;
    procedure Clear;
  public
    property Bitmap: HBITMAP read FBitmap;
    procedure Execute(Rect: TRect);
    destructor Destroy; override;
  end;

procedure TScreenShot.Clear;
begin
  DeleteObject(FBitmap);
  FBitmap := 0;
end;

destructor TScreenShot.Destroy;
begin
  Clear;
  inherited;
end;

procedure TScreenShot.Execute(Rect: TRect);
const
  CAPTUREBLT = $40000000;
var
  Width, Height: Integer;
  DesktopWindow: HWND;
  SourceDC, TargetDC: HDC;
begin
  if FBitmap <> 0 then
    Clear;

  Width := Rect.Right - Rect.Left;
  Height := Rect.Bottom - Rect.Top;

  DesktopWindow := GetDesktopWindow;
  SourceDC := GetDC(DesktopWindow);
  TargetDC := CreateCompatibleDC(SourceDC);
  FBitmap := CreateCompatibleBitmap(SourceDC, Width, Height);
  SelectObject(TargetDC, FBitmap);
  BitBlt(TargetDC, 0, 0, Width, Height, SourceDC, Rect.Left, Rect.Top, SRCCOPY or CAPTUREBLT);
  ReleaseDC(DesktopWindow, SourceDC);
  DeleteDC(TargetDC);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

procedure TScreenShot.Execute(Bounds: TRect);
const
  CAPTUREBLT = $40000000;
var
  Width, Height: Integer;
  DesktopWindow: HWND;
  SourceDC, TargetDC: HDC;
begin
  if FBitmap <> 0 then
    Clear;

  Width := Bounds.Right - Bounds.Left;
  Height := Bounds.Bottom - Bounds.Top;

  DesktopWindow := GetDesktopWindow;
  SourceDC := GetDC(DesktopWindow);
  TargetDC := CreateCompatibleDC(SourceDC);
  FBitmap := CreateCompatibleBitmap(SourceDC, Width, Height);
  SelectObject(TargetDC, FBitmap);
  BitBlt(TargetDC, 0, 0, Width, Height, SourceDC, Bounds.Left, Bounds.Top, SRCCOPY or CAPTUREBLT);

  ReleaseDC(DesktopWindow, SourceDC);
  DeleteDC(TargetDC);
end;

procedure TScreenshot.Cut(Links, Rechts, Oben, Unten : Integer; SourceBitmap : TBitmap; var TargetBmp : TBitmap);
begin
  TargetBmp.Width := Rechts - Links;
  TargetBmp.Height := Unten - Oben;
  Windows.BitBlt(TargetBmp.Canvas.Handle, 0, 0, rechts, unten, SourceBitmap.Canvas.Handle, links, oben, SRCCOPY);
  randomize;
  TargetBmp.SaveToFile('L:\Tests\'+inttostr(random(99999))+'.bmp');
end;                    

1:
2:
3:
4:

    TS.Execute(Rect(Links,Oben,Links+100,Oben+100));
    SourceBmp.Handle := TS.Bitmap;

    TS.Cut(50,100,90,100, SourceBmp, TargetBmp);                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TMain.GetImgLstSynched(pos : integer; var bmp : TBitmap);
begin
  ColorL.Nr := Pos;
  Synchronize(GetImgLst);
  bmp.Assign(ColorL.Bmp);
end;

procedure TMain.GetImgLst;
begin
  GUI.ImgLst.GetBitmap(ColorL.Nr, ColorL.Bmp);
end;