det går LANGSOMT....zzzZZZzzz

nogen der kender en lidt bedere måde at lave sådan en "markerings boks" eller hvad jeg nu skal kalde det, det går nemlig også langsomt for den at følge med musen.

Hvordan laver du din markeringsbox nu?

bruger du din forms canvas til at tegne med? Borrisholt har i sin tid lavet en anden timer (ThreadTimer) den er meget mere stabil end delphi's standard TTimer!

Hej Hermandsen. Jeg går udfra at du har fået et nyhedsbrev fra mig i løbet af dagen. Der er kommet en tutorial mere siden nyhedsbrevet: "Lys og Materials" - synes bare lige du skulle vide det!!! :)) God Førnøjelse!

>>zerohero
Du kan da tro jeg har fået det!!! ;)

jeg laver den med en TShape

Prøv at komme med lidt kode... Personligt ville jeg nok gøre således:

private
  Drawing: Boolean;
  StartX, StartY: Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drawing := False;
end;

procedure TForm1.FormMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True;
  StartX := X;
  StartY := Y;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then with Canvas do
  begin
    //Clear formen
    Brush.Color := clBtnFace;
    Pen.Color := clBtnFace;
    Rectangle(GetClientRect);
    //Tegner det nye rektangel
    Brush.Color := clBlack;
    Pen.Color := clBlack;
    Rectangle(StartX, StartY, X, Y);
  end;
end;

Ved ikke om det kunne hjæple... Personligt tror jeg faktisk også det er hurtigere end at bruge en Shape, men jeg er ikke 100% sikker...

//hermandsen

Jeg tror jeg ville gøre således ;))...

var
  t : integer;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.interval := 50;
  if timer1 <> nil then
  inc(t,1);
  caption := inttostr(t);
end;

var
  b : boolean;
  sx, sy : integer;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssleft in shift then
  with canvas do
  begin
    if not b then
    begin
      sx := x;
      sy := y;
      b := true;
    end;
    pen.style := psdot;
    brush.color := color;
    fillrect(clientrect);
    rectangle(sx,sy,x,y);
  end;
end;

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

ZeroHero

Der bliver ingen påvirkelse af min TTimer ved at gøre det på denne måde :))

øhh Hermandesn du har 2 FormMouseDown procedure kørende - du mener vist at den sidste skal være en FormMouseMove, gør du ikke? ;)

faktisk behøver du kun 2 procedure, med mit eksempel:

var
  t : integer;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.interval := 50;
  if timer1 <> nil then
  inc(t,1);
  caption := inttostr(t);
end;

var
  b : boolean;
  sx, sy : integer;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssleft in shift then
  with canvas do
  begin
    if not b then
    begin
      sx := x;
      sy := y;
      b := true;
    end;
    pen.style := psdot;
    brush.color := color;
    brush.Style := bsclear;
    fillrect(clientrect);
    rectangle(sx,sy,x,y);
  end
  else
    b := false;
end;

>>zerohero
Oups... My bad... Sad og kopierede fra hjælpen, da jeg ikke kunne huske alle de parametre der var med MouseMove og MouseDown, og så er det vist gået galt en enkelt gang... ;)

Hvad mangler du? Hvad var der galt med svaret?

hmmm, den laver godt nok en box men.... jeg har en masse billeder på min form --> de forsvinder ved "fillrect(clientrect);"

nu har jeg rodet lidt så det passer til mine behov:

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

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if down then begin
    canvas.pen.style := psdot;
    canvas.pen.color := cllime;
    canvas.Brush.Style := bsclear;
    canvas.rectangle(stx,sty,x,y);
end;


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

hvordan får jeg den så til når den opdaterer rect'en kun at fjerne den rect der blev lavet tidligere? lige nu fylder den jo hele min skærm med dem når jeg rykker musen frem og tilbage..

sludder, det ser sådan ud:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
down := true;
STx := x;
STy := y;
end;

Jeg er ikke helt sikker på hvad du vil, men prøv:

Canvas.Rectangle(GetClientRect);

