Panel mozgatása késleltetéssel?

Panel mozgatása késleltetéssel?
2011-12-30T09:13:54+01:00
2012-01-01T14:30:46+01:00
2022-11-24T05:43:03+01:00
Eric
Sziasztok!

Egy olyat szeretnék megoldani, hogy adott egy panel, amin, ha lenyomom az egér bal gombját, akkor egy kis idő múlva odatapasztja azt az egérhez, majd mozgathatom ide-oda. De ha még időben (egeret nyomva tartva) lehúzom az egeret róla, akkor a helyén marad. A saját probálkozásom:


unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts; type TForm1 = class(TForm) Timer1: TTimer; Panel1: TPanel; ApplicationEvents1: TApplicationEvents; procedure Timer1Timer(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); private { Private declarations } Dragged: Boolean; OldPos: TPoint; public { Public declarations } counter: integer; drag: boolean; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); begin counter:=counter+1; if (counter=1) and (drag) then begin Dragged:=True; panel1.Color:=clyellow; Timer1.Enabled:=false; end; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin counter:=0; timer1.Enabled:=true; GetCursorPos(OldPos); SetCapture(panel1.Handle); end; procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var NewPos: TPoint; begin if (Dragged) and (drag) then with Panel1 do begin GetCursorPos(NewPos); Left:=Left-OldPos.X+NewPos.X; Top:=Top-OldPos.Y+NewPos.Y; OldPos:=NewPos; end; end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin counter:=0; if (Dragged) and (drag) then begin ReleaseCapture; Dragged:=False; panel1.Color:=clbtnface; end; end; procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); var ctrl : TWinControl; begin ctrl := FindVCLWindow(Mouse.CursorPos) ; if ctrl <> nil then begin if ctrl is TPanel then begin drag:=true end else begin drag:=false; end; end; end; end.

Ez végülis működik, de arra lennék kíváncsi, hogy van-e egyszerűbb, tökéletesebb módja ennek?

Valami olyasmit szeretnék megcsinálni (hatást), mint amikor okos telefonon, ha hosszabban nyomjuk az ikont, akkor az "odatapad" az ujjunkhoz, és mozgathatjuk.

Köszönöm: Eric
Mutasd a teljes hozzászólást!
talán ez is egy megoldás lehet:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } dt:TPoint; isDragged:Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); var cp:TPoint;r:TRect; begin GetCursorPos(cp); GetWindowRect(Panel1.Handle,r); if PtInRect(r,cp) then begin dt:=Panel1.ScreenToClient(cp); isDragged:=True;end; Timer1.Enabled:=False; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin Timer1.Enabled:=True; end; end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Timer1.Enabled:=False; isDragged:=False; end; procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var cp:TPoint; begin if isDragged then begin GetCursorPos(cp); cp.X:=cp.X-dt.X; cp.Y:=cp.Y-dt.Y; cp:=ScreenToClient(cp); Panel1.Left:=cp.X; Panel1.Top:=cp.Y; end; end; end.
Mutasd a teljes hozzászólást!

  • Szerintem a setcapture nem túl egészséges a mousedown eljárásba, de nem tom.

    Gondoltam írok egyet én is, csak kíváncsiságból

    unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; const dwTimeOut: Cardinal = 1250; // 1,25 sec type TForm1 = class(TForm) Panel1: TPanel; tmr: TTimer; Panel2: TPanel; Panel3: TPanel; procedure PanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure tmrTimer(Sender: TObject); private FDrag: TPanel; FdwStart: cardinal; FPosStart: TPoint; procedure Leave; public { Public declarations } end; var Form1: TForm1; function ElapsedTick(const TickFrom: cardinal): cardinal; implementation {$R *.dfm} // util - eltelt idő function ElapsedTick(const TickFrom: cardinal): cardinal; var iTickNow: cardinal; begin iTickNow := GetTickCount; if iTickNow >= TickFrom then Result := iTickNow - TickFrom else Result := iTickNow + (MAXDWORD - TickFrom); end; { ** from ** } procedure TForm1.Leave; begin FDrag := nil; Screen.Cursor := crDefault; end; procedure TForm1.PanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDrag := Sender as TPanel; // ki a delikvens FdwStart := GetTickCount; // ez lesz az időzítőnk FPosStart := Point(x, y); // innen indul minden ez a poziciónáláshoz kell - ez még változhat... end; procedure TForm1.PanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (Shift = [ssLeft]) and (FDrag <> nil) then // bal gomb és van mit cibálni begin if (ElapsedTick(FdwStart) >= dwTimeOut) then begin Screen.Cursor := crDrag; FDrag.Left := FDrag.Left + (X - FPosStart.X); FDrag.Top := FDrag.Top + (Y - FPosStart.Y); end else begin {FdwStart := GetTickCount;} // itt akár ujraindítható a timeout is ha mondjuk mozdulnia sem szabad az egérnek FPosStart := Point(x, y); // átállítjuk a poziciót ne ugorjon a panel amikor elkezdődik a móka(még nincs itt az idő)... end; end; end; procedure TForm1.PanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Leave; end; procedure TForm1.tmrTimer(Sender: TObject); var r: TRect; pt: TPoint; begin if (FDrag <> nil) then begin r := FDrag.BoundsRect; r.TopLeft := ClientToScreen(r.TopLeft); r.BottomRight := ClientToScreen(r.BottomRight); pt := Mouse.CursorPos; if (pt.X >= r.Left) and (pt.X <= r.Right) and (pt.Y >= r.Top) and (pt.Y <= r.Bottom) then // még mindig jo helyen áll-e az egér begin if ElapsedTick(FdwStart) >= dwTimeOut then begin FPosStart := FDrag.ScreenToClient(pt); // az indok ugyanaz mint fentebb... Screen.Cursor := crDrag; // mutassuk hogy már mozgatható end; end else begin Leave; // nem jo helyen van az egér ReleaseCapture; end; end; end; end.

    A timer.interval = 1 de a dfm et nem másolom be :)
    Minden panelnak bekötöd a megfelelő 3 eljárást (mdown, mup, mmove) és tulajdonképpen le van kezelve mindenkire a mozgatás.

    Szerintem, ilyen feladatban ne használj with-et, semmi nem indokolja, semmit nem rövidít a kódon, sőt... persze ez csak egy tanács
    Mutasd a teljes hozzászólást!
  • talán ez is egy megoldás lehet:

    unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } dt:TPoint; isDragged:Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); var cp:TPoint;r:TRect; begin GetCursorPos(cp); GetWindowRect(Panel1.Handle,r); if PtInRect(r,cp) then begin dt:=Panel1.ScreenToClient(cp); isDragged:=True;end; Timer1.Enabled:=False; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin Timer1.Enabled:=True; end; end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Timer1.Enabled:=False; isDragged:=False; end; procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var cp:TPoint; begin if isDragged then begin GetCursorPos(cp); cp.X:=cp.X-dt.X; cp.Y:=cp.Y-dt.Y; cp:=ScreenToClient(cp); Panel1.Left:=cp.X; Panel1.Top:=cp.Y; end; end; end.
    Mutasd a teljes hozzászólást!
  • BUÉK!
    Ez az igazán tuti, köszönöm szépen!

    Eric
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd