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;
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.
Like many other Firemonkey developers, I need a general multi-platform solution to send messages from a thread to the main thread (to replace PostMessage). I need it to also work on iOS.
There is a solution by François Piette that is implemented for Android and Windows, but not for iOS:
TMessagingSystem.
However, I think it can be done much more simple by using the "new" TMessageManager in combination with TThread.Queue(). But no one have published code, using this aproach, that actually works (e.g. this one is not complete).
Do you have a tested implementation you would like to share with the community (or maybe just suggestions how to implement it right)?
Ok, here is my implementation. I did not use TMessagingSystem as it seems to just add complexity (for my situation at least). It works so far, but if anyone have suggestions for improvements, I will be happy to improve it.
I looked at the solution by Uwe Raabe but I wanted to make it more straightforward and easy to implement in the large codebase that I am converting to FMX.
With the solution below I can simply replace all PostMessage() with gMessageHandler.PostMessage (removing the win handle argument), and add the message functions in the form to tMainForm.MessageCallBack.
I created a small unit that I can include everywhere I need the PostMessage function. Those places does not need to know about the form:
unit MessageHandler
interface
tAllOSMessage = procedure(aMessageID, aData1, aData2: integer) of object;
tAllOSMessageHandler = class
private
fOnMessage : tAllOSMessage;
public
constructor Create(aMessageCallBack: tAllOSMessage);
procedure PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread = nil);
end;
var
gMessageHandler: tAllOSMessageHandler;
implementation
constructor tAllOSMessageHandler.Create(aMessageCallBack: tAllOSMessage);
begin
fOnMessage := aMessageCallBack;
end;
procedure tAllOSMessageHandler.PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread);
begin
if aSourceThread=nil then
aSourceThread := TThread.CurrentThread;
aSourceThread.Queue(nil, procedure
begin
if Assigned(fOnMessage) then
fOnMessage(aMessageID, aData1, aData2);
end );
end;
end.
Then I add these lines to the main form unit:
//Added to main form:
tMainForm = class(TForm)
...
procedure MessageCallBack(aMessageID, aData1, aData2: integer);
//Added to MainFormCreate
gMessageHandler := tAllOSMessageHandler.Create(MessageCallBack);
//Added to MainFormDestroy
FreeAndNil(gMessageHandler)
procedure tMainForm.MessageCallBack(aMessageID, aData1, aData2: integer);
begin
case aMessageID of
MyMessage1 : MyFunction1(aData1,aData2);
...
end;
end;
I want to know how can I write a module to show something like clock or other thing on Borland Delphi 7 IDE status bar, because I know it's possible but I couldn't find how!
To insert a text in a StatusBar, you have to insert a panel first.
Just select your statusbar, find the property "Panels" (or perform double click over the statusbar) and click in "Add new".
After that, you can write what you want inside the panel in the property "Text" (you can insert one or more panels).
To do it programmatically, you can do something like this:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Today is: ' + FormatDateTime('dd/mm/yyyy hh:nn:ss', Now);
end;
Since OP didn't replied with more details, I'm going to post a little demonstration how to reach a status bar of Delphi's edit window. I had no success with adding new distinct status panel w/o disturbing layout, so I'm just changing the text of INS/OVR indicator panel.
Disclaimer: I still do not have access to the machine with Delphi 7 installed, so I've done that in BDS ("Galileo") IDE. However, differences should be minor. I believe what main difference lies in the way how we locate edit window.
Key strings are: 'TEditWindow' for edit window class name and 'StatusBar' for TStatusBar control name owned by edit window. These strings are consistent across versions.
{ helper func, see below }
function FindForm(const ClassName: string): TForm;
var
I: Integer;
begin
Result := nil;
for I := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[I].ClassName = ClassName then
begin
Result := Screen.Forms[I];
Break;
end;
end;
end;
procedure Init;
var
EditWindow: TForm;
StatusBar: TStatusBar;
StatusPanel: TStatusPanel;
begin
EditWindow := FindForm('TEditWindow');
Assert(Assigned(EditWindow), 'no edit window');
StatusBar := EditWindow.FindComponent('StatusBar') as TStatusBar;
(BorlandIDEServices as IOTAMessageServices).AddTitleMessage(Format('StatusBar.Panels.Count = %d', [StatusBar.Panels.Count]));
//StatusPanel := StatusBar.Panels.Add;
StatusPanel := StatusBar.Panels[2];
StatusPanel.Text := 'HAI!';
end;
initialization
Init;
finalization
// nothing to clean up yet
Another note: As you see, I use Open Tools API to output debug messages only, to interact with IDE I do use Native VCL classes. Therefore, this code must be in package.
The code above is a relevant part of the unit which should be contained in package. Do not forget to add ToolsAPI to uses clause as well as other appropriate referenced units (up to you).
Package should require rtl, vcl and designide (important!).
Since I run the testcase directly from initialization section, installing the package is enough for testcase to run and produce some result.
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.