prøv dette, så vil du forstå....

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; 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;
  down : boolean;
  stx,sty : integer;
implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
down := true;
STx := x;
STy := y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);

begin
if down then begin
    canvas.pen.style := psdot;
    canvas.pen.color := cllime;
    canvas.Brush.Style := bsclear;
  canvas.rectangle(stx,sty,x,y);
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
down := false;
end;

end.

Arh... I get it... ;)

Brug lige føgende i stedet:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; 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;
  Down: Boolean;
  stx, sty, oldx, oldy: integer;
implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  down := true;
  stx := x;
  sty := y;
  oldx := x;
  oldy := y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if down then with Canvas do
  begin
    Pen.Color := Color;
    Rectangle(stx,sty,oldx,oldy);
    Pen.Style := psdot;
    Pen.Color := cllime;
    Brush.Style := bsclear;
    Rectangle(stx,sty,x,y);
    oldx := x;
    oldy := y;
  end;
end;

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

end.

prøv at indsætte et billede på formen og kør over med musen....

Prøv det her:

unit Unit1;

interface

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

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

var
  Form1: TForm1;
  Down: Boolean;
  stx, sty, oldx, oldy: integer;
implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  down := true;
  stx := x;
  sty := y;
  oldx := x;
  oldy := y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if down then with Canvas do
  begin
    Pen.Color := Color;
    Rectangle(stx,sty,oldx,oldy);
    Pen.Style := psdot;
    Pen.Color := cllime;
    Brush.Style := bsclear;
    Rectangle(stx,sty,x,y);
    oldx := x;
    oldy := y;
    Image1.Repaint;
  end;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

end.

hehe, forestil dig at jeg har omkring 50 billeder på min form....
kan man ikke slette canvas med canvas.free eller noget for det vil jo nok tage lidt tid at repainte 50 billeder. eller hvad ved jeg, er der heller ik noget der hedder 'undo' eller sådan noget.... jeg er godt nok vild efter at få det til at køre!! hehe

Så findes der faktisk noget RIGTIGT smart du kan!!! :)

Du får altså bare ændringerne denne her gang...

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if down then with Canvas do
  begin
    Rectangle(stx,sty,oldx,oldy);
    Pen.Style := psdot;
    Pen.Mode := pmNotXor;
    Pen.Color := clLime;
    Brush.Style := bsclear;
    Rectangle(stx,sty,x,y);
    oldx := x;
    oldy := y;
  end;
end;

hmmmm det var jo lige det jeg stod og manglede..BRAVO
MEEEEEEN... jeg vil gerne have at rektanglet forsvinder når jeg slipper knappen.... det skal som jeg startede med at skrive jo være ligesom når man markerer flere ikoner på fx. skrivebordet.

tyg lidt på den....hehe

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  down := false;
  Canvas.Rectangle(stx,sty,oldx,oldy);
end;

Var der mere? :)

Du kan forresten godt fjerne

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

igen... Det behøves ikke mere! :)

nu har jeg sgu afvist dine svar så mange gange ...så du får sgu 100 point når det lykkes.
hmmm om der var mere....ok ja, hvis jeg laver en rect og slipper musen så kan jeg ikke få lov til at lave en ny hvis det er inde for det samme område som den forrige...(kun nogle gange)... skriv lige hvis du har brug for uddybning...

Uddybning! :)

Er det når du starter trækket fra dit billede?

ikke fra billedet nej, det er kun nogle gange den gør det!! og det er efter hvad jeg kan se hvis jeg starter trækket fra et punkt som er 'inde' for den forrige rect....hmmmm jeg er sq ik så god til at forklare..sorry

Øhhh, nej... Lav et direkte eksempel, og sig evt. hvilke koordinater du starter og slutter trækket på...

procedure MouseDown;//gider ikke skrive parametre! ;)
begin
  Caption := Format('X = %d  ||  Y = %d', [X, Y]);
end;

procedure MouseUp;//gider ikke skrive parametre! ;)
begin
  Caption := Format('X = %d  ||  Y = %d', [X, Y]);
