Good evening :-)!
I have this code to use Drag & Drop method for files:
TForm1 = class(TForm)
...
public
procedure DropFiles(var msg: TMessage ); message WM_DROPFILES;
end;
procedure TForm1.FormCreate(Sender: TObject)
begin
DragAcceptFiles(ListView1.Handle, True);
end;
procedure TForm1.DropFiles(var msg: TMessage );
var
i, count : integer;
dropFileName : array [0..511] of Char;
MAXFILENAME: integer;
begin
MAXFILENAME := 511;
count := DragQueryFile(msg.WParam, $FFFFFFFF, dropFileName, MAXFILENAME);
for i := 0 to count - 1 do
begin
DragQueryFile(msg.WParam, i, dropFileName, MAXFILENAME);
Memo1.Lines.Add(dropFileName);
end;
DragFinish(msg.WParam);
end;
In area of ListView is DragCursor, but in Memo1 aren't any records.
When I use for example ListBox and method DragAcceptFiles(ListBox1.Handle, True) ever is fine.
ListView property DragMode I set to dmAutomatic.
Thanks :-)
You've called DragAcceptFiles for the ListView, so Windows sends the WM_DROPFILES to your ListView and not to your Form. You have to catch the WM_DROPFILES message from the ListView.
private
FOrgListViewWndProc: TWndMethod;
procedure ListViewWndProc(var Msg: TMessage);
// ...
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Redirect the ListView's WindowProc to ListViewWndProc
FOrgListViewWndProc := ListView1.WindowProc;
ListView1.WindowProc := ListViewWndProc;
DragAcceptFiles(ListView1.Handle, True);
end;
procedure TForm1.ListViewWndProc(var Msg: TMessage);
begin
// Catch the WM_DROPFILES message, and call the original ListView WindowProc
// for all other messages.
case Msg.Msg of
WM_DROPFILES:
DropFiles(Msg);
else
if Assigned(FOrgListViewWndProc) then
FOrgListViewWndProc(Msg);
end;
end;
Your problem is, you're registering the list view window as a drop target, but handling the WM_DROPFILES message in the form class. The message is sent to the list view control, you should handle the message there.
Related
In a 32-bit Delphi 11 VCL Application on Windows 10, when RIGHT-CLICKING any menu item, I need to get the name of the clicked MenuItem.
I use a TApplicationEvents component and this code to get notified when I click on any menu item:
procedure TformMain.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
CodeSite.Send('TformMain.ApplicationEvents1Message: WM_COMMAND');
end;
end;
end;
However:
How to get notified only when RIGHT-clicking the menu item?
How to get the NAME of the clicked MenuItem?
Each TMenu (i.e. TMainMenu or TPopupMenu) offers a method FindItem, which allows you to find an item by varying criteria. In your case the correct call for the form's main menu would be
TheMenuItem := Menu.FindItem(Msg.wParam, fkCommand);
Since I have several forms in my application and several (popup) menus on each of these forms, a special solution is needed here:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
// Todo: Check HERE for RightMouseButtonDown - BUT HOW? (Or how to check HERE for modifier keys?)
var ThisMenuItem := GetMenuItem(Msg.wParam);
if Assigned(ThisMenuItem) then
begin
CodeSite.Send('TForm1.ApplicationEvents1Message: Clicked MenuItem Name', ThisMenuItem.Name);
end;
end;
end;
end;
function TForm1.GetMenuItem(const aWParam: NativeUInt): TMenuItem;
var
ThisMenuItem: TMenuItem;
begin
Result := nil;
var ThisForm := Screen.ActiveForm; // works on any form in the application
for var i := 0 to ThisForm.ComponentCount - 1 do
begin
if ThisForm.Components[i] is TMenu then
begin
ThisMenuItem := TMenu(ThisForm.Components[i]).FindItem(aWParam, fkCommand);
if Assigned(ThisMenuItem) then
begin
Result := ThisMenuItem;
EXIT;
end;
end;
end;
end;
im working on a little Project right now and i want to synchronize 5 listBoxes scrolling together. The names of the listboxes are:
KidList
PointList
NoteList
CommentList
CommentListKid
How can i do it?
You could try the following technique.
First, add a private field
private
SyncBoxes: TArray<TListBox>;
to your form and initialise it when the form is created:
procedure TForm1.FormCreate(Sender: TObject);
begin
SyncBoxes := [ListBox1, ListBox2, ListBox3, ListBox4];
end;
Then define the following interposer class:
type
TListBox = class(Vcl.StdCtrls.TListBox)
strict private
procedure Sync;
protected
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
end;
implemented as
procedure TListBox.CNCommand(var Message: TWMCommand);
begin
inherited;
if Message.NotifyCode = LBN_SELCHANGE then
Sync;
end;
procedure TListBox.Sync;
var
LB: TListBox;
begin
for LB in Form1.SyncBoxes do
if LB <> Self then
LB.TopIndex := Self.TopIndex;
end;
procedure TListBox.WMMouseWheel(var Message: TWMMouseWheel);
begin
inherited;
Sync;
end;
procedure TListBox.WMVScroll(var Message: TWMVScroll);
begin
inherited;
Sync;
end;
Of course, in a real app you would refactor this.
The result is possibly good enough:
The list box's scrolling animation makes synchronisation a little bit delayed, however.
I've created an class that should propagate to the entire application a customized message when its going to be freed.
I did it with PostMessage and it worked with few bugs
PostMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
then I realized it should be synchronous - via SendMessage.
SendMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
On my Form I was handling the messages with a TApplicationEvents component, but just switching SendMessage to PostMessage didn't make it handle the message
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Handled := True;
end;
end;
It works if I pass the Form Handle but not working with Application.Handle...
What am I doing wrong?
The TApplication(Events).OnMessage event is triggered only for messages that are posted to the main UI thread message queue. Sent messages go directly to the target window's message procedure, bypassing the message queue. That is why your OnMessage event handler works with using PostMessage() but not SendMessage().
To catch messages that are sent to the TApplication window, you need to use TApplication.HookMainWindow() instead of TApplication(Events).OnMessage, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MyAppHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MyAppHook);
end;
function TForm1.MyAppHook(var Message: TMessage): Boolean;
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Result := True;
end else
Result := False;
end;
That being said, a better solution is to use AllocateHWnd() to create your own private window that you can post/send your custom messages to, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyWnd := AllocateHWnd(MyWndMsgProc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(FMyWnd);
end;
procedure TForm1.MyWndMsgProc(var Message: TMessage);
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Message.Result := 0;
end else
Message.Result := DefWindowProc(FMyWnd, Message.Msg, Message.WParam, Message.LParam);
end;
Then you can post/send messages to FMyWnd.
I have a simple form that only contains a TTouchKeyboard. The forms BorderStyle is set to bsToolWindow. To avoid the form getting focus when clicking the touch keyboard I handle the WM_MOUSEACTIVATE message with this implementation:
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
The BorderStyle setting allows the form to be dragged with the title bar, but in that case the form still gets the focus. Is there a way to avoid this?
Update: I tried adding WS_EX_NOACTIVATE to ExStyle in CreateParams, but unfortunately that doesn't hinder the form to receive focus when dragged.
procedure TKeyboardForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
end;
Because I was not very pleased with the approach that requires me to manually update the focused form variable in the keyboard form, I searched for a more transparent solution and came up with this approach.
Update: The previous approach had some issues with VCL styles. In addition not all of the message handlers were really necessary, though others turned out to be helpful, too. This version works well with VCL styles avoiding any flicker as far as possible:
type
TKeyboardForm = class(TForm)
TouchKeyboard1: TTouchKeyboard;
private
FLastFocusedForm: TCustomForm;
procedure SetLastFocusedForm(const Value: TCustomForm);
protected
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property LastFocusedForm: TCustomForm read FLastFocusedForm write SetLastFocusedForm;
public
class constructor Create;
destructor Destroy; override;
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
type
TKeyboardFormStyleHook = class(TFormStyleHook)
protected
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
end;
procedure TKeyboardFormStyleHook.WMNCActivate(var Message: TWMNCActivate);
begin
{ avoids the title bar being drawn active for blink }
Message.Active := False;
inherited;
end;
class constructor TKeyboardForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TKeyboardForm, TKeyboardFormStyleHook);
end;
destructor TKeyboardForm.Destroy;
begin
LastFocusedForm := nil;
inherited;
end;
procedure TKeyboardForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FLastFocusedForm) then begin
FLastFocusedForm := nil;
end;
inherited;
end;
function TKeyboardForm.SetFocusedControl(Control: TWinControl): Boolean;
begin
LastFocusedForm := Screen.FocusedForm;
result := inherited;
end;
procedure TKeyboardForm.SetLastFocusedForm(const Value: TCustomForm);
begin
if FLastFocusedForm <> Value then
begin
if FLastFocusedForm <> nil then begin
FLastFocusedForm.RemoveFreeNotification(Self);
end;
FLastFocusedForm := Value;
if FLastFocusedForm <> nil then begin
FLastFocusedForm.FreeNotification(Self);
end;
end;
end;
procedure TKeyboardForm.WMActivate(var Message: TWMActivate);
begin
Message.Active := WA_INACTIVE;
inherited;
end;
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TKeyboardForm.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (FLastFocusedForm <> nil) and (message.FocusedWnd <> FLastFocusedForm.Handle) then begin
SendMessage(FLastFocusedForm.Handle, WM_SETFOCUS, 0, 0);
Message.FocusedWnd := FLastFocusedForm.Handle;
end;
end;
The following combination of WMMouseActivate(), WMNCActivate() and reseting focus seems to fulfill your wishes:
The keyboard form (with BorderStyle = bsToolWindow) has message handlers for WM_MOUSEACTIVATE (as you already have) and WM_NCACTIVATE. The latter for having a point where to reset focus to the window with the edit control.
In addition the keyboardform will keep track of which form holds the edit (or other) control that has focus, and does that by introducing a new method for showing, which I called ShowUnfocused() and a field called FocusedForm: THandle.
procedure TKbdForm.ShowUnfocused(FocusedWindow: THandle);
begin
FocusedForm := FocusedWindow;
Show;
end;
procedure TKbdForm.FormShow(Sender: TObject);
begin
SetForegroundWindow(FocusedForm);
end;
procedure TKbdForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TKbdForm.WMNCActivate(var Message: TWMNCActivate);
begin
Message.Result := 1; // important
SetForegroundWindow(FocusedForm);
end;
The keyboardform is invoked by the following common code of the edit controls:
procedure TForm17.EditClick(Sender: TObject);
begin
KbdForm.ShowUnfocused(self.Handle);
(Sender as TWinControl).SetFocus;
end;
An alternative to what is said above, could be to set the BorderStyle = bsNone and arrange the dragging of the form with the Mouse Down, Move, Up events directly from the forms surface (or maybe a panel to mimic a top frame), and adding a close button. The challenge would be to get it visually acceptable.
As the title says, I'd like a component (say, a label) to be notified when it's parent (say, a panel) receives and loses focus. I wandered a bit in Delphi source, in hope of using TControl.Notify, but it's only used to notify child controls of some property changes like font and color. Any suggestions?
Whenever the active control in an application changes, a CM_FOCUSCHANGED message is broadcast to all controls. Simply intercept it, and act accordingly.
Also, I assumed that by when it's parent (say, a panel) receives and loses focus you mean whenever a (nested) child control on that parent/panel receives or loses focus.
type
TLabel = class(StdCtrls.TLabel)
private
function HasCommonParent(AControl: TWinControl): Boolean;
procedure CMFocusChanged(var Message: TCMFocusChanged);
message CM_FOCUSCHANGED;
end;
procedure TLabel.CMFocusChanged(var Message: TCMFocusChanged);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
begin
inherited;
Font.Style := FontStyles[HasCommonParent(Message.Sender)];
end;
function TLabel.HasCommonParent(AControl: TWinControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
If you don't like to subclass TJvGradientHeader, then it is possible to design this generically by the use of Screen.OnActiveControlChange:
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FHeaders: TList;
procedure ActiveControlChanged(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FHeaders := TList.Create;
FHeaders.Add(Label1);
FHeaders.Add(Label2);
Screen.OnActiveControlChange := ActiveControlChanged;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FHeaders.Free;
end;
function HasCommonParent(AControl: TWinControl; AMatch: TControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = AMatch.Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
procedure TForm1.ActiveControlChanged(Sender: TObject);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
var
I: Integer;
begin
for I := 0 to FHeaders.Count - 1 do
TLabel(FHeaders[I]).Font.Style :=
FontStyles[HasCommonParent(Screen.ActiveControl, TLabel(FHeaders[I]))];
end;
Note that I chose TLabel to demonstrate this works also for TControl derivatives.