Ver Mensaje Individual
  #8  
Antiguo 15-12-2006
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
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
  // Obtenemos las coordenadas de la ventana activa
  GetWindowRect(GetForegroundWindow,SrcRect); 
  // Lo intersecamos con el area de trabajo
  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;

// Esto es lo mismo de antes solo que ahora no pasamos las coordenadas a la funcion Copiar
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.
Responder Con Cita