end;

hehe, det virker nu!! der gik bare lidt ged i mit billede....sorry
kender du en måde jeg kan bruge "setCaptureControl(form1);" på, så jeg også kan starte trækket fra billedet. hvis jeg sætter det i form.create er curseren bare et timeglas når programmet starter og det virker kun en gang... :(

Det har jeg sgu aldrig leget med før... Kig lidt i hjælpen! :)

PROBLEM!!!
sæt en timer til at køre et billede hen over skærmen og lav et træk ned over billedet..

Hehe... DET GØR MAN IKKE!!! :)

det er netop lige det man gør!!!

HA!!! Løsning:

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  down := true;
  stx := x;
  sty := y;
  oldx := x;
  oldy := y;
  Timer1.OnTimer := nil;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  down := false;
  Canvas.Rectangle(stx,sty,oldx,oldy);
  Timer1.OnTimer := Timer1Timer;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Image1.Left := Image1.Left +1;
end;

end.

Jeg stopper simpelthen dit billede når jeg laver rektanglet! :)

NEJ NEJ NEJ..... *River mig i håret*
som du ser oppe for oven skriver jeg at min timer næsten går i stå når jeg laver et træk... det er lige netop det jeg ville forebygge med hele dette spm. HEHE jeg kan altså ik lade være med at grine ad (ik for at være ond eller noget)
"Jeg stopper simpelthen dit billede når jeg laver rektanglet! :)"
better luck next time....hehe

Så du vil altså have at billedet til at køre hen over skærmen, og derved dit regtangel, samtidig med at du trækker det?

øhhhh det fattede jeg ik lige.
hør her: mine billeder kører rundt på skærmen og samtidig vil jeg gerne bare kunne trække et rektangel ud over dem...get it?
forestil dig at ikonerne på dit skrivebord flyver rundt men du stadig kan markere dem....<<-- godt eksempel

Okay... Så er jeg med! Kigger på det...

okay godt så!.. lige en ting mere når man trækker skal rektanglet altid være HELT øverst(også over et billede der bevæger sig)..

I win! :)

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Rectangle(stx,sty,oldx,oldy);
end;

Er det ikke det?

Hey zerohero forresten... Håber ikke vi har spammet din mailbox for meget! :)

hmmm det virker ikke helt, prøv at slippe knappen over billedet

procedure TForm1.FormPaint(Sender: TObject);
begin
  if down then
    Canvas.Rectangle(stx,sty,oldx,oldy);
end;

hvad med HELT øverst?

Hvor helt øverst?

når man trækker skal rektanglet altid være HELT øverst(også over et billede der bevæger sig)..

Jeg tror altså ikke jeg kan hjælpe dig meget mere... Du har vist også fået RIGELIGT med svar! :)

Jeg skrider i seng... Skal være lydmand i Tyskland i morgen, så det vist bedst at jeg får lidt søvn! ;)

Natter!

skriv lige et svar

Svar!

hmmm jeg kan ikke vælge avanceret!! jeg opretter lige et spm så du kan få dine point

Hold kæft for en gang sladder tanter *G* - jeg vågendede op og modtog 48 mails - hvoraf langt de fleste var fra dette spørgsmål!!! :)) Klokken 6.30 i morges var I først færdig tsk tsk tsk - har I ikke noget liv! ;))....

ZeroHero

>>ZeroHero
Hehe... Sorry... Han blev jo ved med at kommer med nye spørgsmål, og mine svar blev konstant afvist... :)

Lige en lille komentar, dit delphi program er ikke Mutitask internt i programmet, derfor går din timer i stå dår du Bliver ved med at genere OnMouseMove events, en løsning kunne være at give din timer en chance ved at starte din OnMouseMoveEvent med Application.ProssesMessage; Det kunne godt være en løsning helt uden alle mulige krumspring og med den kode du havde lavet fra starten, man kommer langt med KIS også når man koder

/Martin

>>martinlind
KIS?!?

Keep It Simple !