How to catch Paste command and change text of Clipboard before that text is pasted into a TMemo, but, after Paste, text in Clipboard must be same like before changing?
Example, Clipboard have text 'Simple Question', text that go in the TMemo is 'Симплe Qуeстиoн', and after that text in Clipboard is like before changing, 'Simple Question'.
Derive a new control that descends from 'TMemo' to intercept the WM_PASTE message:
type
TPastelessMemo = class(TMemo)
protected
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
end;
uses
clipbrd;
procedure TPastelessMemo.WMPaste(var Message: TWMPaste);
var
SaveClipboard: string;
begin
SaveClipboard := Clipboard.AsText;
Clipboard.AsText := 'Simple Question';
inherited;
Clipboard.AsText := SaveClipboard;
end;
If you would like to prohibit any paste operation at all, empty the WMPaste handler.
This is an alternative to Sertac's excellent answer, which is to override the control's WndProc:
// For detecting WM_PASTE messages on the control
OriginalMemoWindowProc: TWndMethod;
procedure NewMemoWindowProc(var Message: TMessage);
//...
// In the form's OnCreate procedure:
// Hijack the control's WindowProc in order to detect WM_PASTE messages
OriginalMemoWindowProc := myMemo.WindowProc;
myMemo.WindowProc := NewMemoWindowProc;
//...
procedure TfrmMyForm.NewMemoWindowProc(var Message: TMessage);
var
bProcessMessage: Boolean;
begin
bProcessMessage := True;
if (Message.Msg = WM_PASTE) then
begin
// Data pasted into the memo!
if (SomeCondition) then
bProcessMessage := False; // Do not process this message any further!
end;
if (bProcessMessage) then
begin
// Ensure all (valid) messages are handled!
OriginalMemoWindowProc(Message);
end;
end;
Related
Is there a Windows API for setting up a custom cursor for the form's title bar, system menu icon and minimize, maximize and close buttons?
I'm having a function for loading and setting cursors for a given control:
type
TFrm_Main = class(TForm)
....
private
procedure SetCursor_For(AControl: TControl; ACursor_FileName: string;
Const ACurIndex: Integer);
...
end;
const
crOpenCursor = 1;
crRotateCursor = 2;
crCursor_Water = 3;
var
Frm_Main: TFrm_Main;
...
procedure TFrm_Main.SetCursor_For(AControl: TControl; ACursor_FileName:
string; const ACurIndex: Integer);
begin
Screen.Cursors[ACurIndex] := Loadcursorfromfile(PWideChar(ACursor_FileName));
AControl.Cursor := ACurIndex;
end;
And I'm using it this way for the form:
SetCursor_For(Frm_Main, 'Cursors\Cursor_Rotate.ani', crRotateCursor);
But I'm missing a way to setup cursor for particular form parts like form title bar, system menu icon and minimize, maximize and close buttons. Is there a way to set cursor for these form parts?
Handle the WM_SETCURSOR message and test the message parameter's HitTest field for one of the following hit test code values, and set the cursor by using SetCursor function returning True to the message Result (Windows API macros TRUE and FALSE coincidentally match to the Delphi's Boolean type values, so you can only typecast there):
HTCAPTION - Title bar
HTSYSMENU - System menu icon
HTMINBUTTON - Minimize button
HTMAXBUTTON - Maximize button
HTCLOSE - Close button
For example:
type
TForm1 = class(TForm)
private
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
end;
implementation
procedure TForm1.WMSetCursor(var Msg: TWMSetCursor);
begin
case Msg.HitTest of
HTCAPTION:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crHandPoint]);
end;
HTSYSMENU:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crHelp]);
end;
HTMINBUTTON:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crUpArrow]);
end;
HTMAXBUTTON:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crSizeAll]);
end;
HTCLOSE:
begin
Msg.Result := LRESULT(True);
Winapi.Windows.SetCursor(Screen.Cursors[crNo]);
end;
else
inherited;
end;
end;
How can I make a second form can follow the position of the main form wherever the main form shifted. for example, can be seen in this GIF image:
I tried using this delphiDabbler tip, which is to stop a form moving, but did not manage to get something that worked.
In the main form you need this:
type
TMainForm = class(TForm)
protected
procedure WMWindowPosChanged(var Msg: TWMWindowPosChanged);
message WM_WINDOWPOSCHANGED;
end;
....
procedure TMainForm.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
inherited;
if Assigned(OtherForm) and not Application.Terminated then
begin
OtherForm.Left := Left + Width;
OtherForm.Top := Top;
end;
end;
This ensures that whenever the main form's position changes, the other form clamps to it. Note that this message can be sent before the other form is created, and after it is no longer valid. Hence the if statement.
And on the other form do this:
type
TOtherForm = class(TForm)
protected
procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging);
message WM_WINDOWPOSCHANGING;
end;
....
procedure TOtherForm.WMWindowPosChanging(var Msg: TWMWindowPosChanging);
begin
inherited;
if not Application.Terminated then
begin
Msg.WindowPos.x := MainForm.Left + MainForm.Width;
Msg.WindowPos.y := MainForm.Top;
end;
end;
This ensures that any attempts to move the other form are rejected.
Handle WM_WINDOWPOSCHANGING to move your other form(s) at the same time.
...
public
OldTop, OldLeft: Integer;
procedure WindowPosChanging(var Msg: TWMWindowPosChanging);
message WM_WINDOWPOSCHANGING;
end;
...
implementation
...
procedure TForm1.WindowPosChanging(var Msg: TWMWindowPosChanging);
var
DTop, DLeft: Integer;
begin
// well and here inside of you put the relationship of like you
// want him to move.
// an example of this moving them in the same sense can be...
if (Form2 = nil) or (not Form2.Visible) then Exit;
// this line is to avoid the error of calling them when the forms
// are creating or when they are not visible...
DTop := Top - OldTop;
DLeft := Left - OldLeft;
Form2.Top := Form2.Top + DTop;
Form2.Left := Form2.Left + DLeft;
OldTop := Top;
OldLeft := Left;
inherited;
end;
Source:
http://delphi.cjcsoft.net/viewthread.php?tid=43047
(original code updated according to suggestions in comments)
Or something like this
Two forms to snap each other
I'm trying to stop a TMemo (and also TRichEdit) control from eating Escape keys.
If the user is focused in a TEdit, pressing Escape will trigger the form to do what the form does when the user presses escape. If the user is focused in a TMemo, pressing escape is eaten by the TMemo.
Of course i could do the hack:
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 then
begin
//figure out how to send a key to the form
end;
end;
But that is not ideal (i have to handle the escape key, rather than letting the form handle it).
Of course i could do the hack:
Form1.KeyPreview := True;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 then
begin
//Figure out how to invoke what the form was going to do when the user presses escape
end;
end;
But that is not ideal (i have to handle the escape key, rather than letting the form handle it).
So we'll answer the question rather than the problem
Instead we'll take this opportunity to learn something. How is it that a TMemo is even receiving a keyPress event associated with the escape key, when a TEdit doesn't:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 then
begin
//never happens
end;
end;
The TEdit and TMemo are the same Windows EDIT common control.
Why does escape bypass the form's KeyPreview
If i turn on the form's KeyPreview, and the user presses Escape while focused in a TEdit box, and a button's Cancel property is set, the form closes and:
the Edit1.KeyPress event is not triggered
the Form1.KeyPress event is not triggered
If an Action is created, whose Shortcut is Esc, then no KeyPress event is raised, no matter what control the user is focused in.
tl;dr: Where is the TMemo.WantEscape property?
The behaviour you observe is controlled by the handling of the WM_GETDLGCODE message. For a memo that looks like this:
procedure TCustomMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
else Message.Result := Message.Result and not DLGC_WANTTAB;
if not FWantReturns then
Message.Result := Message.Result and not DLGC_WANTALLKEYS;
end;
For an edit control the VCL does not implement special handling for WM_GETDLGCODE and the underlying Windows edit control handles it.
In a standard Win32 app the Windows dialog manager sends the WM_GETDLGCODE messages. But Delphi is not built on top of the dialog manager, and so the VCL is in charge of sending WM_GETDLGCODE. It does so in the CN_KEYDOWN handler. The code looks like this:
Mask := 0;
case CharCode of
VK_TAB:
Mask := DLGC_WANTTAB;
VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
Mask := DLGC_WANTARROWS;
VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
Mask := DLGC_WANTALLKEYS;
end;
if (Mask <> 0) and
(Perform(CM_WANTSPECIALKEY, CharCode, 0) = 0) and
(Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and
(GetParentForm(Self).Perform(CM_DIALOGKEY,
CharCode, KeyData) <> 0) then Exit;
Notice that VK_RETURN, VK_EXECUTE, VK_ESCAPE and VK_CANCEL are all lumped together. This means that a VCL control has to decide whether or not to process these keys itself, or let the form handle them in its CM_DIALOGKEY handler.
As you can see from TCustomMemo.WMGetDlgCode you can influence that choice with the WantReturns property. So, you can persuade the VCL to let the form handle ESC by simply setting WantReturns on the memo to False. But that also stops the ENTER key reaching memo and makes it rather tricky for the user of the memo to enter new lines. They have to do it with CTRL + ENTER.
In fact WantReturns should really have been named WantReturnsAndEscapesAndExecutesAndCtrlBreaks. The VCL designers could have implemented a WantEscapes property but it's just not there.
So you are left handling it yourself one way or another. Personally, I do so with my own derived memo control. It overrides the KeyDown method and does this:
procedure TMyMemo.KeyDown(var Key: Word; Shift: TShiftState);
var
Form: TCustomForm;
Message: TCMDialogKey;
begin
inherited;
if (Key=VK_ESCAPE) and (Shift*[ssShift..ssCtrl])=[]) then begin
Form := GetParentForm(Self);
if Assigned(Form) then begin
// we need to dispatch this key press to the form so that it can 'press'
// any buttons with Cancel=True
Message.Msg := CM_DIALOGKEY;
Message.CharCode := VK_ESCAPE;
Message.KeyData := 0;
Message.Result := 0;
Form.Dispatch(Message);
end;
end;
end;
Another way to achieve this is to handle CM_WANTSPECIALKEY and WM_GETDLGCODE. Here's a crude interposer that illustrates the technique:
type
TMemo = class(StdCtrls.TMemo)
protected
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
end;
procedure TMemo.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
case Msg.CharCode of
VK_ESCAPE:
Msg.Result := 0;
VK_RETURN, VK_EXECUTE, VK_CANCEL:
Msg.Result := 1;
else
inherited;
end;
end;
procedure TMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
Msg.Result := Msg.Result and not DLGC_WANTALLKEYS;
end;
I want to restrict users (based on special condition) to open a tab or not in a page control. ie, the user can click on the tab but it will not be displayed to him. Instead, a message will show to him that "he don't have the access right to see such tab".
On what event I should write the checking code, and what tab property (of TPageControl component) will allow/block user to enter such tab?
In an ideal world you would set AllowChange to False from theOnChanging event to block a page change. However, this does not appear to be viable because I can find no way of discerning, from within OnChanging, which page the user is trying to select.
Even looking at the underlying Windows notification seems to offer little hope. The TCN_SELCHANGING notification identifies the control, but not says nothing about the pages involved, so far as I can tell.
The best I can come up with is to use OnChanging to note the current active page and then do the hard work in OnChange. If the selected page has been changed to something undesirable, then just change it back.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
FPreviousPageIndex := PageControl1.ActivePageIndex;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex=1 then begin
PageControl1.ActivePageIndex := FPreviousPageIndex;
Beep;
end;
end;
Rather messy I know, but it has the virtue of working!
The OnChanging event does not allow you to determine which tab is being selected, because Windows itself does not report that information. What you can do, however, is subclass the TPageControl.WindowProc property to intercept messages that are sent to the TPageControl before it processes them. Use mouse messages to determine which tab is being clicked on directly (look at the TPageControl.IndexOfTabAt() method), and use keyboard messages to detect left/right arrow presses to determine which tab is adjacent to the active tab (look at the TPageControl.FindNextPage() method).
Use the OnChanging event of the page control.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
if (self.PageControl1.TabIndex= 1)and
(NotAllowUser = 'SomePerson') then
begin
AllowChange:= False;
ShowMessage('Person not allow for this Tab');
end;
end;
Ok, the PageControle1.TabIndex is the activepageindex and not the one i want to select.
How can i get the clicked Page.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
var
P: TPoint;
NewTabIndex: Integer;
begin
P := PageControl1.ScreenToClient(Mouse.CursorPos);
NewTabIndex := PageControl1.IndexOfTabAt(P.X, P.y);
if (NewTabIndex= 1) then
begin
AllowChange:= false;
Beep
end;
end;
New Attempt
TMyPageControl = Class(TPageControl)
private
FNewTabSheet: TTabSheet;
FOnMyChanging: TMyTabChangingEvent;
procedure SetOnMyChanging(const Value: TMyTabChangingEvent);
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
protected
function CanChange: Boolean; Override;
public
property OnMyChanging: TMyTabChangingEvent read FOnMyChanging write SetOnMyChanging;
End;
{ TMyPageControl }
function TMyPageControl.CanChange: Boolean;
begin
Result := True;
if Assigned(FOnMyChanging) then FOnMyChanging(Self, FNewTabSheet ,Result);
end;
procedure TMyPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
(Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
begin
FNewTabSheet := FindNextPage(ActivePage, GetKeyState(VK_SHIFT) >= 0,True);
SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
Message.Result := 1;
end else
inherited;
end;
procedure TMyPageControl.CNNotify(var Message: TWMNotify);
var
P: TPoint;
NewTabIndex: Integer;
begin
with Message do
case NMHdr.code of
TCN_SELCHANGE:
Change;
TCN_SELCHANGING:
begin
Result := 1;
P := self.ScreenToClient(Mouse.CursorPos);
NewTabIndex := self.IndexOfTabAt(P.X, P.y);
FNewTabSheet:= self.Pages[NewTabIndex];
if CanChange then Result := 0;
end;
end;
end;
procedure TMyPageControl.SetOnMyChanging(const Value: TMyTabChangingEvent);
begin
FOnMyChanging := Value;
end;
You can show tab and effectively disable changing in OnChanging event of TPageControl. All you need to do is set AllowChange var to False.
procedure TForm1.PageControl1(Sender: TObject; var AllowChange: Boolean);
begin
AllowChange := MyCondition;
if MyCondition
ShowMessage('User doesn''t have permission to see this tab.');
end
Sometimes it is better just to hide unwanted TabSheets with something like this:
TabSheetNN.TabVisible:=Somecondition;
than trying to prevent switching to these tabs.
Sure, it would be better if Sender in OnChanging event will be TabSheet , not TPageControl.
I have got a Delphi application which uses TOpenDialog to let the user select a file. By default, the open dialog is displayed centered on the current monitor which nowadays can be "miles" away from the application's window. I would like the dialog to be displayed centered on the TOpenDialog's owner control, failing that, I'd settle for the application's main window.
The following code kind of works, it is derived from TJvOpenDialog which gave me some hint on how to do it:
type
TMyOpenDialog = class(TJvOpenDialog)
private
procedure SetPosition;
protected
procedure DoFolderChange; override;
procedure WndProc(var Msg: TMessage); override;
end;
procedure TMyOpenDialog.SetPosition;
begin
var
Monitor: TMonitor;
ParentControl: TWinControl;
Res: LongBool;
begin
if (Assigned(Owner)) and (Owner is TWinControl) then
ParentControl := (Owner as TWinControl)
else if Application.MainForm <> nil then
ParentControl := Application.MainForm
else begin
// this code was already in TJvOpenDialog
Monitor := Screen.Monitors[0];
Res := SetWindowPos(ParentWnd, 0,
Monitor.Left + ((Monitor.Width - Width) div 2),
Monitor.Top + ((Monitor.Height - Height) div 3),
Width, Height,
SWP_NOACTIVATE or SWP_NOZORDER);
exit; // =>
end;
// this is new
Res := SetWindowPos(GetParent(Handle), 0,
ParentControl.Left + ((ParentControl.Width - Width) div 2),
ParentControl.Top + ((ParentControl.Height - Height) div 3),
Width, Height,
SWP_NOACTIVATE or SWP_NOZORDER);
end;
procedure TMyOpenDialog.DoFolderChange
begin
inherited DoFolderChange; // call inherited first, it sets the dialog style etc.
SetPosition;
end;
procedure TMyOpenDialog.WndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_ENTERIDLE: begin
// This has never been called in my tests, but since TJVOpenDialog
// does it I figured there may be some fringe case which requires
// SetPosition being called from here.
inherited; // call inherited first, it sets the dialog style etc.
SetPosition;
exit;
end;
end;
inherited;
end;
"kind of works" meaning that the first time the dialog is opened, it is displayed centered on the owner form. But, if I then close the dialog, move the window and open the dialog again, SetWindowPos doesn't seem to have any effect even though it does return true. The dialog gets opened at the same position as the first time.
This is with Delphi 2007 running on Windows XP, the target box is also running Windows XP.
The behaviour you describe I can reproduce only by passing a bogus value for the OwnerHwnd to the dialog's Execute method.
This window handle is then passed on to the underlying Windows common control and in fact you will have other problems with your dialogs if you do not set it to the handle of the active form when the dialog is shown.
For example when I call Execute and pass Application.Handle, the dialog always appears on the same window, in a rather bizarre location, irrespective of where my main form is.
When I call Execute and pass the handle to my main form, the dialog appears on top of the main form, slightly shifted to the right and down. This is true no matter which monitor the form is on.
I am using Delphi 2010 and I don't know whether or not you have the overloaded version of Execute available on your version of Delphi. Even if you don't have that available, you should still be able to create a derived class that will pass a more sensible value for OwnerHwnd.
Although I don't have conclusive 100% evidence that this is your problem, I think that this observation will lead you to a satisfactory resolution.
TJvOpenDialog is a descendant of TOpenDialog, hence you should run your placement call after the VCL centers the dialog. The VCL does it in response to a CDN_INITDONE notification. Responding to a WM_SHOWWINDOW message is too early, and in my tests the window procedure never receives a WM_ENTERIDLE message.
uses
commdlg;
[...]
procedure TJvOpenDialog.DoFolderChange;
begin
inherited DoFolderChange;
// SetPosition; // shouldn't be needing this, only place the dialog once
end;
procedure TJvOpenDialog.WndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_NOTIFY: begin
if POFNotify(Msg.LParam)^.hdr.code = CDN_INITDONE then begin
inherited; // VCL centers the dialog here
SetPosition; // we don't like it ;)
Exit;
end;
end;
inherited;
end;
or,
procedure TJvOpenDialog.WndProc(var Msg: TMessage);
begin
case Msg.Msg of
WM_NOTIFY: if POFNotify(Msg.LParam)^.hdr.code = CDN_INITDONE then
Exit;
end;
inherited;
end;
to have the dialog where the OS puts it, it actually makes sense.
I tried both examples without success ... but here is a symple solution:
type
TPThread = class(TThread)
private
Title : string;
XPos,YPos : integer;
protected
procedure Execute; override;
end;
TODialogPos = class(Dialogs.TOpenDialog)
private
Pt : TPThread;
public
function Execute(X,Y : integer):boolean; reintroduce;
end;
TSDialogPos = class(Dialogs.TSaveDialog)
private
Pt : TPThread;
public
function Execute(X,Y : integer):boolean; reintroduce;
end;
implementation
procedure TPThread.Execute;
var ODhandle : THandle; dlgRect : TRect;
begin
ODhandle:= FindWindow(nil, PChar(Title));
while (ODhandle = 0) do ODhandle:= FindWindow(nil, PChar(Title));
if ODhandle <> 0 then begin
GetWindowRect(ODhandle, dlgRect);
with dlgRect do begin
XPos:=XPos-(Right-Left) div 2;
YPos:=YPos-(Bottom-Top) div 2;
MoveWindow(ODhandle, XPos, YPos,Right-Left,Bottom-Top,True);
SetWindowPos(ODhandle, HWND_TOP, XPos, YPos, 0, 0, SWP_NOSIZE);
end
end;
DoTerminate;
end;
function TODialogPos.Execute(X,Y : integer):boolean;
begin
Pt:= TPThread.Create(False);
Pt.XPos := X;
Pt.YPos := Y;
if Self.Title <> '' then
Pt.Title := Self.Title
else begin
Self.Title := 'Open';
Pt.Title := Self.Title;
end;
Result:= inherited Execute;
Pt.Free;
end;
function TSDialogPos.Execute(X,Y : integer):boolean;
begin
Pt:= TPThread.Create(False);
Pt.XPos := X;
Pt.YPos := Y;
if Self.Title <> '' then
Pt.Title := Self.Title
else begin
Self.Title := 'Save';
Pt.Title := Self.Title;
end;
Result:= inherited Execute;
Pt.Free;
end;
...
Use it like (for example center Save Dilaog in Form1) the following code:
type
TForm1 = class(TForm)
...
...
dlgSave:=TSDialogPos.Create(self);
dlgSave.Filter := 'Symbol File (*.asy)|*.asy';
dlgSave.Options:=[ofHideReadOnly,ofExtensionDifferent,ofPathMustExist,
ofCreatePrompt,ofNoTestFileCreate,ofNoNetworkButton,
ofOldStyleDialog,ofEnableIncludeNotify,ofEnableSizing];
...
with dlgSave do begin
Title :='Copy : [ *.asy ] with Attributes';
InitialDir:= DirectoryList.Directory;
FileName:='*.asy';
end;
...
with Form1 do
if dlgSave.Execute(Left+Width div 2, Top+Height div 2) then begin
// your code
end;
...
dlgSave.Free
...