Ver Mensaje Individual
  #6  
Antiguo 02-05-2007
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
Aunque he pensado que puede que te encuentres detrás de algún proxy que te impide bajar archivos zip.

En cualquier caso, aquí te dejo el archivo pas que esta dentro del zip:
Código Delphi [-]
unit ufrmMain;

interface

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

type
  TfrmMain = class(TForm)
    ScrollBox1: TScrollBox;
    imgPantalla: TImage;
    Panel1: TPanel;
    lbTop: TLabel;
    lbLeft: TLabel;
    lbBottom: TLabel;
    lbRight: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure imgPantallaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgPantallaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    Seleccion: TRect;
    procedure Seleccionar(R: TRect);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Seleccionar(R: TRect);
begin
  imgPantalla.Canvas.Brush.Style:= bsClear;;
  imgPantalla.Canvas.Pen.Style:= psDash;
  imgPantalla.Canvas.Pen.Mode:= pmNot;
  imgPantalla.Canvas.Rectangle(Seleccion);
  imgPantalla.Canvas.Rectangle(R);
  Seleccion:= R;
  if Seleccion.Left > Seleccion.Right then
  begin
    R.Left:= Seleccion.Right;
    R.Right:= Seleccion.Left;
  end;
  if Seleccion.Top > Seleccion.Bottom then
  begin
    R.Top:= Seleccion.Bottom;
    R.Bottom:= Seleccion.Top;
  end;
  if not isRectEmpty(R) then
  begin
    lbTop.Caption:= 'Top = ' + IntToStr(R.Top);
    lbLeft.Caption:= 'Left = ' + IntToStr(R.Left);
    lbBottom.Caption:= 'Bottom = ' + IntToStr(R.Bottom);
    lbRight.Caption:= 'Right = ' + IntToStr(R.Right);
  end else
  begin
    lbTop.Caption:= 'Top = ';
    lbLeft.Caption:= 'Left = ';
    lbBottom.Caption:= 'Bottom = ';
    lbRight.Caption:= 'Right = ';
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  bmp: Tbitmap;
begin
  FillChar(Seleccion,SizeOf(Seleccion),0);
  bmp:= Tbitmap.Create;
  try
    try
      bmp.Width:= GetSystemMetrics(SM_CXSCREEN);
      bmp.Height:= GetSystemMetrics(SM_CYSCREEN);
      BitBlt(bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,GetDc(0),0,0,SRCCOPY);
      imgPantalla.Picture.Bitmap.Assign(bmp);
    finally
      bmp.free;
    end;
  except end;
end;

procedure TfrmMain.imgPantallaMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    Seleccionar(Rect(X,Y,X,Y));
end;

procedure TfrmMain.imgPantallaMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    if x < 0 then x:= 0;
    if y < 0 then y:= 0;
    if x > imgPantalla.Width then x:= imgPantalla.Width;
    if y > imgPantalla.Height then y:= imgPantalla.Height;
    Seleccionar(Rect(Seleccion.Left,Seleccion.Top,X,Y));
  end;
end;

end.
Responder Con Cita