Is there a simple/clever way to load the standard Windows TEdit menu into this TRichEdit?
I know that I could create a simple menu to simulate the TEdit menu for the simple operations like copy/paste etc. (Example), however I would also like to keep the more advanced menu options such as the unicode options, reading order, and to utilize the same localization strings.
Edit: I have found a possible lead (trying to figure it out as I'm not an MFC expert)...
Based on the "possible lead" and a bit of MSDN, I came up with a possible solution.
I'm still unable to resolve the reading order issue (and the unicode options). It seems that it works differently for RichEdit than for Edit, and simply setting or getting the WS_EX_RTLREADING flag does not work as excpected. Anyways, here is the code:
procedure RichEditPopupMenu(re: TRichEdit);
const
IDM_UNDO = WM_UNDO;
IDM_CUT = WM_CUT;
IDM_COPY = WM_COPY;
IDM_PASTE = WM_PASTE;
IDM_DELETE = WM_CLEAR;
IDM_SELALL = EM_SETSEL;
IDM_RTL = $8000; // WM_APP ?
Enables: array[Boolean] of DWORD = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
Checks: array[Boolean] of DWORD = (MF_UNCHECKED, MF_CHECKED);
var
hUser32: HMODULE;
hmnu, hmenuTrackPopup: HMENU;
Cmd: DWORD;
Flags: Cardinal;
HasSelText: Boolean;
FormHandle: HWND;
// IsRTL: Boolean;
begin
hUser32 := LoadLibraryEx(user32, 0, LOAD_LIBRARY_AS_DATAFILE);
if (hUser32 <> 0) then
try
hmnu := LoadMenu(hUser32, MAKEINTRESOURCE(1));
if (hmnu <> 0) then
try
hmenuTrackPopup := GetSubMenu(hmnu, 0);
HasSelText := Length(re.SelText) <> 0;
EnableMenuItem(hmnu, IDM_UNDO, Enables[re.CanUndo]);
EnableMenuItem(hmnu, IDM_CUT, Enables[HasSelText]);
EnableMenuItem(hmnu, IDM_COPY, Enables[HasSelText]);
EnableMenuItem(hmnu, IDM_PASTE, Enables[Clipboard.HasFormat(CF_TEXT)]);
EnableMenuItem(hmnu, IDM_DELETE, Enables[HasSelText]);
EnableMenuItem(hmnu, IDM_SELALL, Enables[Length(re.Text) <> 0]);
// IsRTL := GetWindowLong(re.Handle, GWL_EXSTYLE) and WS_EX_RTLREADING <> 0;
// EnableMenuItem(hmnu, IDM_RTL, Enables[True]);
// CheckMenuItem(hmnu, IDM_RTL, Checks[IsRTL]);
FormHandle := GetParentForm(re).Handle;
Flags := TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_NONOTIFY or TPM_RETURNCMD;
Cmd := DWORD(TrackPopupMenu(hmenuTrackPopup, Flags,
Mouse.CursorPos.X, Mouse.CursorPos.Y, 0, FormHandle, nil));
if Cmd <> 0 then
begin
case Cmd of
IDM_UNDO: re.Undo;
IDM_CUT: re.CutToClipboard;
IDM_COPY: re.CopyToClipboard;
IDM_PASTE: re.PasteFromClipboard;
IDM_DELETE: re.ClearSelection;
IDM_SELALL: re.SelectAll;
IDM_RTL:; // ?
end;
end;
finally
DestroyMenu(hmnu);
end;
finally
FreeLibrary(hUser32);
end;
end;
procedure TForm1.RichEditEx1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
begin
RichEditPopupMenu(TRichEdit(Sender));
Handled := True;
end;
Any feedback would be nice :)
Related
Following _isEdit function detects whether input could be applied to the currently focused control:
class function TSpeedInput._getFocusedControlClassName(): WideString;
var
lpClassName: array[0..1000] of WideChar;
begin
FillChar(lpClassName, SizeOf(lpClassName), 0);
Windows.GetClassNameW(GetFocus(), PWideChar(#lpClassName), 999);
Result := lpClassName;
end;
class function TSpeedInput._isEdit(): Boolean;
const
CNAMES: array[0..3] of string = ('TEdit', 'TMemo', 'TTntMemo.UnicodeClass',
'TTntEdit.UnicodeClass');
var
cn: WideString;
i: Integer;
begin
Result := False;
cn := _getFocusedControlClassName();
for i := Low(CNAMES) to High(CNAMES) do
if cn = CNAMES[i] then begin
Result := True;
Exit;
end;
//MessageBoxW(0, PWideChar(cn), nil, 0);
end;
What I don't like about it is the hard coding of the class name list. Could it be detected that a currently focused window belongs to the editors family or, better to say, that it has an active caret? (in order that _isEdit returns False for a WhateverItIsControl that is in read-only mode).
If the Handle of the control is allocated, you can use this hack:
function IsEdit(AControl: TWinControl): boolean;
begin
if AControl.HandleAllocated then
begin
Result := SendMessage(AControl.Handle, EM_SETREADONLY,
WPARAM(Ord(AControl.Enabled)), 0) <> 0;
end
else
begin
Result := AControl is TCustomEdit;
end;
end;
If the controls you are interested in are on a specific form and are owned by that form (and are standard Delphi controls) you could use the following:
function TFormML2.FocusIsEdit: boolean;
var
i : integer;
begin
Result := FALSE;
for i := 0 to ComponentCount - 1 do
begin
if Components[ i ] is TCustomEdit then
begin
if (Components[ i ] as TCustomEdit).Focused and not (Components[ i ] as TCustomEdit).ReadOnly then
begin
Result := TRUE;
break;
end;
end;
end;
end;
If you know the form and can pass it as a parameter, you could do something similar.
TCustomEdit is the ancestor of all edit boxes, memos, etc.
I need to suppress the printing of outlook userproperties programmatically added to a mail item. I had seen the following question that has a solution for dot.net here Suppressing Outlook Field Printing but i'm having trouble translating the code to delphi. My main problem is the invokemember line i'm guessing i need to use userproperty.invoke somehow in delphi but i'm clueless on how i should use the parameters that the invoke methode requires. Can someone help me translate the solution from that question to delphi code ?
Thanks with the help of the people from addin-express i have a working solution... that seems to work for outlook 2016 still have to test other outlook versions. The problem was that i did not know what parameters to use for the invoke function.
I'm posting my function here
function TAddInModule.RemoveUserPropertyPrintFlag(
var aUserProperty: UserProperty): Boolean;
const
propID: integer = 107;
removePrinterFlag: integer = $4;
var
res: OleVariant;
disp : TDispParams;
flags: Integer;
dispIDs: array[0..0] of TDispID;
args: array [0..0] of TVariantArg;
begin
Result := False;
disp.cNamedArgs:= 0;
disp.cArgs:= 0;
if aUserProperty.Invoke(propID, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, disp, #res, nil, nil) = S_OK then
begin
if TVarData(res).VType = varInteger then
begin
flags := TVarData(res).VInteger;
args[0].vt := VT_INT;
args[0].intVal := flags and (not removePrinterFlag);
disp.cArgs := 1;
disp.cNamedArgs := 1;
dispIDs[0]:= DISPID_PROPERTYPUT;
disp.rgdispidNamedArgs := #dispIDs;
disp.rgvarg := #args;
Result:= aUserProperty.Invoke(propID, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYPUT, disp, nil, nil, nil) = S_OK;
end;
end;
end;
The translated code to delphi from the answer of the other stackoverflow should be something like this (not tested):
function TAddInModule.SuppressUserPropertyPrinting(mailItem: _MailItem) : HResult;
const
propID: integer = 107;
removePrinterFlag: integer = $4;
var
props: UserProperties;
prop: UserProperty;
i: integer;
res: OleVariant;
disp : TDispParams;
flags: Integer;
dispIDs: array[0..0] of TDispID;
args: array [0..0] of TVariantArg;
begin
props := mailItem.UserProperties;
if props.Count > 0 then begin
for i := 1 to props.Count do begin
prop := props.Item(i);
disp.cNamedArgs:= 0;
disp.cArgs:= 0;
Result:= prop.Invoke(propID, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, disp, #res, nil, nil);
if TVarData(res).VType = varInteger then begin
flags := TVarData(res).VInteger;
args[0].vt := VT_INT;
args[0].intVal := flags and (not removePrinterFlag);
disp.cArgs := 1;
disp.cNamedArgs := 1;
dispIDs[0]:= DISPID_PROPERTYPUT;
disp.rgdispidNamedArgs := #dispIDs;
disp.rgvarg := #args;
Result:= prop.Invoke(propID, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYPUT, disp, nil, nil, nil);
end;
prop := nil;
end;
end;
props := nil;
end;
You will need to use IDispatch.Invoke() in Delphi. Disp id is 107 and the value must be a variant of type varInteger and the value of 4. There are quite a few examples of calling IDispatch.Invoke in the VCL source code.
If using Redemption (I am its author) is an option, it explicitly exposes the RDOUserProperty.Printable property.
Below is the complete routine I'm using to send the key Ctrl + Shift + S to a PDF document. It should show the save dialog but fails to do so.
The procedure opens a pdf document residing in sFolder using GetFiles. There is only one pdf doc in sFolder.
As you can see from the commented out lines, I also tried the sndkey32 without success.
procedure TForm1.Button1Click(Sender: TObject);
var
oBrowser: TBrowseForFolder;
oList: TStringDynArray;
sFile: string;
sFolder: string;
oShellExecuteInfo: TShellExecuteInfo;
begin
oBrowser := TBrowseForFolder.Create(self);
oBrowser.Execute;
sFolder := oBrowser.Folder;
oBrowser.Free;
if DirectoryExists(sFolder) then begin
oList := TDirectory.GetFiles(sFolder, '*.pdf', TSearchOption.soAllDirectories);
if Length(oList) > 0 then begin
for sFile in oList do begin
FillChar(oShellExecuteInfo, SizeOf(oShellExecuteInfo), 0);
oShellExecuteInfo.cbSize := SizeOf(TShellExecuteInfo);
with oShellExecuteInfo do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(sFile);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#oShellExecuteInfo) then begin
ShowWindow(oShellExecuteInfo.Wnd, 1);
SetForegroundWindow(oShellExecuteInfo.Wnd);
Winapi.Windows.SetFocus(oShellExecuteInfo.Wnd);
SendKey(Ord('s'), [ssCtrl, ssShift], False);
// if sndkey32.AppActivate('adobe') then
// sndkey32.SendKeys('^+S', False);
end;
end;
end;
end;
end;
procedure TForm1.SendKey(key: Word; const shift: TShiftState; specialkey: Boolean);
type
TShiftKeyInfo = record
shift: Byte;
vkey: Byte;
end;
ByteSet = set of 0 .. 7;
const
shiftkeys: array [1 .. 3] of TShiftKeyInfo = ((shift: Ord(ssCtrl); vkey: VK_CONTROL), (shift: Ord(ssShift); vkey: VK_SHIFT), (shift: Ord(ssAlt); vkey: VK_MENU));
var
flag: DWORD;
bShift: ByteSet absolute shift;
j: Integer;
begin
for j := 1 to 3 do begin
if shiftkeys[j].shift in bShift then keybd_event(shiftkeys[j].vkey, MapVirtualKey(shiftkeys[j].vkey, 0), 0, 0);
end;
if specialkey then flag := KEYEVENTF_EXTENDEDKEY
else flag := 0;
keybd_event(key, MapVirtualKey(key, 0), flag, 0);
flag := flag or KEYEVENTF_KEYUP;
keybd_event(key, MapVirtualKey(key, 0), flag, 0);
for j := 3 downto 1 do begin
if shiftkeys[j].shift in bShift then keybd_event(shiftkeys[j].vkey, MapVirtualKey(shiftkeys[j].vkey, 0), KEYEVENTF_KEYUP, 0);
end;
end;
The window oShellExecuteInfo.Wnd is a window in your Delphi process. You assign it as Application.Handle. You seem to be hoping that it will be the main window of the PDF viewer but that's not the case.
So you need to find the main window of the PDF viewer. That involves a call to EnumerateWindows to get all top level windows. Then, for each one, use GetWindowThreadProcessId to test whether or not the window is owned by the PDF viewer process.
Some other comments:
You neglect error checking when calling API functions.
You should use SendInput rather than keybd_event.
You leak the process handle returned by ShellExecuteEx.
It is possible that ShellExecuteEx does not return a process handle at all. That depends on how the file association is setup, and whether or not Acrobat was already running.
You may need to wait until the new process has finished starting up before you send input.
Your program seems to assume that the installed PDF viewer is Acrobat. What if it is not?
I need the opposite information that the question "How to get cursor position on a control?" asks.
Given the current cursor position, how can I find the form (in my application) and the control that the cursor is currently over? I need the handle to it so that I can use Windows.SetFocus(Handle).
For reference, I'm using Delphi 2009.
I experienced some problems with suggested solutions (Delphi XE6/Windows 8.1/x64):
FindVCLWindow doesn't search disabled controls (Enabled=False).
TWinControl.ControlAtPos doesn't search controls if they are disabled
indirectly (for example if Button.Enabled=True, but Button.Parent.Enabled=False).
In my case it was a problem, because i need to find any visible control under the mouse cursor, so i have to use my own implementation of function FindControlAtPos:
function FindSubcontrolAtPos(AControl: TControl; AScreenPos, AClientPos: TPoint): TControl;
var
i: Integer;
C: TControl;
begin
Result := nil;
C := AControl;
if (C=nil) or not C.Visible or not TRect.Create(C.Left, C.Top, C.Left+C.Width, C.Top+C.Height).Contains(AClientPos) then
Exit;
Result := AControl;
if AControl is TWinControl then
for i := 0 to TWinControl(AControl).ControlCount-1 do
begin
C := FindSubcontrolAtPos(TWinControl(AControl).Controls[i], AScreenPos, AControl.ScreenToClient(AScreenPos));
if C<>nil then
Result := C;
end;
end;
function FindControlAtPos(AScreenPos: TPoint): TControl;
var
i: Integer;
f,m: TForm;
p: TPoint;
r: TRect;
begin
Result := nil;
for i := Screen.FormCount-1 downto 0 do
begin
f := Screen.Forms[i];
if f.Visible and (f.Parent=nil) and (f.FormStyle<>fsMDIChild) and
TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(AScreenPos)
then
Result := f;
end;
Result := FindSubcontrolAtPos(Result, AScreenPos, AScreenPos);
if (Result is TForm) and (TForm(Result).ClientHandle<>0) then
begin
WinAPI.Windows.GetWindowRect(TForm(Result).ClientHandle, r);
p := TPoint.Create(AScreenPos.X-r.Left, AScreenPos.Y-r.Top);
m := nil;
for i := TForm(Result).MDIChildCount-1 downto 0 do
begin
f := TForm(Result).MDIChildren[i];
if TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(p) then
m := f;
end;
if m<>nil then
Result := FindSubcontrolAtPos(m, AScreenPos, p);
end;
end;
I think FindVCLWindow will meet your needs. Once you have the windowed control under the cursor you can walk the parent chain to find the form on which the window lives.
If you want to know the control inside a form that is at a certain x,y coordinate
Use
function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
AllowWinControls: Boolean = False; AllLevels: Boolean = False): TControl;
Given the fact that you seem only interested in forms inside your application, you can just query all forms.
Once you get a non-nil result, you can query the control for its Handle, with code like the following
Pseudo code
function HandleOfControlAtCursor: THandle;
const
AllowDisabled = true;
AllowWinControls = true;
AllLevels = true;
var
CursorPos: TPoint
FormPos: TPoint;
TestForm: TForm;
ControlAtCursor: TControl;
begin
Result:= THandle(0);
GetCursorPos(CursorPos);
for each form in my application do begin
TestForm:= Form_to_test;
FormPos:= TestForm.ScreenToClient(CursorPos);
ControlAtCursor:= TestForm.ControlAtPos(FormPos, AllowDisabled,
AllowWinControls, AllLevels);
if Assigned(ControlAtCursor) then break;
end; {for each}
//Break re-enters here
if Assigned(ControlAtCursor) then begin
while not(ControlAtCursor is TWinControl) do
ControlAtCursor:= ControlAtCursor.Parent;
Result:= ControlAtCursor.Handle;
end; {if}
end;
This also allows you to exclude certain forms from consideration should you so desire. If you're looking for simplicity I'd go with David and use FindVCLWindow.
P.S. Personally I'd use a goto rather than a break, because with a goto it's instantly clear where the break re-enters, but in this case it's not a big issue because there are no statements in between the break and the re-entry point.
Is there anyway to get the THotkey component in delphi to support the windows key?
Or does anyone know of a component that can do this?
Thanks heaps!
IMHO it is a good thing THotKey does not support this.
Don't use the windows key for keyboard shortcuts in your program, the "Windows Vista User Experience Guidelines" says the following under Guidelines - Interaction - Keyboard:
Don't use the Windows logo modifier key for program shortcut keys. Windows logo key is reserved for Windows use. Even if a Windows logo key combination isn't being used by Windows now, it may be in the future.
Even if the shortcut isn't used by Windows, using such a keyboard shortcut would be confusing to users, as it would perform a function in your program, while other such shortcuts like Win+E or Win+R activate a system-wide function, deactivating your program in the process.
Edit:
THotKey is a light wrapper around a system control, supporting only the things that this system control supports. There is no documented way to set anything but the Alt, Ctrl and Shift modifiers for the shortcut.
You might be able to create your own control to display shortcuts using the Windows key, and set a global keyboard hook (look into the SetWindowsHookEx() API function).
I don't know if you can do it with the THotkey component.
But you can capture the left and right Windows Key in any KeyDown event using:
if key = vk_LWin then showmessage('left');
if key = vk_RWin then showmessage('right');
Sure its possible - you need to make your own copy of { THotKey } and tweak it a little to support also Win key. You need to add your own KeyDown() and Repaint() functions to this class .
Like this:
TMyCustomHotKey = class(TWinControl)
public
WinKey: boolean;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
constructor Create(AOwner: TComponent); override;
end;
TMyHotKey = class(TMyCustomHotKey)
..
procedure TMyCustomHotKey.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
a : integer;
lbl : string;
tmphot : tshortcut;
begin
a:= 0;
if GetAsyncKeyState(VK_LWIN) <> 0 then a:= 1;
if GetAsyncKeyState(VK_RWIN) <> 0 then a:= 1;
if a=1 then begin
winkey := true;
end else
begin
winkey := false;
end;
rePaint();
}
procedure TMyCustomHotKey.WMPaint(var Message: TWMPaint);
var
PS: TPaintStruct;
DC: HDC;
Canvas: TCanvas;
i: Integer;
X, Y: Integer;
OldColor: TColor;
Size: TSize;
Max: Integer;
s, Palabra, PrevWord: string;
OldPen, DrawPen: HPEN;
tmphot : tshortcut;
Key: Word;
Shift: TShiftState;
lbl ,res: string;
keyboardState: TKeyboardState;
asciiResult: Integer;
begin
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
Canvas := TCanvas.Create;
try
OldColor := Font.Color;
Canvas.Handle := DC;
Canvas.Font.Name := Font.Name;
Canvas.Font.Size := Font.Size;
with Canvas do
begin
Brush.Color := Self.Color;
FillRect(Self.ClientRect);
Font.Color := OldColor;
tmphot := gethotkey;
ShortCutToKey(tmphot, Key, Shift);
res := GetCharFromVKey(key);
if (winkey = false) and (key = 0 ) and (tmphot = 0)then
BEGIN lbl := 'Enter hotkey [CTRL/ALT/WIN] + Key' ;
TextOut(1 ,1,lbl) ;
END
else begin
if winkey then lbl := 'Win +' else lbl := '';
if ssAlt in Shift then lbl := lbl+ 'Alt + ';
if ssShift in Shift then lbl := lbl+ 'Shift + ';
if (not winkey) and (ssCtrl in Shift) then lbl := lbl+ 'Ctrl + ';
lbl := lbl+ res;
end;
TextOut(1 ,1,lbl);
end;
finally
if Message.DC = 0 then EndPaint(Handle, PS);
end;
Canvas.Free;
SETCARETPOS(1,1);
end;
See RegisterHotKey function on MSDN.
THotKey doesn't support the Win-Key. I would add a check box next to it maybe for the Win-Key modifier.