Hvordan laver man en "markeringsfirkant"?

http://eksperten.dk/spm/570309

Det har jeg set og der står intet...

Jo der gør.

Så vis mig koden ;-)

Læs det afsnit nico26 skriver om. Der er også kodeeksempler.

Jeg HAR læst det, og det de mener med "rubber banding" er det samme som der sker hvis du vil tegne en ret linie i Word eller Paint. Den tegner stregen mens man trækker i den. Det har intet med firkantede markeringer at gøre.

Det er jo bare at tegne en firkant i stedet for en ret linje.

Hej futterama
Prøv denne kode, som tegner en firkant på formen.

//EHT

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  var
  A, B, C, D: TPoint;
  XStart, YStart: Integer;
const
  CanDraw:boolean = false;

implementation

{$R *.DFM}
procedure Tegn(PenMode: TPenMode; PenColor: integer; Penwidth: integer;PenStyle:TPenStyle);
begin
with Form1.Canvas do
  begin
    Pen.Mode := PenMode;
    Pen.Style := PenStyle;
    Pen.Width := Penwidth;
    Pen.color := Pencolor;
    PolyLine([A, B, D, C, A]);
  end;
end;

procedure StartSlutFelt(X, Y: Integer);
begin
  A.X := XStart;
  A.Y := YStart;
  B.X := X;
  B.Y := A.Y;
  C.X := A.X;
  C.Y := Y;
  D.X := B.X;
  D.Y := C.Y;
  Tegn(pmNotXor, clBlack, 1,psDot);
end;

procedure FlytteFelt(X, Y: integer);
begin
  Tegn(pmNotXor, clBlack, 1,psDot); //tegner
  A.X := XStart;
  A.Y := YStart;
  B.X := X;
  B.Y := A.Y;
  C.X := A.X;
  C.Y := Y;
  D.X := B.X;
  D.Y := C.Y;
  Tegn(pmNotXor, clBlack, 1,psDot); //sletter igen

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if CanDraw then FlytteFelt(X, Y);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  XStart := X;
  YStart := Y;
  StartSlutFelt(X, Y);
  CanDraw := true;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
CanDraw := false;
FlytteFelt(X, Y);
StartSlutFelt(X,Y);
end;

end.

Med nogle få ændringer virker det som jeg gerne vil have det, tak :-)