I've run into a strange problem with the MediaPlayer component
that appears to be a bug with either the API or Delphi.
I display the video directly on the Form2 canvas and allow
the user to zoom and drag the video within the window.
I use the Form2.MouseDown and MouseUp events to drag.
The drag was behaving erratically and I traced the problem
to inconsistent use of the window coordinates in the events.
An MPG or WMV video (compressed) will report the MouseDown
coordinates relative to the video, but the MouseUp relative
to the form. An AVI video (uncompressed) will report both
relative to the form.
I'm using Delphi XE3 with Windows 7.
Has anyone else encountered this anomaly, and how can I
get consistent X,Y coordinates?
Added 7/20:
I don't know what MCVE means, but I added some code in case someone
wants to try and duplicate the problem.
Label1 & Label2 report the mouse coordinates, and if the video is moved
out of the (0,0) position then the coordinates will jump as the mouse
crosses into or out of the video. It should not do that, it should
always report coordinates relative to the window, not the video.
FormMouseUp will always report relative to the window.
FormMouseDown and FormMouseMove jump back and forth.
procedure TForm1.MFLoadFileClick(Sender: TObject);
begin
MediaPlayer1.Open;
MediaPlayer1.Display := Form2;
end;
procedure TForm2.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption := IntToStr(X); {diag}
Label2.Caption := IntToStr(Y); {diag}
VidLoc := Form1.MediaPlayer1.DisplayRect;
mX := X; mY := Y;
MouseDown := True;
end;
procedure TForm2.FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption := IntToStr(X); {diag}
Label2.Caption := IntToStr(Y); {diag}
end;
procedure TForm2.FormMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var VL : tRect;
begin
Label1.Caption := IntToStr(X); {diag}
Label2.Caption := IntToStr(Y); {diag}
if (MouseDown and Form1.Loaded) then begin
VL := VidLoc;
VL.Left := VidLoc.Left - mX + X;
VL.Top := VidLoc.Top - mY + Y;
Form1.MediaPlayer1.DisplayRect := VL;
Form1.MediaPlayer1.Step;
end;
MouseDown := False;
end;
Oddly enough, moving the video in a panel doesn't work, but moving the panel did.
I didn't want to do that because it requires keeping track of too many objects, but it'll have to do.
Moving the panel uses the same code as above, but with other assorted properties.
Related
I want to move a TPanel on another TPanel by mouse at runtime with Delphi 10.4.2 and FMX. I tried OnMouseDown, OnMouseMove and OnMouseUp events. But it is not clear what the contents of X and Y values are in the events. The documentation says that they are screen coordinates. Relative to the screen, form, parent control or the control itself? How can I solve the movement of the TPanel?
The documentation says that they are screen coordinates.
No, it doesn't. The FMX.Types.TMouseEvent and FMX.Types.TMouseMoveEvent
documentation both say:
X and Y--the pixel coordinates of the mouse pointer within the client area of the control.
How can I solve the movement of the TPanel?
Like this:
var
LastPt: TPointF;
Dragging: Boolean = False;
procedure TMyForm.PanelToDragMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button = TMouseButton.mbLeft then
begin
LastPt := TPointF.Create(X, Y);
Dragging := True;
end;
end;
procedure TMyForm.PanelToDragMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button = TMouseButton.mbLeft then
Dragging := False;
end;
procedure TMyForm.PanelToDragMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Single);
var
CurrPt: TPointF;
begin
if Dragging then
begin
CurrPt := TPointF.Create(X, Y);
PanelToDrag.Position.Point := PanelToDrag.Position.Point + (CurrPt - LastPt);
LastPt := CurrPt;
end;
end;
Basically, while the mouse is moving around the Panel, the code is simply calculating the offset the mouse has moved from the last known position to the current position, and then applying that offset to the Panel's current Position within its Parent.
I am creating a form where there are icons- like on desktop and they can be moved freely.
I want to show sometimes even 500 or more icons so they need to work fast.
My icon is:
TMyIcon = class(TGraphicControl)
so it does not have a Windows handle.
The drawing is:
1 x Canvas.Rectangle (which is about 64x32)
1 x Canvas.TextOut (a bit smaller than the rectangle)
1 x Canvas.Draw (image is 32x32)
The code to move stuff is like this:
MyIconMouseMove:
Ico.Left := Ico.Left + X-ClickedPos.X;
Ico.Top := Ico.Top + Y-ClickedPos.Y;
On the form there is usually like 50 or so icons- the rest is outside the visible area.
When I have 100 icons- I can move them freely and it works fast. But when I create 500 icons then it gets laggy- but the number of visible icons is still the same.
How can I tell Windows to completely ignore the invisible icons so everything works smoothly?
Or maybe there is a component which can show desktop-like icons with ability to move them around? Something like TShellListView with AutoArrange = False?
TGraphicControl is a control that doesn't have a handle of its own. It uses its parent to display its content. That means, that changing the appearance of your control will force the parent to be redrawn as well. That may also trigger repainting all other controls.
In theory, only the part of the parent where control X is positioned needs to be invalidated, so only controls that overlap that part should need to be repainted. But still, this might cause a chain reaction, causing lots of paint methods be called everytime you change a single pixel in one of those controls.
Apparently, also icons outside the visible area are repainted. I think you can optimize this by setting the Visible property of the icons to False if they are outside the visible area.
If this doesn't work, you may need a completely different approach: there's the option to paint all icons on a single control, allowing you to buffer images. If you are dragging an icon, you can paint all other icons on a bitmap once. On every mouse move, you only need to paint that buffered bitmap and the single icon that is dragged, instead of 100 (or 500) separate icons. That should speeds things up quite a bit, although it is gonna take a little more effort to develop.
You could implement it like this:
type
// A class to hold icon information. That is: Position and picture
TMyIcon = class
Pos: TPoint;
Picture: TPicture;
constructor Create(Src: TBitmap);
destructor Destroy; override;
end;
// A list of such icons
//TIconList = TList<TMyIcon>;
TIconList = TList;
// A single graphic controls that can display many icons and
// allows dragging them
TIconControl = class(TGraphicControl)
Icons: TIconList;
Buffer: TBitmap;
DragIcon: TMyIcon;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Initialize;
// Painting
procedure ValidateBuffer;
procedure Paint; override;
// Dragging
function IconAtPos(X, Y: Integer): TMyIcon;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
end;
{ TMyIcon }
// Some random initialization
constructor TMyIcon.Create(Src: TBitmap);
begin
Picture := TPicture.Create;
Picture.Assign(Src);
Pos := Point(Random(500), Random(400));
end;
destructor TMyIcon.Destroy;
begin
Picture.Free;
inherited;
end;
Then, the graphiccontrol itself:
{ TIconControl }
constructor TIconControl.Create(AOwner: TComponent);
begin
inherited;
Icons := TIconList.Create;
end;
destructor TIconControl.Destroy;
begin
// Todo: Free the individual icons in the list.
Icons.Free;
inherited;
end;
function TIconControl.IconAtPos(X, Y: Integer): TMyIcon;
var
r: TRect;
i: Integer;
begin
// Just return the first icon that contains the clicked pixel.
for i := 0 to Icons.Count - 1 do
begin
Result := TMyIcon(Icons[i]);
r := Rect(0, 0, Result.Picture.Graphic.Width, Result.Picture.Graphic.Height);
OffsetRect(r, Result.Pos.X, Result.Pos.Y);
if PtInRect(r, Point(X, Y)) then
Exit;
end;
Result := nil;
end;
procedure TIconControl.Initialize;
var
Src: TBitmap;
i: Integer;
begin
Src := TBitmap.Create;
try
// Load a random file.
Src.LoadFromFile('C:\ff\ff.bmp');
// Test it with 10000 icons.
for i := 1 to 10000 do
Icons.Add(TMyIcon.Create(Src));
finally
Src.Free;
end;
end;
procedure TIconControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if Button = mbLeft then
begin
// Left button is clicked. Try to find the icon at the clicked position
DragIcon := IconAtPos(X, Y);
if Assigned(DragIcon) then
begin
// An icon is found. Clear the buffer (which contains all icons) so it
// will be regenerated with the 9999 not-dragged icons on next repaint.
FreeAndNil(Buffer);
Invalidate;
end;
end;
end;
procedure TIconControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Assigned(DragIcon) then
begin
// An icon is being dragged. Update its position and redraw the control.
DragIcon.Pos := Point(X, Y);
Invalidate;
end;
end;
procedure TIconControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if (Button = mbLeft) and Assigned(DragIcon) then
begin
// The button is released. Free the buffer, which contains the 9999
// other icons, so it will be regenerated with all 10000 icons on
// next repaint.
FreeAndNil(Buffer);
// Set DragIcon to nil. No icon is dragged at the moment.
DragIcon := nil;
Invalidate;
end;
end;
procedure TIconControl.Paint;
begin
// Check if the buffer is up to date.
ValidateBuffer;
// Draw the buffer (either 9999 or 10000 icons in one go)
Canvas.Draw(0, 0, Buffer);
// If one ican was dragged, draw it separately.
if Assigned(DragIcon) then
Canvas.Draw(DragIcon.Pos.X, DragIcon.Pos.Y, DragIcon.Picture.Graphic);
end;
procedure TIconControl.ValidateBuffer;
var
i: Integer;
Icon: TMyIcon;
begin
// If the buffer is assigned, there's nothing to do. It is nilled if
// it needs to be regenerated.
if not Assigned(Buffer) then
begin
Buffer := TBitmap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
for i := 0 to Icons.Count - 1 do
begin
Icon := TMyIcon(Icons[i]);
if Icon <> DragIcon then
Buffer.Canvas.Draw(Icon.Pos.X, Icon.Pos.Y, Icon.Picture.Graphic);
end;
end;
end;
Create one of those controls, make it fill the form and initialize it with 10000 icons.
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
with TIconControl.Create(Self) do
begin
Parent := Self;
Align := alClient;
Initialize;
end;
end;
It's a bit quick&dirty, but it shows this solution may work very well. If you start dragging (mouse down), you will notice a small delay as the 10000 icons are drawn on the bitmap that passes for a buffer. After that, theres no noticable delay while dragging, because only two images are drawn on each repaint (instead of 500 in your case).
You might want to check out this control which is exactly what you asked for.
rkView from RMKlever
It is basically an icon or photo thumbnail viewer with scrolling etc.
Hy guys,
I try to move my own component on runtime mode with mouse alike in design mode.
the component isn't moved untill mouse button isn't released and in this time a empty frame is displayed and a hint show lefttop corner possition.
I done a lots of tries but no success untill now.
Any help
Here (http://neftali.clubdelphi.com/?p=269) on my web, you can find a component called TSelectOnRuntime. You can view the source code and study it. It's an simple approach to select, resize and move components on runtime.
Download the demo and evaluate, if it's valid for you (include the source of component, demo sources and compiled demos).
Well, I'll post it here. The following code uses undocumented WM_SYSCOMMAND constant $F012 and works with TWinControl descendants.
Note, that it's undocumented and it might not work on future versions of Windows (as anything else from Windows API if they decide to), but it works (tested on several Windows versions) and it's the easiest way how to move the component at runtime.
procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
ReleaseCapture;
YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
The similar magic exists also for sizing, namely command $F008.
procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGSIZE = $F008;
begin
ReleaseCapture;
YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGSIZE, 0);
end;
If what i think you are trying to do is move controls at runtime, then here is some code you may use (and possibly modify slightly) to your needs:
var
MouseDownPos, LastPosition : TPoint;
DragEnabled,Resizing : Boolean;
procedure TForm1.ControlMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseDownPos.X := X;
MouseDownPos.Y := Y;
DragEnabled := True;
end;
//handle dragging of controls
procedure TForm1.ControlMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if DragEnabled then
begin
if Sender is TControl then
begin
TControl(Sender).Left := TControl(Sender).Left + (X - MouseDownPos.X);
TControl(Sender).Top := TControl(Sender).Top + (Y - MouseDownPos.Y);
end;
end;
end;
For resizing controls you could use something like:
procedure TForm1.ControlMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
cntrl := Sender as TControl;
if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
cntrl.Cursor := crSizeNWSE
else cntrl.Cursor := crDefault;
if Resizing then
begin
cntrl.Width := cntrl.Width + (X - LastPosition.X);
LastPosition.X := X;
cntrl.Height := cntrl.Height + (Y - LastPosition.Y);
LastPosition.Y := Y;
end;
end;
procedure TForm1.ControlMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
begin
LastPosition.X := X;
LastPosition.Y := Y;
Resizing := True;
end;
end;
Extensions to this may be snapping to a grid. This code may need to be modified slightly.
There is a component out there named TSizeCtrl which lets you move controls at runtime. You can find source code here or the component for download at Torry's.
It can be used like this:
SizeCtrl1 := TSizeCtrl.Create(MyForm);
SizeCtrl1.GridSize := 20;
SizeCtrl1.Enabled := True;
SizeCtrl1.RegisterControl(MyControl);
SizeCtrl1.AddTarget(MyControl);
This will let you drag MyControl around and resize it. It draws a frame while dragging and provides the handles for resizing.
I want to know the position of the cursor on a TCustomControl. How does one go about finding the coordinates?
GetCursorPos can be helpful if you can't handle a mouse event:
function GetCursorPosForControl(AControl: TWinControl): TPoint;
var
P: TPoint;
begin
Windows.GetCursorPos(P);
Windows.ScreenToClient(AControl.Handle, P );
result := P;
end;
You can use MouseMove event:
procedure TCustomControl.MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Label1.Caption := IntToStr(x) + ' ' + IntToStr(y);
end;
If you want the cursor position when they click on the control, then use Mouse.CursorPos to get the mouse position, and Control.ScreenToClient to convert this to the position relative to the Control.
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt: TPoint;
begin
pt := Mouse.CursorPos;
pt := Memo1.ScreenToClient(pt);
Memo1.Lines.Add(Format('x=%d, y=%d', [pt.X, pt.y]));
end;
EDIT:
As various people have pointed out, this is pointless on a mouse down event. However as TCustomControl.OnMouseDown is protected, it may not always be readily available on third-party controls - mind you I would probably not use a control with such a flaw.
A better example might be an OnDblClick event, where no co-ordinate information is given:
procedure TForm1.DodgyControl1DblClick(Sender: TObject);
var
pt: TPoint;
begin
pt := Mouse.CursorPos;
pt := DodgyControl1.ScreenToClient(pt);
Memo1.Lines.Add(Format('x=%d, y=%d', [pt.X, pt.y]));
end;
In Delphi 2007, in a mouse move event, I try to change the mouse cursor with:
procedure TFr_Board_Display.PaintBox_Proxy_BoardMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if left_mouse_button_down then begin
if some_condition then begin
Cursor := crDrag;
end
else begin
Cursor := crNoDrop;
end;
end
else begin
if some_other_condition then begin
Cursor := crHandPoint;
end
else begin
Cursor := crDefault;
end;
end;
end;
for example. However, when the left mouse button is down, and I move the mouse, the cursor doesn't change to either crDrag or crNoDrop. The code is executed (e.g. Cursor := crDrag;) but the cursor does not change. When the left mouse button is up, and I move the mouse, the cursor changes no problem.
(I originally tried to use some Drag & Drop events and properties, but couldn't get everything to work the way I wanted.)
Edit: Clarified desired behavior, and formatted code.
Edit: Thank you, Gamecat, but I want the cursor to change when the left mouse button is down and the while the mouse is moving the cursor should change back and forth between crDrag and crNoDrop.
If you set the mouse cursor in the OnMouseDown and reset it in the OnMouseUp, anything works fine:
procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Cursor := crCross;
end;
procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Cursor := crDefault; // Or you can restore a saved cursor.
end;
If you want the mousecursor to react at the mouse move, use the following:
procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then begin
if X<100 then
Screen.Cursor := crCross
else
Screen.Cursor := crHourGlass;
end else
Screen.Cursor := crDefault; // Or you can restore a saved cursor.
end;
procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Screen.Cursor := crDefault; // Or you can restore a saved cursor.
end;
The MouseUp is needed, else the cursor won't change back if it hovers above a control.
Be sure to use Screen.Cursor everywhere.
Slightly off-topic, but perhaps useful to you.
I created a global stack to allow nested cursor changes. It lets any piece of code set the mouse cursor to what they want without worrying about what their caller or callee's set it to.
For example:
procedure AskUserWhatToDo;
begin
PushMouseCursor(crArrow);
try
if MessageDlg('Abort?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
SysUtils.Abort;
finally
PopMouseCursor;
end;
end;
procedure LongProcess;
begin
PushMouseCursor(crHourglass);
try
// do something
if QuestionableState then
AskUserWhatToDo;
// do something
finally
PopMouseCursor;
end;
end;
Neither procedure has to worry about what state the other needs or leaves the mouse cursor.
//===============================================================
// in a universal utility module (mine is called CraftWindows.pas)
function SetMouseCursor(ACursor : TCursor) : TCursor;
begin
Result := Screen.Cursor;
Screen.Cursor := ACursor;
end;
var
GlobalMouseCursorStack : TList = nil;
procedure PushMouseCursor(ACursor : TCursor);
begin
if GlobalMouseCursorStack = nil then
GlobalMouseCursorStack := TList.Create;
GlobalMouseCursorStack.Add(Pointer(SetMouseCursor(ACursor)));
end;
procedure PopMouseCursor;
begin
if (GlobalMouseCursorStack <> nil) and (GlobalMouseCursorStack.Count > 0) then
begin
SetMouseCursor(TCursor(GlobalMouseCursorStack.Last));
GlobalMouseCursorStack.Delete(GlobalMouseCursorStack.Count - 1);
end;
end;
...
finalization
GlobalMouseCursorStack.Free;