In VCL forms I use WM_SYSCOMMAND, but in firemonkey it is undeclared.
I test this code:
procedure TForm4.dragPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
isDraging := true;
X0 := X;
Y0 := Y;
end;
procedure TForm4.dragPanelMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Single);
begin
if isDraging then
begin
Form4.Left := Trunc(Form4.Left + X - X0);
Form4.Top := Trunc(Form4.Top + Y - Y0);
end;
end;
procedure TForm4.dragPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
isDraging := False;
end;
this works, but just for slow moves!!!
How can I move form in Firemonkey?
What easier is just to use the StartWindowDrag method of the Form. This way it will work in both Windows and MacOS and its only 1 line of code. Like so:
procedure TForm4.dragPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
Self.StartWindowDrag;
end;
If the VCL code that you want to replicate is:
SendMessage(MyForm.Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
then the equivalent for FMX would be:
SendMessage(FmxHandleToHWND(MyForm.Handle), WM_SYSCOMMAND, SC_DRAGMOVE, 0);
The reason is that MyForm.Handle is an FMX handle. That's not the same as a window handle. You convert to a window handle with FmxHandleToHWND().
You may need to declare a couple of constants:
const
WM_SYSCOMMAND = $0112;
SC_DRAGMOVE = $F012;
Related
I'm new to Delphi. I need a help for complete my code. I just drawing a path. Now i want to save it to Android local storage as an Image format.
This is my code
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
if ssLeft in Shift then
Path1.Data.MoveTo(PointF(X,Y) - Path1.BoundsRect.TopLeft);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
begin
if ssLeft in Shift then
Path1.Data.LineTo(PointF(X,Y) - Path1.BoundsRect.TopLeft);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
//save code goes here
end;
I'm developing a drag 'n drop application and i'm feeling troubled with the Default DragCursor when Drag and Dropping an item as the following list of the default DragCursors:
So i'm trying to develop a new way to the user see the Drag 'n Drop movement like GMAIL:
My question is:
Are there the possibility to use Drag 'n drop events together Mouse events in Delphi 7?
If i put dmAutomatic in DragMode the MouseDown event does not work and if I put dmManual in DragMode the MouseDown works fine, but the DragDrop event does not work.
Here is my code below:
type
TForm1 = class(TForm)
pnlInformacaoDragDrop: TPanel;
pnl1: TPanel;
pnl2: TPanel;
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);
procedure pnl1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure pnl2DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure pnl2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure pnl1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure pnl1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pnl1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(Self) then
begin
if pnlInformacaoDragDrop.Visible then
begin
pnlInformacaoDragDrop.Left :=X + 10;
pnlInformacaoDragDrop.Top := Y + 10;
end;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(Self) then
begin
if not pnlInformacaoDragDrop.Visible then
pnlInformacaoDragDrop.Visible := True;
// img1.BeginDrag(True);
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(Self) then
begin
if pnlInformacaoDragDrop.Visible then
pnlInformacaoDragDrop.Visible := False;
end;
end;
procedure TForm1.pnl1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
TPanel(Sender).Caption := TPanel(Sender).Caption + ' - ' + TPanel(Source).Caption;
end;
procedure TForm1.pnl2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
TPanel(Sender).Caption := TPanel(Sender).Caption + ' - ' + TPanel(Source).Caption;
end;
procedure TForm1.pnl2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := true;
end;
procedure TForm1.pnl1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := true;
end;
Sorry for my simple question, but I don't know how can i do it...
Thanks a lot!
You can use dmAutomatic and write a handler for the OnStartDrag event instead of the mouse events you tried to use.
From D7 documentation:
Description
Use the OnStartDrag event handler to implement special processing when
the user starts to drag the control or an object it contains.
OnStartDrag only occurs if DragKind is dkDrag.
...
The OnStartDrag event handler can create a TDragControlObjectEx
instance for the DragObject parameter to specify the drag cursor, or,
optionally, a drag image list.
Drag-n-drop is a modal operation. It necessarily will abscond with the mouse events while the button is down in order to service the drag operation.
In cmAutomatic, you're telling the component to automatically initiate a drag-n-drop operation on left button down. In dmManual, you are responsible for initiating the drag operation by calling BeginDrag from within the MouseDown event.
IOW, without grabbing the actual Windows mouse events (WM_LBUTTONDOWN, WM_MOUSEMOVE, WM_LBUTTONUP, etc..), the VCL drag-n-drop mechanism will obscure the higher-level mouse events. However, should you decide to process those messages directly, you will also break the drag-n-drop mechanism. Without carefully managing the events and the drag-n-drop subsystem, you can easily make things behave very badly.
I have use for the TControlBar component in my current project but I'm having issues with the control drawing extra rows when I'm moving the bands around,
basically what I want is the ControlBar to always only have 1 Row which is of fixed Height, and where the bands can't escape it while being dragged.
How can I achieve this ?
You can do a workaround for this:
procedure TForm1.ControlBar1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var R:TRect;
Pt:TPoint;
begin
Pt:=ControlBar1.ClientToScreen(Point(0,Y));
R.Left:=Pt.X;
R.Top:=Pt.Y;
R.Right:=Pt.X+ControlBar1.Width;
R.Bottom:=Pt.Y;
ClipCursor(#R);
end;
procedure TForm1.ControlBar1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ClipCursor(nil) ;
end;
With that you can restrict the mouse movement to allow only vertical positioning of the Bands.
I solved this months ago by basically deriving my own component from the TPanel class and implementing a drag solution of child panels to mimic the behavior I wanted.
This is the most basic principle I used to implement the desired effect :
var oldPos : TPoint;
procedure TMainForm.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
if Button = mbLeft then
if (Sender is TWinControl) then
begin
inReposition:=True;
SetCapture(TWinControl(Sender).Handle);
GetCursorPos(oldPos);
TWinControl(Sender).BringToFront;
end else
((Sender as TLabel).Parent as TQPanelSub).OnMouseDown((Sender as TLabel).Parent as TQPanelSub,Button,Shift,X,Y)
end;
procedure TMainForm.ControlMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
var
newPos: TPoint;
temp : integer;
begin
if (Sender is TWinControl) then begin
if inReposition then
begin
with TWinControl(Sender) do
begin
GetCursorPos(newPos);
Screen.Cursor := crSize;
(* Constrain to the container *)
Top := 0;
temp := Left - oldPos.X + newPos.X;
if (temp >= 0) and (temp <= (Parent.Width - Width))
then Left := temp;
oldPos := newPos;
end;
end;
end else
((Sender as TLabel).Parent as TQPanelSub).OnMouseMove((Sender as TLabel).Parent as TQPanelSub,Shift,X,Y);
end;
procedure TMainForm.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
if inReposition then
begin
Screen.Cursor := crDefault;
ReleaseCapture;
inReposition := False;
end;
end;
This is just the basis that I wanted from the TControlBar which infact is a horribly written component.
I need to draw a line in delphi using the cursor, I already have created the line code, but I can't get what to do next? How can do that, I push the mouse, when the line needs to start and drag my mouse or simple I release mouse button and I draw the line.
procedure TForm1.Button1Click(Sender: TObject);
var
x0, y0, x1, y1: Integer;
begin
x0 := StrToInt(Edit1.Text);
y0 := StrToInt(Edit2.Text);
x1 := StrToInt(Edit3.Text);
y1 := StrToInt(Edit4.Text);
Brezenhems(x0 , Y0 , X1 , Y1);
end;
I hope that someone helps me
Thanks
Something like this:
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm4 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm: TBitmap;
procedure AddLineToCanvas;
procedure SwapBuffers;
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.FormCreate(Sender: TObject);
begin
bm := TBitmap.Create;
FDrawingLine := false;
end;
procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X, Y);
FDrawingLine := true;
end;
procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers;
Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
Canvas.LineTo(X, Y);
end;
end;
procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X, Y);
AddLineToCanvas;
SwapBuffers;
end;
procedure TForm4.AddLineToCanvas;
begin
bm.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm4.FormPaint(Sender: TObject);
begin
SwapBuffers;
end;
procedure TForm4.SwapBuffers;
begin
BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
bm.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TForm4.FormResize(Sender: TObject);
begin
bm.SetSize(ClientWidth, ClientHeight);
end;
end.
Compiled sample EXE
Notice that this method is simple and robust, but not optimal in terms of performance. This will likely be an issue if you try to run this on a Windows 3.1-era computer.
Another technique that can be used, without the need to create a bitmap, is using the Pen.Mode property. Something like this:
TForm2 = 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
PO,LP: TPoint;
draw: boolean;
public
{ Public declarations }
end;
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
PO.X:= X;
PO.Y:= Y;
LP.X:= X;
LP.Y:= Y;
draw:= true;
Canvas.Pen.Mode:= pmNotXor;
end;
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if draw then
begin
if (LP.X <> PO.X) or (LP.Y <> PO.Y) then
begin
Canvas.MoveTo(PO.X,PO.Y);
Canvas.LineTo(LP.X,LP.Y);
end;
LP.X:= X;
LP.Y:= Y;
Canvas.MoveTo(PO.X,PO.Y);
Canvas.LineTo(LP.X,LP.Y);
end;
end;
procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if draw then draw:= false;
end;
I need to implement a pan as I click and drag the mouse, and zoom/unzoom towards/away from the mouse cursor that uses the mouse wheel. (In Delphi 2010, with the image anchored to left,right,top,bottom the form.)
I've just installed Graphics32 and seen how its built-in scroll bars and .Scale allow some of this. It's tantalizingly easy to at least get that far.
Questions:
Is Graphics32 a good tool for this kind of thing? Are there other (perhaps more simple?) tools that I might look into?
Does anyone have any pointers or sample code on how to implement the above?
Thanks.
Graphics32 provides a component named TImgView32 which can zoom by setting the Scale property. The appropriate way to do so is by using the OnMouseWheelUp and -Down events. Set TabStop to True for triggering these events and set Centered to False. But scaling in this manner does not comply with your wish to center the zooming operation at the mouse cursor. So repositioning and resizing around that point is a nicer solution. Further, as I understand, the image is always aligned in the top-left corner of the component, so panning must also be accomplished by repositioning the component.
uses
Windows, Classes, Controls, Forms, GR32_Image, GR32_Layers, Jpeg;
type
TForm1 = class(TForm)
ImgView: TImgView32;
procedure FormCreate(Sender: TObject);
procedure ImgViewMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FDragging: Boolean;
FFrom: TPoint;
end;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ImgView.Bitmap.LoadFromFile('D:\Pictures\Mona_Lisa.jpg');
ImgView.TabStop := True;
ImgView.ScrollBars.Visibility := svHidden;
ImgView.ScaleMode := smResize;
end;
procedure TForm1.ImgViewMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
R: TRect;
begin
MousePos := ImgView.ScreenToClient(MousePos);
with ImgView, MousePos do
if PtInRect(ClientRect, MousePos) then
begin
R := BoundsRect;
R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
BoundsRect := R;
Handled := True;
end;
end;
procedure TForm1.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
FDragging := True;
ImgView.Enabled := False; { Temporarily, to get MouseMove to the parent }
FFrom := Point(X, Y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDragging then
ImgView.SetBounds(X - FFrom.X, Y - FFrom.Y, ImgView.Width, ImgView.Height);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
ImgView.Enabled := True;
ImgView.SetFocus;
end;
Edit: Alternative with TImage instead of TImgView32:
uses
Windows, Classes, Controls, Forms, Jpeg, ExtCtrls;
type
TForm1 = class(TForm)
Image: TImage;
procedure FormCreate(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageDblClick(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FDragging: Boolean;
FFrom: TPoint;
FOrgImgBounds: TRect;
end;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
Image.Picture.LoadFromFile('D:\Pictures\Mona_Lisa.jpg');
Image.Stretch := True;
Image.Height := Round(Image.Width * Image.Picture.Height / Image.Picture.Width);
FOrgImgBounds := Image.BoundsRect;
end;
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
R: TRect;
begin
MousePos := Image.ScreenToClient(MousePos);
with Image, MousePos do
if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
(Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
begin
R := BoundsRect;
R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
BoundsRect := R;
Handled := True;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDragging then
Image.SetBounds(X - FFrom.X, Y - FFrom.Y, Image.Width, Image.Height);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image.Enabled := True;
FDragging := False;
end;
procedure TForm1.ImageDblClick(Sender: TObject);
begin
Image.BoundsRect := FOrgImgBounds;
end;
procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not (ssDouble in Shift) then
begin
FDragging := True;
Image.Enabled := False;
FFrom := Point(X, Y);
MouseCapture := True;
end;
end;