[AXS]

Этот код позволяет выделить мышкой прямоугольную область и сохраняет координаты выделения в SRect

Код:

var
  AncX, AncY, CurX, CurY: Integer;
  Select: Boolean = False;
  SRect:TRect;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not Select then
    begin
      AncX := X;
      CurX := X;
      AncY := Y;
      CurY := Y;
      SRect.Left:=X;
      SRect.Top:=Y;
      Select := True;
    end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Select then
    begin
      Image1.Canvas.Pen.Mode := pmNotXor;
      Image1.Canvas.Pen.Style:= psDot;
      Image1.Canvas.Pen.Width := 1;
      Image1.Canvas.Brush.Style := bsClear;
      Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
      CurX := X;
      CurY := Y;
      Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
      Image1.Canvas.Pen.Style:= psSolid;
    end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Select then
  if (AncX <> CurX) and (AncY <> CurY) then
    begin
      Select := False;
      Image1.Canvas.Pen.Mode := pmXor;
      Image1.Canvas.Brush.Style := bsClear;
      Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
      SRect.Right:=X;
      SRect.Bottom:=Y;
      Close;
    end;
end;

Код не полный. Я его немного урезал чтоб не загромождать.