If I set DragMode to dmAutomatic it prevents me from selecting rows.
If I used OnCellClick to call BeginDrag it only fires on mouse up, which is not dragging in my opinion.
If I use OnMouseDown it only fires on title row.
How I am I supposed do it?
Overloading MouseDown will lead to the desired result.
type
TDBGrid=Class(DBGrids.TDBGrid)
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
End;
TForm2 = class(TForm)
.......
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TDBGrid }
procedure TDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Begindrag(false);
inherited;
end;
Related
I want to dynamically create TImage controls and then drag and drop them. But if I want to assign the procedure used for the dragging to an event of this Image, it gives me:
Error: Wrong number of parameters specified for call to "ClickEvent"
This is my code for the dragging:
procedure ClickEvent(Sender:TObject; Button:TMouseButton; Shift:TShiftstate; X,Y:Integer);
begin
if Button = mbLeft then TControl(Sender).BeginDrag(False);
end;
And here I create the Image and add the properties:
procedure SpawnCard(Ort:TWinControl; sKarte:TKarteClass; Liste: Array of TKarte; BilderListe:Array of TCustomImage);
var
Bild:TImage;
begin
Liste[High(Liste)]:=sKarte.Create();
Bild:=TImage.Create(Combat);
with Bild do
begin
OnMouseDown:=ClickEvent;
Parent:=Ort;
Top:=1;
Left:=200*length(BilderListe);
width:=200;
height:=300;
Proportional:=True;
Stretch:=True;
Picture.LoadFromFile(Liste[High(Liste)].PicPath);
end;
BilderListe[High(BilderListe)]:=Bild;
end;
I don't want to call ClickEvent, I just want to assign it to the event.
TImage.OnMouseDown (inherited from its TControl parent class) is a TMouseEvent property.
TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer) of object;
As you can see, it's declared as "of object", which means it expects a method pointer (See the Method Pointers section).
Example 1:
Declare the ClickEvent on the form (or any other object):
TForm1 = class(TForm)
Image1: TImage;
public
procedure ClickEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
end;
...
procedure TForm1.ClickEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then TControl(Sender).BeginDrag(False);
end;
Then you can assign it as follows:
Image1.OnMouseDown := Form1.ClickEvent;
Example 2:
Declare the ClickEvent as a class method:
TMyEventHandlers = class
class procedure ClickEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
end;
...
class procedure TMyEventHandlers.ClickEvent(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then TControl(Sender).BeginDrag(False);
end;
Then you can assign it as follows:
Image1.OnMouseDown := TMyEventHandlers.ClickEvent;
I made an application that lets you create a rectangle and resize it however you want but it has a problem.
Whenever I want to draw a new rectangle on an existing one happens.
Here is the code for the application :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
xstart,ystart,oldx,oldy,click1,lastx,lasty,copyrect_click:integer;
in_workspace,click_bol,copyrect_bol:boolean;
destrect,sourcerect:trect;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
click_bol:=true;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if click_bol then
begin
xstart:=x;
ystart:=y;
oldx:=x;
oldy:=y;
image1.Canvas.pen.mode:=pmnotxor;
image1.canvas.rectangle(xstart,ystart,oldx,oldy);
click1:=click1+1;
in_workspace:=true;
if click1 mod 2=0 then
begin
image1.canvas.Pen.mode:=pmCopy;
image1.Canvas.Rectangle(xstart,ystart,x,y);
in_workspace:=false;
end;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (in_workspace=true) and (click_bol=true) then
begin
image1.canvas.Rectangle(xstart,ystart,oldx,oldy);
image1.canvas.Rectangle(xstart,ystart,x,y);
oldx:=x;
oldy:=y;
end;
end;
end.
I suspect it's because of the NotXor penmode and as you can see from the code I tried to change it to Copy penmode when it draws the actual rectagle but to no avail.
How can I improve this code in order not to have the rectangles change color then I draw them one on another?
Firstly I don't think that you really understand what you are doing and why it works (sort of). I think that you have dug up some code from somewhere and are trying to migrate it. All those global variables are a bad sign.
(You also have no mouse-up function - so what you have published will never produce the image you have shown.)
So, what does it do? Well, the canvas background is white and the pen is black (these are default values that you don't change) so if you XORed them the result would actually be white - it would appear to do nothing (unless you changed the pen colour to white), and the NotXOR makes it black. The original program I am guessing used XOR as that was more normal in older programs.
However, these days graphics have greatly improved, and, as David Heffernan says, better to just draw on the old background, and as you progress your program to using colours, this will become more important.
This shows the equivalent to what you are trying to achieve using this method.
Notice that there is much less code. I have removed the button click - it is just a waste of time. Better to put that in the mouse-down event. I have also not dealt with right mouse click etc. (but then, neither did you).
unit Unit10;
interface
uses
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ComCtrls,
Vcl.Grids, Vcl.Buttons, VCL.ExtCtrls,
System.Classes;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormActivate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
fSave : TPicture;
xstart,ystart:integer;
click_bol:boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
fSave := TPicture.Create;
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xstart:=x;
ystart:=y;
fSave.Assign( image1.Picture);
click_bol:=true;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Click_bol then
begin
image1.Picture.Assign( fSave );
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
image1.Canvas.Brush.Style := bsClear;
image1.Canvas.Rectangle(xstart,ystart,x,y);
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
click_bol := FALSE;
end;
initialization
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 would like to get some hints on working with TeeChart TAreaSeries, and specifically on creating NOT overlapping series.
When I create two Area series on the same plot, related to the same BottomAxis and LeftAxis I get something like this:
https://skydrive.live.com/redir?resid=9966BBBE2447AA89!116&authkey=!AKm6DMvrxleX5ps
And if I scroll the plot vertically I will see these two series expanding downwards endlessly to the negative infinity (Y coordinate).
But I wonder if it is possible to 'cut' the lower part of the series at some Y point?
So that I could retrieve something like this:
https://skydrive.live.com/redir?resid=9966BBBE2447AA89!115&authkey=!AGaejDREPKnPYMY
(Excuse me for the links instead of images, I don't have permission to post them due to the reputation restrictions)
Yes, you can do something as in the All Features\Welcome!\Axes\Opaque zones example at the new features demo, available at TeeChart's program group, for example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeeGDIPlus, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
TForm1 = class(TForm)
Chart1: TChart;
Series1: TAreaSeries;
Series2: TAreaSeries;
procedure FormCreate(Sender: TObject);
procedure Series1Click(Sender: TChartSeries; ValueIndex: Integer;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
ClipRect: TRect;
procedure SeriesBeforeDraw(Sender: TObject);
procedure SeriesAfterDraw(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses TeCanvas;
procedure TForm1.FormCreate(Sender: TObject);
begin
Series1.BeforeDrawValues:=SeriesBeforeDraw;
Series1.AfterDrawValues:=SeriesAfterDraw;
end;
procedure TForm1.SeriesBeforeDraw(Sender: TObject);
Function SeriesRect(Series:TChartSeries):TRect;
begin
With result do
begin
Left:=Series.GetHorizAxis.IStartPos;
Right:=Series.GetHorizAxis.IEndPos;
Top:=Series.GetVertAxis.IStartPos;
Bottom:=Series.GetVertAxis.CalcYPosValue(700);
end;
end;
begin
ClipRect:=SeriesRect( Sender as TChartSeries );
{ make opaque }
With Chart1 do
if CanClip then
Canvas.ClipRectangle(ClipRect);
end;
procedure TForm1.SeriesAfterDraw(Sender: TObject);
begin
Chart1.Canvas.UnClipRectangle;
end;
procedure TForm1.Series1Click(Sender: TChartSeries; ValueIndex: Integer;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Caption:=IntToStr(ValueIndex);
end;
procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Series1.Clicked(X,Y)<>-1) then
Chart1.CancelMouse:=not PointInRect(ClipRect,X,Y);
end;
end.
which produces this chart:
I have a situation where I have a TImage and on top of it a TPanel covering it partially and they share the same parent:
------------------
| Image1 |
| ------------ |
| | Panel1 | |
| ------------ |
| |
------------------
Panel1 is receiving mouse down/move/up events and processing it (so does Image1), but in some situation I would like to "redirect" the mouse down message to Image1 as if to simulate that Image1 was clicked rather than Panel1.
Here is what I did:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (ssLeft in Shift) then
Beep;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
//...
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShowMessage('boo!');
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
if FRedirectToImage then begin
ReleaseCapture; // do I need to send a WM_LBUTTONUP as well to the panel?
GetCursorPos(P);
P := ScreenToClient(P);
Image1.Perform(WM_LBUTTONDOWN, MK_LBUTTON, Longint(PointToSmallPoint(P)));
Exit;
end;
// Normal handling
if (ssLeft in Shift) then begin
// ...
end;
end;
It works as expected but I'm not sure It's the right way.
My question is, am I doing it right? is there a better or recommended way of doing it?
Update (1) :
Handling WM_NCHITTEST as suggested is a valid answer and I thought about it also. even setting Panel1.Enabled to False will route the mouse messages to the underlying Image1 control.
But (!) consider this situation where I click the x location on the Panel and still need to route the message to Image1:
------------------
| Image1 |
| --------------
| | Panel1 x |
| --------------
| |
------------------
My method works, but WM_NCHITTEST is not applicable in the described scenario. I still didn't get an answer if my method is valid or not. (or maybe I should ask another question with the above scenario?)
Handle wm_NCHitTest messages sent to the panel and return htTransparent. The OS will send the mouse message to the next control down without any further processing required from your program. (From the OS perspective, the "next control down" is the parent control of both the panel and the image; the VCL takes care of routing the mouse message back to the image control, as it does with all TGraphicControl descendants, since they aren't real windowed controls.)
Something like this:
procedure TParentForm.PanelWindowProc(var Msg: TMessage);
begin
FPrevPanelWindowProc(Msg);
if (Msg.Message = wm_NCHitTest) and FRedirectToImage then
Msg.Result := htTransparent;
end;
Assign that method to the panel's WindowProc method. Store the previous value of the property in a field of the form.
var
FPrevPanelWindowProc: TWndMethod;
FPrevPanelWindowProc := Panel.WindowProc;
Panel.WindowProc := Self.PanelWindowProc;
In case when the control from which you want to redirect mouse events will not be in its whole client area inside the control to which those events should be redirected (as you've shown in your question update), then the WM_NCHITTEST message might be send to another control. Then the only one way remains to use IMHO, redirect all mouse messages.
As #David mentioned in his comment, you can do this message redirection in a global way by writing an event handler for the OnMessage event for TApplication. Or use a TApplicationEvents object.
In the following example, you can define the range of messages, that will be redirected as well as specify the list of source and target controls for that redirection. For redirecting is used the OnMessage event of the TApplication object, but since your target is in this case TGraphicControl descendant, you can't only change the recipient of the incoming message, but you have to eat this message and perform the message on the target control through the Perform method by yourself.
Here is the code showing how to redirect all mouse messages from Panel1 to Image1. You can get the whole testing project from here if you want:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TMsgRange = record
MsgFrom: UINT;
MsgTo: UINT;
end;
TRedirect = record
Source: HWND;
Target: TControl;
end;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FRedirectList: array of TRedirect;
FRedirectEnabled: Boolean;
FRedirectMsgRange: TMsgRange;
procedure ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
var
I: Integer;
begin
if FRedirectEnabled and (AMessage.message >= FRedirectMsgRange.MsgFrom) and
(AMessage.message <= FRedirectMsgRange.MsgTo) then
begin
for I := 0 to High(FRedirectList) do
if (AMessage.hwnd = FRedirectList[I].Source) and
Assigned(FRedirectList[I].Target) then
begin
Handled := True;
FRedirectList[I].Target.Perform(AMessage.message,
AMessage.wParam, AMessage.lParam);
Break;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FRedirectEnabled := True;
FRedirectMsgRange.MsgFrom := WM_MOUSEFIRST;
FRedirectMsgRange.MsgTo := WM_MOUSELAST;
SetLength(FRedirectList, 1);
FRedirectList[0].Source := Panel1.Handle;
FRedirectList[0].Target := Image1;
Application.OnMessage := ApplicationMessage;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Memo1.Lines.Add('Image1MouseDown')
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Memo1.Lines.Add('Image1MouseUp')
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Memo1.Lines.Add('Panel1MouseDown')
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Memo1.Lines.Add('Panel1MouseUp')
end;
end.
You can derive your panel class to handle WM_NCHITTEST messages to return HTTRANSPARENT for the region you want the control beneath the panel receive mouse messages. E.g.:
procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
var
Pt: TPoint;
begin
Pt := ScreenToClient(SmallPointToPoint(Message.Pos));
if (Pt.X < 80) and (Pt.Y < 60) then // devise your logic here...
Message.Result := HTTRANSPARENT
else
inherited;
end;
Obviously this is just a test, you can publish a field in your component for it to resolve where that control resides etc..