In the link below, Microsoft describes two ways to limit rotation of an application screen on a tablet.
http://msdn.microsoft.com/en-ca/library/windows/apps/hh700342.aspx
what's happening is that delphi's (XE3) TRibbon doesn't handle rotation well. it tends to get hung.
as would be expected, the MS web site describes how to do this from MS development products. I don't see how I can do this in my Delphi project.
Method 1:
add this to your appxmanifest file:
<InitialRotationPreference>
<Rotation Preference="landscape"/>
<Rotation Preference="landscapeFlipped"/>
</InitialRotationPreference>
I haven't yet found where/how the appxmanifest should be part of the application so I can do this in delphi.
Method 2:
call this with code:
Windows.Graphics.Display.DisplayProperties.AutoRotationPreferences =
Windows.Graphics.Display.DisplayOrientations.Landscape;
to migrate this to delphi, I'd need to know API DLL information so I could do something similar.
Any ideas?
Could there be a COM object or DLL that gives us access to this?
Those calls are to disable rotation for a WindowsRT application (FKA Metro) which you cannot build with Delphi (yet). Even a Metropolis app is still a desktop app. There is a solution on the Intel site.
Based on feedback from X-Ray I cleaned up the code:
unit MetroDisplayRotation;
(*
* Usage: TMetroDisplayRotation.SetDisplayAutoRotationPreferences(
* TMetroDisplayRotation.ORIENTATION_PREFERENCE_LANDSCAPE or
* TMetroDisplayRotation.ORIENTATION_PREFERENCE_LANDSCAPE_FLIPPED);
*)
interface
type
TMetroDisplayRotation = class
public const
ORIENTATION_PREFERENCE_NONE = $0;
ORIENTATION_PREFERENCE_LANDSCAPE = $1;
ORIENTATION_PREFERENCE_PORTRAIT = $2;
ORIENTATION_PREFERENCE_LANDSCAPE_FLIPPED = $4;
ORIENTATION_PREFERENCE_PORTRAIT_FLIPPED = $8;
class procedure SetDisplayAutoRotationPreferences(ORIENTATION_PREFERENCE: Integer);
end;
implementation
uses
SysUtils, Windows;
{ TMetroDisplayRotation }
class procedure TMetroDisplayRotation.SetDisplayAutoRotationPreferences(
ORIENTATION_PREFERENCE: Integer);
type
TSDARP = procedure(ORIENTATION_PREFERENCE: Integer); stdcall;
var
UserHandle: THandle;
SDARP: TSDARP;
begin
UserHandle := GetModuleHandle('User32.dll');
#SDARP := GetProcAddress(UserHandle, 'SetDisplayAutoRotationPreferences');
if Assigned(SDARP) then
SDARP(ORIENTATION_PREFERENCE);
end;
end.
You will want to make sure you ONLY call this on Windows 8 since that procedure doesn't exist elsewhere.
Usage: TMetroDisplayRotation.SetDisplayAutoRotationPreferences(TMetroDisplayRotation.ORIENTATION_PREFERENCE_LANDSCAPE or TMetroDisplayRotation.ORIENTATION_PREFERENCE_LANDSCAPE_FLIPPED);
Another BAD option is to disable it for the entire tablet. Just go to HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\AutoRotation in the registry and change Enable to 0.
Related
I changed for Delphi 10.3 and its default TOpenDialog contains a preview pane. I made some searches and found the IFileDialogCustomize interface provided by Microsoft to customize standard WinAPI dialogs. I know I have to use the OnSelectionChange event handler to modify the picture of the pane. The big question for me is : how can I access the preview pane image by IFileDialogCustomize? What is the ItemID for this? I couldn't find any answer to this question on the net. Somebody know the answer? Then please share with me and the community! :)
I replaced some code fragments by ... for the sake of brevity, because these are trivial or app dependent sections.
procedure TMainWindow.OnSelectionChange( Sender : TObject );
var
dc : HDC;
aBMP : TBitmap;
function isSelectedFilePreviewAble : boolean;
begin
result := ...;
end;
functon getPreviewPictureDC : HDC;
var
iCustomize : IFileDialogCustomize;
h : THandle;
begin
if OpenDialog1.QueryInterface( IFileDialogCustomize, iCustomize ) = S_OK then
begin
h := iCustomize.??? this is the missing code fragment
result := GetDC( h );
end else
result := 0;
end;
procedure generatePreviewPicture;
begin
...
end;
begin
dc := getPreviewPictureDC;
if ( dc <> 0 ) then
begin
aBMP := TBitmap.Create;
try
if ( isSelectedFilePreviewAble ) then
generatePreviewPicture;
StretchBlt( aBMP.Handle, ...);
finally
aBMP.Free;
ReleaseDC( dc );
end;
end;
end;
I made some searches and found the IFileDialogCustomize interface provided by Microsoft to customize standard WinAPI dialogs.
First, IFileDialogCustomize does not "customize standard WinAPI dialogs". It customizes only IFileOpenDialog and IFileSaveDialog dialogs, no others.
Second, TOpenDialog primarily uses the legacy Win32 API GetOpenFileName() function. On Windows Vista+, GetOpenFileName() uses IFileOpenDialog internally with basic options enabled, so that legacy apps can still have a modern look.
Although, under the following conditions, TOpenDialog will instead use IFileOpenDialog directly rather than using GetOpenFileName():
Win32MajorVersion is >= 6 (Vista+)
UseLatestCommonDialogs is True
StyleServices.Enabled is True
TOpenDialog.Template is nil
TOpenDialog.OnIncludeItem, TOpenDialog.OnClose, and TOpenDialog.OnShow are unassigned.
But even so, TOpenDialog still does not give you access to its internal IFileOpenDialog interface, when it is used.
If you really want to access the dialog's IFileOpenDialog and thus its IFileDialogCustomize, you need to use TFileOpenDialog instead of TOpenDialog (just know that dialog won't work on XP and earlier systems, if you still need to support them).
The big question for me is : how can I access the preview pane image by IFileDialogCustomize?
You don't. The preview pane is not a dialog customization, so it can't be accessed via IFileDialogCustomize. Even if you could get a control ID for the preview pane (which you can't), there is no function of IFileDialogCustomize that would allow you to access the preview pane's HWND or HDC, or otherwise alter the content of the preview pane in any way. The preview pane is an integral and private component of IFileDialog for any file type that supports previews. It is not something that you can access and draw on directly. IFileOpenDialog itself will update the preview pane as needed when the user selects a file that has (or lacks) a preview to display.
My boss want to show previews for our own file formats.
The correct way to handle that on Vista+ is to create a Preview Handler for your custom file types. Then, any Shell component that wants to display previews of your files, including IFileOpenDialog, can use your handler.
I'm searching for an easy way to make the user select a color, in VCL I've always used the TColorDialog (VCL.Dialogs), but there either is no equivalent in FMX or I'm just not able to find it.
I could obviousely make my own color dialog using the existing components, but I thought there might be an easier & more elegant solution. I also thought about directly using Windows ChooseColor, but I'd need some sample code on how to wrap that; also this would not translate to Mac which is not an immediate issue but might impose problems later on.
For a cross-platform solution you can build you own dialog using the FMX components like TColorPanel, TColorPicker and so on. How you are asking about a wrapper for the Windows ChooseColor Dialog this is a very simple sample adapted from the MSDN documentation.
uses
System.UIConsts,
FMX.Platform.Win,
Winapi.Windows,
Winapi.CommDlg;
const
MaxCustomColors = 16;
type
TCustomColors = array[0..MaxCustomColors - 1] of Longint;
procedure TForm1.Button1Click(Sender: TObject);
var
cc : TChooseColor;
acrCustClr: TCustomColors;
hwnd : THandle;
rgbCurrent : DWORD;
begin
FillChar(cc, sizeof(cc), #0);
cc.lStructSize := sizeof(cc);
cc.hwndOwner := FmxHandleToHWND(Self.Handle);
cc.lpCustColors := #acrCustClr;
cc.rgbResult := RGBtoBGR(claYellow);
cc.Flags := CC_FULLOPEN OR CC_RGBINIT;
if (ChooseColor(cc)) then
Rectangle1.Fill.Color:= MakeColor(GetRValue(cc.rgbResult), GetGValue(cc.rgbResult), GetBValue(cc.rgbResult));
end;
In many confirmation dialogs it is usefull to have such option (quick wayt to disable confirmation).
But i can't find how to do that. I don't want to design it myself because i need this dialog to be standard-like and don't wont to redesign with every update of Delphi. Is there simple way to use Delphi standard confirmation dialog with such checkbox ?
UPDATE2. Suggested SynTaskDialog library from Synopse project does great job (all i need and even more), i will use it in my projects. Thanks!
UPDATE. So, thank you guys for ideas. System function MessageBoxCheck is nice solution but seem to be not so stable as it should be. In general i agree that it is good idea to use latest API functions to provide users with best UI experience of modern os and use old-fashioned design for older systems. At moment i stay on simple solution (code is following), but if someone share the code with support of UI for modern OS, it will be nice.
function MsgDlgWithCB(const Msg,Title,CBMsg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn;
var cbDontAskAnymore: TCheckBox): TForm;
var
i: integer;
b: TButton;
y: integer;
begin
Result := CreateMessageDialog(Msg, DlgType, Buttons, DefaultButton) ;
Result.Position := poScreenCenter;
cbDontAskAnymore := TCheckBox.Create(Result);
cbDontAskAnymore.Caption := CBMsg;
cbDontAskAnymore.Width := 130;
y := -1;
for i := 0 to result.ComponentCount-1 do
if result.Components[i] is TButton then
begin
b := TButton(result.Components[i]);
b.Left := b.Left + cbDontAskAnymore.Width + 16;
Result.ClientWidth := Max(Result.ClientWidth, b.Left+b.Width+16);
y := b.Top+b.Height-cbDontAskAnymore.Height;
end;
if y<0 then
y := Result.ClientHeight - cbDontAskAnymore.height - 16;
Result.Caption := Title;
cbDontAskAnymore.Parent := Result;
cbDontAskAnymore.Top := y;
cbDontAskAnymore.Left := 8;
end;
function MessageDlgCheckbox(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn;
var cbDontAskAnymore: Boolean;
const Title: string ='Confirmation';
const CBMsg: string = 'Don''t ask anymore'): integer;
var
f: TForm;
c: TCheckbox;
begin
f := MsgDlgWithCB(Msg,Title,CBMsg,DlgType,Buttons,DefaultButton,c);
try
result := f.ShowModal;
cbDontAskAnymore := c.Checked;
finally
f.free;
end;
end;
You can use our Open Source SynTaskDialog unit.
Windows provides a generic task dialog available since Vista/Seven. But there is none available with previous versions of Windows, i.e. Windows XP or 2K.
This unit (licensed under a MPL/GPL/LGPL tri-license) will use the new TaskDialog API under Vista/Seven, and emulate it with pure Delphi code and standard themed VCL components under XP or 2K. It supports Delphi 6 up to XE4, and is Win32/Win64 Unicode ready.
Here is the result under a Windows Seven 64 bit computer:
And here is the same dialog created from our emulated pure Delphi code:
Since this screenshot was made on a Win 7 machine, the styling is native for that OS. When the emulated version of the dialog runs on XP it displays in a style native to that OS.
You have your "Do not ask for this setting next time" checkbox... and potentially much more!
The system native functionality that offers such facilities is the task dialog API introduced in Vista. This provides means for you to show much more capable dialogs than the older MessageBox API.
Should you need to support XP then you will have to create your own dialog. For example by deriving from TForm and calling ShowModal. If you do this, make the form capable of building itself dynamically. Don't make one form per message that you show!
In my codebase, I have my own wrapper of the task dialog API. This detects at runtime versions of Windows that do not support task dialog and falls back on a custom built Delphi dialog.
Regarding SHMessageBoxCheck I'd be a little wary of taking a dependency on that. According to its documentation it's not supported beyond XP, and you have to import it by ordinal. I'd personally be worried that it might be dropped from a future version of Windows. That said, MS has a strong track record of doing whatever it takes to keep legacy apps working with new OS releases.
I have an application that mimics Windows Explorer, it uses a TcxShellListView amongst other shell controls.
A really nice feature would be to be able to Copy & Paste and Cut & Paste files between the real Windows Explorer and my application.
Drag & Drop already works out of the box, but it seems that DevExpress hasn't implemented the clipboard side, yet.
Any Ideas?
If you want to implement the copy/paste yourself, the mechanism is almost identical to drag and drop. The drag and drop code that you have will create an IDataObject. To copy, instead of calling DoDragDrop to initiate a drag, simply call OleSetClipboard passing the IDataObject. And for pasting you call OleGetClipboard to get the IDataObject from the clipboard. And then you simply use the exact same code as for a drop operation to decode the IDataObject. That's all there is to it.
There is another way to do it, probably a better approach in my view. And that is to use IContextMenu to do the work. And example of this can be found in the TurboPower tpShellShock project. Have a look for ShellMenuExecute in the StShlCtl unit. So long as the DevExpress component is using the shell interfaces, i.e. IShellFolder, then you will be able to use that same approach. The advantage of this shell based approach is that you are getting the shell to do the work. If a copy dialog needs to be shown, then the shell will do so. This will give you the most integrated user experience.
This code looks like this:
procedure ShellMenuExecute(
const Sender : TObject; const Folder : IShellFolder;
var Pidl : PItemIDList; const Count : Integer;
const AHandle : THandle; ClipboardAction : TStMenuAction);
var
CM : IContextMenu;
CI : TCmInvokeCommandInfo;
begin
if Folder <> nil then begin
if (Folder.GetUIObjectOf(AHandle, Count, Pidl,
IID_IContextMenu, nil, Pointer(CM)) = NOERROR)
then begin
ZeroMemory(#CI, SizeOf(CI));
CI.cbSize := SizeOf(TCmInvokeCommandInfo);
CI.hwnd := AHandle;
case ClipboardAction of
caCut : CI.lpVerb := 'cut';
caCopy : CI.lpVerb := 'copy';
caPaste : CI.lpVerb := 'paste';
caProperties : CI.lpVerb := 'properties';
end;
CM.InvokeCommand(CI);
CM := nil;
end;
end;
end;
I think you should be able to use this code pretty much as is. I would point out that the handle parameter is declared incorrectly. It should be HWND. It's used as the owning window for any dialog that is shown during the call to InvokeCommand.
I am handling from my Application associated extension files from Windows. So when you double click a file from Windows it will execute my program, and I handle the file from there, something like:
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 0 to ParamCount -1 do
begin
if SameText(ExtractFileExt(ParamStr(i)), '.ext1') then
begin
// handle my file..
// break if needed
end else
if SameText(ExtractFileExt(ParamStr(i)), '.ext2') then
begin
// handle my file..
// break if needed
end else
end;
end;
That works pretty much how I want it to, but when I was testing I realised it does not consider using only one instance of my program.
So for example, if I selected several Files from Windows and opened them all at the same time, this will create the same number of instances of my program with the number of Files being opened.
What would be a good way to approach this, so that instead of several instances of my program being opened, any additional Files from Windows being opened will simply focus back to the one and only instance, and I handle the Files as normal?
Thanks
UPDATE
I found a good article here: http://www.delphidabbler.com/articles?article=13&part=2 which I think is what I need, and shows how to work with the Windows API as mentioned by rhooligan. I am going to read through it now..
Here is some simple example code that gets the job done. I hope it is self-explanatory.
program StartupProject;
uses
SysUtils,
Messages,
Windows,
Forms,
uMainForm in 'uMainForm.pas' {MainForm};
{$R *.res}
procedure Main;
var
i: Integer;
Arg: string;
Window: HWND;
CopyDataStruct: TCopyDataStruct;
begin
Window := FindWindow(SWindowClassName, nil);
if Window=0 then begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end else begin
FillChar(CopyDataStruct, Sizeof(CopyDataStruct), 0);
for i := 1 to ParamCount do begin
Arg := ParamStr(i);
CopyDataStruct.cbData := (Length(Arg)+1)*SizeOf(Char);
CopyDataStruct.lpData := PChar(Arg);
SendMessage(Window, WM_COPYDATA, 0, NativeInt(#CopyDataStruct));
end;
SetForegroundWindow(Window);
end;
end;
begin
Main;
end.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TMainForm = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
public
procedure ProcessArgument(const Arg: string);
end;
var
MainForm: TMainForm;
const
SWindowClassName = 'VeryUniqueNameToAvoidUnexpectedCollisions';
implementation
{$R *.dfm}
{ TMainForm }
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WinClassName := SWindowClassName;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 1 to ParamCount do begin
ProcessArgument(ParamStr(i));
end;
end;
procedure TMainForm.ProcessArgument(const Arg: string);
begin
ListBox1.Items.Add(Arg);
end;
procedure TMainForm.WMCopyData(var Message: TWMCopyData);
var
Arg: string;
begin
SetString(Arg, PChar(Message.CopyDataStruct.lpData), (Message.CopyDataStruct.cbData div SizeOf(Char))-1);
ProcessArgument(Arg);
Application.Restore;
Application.BringToFront;
end;
end.
The logic goes something like this. When you start your application, you iterate through the list of running processes and see if your application is already running. If it is running, you need to activate the window of that instance and then exit.
Everything you need to do this is in the Windows API. I found this sample code on CodeProject.com that deals with processes:
http://www.codeproject.com/KB/system/Win32Process.aspx
On finding and activating a window, the basic approach is to find the window of interest using the window class name then activate it.
http://www.vb6.us/tutorials/activate-window-api
Hopefully this gives you a good starting point.
There are many answers here that show how to implement this. I want to show why NOT to use the FindWindow approach.
I am using FindWindow (something similar with the one shown by David H) and I have seen it failed starting with Win10 - I don't know what they changed in Win10.
I think the gap between the time when the app starts and the time when we set the unique ID via CreateParams is too big so another instance has somehow time to run in this gap/interval.
Imagine two instances started at only 1ms distance (let's say that the user click the EXE file and then presses enter and keeps it pressed by accident for a short while). Both instances will check to see if a window with that unique ID exists, but none of them had the chance to set the flag/unique ID because creating the form is slow and the unique ID is set only when the form is constructed. So, both instances will run.
So, I would recommend the CreateSemaphore solution instead:
https://stackoverflow.com/a/460480/46207
Marjan V already proposed this solution but didn't explained why it is better/safer.
I'd use mutexes. You create one when your program starts.
When the creation fails it means another instance is already running. You then send this instance a message with your command line parameters and close. When your app receives a message with a command line, it can parse the parameters like you are already doing, check to see whether it already has the file(s) open and proceed accordingly.
Processing this app specific message ia also the place to get your app to the front if it isn't already. Please do this politely (SetForegroundWindow) without trying to force your app in front of all others.
function CreateMutexes(const MutexName: String): boolean;
// Creates the two mutexes to see if the program is already running.
// One of the mutexes is created in the global name space (which makes it
// possible to access the mutex across user sessions in Windows XP); the other
// is created in the session name space (because versions of Windows NT prior
// to 4.0 TSE don't have a global name space and don't support the 'Global\'
// prefix).
var
SecurityDesc: TSecurityDescriptor;
SecurityAttr: TSecurityAttributes;
begin
// By default on Windows NT, created mutexes are accessible only by the user
// running the process. We need our mutexes to be accessible to all users, so
// that the mutex detection can work across user sessions in Windows XP. To
// do this we use a security descriptor with a null DACL.
InitializeSecurityDescriptor(#SecurityDesc, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(#SecurityDesc, True, nil, False);
SecurityAttr.nLength := SizeOf(SecurityAttr);
SecurityAttr.lpSecurityDescriptor := #SecurityDesc;
SecurityAttr.bInheritHandle := False;
if (CreateMutex(#SecurityAttr, False, PChar(MutexName)) <> 0 )
and (CreateMutex(#SecurityAttr, False, PChar('Global\' + MutexName)) <> 0 ) then
Result := True
else
Result := False;
end;
initialization
if not CreateMutexes('MyAppNameIsRunningMutex') then
//Find and SendMessage to running instance
;
end.
Note: above code is adapted from an example on the InnoSetup site. InnoSetup creates installer applications and uses this approach in the installer to check whether (a previous version of) the application being installed is already running.
Finding the other instance and sending it a message, I'll leave for another question (or you can use the WM_COPYDATA approach from David's answer). Actually, there is a StackOverflow question that deals exactly with this: How to get the process thread that owns a mutex Getting the process/thread that owns the mutex may be a bit of a challenge, but the answers to this question do address ways to get the information from one instance to the other.
Windows has different ways to handle file associations to executable.
The "command line" approach is only the simplest one, but also the most limited one.
It also supports DDE (it still works although officially deprecated) and COM (see http://msdn.microsoft.com/en-us/library/windows/desktop/cc144171(v=vs.85).aspx).
If I recall correctly both DDE and COM will let your application receive the whole list of selected files.
I used window/message approach by myself with addition of events for tracking if the other instance is running:
Try to create event "Global\MyAppCode" (the "Global" namespace is used for handling various user sessions as I needed single instance system-wide; in your case you'll probably prefer "Local" namespace which is set by default)
If CreateEvent returned error and GetLastError = ERROR_ALREADY_EXISTS then the instance is running already.
FindWindow/WM_COPYDATA to transfer data to that instance.
But the drawbacks with messages/windows are more than significant:
You must always keep your window's Caption constant. Otherwise you'll have to list all the windows in the system and loop through them for partial occurrence of some constant part. Moreover the window's caption could be easily changed by a user or 3rd part app so the search would fail.
Method requires a window to be created so no console/service apps, or they must create a window and perform message loop especially for handling the single instance.
I'm not sure FindWindow could find a window that is opened in another user session
For me, WM_COPYDATA is rather awkward method.
So currently I'm a fan of named pipe approach (haven't implemented it yet though).
On launch, app tries to connect to "Global\MyAppPipe". If successed, other instance is running. If failed, it creates this pipe and finishes instance check.
2nd instance writes the required data to pipe and exits.
1st instance receives data and does some stuff.
It works through all user sessions (with namespace "Global") or just a current session; it doesn't depend on strings used by UI (no localization and modification issues); it works with console and service apps (you'll need to implement pipe reading in a separate thread/message loop though).