Usando como base el ejemplo19, cambiamos el codigo por este otro:
Código Delphi
[-]
procedure Copiar(DestDc: HDC; Zoom: Integer);
var
SrcWindow: THandle;
SrcDC: HDC;
SrcRect: TRect;
Ancho, Alto: Integer;
begin
GetWindowRect(GetForegroundWindow,SrcRect);
IntersectRect(SrcRect,SrcRect,Screen.WorkAreaRect);
SrcWindow:= GetDesktopWindow;
if SrcWindow <> 0 then
begin
SrcDC:= GetDC(SrcWindow);
if SrcDC <> 0 then
try
Ancho:= SrcRect.Right - SrcRect.Left;
Alto:= SrcRect.Bottom - SrcRect.Top;
StretchBlt( DestDC, 0, 0, Ancho * Zoom, Alto * Zoom, SrcDC, SrcRect.Left,
SrcRect.Top, Ancho, Alto, SRCCOPY);
finally
ReleaseDC(SrcWindow,SrcDC);
end;
end;
end;
procedure TfrmMain.tbZoomChange(Sender: TObject);
begin
pbZoom.Canvas.FillRect(pbZoom.Canvas.ClipRect);
end;
procedure TfrmMain.RelojTimer(Sender: TObject);
var
Bitmap: TBitmap;
begin
if btnCopiar.Checked then
begin
Copiar(pbZoom.Canvas.Handle,tbZoom.Position);
end;
if btnBorrar.Checked then
begin
pbZoom.Canvas.FillRect(pbZoom.Canvas.ClipRect);
Copiar(pbZoom.Canvas.Handle,tbZoom.Position);
end;
if btnBuffer.Checked then
begin
Bitmap:= TBitmap.Create;
try
Bitmap.Canvas.Brush.Color:= pbZoom.Canvas.Brush.Color;
Bitmap.Width:= pbZoom.Width;
Bitmap.Height:= pbZoom.Height;
Bitmap.Canvas.FillRect(pbZoom.Canvas.ClipRect);
Copiar(Bitmap.Canvas.Handle,tbZoom.Position);
pbZoom.Canvas.Draw(0,0,Bitmap);
finally
Bitmap.Free;
end;
end;
end;
Puede que esto se aproxime un poco mas a lo que buscas.