Added TCEFFileDialogInfo

MiniBrowser now uses TCEFFileDialogInfo to show custom open and save dialogs.

demos/Delphi_VCL/MiniBrowser/MiniBrowser.dpr

@@ -42,17 +42,16 @@ program MiniBrowser;
 
 uses
   {$IFDEF DELPHI16_UP}
-  WinApi.Windows,
+  Vcl.Forms, WinApi.Windows,
-  Vcl.Forms,
   {$ELSE}
-  Forms,
+  Forms, Windows,
-  Windows,
   {$ENDIF }
   uCEFApplication,
   uMiniBrowser in 'uMiniBrowser.pas' {MiniBrowserFrm},
   uPreferences in 'uPreferences.pas' {PreferencesFrm},
   uSimpleTextViewer in 'uSimpleTextViewer.pas' {SimpleTextViewerFrm},
-  uFindFrm in 'uFindFrm.pas' {FindFrm};
+  uFindFrm in 'uFindFrm.pas' {FindFrm},
+  uDirectorySelector in 'uDirectorySelector.pas' {DirectorySelectorFrm};
 
 {$R *.res}
 

demos/Delphi_VCL/MiniBrowser/MiniBrowser.dproj

@@ -148,6 +148,10 @@
         <DCCReference Include="uFindFrm.pas">
             <Form>FindFrm</Form>
         </DCCReference>
+        <DCCReference Include="uDirectorySelector.pas">
+            <Form>DirectorySelectorFrm</Form>
+            <FormType>dfm</FormType>
+        </DCCReference>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

demos/Delphi_VCL/MiniBrowser/uDirectorySelector.dfm

@@ -0,0 +1,92 @@
+object DirectorySelectorFrm: TDirectorySelectorFrm
+  Left = 0
+  Top = 0
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = 'Select a directory'
+  ClientHeight = 441
+  ClientWidth = 317
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = 'Segoe UI'
+  Font.Style = []
+  Position = poScreenCenter
+  PixelsPerInch = 96
+  TextHeight = 15
+  object Panel1: TPanel
+    Left = 0
+    Top = 405
+    Width = 317
+    Height = 36
+    Align = alBottom
+    BevelOuter = bvNone
+    Padding.Left = 5
+    Padding.Top = 5
+    Padding.Right = 5
+    Padding.Bottom = 5
+    TabOrder = 0
+    object OkBtn: TButton
+      Left = 5
+      Top = 5
+      Width = 120
+      Height = 26
+      Align = alLeft
+      Caption = 'Ok'
+      ModalResult = 1
+      TabOrder = 0
+    end
+    object CancelBtn: TButton
+      Left = 192
+      Top = 5
+      Width = 120
+      Height = 26
+      Align = alRight
+      Caption = 'Cancel'
+      ModalResult = 2
+      TabOrder = 1
+    end
+  end
+  object Panel2: TPanel
+    Left = 0
+    Top = 0
+    Width = 317
+    Height = 31
+    Align = alTop
+    BevelOuter = bvNone
+    Padding.Left = 5
+    Padding.Top = 5
+    Padding.Right = 5
+    Padding.Bottom = 5
+    TabOrder = 1
+    object DriveComboBox1: TDriveComboBox
+      Left = 5
+      Top = 5
+      Width = 307
+      Height = 21
+      Align = alClient
+      DirList = DirectoryListBox1
+      TabOrder = 0
+    end
+  end
+  object Panel3: TPanel
+    Left = 0
+    Top = 31
+    Width = 317
+    Height = 374
+    Align = alClient
+    BevelOuter = bvNone
+    Padding.Left = 5
+    Padding.Right = 5
+    TabOrder = 2
+    object DirectoryListBox1: TDirectoryListBox
+      Left = 5
+      Top = 0
+      Width = 307
+      Height = 374
+      Align = alClient
+      TabOrder = 0
+    end
+  end
+end

demos/Delphi_VCL/MiniBrowser/uDirectorySelector.pas

@@ -0,0 +1,85 @@
+// ************************************************************************
+// ***************************** CEF4Delphi *******************************
+// ************************************************************************
+//
+// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
+// browser in Delphi applications.
+//
+// The original license of DCEF3 still applies to CEF4Delphi.
+//
+// For more information about CEF4Delphi visit :
+//         https://www.briskbard.com/index.php?lang=en&pageid=cef
+//
+//        Copyright © 2021 Salvador Diaz Fau. All rights reserved.
+//
+// ************************************************************************
+// ************ vvvv Original license and comments below vvvv *************
+// ************************************************************************
+(*
+ *                       Delphi Chromium Embedded 3
+ *
+ * Usage allowed under the restrictions of the Lesser GNU General Public License
+ * or alternatively the restrictions of the Mozilla Public License 1.1
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * Unit owner : Henri Gourvest <hgourvest@gmail.com>
+ * Web site   : http://www.progdigy.com
+ * Repository : http://code.google.com/p/delphichromiumembedded/
+ * Group      : http://groups.google.com/group/delphichromiumembedded
+ *
+ * Embarcadero Technologies, Inc is not permitted to use or redistribute
+ * this source code without explicit permission.
+ *
+ *)
+
+unit uDirectorySelector;
+
+{$I cef.inc}
+
+interface
+
+uses
+  {$IFDEF DELPHI16_UP}
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.FileCtrl,
+  Vcl.ExtCtrls;
+  {$ELSE}
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
+  FileCtrl, ExtCtrls;
+  {$ENDIF}
+
+type
+  TDirectorySelectorFrm = class(TForm)
+    Panel1: TPanel;
+    OkBtn: TButton;
+    CancelBtn: TButton;
+    Panel2: TPanel;
+    DriveComboBox1: TDriveComboBox;
+    Panel3: TPanel;
+    DirectoryListBox1: TDirectoryListBox;
+  private
+    procedure SetSelectedDir(const aValue : string);
+    function  GetSelectedDir : string;
+
+  public
+    property SelectedDir : string read GetSelectedDir write SetSelectedDir;
+  end;
+
+implementation
+
+{$R *.dfm}
+
+procedure TDirectorySelectorFrm.SetSelectedDir(const aValue : string);
+begin
+  DirectoryListBox1.Directory := aValue;
+end;
+
+function TDirectorySelectorFrm.GetSelectedDir : string;
+begin
+  Result := DirectoryListBox1.Directory;
+end;
+
+end.

demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm

@@ -122,6 +122,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
         Width = 978
         Height = 21
         Align = alClient
+        ItemIndex = 0
         TabOrder = 0
         Text = 'https://www.google.com'
         Items.Strings = (
@@ -138,6 +139,16 @@ object MiniBrowserFrm: TMiniBrowserFrm
           
             'https://www.w3schools.com/Tags/tryit.asp?filename=tryhtml_iframe' +
             '_name'
+          
+            'https://www.w3schools.com/tags/tryit.asp?filename=tryhtml5_input' +
+            '_type_file'
+          'https://www.htmlquick.com/es/reference/tags/input-file.html'
+          
+            'https://developer.mozilla.org/en-US/docs/Web/HTML/Element/input/' +
+            'file'
+          
+            'https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElemen' +
+            't/webkitdirectory'
           'https://www.w3schools.com/html/html5_video.asp'
           'http://html5test.com/'
           
@@ -279,6 +290,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
     OnCertificateError = Chromium1CertificateError
     OnBeforeResourceLoad = Chromium1BeforeResourceLoad
     OnResourceResponse = Chromium1ResourceResponse
+    OnFileDialog = Chromium1FileDialog
     OnBeforePluginLoad = Chromium1BeforePluginLoad
     OnDevToolsMethodResult = Chromium1DevToolsMethodResult
     Left = 32

demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas

@@ -54,7 +54,7 @@ uses
   AppEvnts, ActiveX, ShlObj, NetEncoding,
   {$ENDIF}
   uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes,
-  uCEFConstants, uCEFWinControl, uCEFSentinel, uCEFChromiumCore;
+  uCEFConstants, uCEFWinControl, uCEFSentinel, uCEFChromiumCore, uCEFFileDialogInfo;
 
 const
   MINIBROWSER_SHOWDEVTOOLS     = WM_APP + $101;
@@ -71,6 +71,7 @@ const
   MINIBROWSER_PDFPRINT_END     = WM_APP + $10C;
   MINIBROWSER_PREFS_AVLBL      = WM_APP + $10D;
   MINIBROWSER_DTDATA_AVLBL     = WM_APP + $10E;
+  MINIBROWSER_SHOWFILEDLG      = WM_APP + $10F;
 
   MINIBROWSER_HOMEPAGE = 'https://www.google.com';
 
@@ -179,6 +180,7 @@ type
     procedure Chromium1BeforePluginLoad(Sender: TObject; const mimeType, pluginUrl: ustring; isMainFrame: Boolean; const topOriginUrl: ustring; const pluginInfo: ICefWebPluginInfo; var pluginPolicy: TCefPluginPolicy; var aResult: Boolean);
     procedure Chromium1ZoomPctAvailable(Sender: TObject; const aZoomPct: Double);
     procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
+    procedure Chromium1FileDialog(Sender: TObject; const browser: ICefBrowser; mode: Cardinal; const title, defaultFilePath: ustring; const acceptFilters: TStrings; selectedAcceptFilter: Integer; const callback: ICefFileDialogCallback; out Result: Boolean);
 
     procedure BackBtnClick(Sender: TObject);
     procedure ForwardBtnClick(Sender: TObject);
@@ -222,6 +224,9 @@ type
     FResponse   : TStringList;
     FRequest    : TStringList;
     FNavigation : TStringList;
+
+    FFileDialogInfo : TCEFFileDialogInfo;
+
     // Variables to control when can we destroy the form safely
     FCanClose : boolean;  // Set to True in TChromium.OnBeforeClose
     FClosing  : boolean;  // Set to True in the CloseQuery event.
@@ -238,6 +243,11 @@ type
     procedure InspectRequest(const aRequest : ICefRequest);
     procedure InspectResponse(const aResponse : ICefResponse);
 
+    function  ShowOpenFileDialog(var aFilePaths : TStringList; aMultiple : boolean) : boolean;
+    function  ShowOpenFolderDialog(var aFilePaths : TStringList) : boolean;
+    function  ShowSaveFileDialog(var aFilePaths : TStringList) : boolean;
+
+
     procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
     procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
     procedure ShowDevToolsMsg(var aMessage : TMessage); message MINIBROWSER_SHOWDEVTOOLS;
@@ -254,6 +264,7 @@ type
     procedure PrintPDFEndMsg(var aMessage : TMessage); message MINIBROWSER_PDFPRINT_END;
     procedure PreferencesAvailableMsg(var aMessage : TMessage); message MINIBROWSER_PREFS_AVLBL;
     procedure DevToolsDataAvailableMsg(var aMessage : TMessage); message MINIBROWSER_DTDATA_AVLBL;
+    procedure ShowFileDialogMsg(var aMessage : TMessage); message MINIBROWSER_SHOWFILEDLG;
     procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
     procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
     procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
@@ -276,7 +287,7 @@ implementation
 
 uses
   uPreferences, uCefStringMultimap, uCEFMiscFunctions, uSimpleTextViewer,
-  uCEFClient, uFindFrm, uCEFDictionaryValue;
+  uCEFClient, uFindFrm, uCEFDictionaryValue, uDirectorySelector;
 
 // Destruction steps
 // =================
@@ -287,11 +298,11 @@ uses
 procedure CreateGlobalCEFApp;
 begin
   GlobalCEFApp                     := TCefApplication.Create;
-  GlobalCEFApp.LogFile             := 'debug.log';
-  GlobalCEFApp.LogSeverity         := LOGSEVERITY_INFO;
   GlobalCEFApp.cache               := 'cache';
   GlobalCEFApp.EnablePrintPreview  := True;
   GlobalCEFApp.EnableGPU           := True;
+  GlobalCEFApp.LogFile             := 'debug.log';
+  GlobalCEFApp.LogSeverity         := LOGSEVERITY_INFO;
 end;
 
 procedure TMiniBrowserFrm.BackBtnClick(Sender: TObject);
@@ -637,6 +648,138 @@ begin
         end;
 end;
 
+procedure TMiniBrowserFrm.Chromium1FileDialog(      Sender                 : TObject;
+                                              const browser                : ICefBrowser;
+                                                    mode                   : Cardinal;
+                                              const title                  : ustring;
+                                              const defaultFilePath        : ustring;
+                                              const acceptFilters          : TStrings;
+                                                    selectedAcceptFilter   : Integer;
+                                              const callback               : ICefFileDialogCallback;
+                                              out   Result                 : Boolean);
+begin
+  Result := True;
+
+  FFileDialogInfo.Mode                   := mode;
+  FFileDialogInfo.Title                  := title;
+  FFileDialogInfo.DefaultFilePath        := defaultFilePath;
+  FFileDialogInfo.SelectedAcceptFilter   := selectedAcceptFilter;
+  FFileDialogInfo.Callback               := callback;
+  FFileDialogInfo.AcceptFilters          := acceptFilters;
+
+  PostMessage(Handle, MINIBROWSER_SHOWFILEDLG, 0, 0);
+end;
+
+
+function TMiniBrowserFrm.ShowOpenFileDialog(var aFilePaths : TStringList; aMultiple : boolean) : boolean;
+var
+  TempDialog  : TOpenDialog;
+  TempOptions : TOpenOptions;
+begin
+  Result := False;
+
+  TempDialog             := TOpenDialog.Create(Application.MainForm);
+  TempDialog.Title       := FFileDialogInfo.Title;
+  TempDialog.InitialDir  := FFileDialogInfo.DefaultFilePath;
+  TempDialog.Filter      := FFileDialogInfo.DialogFilter;
+  TempDialog.FilterIndex := FFileDialogInfo.SelectedAcceptFilter;
+  TempOptions            := TempDialog.Options;
+
+  if aMultiple                       then include(TempOptions, ofAllowMultiSelect);
+  if FFileDialogInfo.OverwritePrompt then include(TempOptions, ofOverwritePrompt);
+  if FFileDialogInfo.HideReadOnly    then include(TempOptions, ofHideReadOnly);
+
+  TempDialog.Options := TempOptions;
+
+  if TempDialog.Execute(Handle) then
+    begin
+      if aMultiple then
+        aFilePaths.AddStrings(TempDialog.Files)
+       else
+        aFilePaths.Add(TempDialog.FileName);
+
+      FFileDialogInfo.SelectedAcceptFilter := TempDialog.FilterIndex;
+
+      Result := True;
+    end;
+
+  FreeAndNil(TempDialog);
+end;
+
+function TMiniBrowserFrm.ShowOpenFolderDialog(var aFilePaths : TStringList) : boolean;
+var
+  TempDirectorySelector : TDirectorySelectorFrm;
+begin
+  Result := False;
+
+  TempDirectorySelector             := TDirectorySelectorFrm.Create(Application.MainForm);
+  TempDirectorySelector.SelectedDir := FFileDialogInfo.DefaultFilePath;
+
+  if (TempDirectorySelector.ShowModal = mrOk) then
+    begin
+      {$WARN SYMBOL_PLATFORM OFF}
+      aFilePaths.Add(IncludeTrailingBackslash(TempDirectorySelector.SelectedDir));
+      {$WARN SYMBOL_PLATFORM ON}
+      Result := True;
+    end;
+
+  FreeAndNil(TempDirectorySelector);
+end;
+
+function TMiniBrowserFrm.ShowSaveFileDialog(var aFilePaths : TStringList) : boolean;
+var
+  TempDialog  : TSaveDialog;
+  TempOptions : TOpenOptions;
+begin
+  Result := False;
+
+  TempDialog             := TSaveDialog.Create(Application.MainForm);
+  TempDialog.Title       := FFileDialogInfo.Title;
+  TempDialog.Filter      := FFileDialogInfo.DialogFilter;
+  TempDialog.FilterIndex := FFileDialogInfo.SelectedAcceptFilter;
+  TempDialog.FileName    := ExtractFileName(FFileDialogInfo.DefaultFilePath);
+  TempDialog.InitialDir  := ExtractFileDir(FFileDialogInfo.DefaultFilePath);
+  TempOptions            := TempDialog.Options;
+
+  if FFileDialogInfo.OverwritePrompt then include(TempOptions, ofOverwritePrompt);
+  if FFileDialogInfo.HideReadOnly    then include(TempOptions, ofHideReadOnly);
+
+  TempDialog.Options := TempOptions;
+
+  if TempDialog.Execute(Handle) and
+     (length(TempDialog.FileName) > 0) then
+    begin
+      aFilePaths.Add(TempDialog.FileName);
+      Result := True;
+    end;
+
+  FreeAndNil(TempDialog);
+end;
+
+procedure TMiniBrowserFrm.ShowFileDialogMsg(var aMessage : TMessage);
+var
+  TempResult    : boolean;
+  TempFilePaths : TStringList;
+begin
+  TempFilePaths := TStringList.Create;
+
+  case FFileDialogInfo.DialogType of
+    dtOpen          : TempResult := ShowOpenFileDialog(TempFilePaths, False);
+    dtOpenMultiple  : TempResult := ShowOpenFileDialog(TempFilePaths, True);
+    dtOpenFolder    : TempResult := ShowOpenFolderDialog(TempFilePaths);
+    dtSave          : TempResult := ShowSaveFileDialog(TempFilePaths);
+    else              TempResult := False;
+  end;
+
+  if TempResult then
+    FFileDialogInfo.Callback.Cont(FFileDialogInfo.SelectedAcceptFilter, TempFilePaths)
+   else
+    FFileDialogInfo.Callback.Cancel;
+
+  FFileDialogInfo.Clear;
+  TempFilePaths.Free;
+end;
+
 procedure TMiniBrowserFrm.Chromium1FullScreenModeChange(Sender: TObject;
   const browser: ICefBrowser; fullscreen: Boolean);
 begin                    
@@ -1069,6 +1212,8 @@ begin
   FShutdownReason      := 'MiniBrowser closing...';
   FHasShutdownReason   := ShutdownBlockReasonCreate(Application.Handle, @FShutdownReason[1]);
 
+  FFileDialogInfo := TCEFFileDialogInfo.Create;
+
   // The MultiBrowserMode store all the browser references in TChromium.
   // The first browser reference is the browser in the main form.
   // When MiniBrowser allows CEF to create child popup browsers it will also
@@ -1088,6 +1233,7 @@ begin
   FResponse.Free;
   FRequest.Free;
   FNavigation.Free;
+  FFileDialogInfo.Free;
 end;
 
 procedure TMiniBrowserFrm.FormShow(Sender: TObject);

packages/CEF4Delphi.dpk

@@ -224,7 +224,8 @@ contains
   uCEFLinkedWinControlBase in '..\source\uCEFLinkedWinControlBase.pas',
   uCEFTimerWorkScheduler in '..\source\uCEFTimerWorkScheduler.pas',
   uCEFFrameHandler in '..\source\uCEFFrameHandler.pas',
-  uCEFOverlayController in '..\source\uCEFOverlayController.pas';
+  uCEFOverlayController in '..\source\uCEFOverlayController.pas',
+  uCEFFileDialogInfo in '..\source\uCEFFileDialogInfo.pas';
 
 end.
 

packages/CEF4Delphi_D7.dpk

@@ -221,6 +221,7 @@ contains
   uCEFLinkedWinControlBase in '..\source\uCEFLinkedWinControlBase.pas',
   uCEFTimerWorkScheduler in '..\source\uCEFTimerWorkScheduler.pas',
   uCEFFrameHandler in '..\source\uCEFFrameHandler.pas',
-  uCEFOverlayController in '..\source\uCEFOverlayController.pas';
+  uCEFOverlayController in '..\source\uCEFOverlayController.pas',
+  uCEFFileDialogInfo in '..\source\uCEFFileDialogInfo.pas';
 
 end.

packages/CEF4Delphi_FMX.dpk

@@ -236,7 +236,8 @@ contains
   uCEFMacOSCustomCocoaTimer in '..\source\uCEFMacOSCustomCocoaTimer.pas',
   uCEFMacOSInterfaces in '..\source\uCEFMacOSInterfaces.pas',
   uCEFFrameHandler in '..\source\uCEFFrameHandler.pas',
-  uCEFOverlayController in '..\source\uCEFOverlayController.pas';
+  uCEFOverlayController in '..\source\uCEFOverlayController.pas',
+  uCEFFileDialogInfo in '..\source\uCEFFileDialogInfo.pas';
 
 end.
 

packages/CEF4Delphi_FMX.dproj

@@ -352,6 +352,7 @@
         <DCCReference Include="..\source\uCEFMacOSInterfaces.pas"/>
         <DCCReference Include="..\source\uCEFFrameHandler.pas"/>
         <DCCReference Include="..\source\uCEFOverlayController.pas"/>
+        <DCCReference Include="..\source\uCEFFileDialogInfo.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

packages/cef4delphi_lazarus.lpk

@@ -22,7 +22,7 @@
     <Description Value="CEF4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC."/>
     <License Value="MPL 1.1"/>
     <Version Major="96" Release="16"/>
-    <Files Count="202">
+    <Files Count="203">
       <Item1>
         <Filename Value="..\source\uCEFAccessibilityHandler.pas"/>
         <UnitName Value="uCEFAccessibilityHandler"/>
@@ -849,6 +849,10 @@
         <Filename Value="..\source\uCEFOverlayController.pas"/>
         <UnitName Value="uCEFOverlayController"/>
       </Item202>
+      <Item203>
+        <Filename Value="..\source\uCEFFileDialogInfo.pas"/>
+        <UnitName Value="uCEFFileDialogInfo"/>
+      </Item203>
     </Files>
     <RequiredPkgs Count="5">
       <Item1>

packages/cef4delphi_lazarus.pas

@@ -66,7 +66,8 @@ uses
   uCEFLinuxFunctions, uCEFLinuxTypes, uCEFLinuxConstants, 
   uCEFWorkSchedulerQueueThread, uCEFLinkedWinControlBase, uCEFLazarusCocoa, 
   uCEFBrowserWindow, uCEFOsrBrowserWindow, uCEFTimerWorkScheduler, 
-  uCEFFrameHandler, uCEFOverlayController, LazarusPackageIntf;
+  uCEFFrameHandler, uCEFOverlayController, uCEFFileDialogInfo, 
+  LazarusPackageIntf;
 
 implementation
 

source/uCEFFileDialogInfo.pas

@@ -0,0 +1,308 @@
+// ************************************************************************
+// ***************************** CEF4Delphi *******************************
+// ************************************************************************
+//
+// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
+// browser in Delphi applications.
+//
+// The original license of DCEF3 still applies to CEF4Delphi.
+//
+// For more information about CEF4Delphi visit :
+//         https://www.briskbard.com/index.php?lang=en&pageid=cef
+//
+//        Copyright © 2021 Salvador Diaz Fau. All rights reserved.
+//
+// ************************************************************************
+// ************ vvvv Original license and comments below vvvv *************
+// ************************************************************************
+(*
+ *                       Delphi Chromium Embedded 3
+ *
+ * Usage allowed under the restrictions of the Lesser GNU General Public License
+ * or alternatively the restrictions of the Mozilla Public License 1.1
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * Unit owner : Henri Gourvest <hgourvest@gmail.com>
+ * Web site   : http://www.progdigy.com
+ * Repository : http://code.google.com/p/delphichromiumembedded/
+ * Group      : http://groups.google.com/group/delphichromiumembedded
+ *
+ * Embarcadero Technologies, Inc is not permitted to use or redistribute
+ * this source code without explicit permission.
+ *
+ *)
+
+unit uCEFFileDialogInfo;
+
+{$IFDEF FPC}
+  {$MODE OBJFPC}{$H+}
+{$ENDIF}
+
+{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
+{$MINENUMSIZE 4}
+
+{$I cef.inc}
+
+interface
+
+uses
+  {$IFDEF DELPHI16_UP}
+  System.Classes, System.SysUtils,
+  {$ELSE}
+  Classes, SysUtils,
+  {$ENDIF}
+  uCEFInterfaces, uCEFTypes;
+
+type
+  TCEFFileDialogInfo = class
+    protected
+      FMode                   : Cardinal;
+      FTitle                  : ustring;
+      FDefaultFilePath        : ustring;
+      FAcceptFilters          : TStrings;
+      FSelectedAcceptFilter   : Integer;
+      FCallback               : ICefFileDialogCallback;
+      FDefaultAudioFileDesc   : ustring;
+      FDefaultVideoFileDesc   : ustring;
+      FDefaultTextFileDesc    : ustring;
+      FDefaultImageFileDesc   : ustring;
+      FDefaultAllFileDesc     : ustring;
+      FDefaultUnknownFileDesc : ustring;
+
+      function  GetOverwritePrompt : boolean;
+      function  GetHideReadonly : boolean;
+      function  GetDialogFilter : ustring; virtual;
+      function  GetDialogType : TCEFDialogType;
+
+      procedure SetAcceptFilters(const aAcceptFilters : TStrings);
+
+      function  CEFAcceptFilterToDialogFilter(const aAcceptFilter : ustring) : ustring; virtual;
+      function  GetDefaultMimeTypeDescription(const aMimeType : ustring) : ustring; virtual;
+
+    public
+      constructor Create;
+      destructor  Destroy; override;
+      procedure   Clear;
+
+      property Mode                   : Cardinal                 read FMode                   write FMode;
+      property Title                  : ustring                  read FTitle                  write FTitle;
+      property DefaultFilePath        : ustring                  read FDefaultFilePath        write FDefaultFilePath;
+      property AcceptFilters          : TStrings                                              write SetAcceptFilters;
+      property SelectedAcceptFilter   : Integer                  read FSelectedAcceptFilter   write FSelectedAcceptFilter;
+      property Callback               : ICefFileDialogCallback   read FCallback               write FCallback;
+      property OverwritePrompt        : boolean                  read GetOverwritePrompt;
+      property HideReadonly           : boolean                  read GetHideReadonly;
+      property DialogFilter           : ustring                  read GetDialogFilter;
+      property DialogType             : TCEFDialogType           read GetDialogType;
+      property DefaultAudioFileDesc   : ustring                  read FDefaultAudioFileDesc   write FDefaultAudioFileDesc;
+      property DefaultVideoFileDesc   : ustring                  read FDefaultVideoFileDesc   write FDefaultVideoFileDesc;
+      property DefaultTextFileDesc    : ustring                  read FDefaultTextFileDesc    write FDefaultTextFileDesc;
+      property DefaultImageFileDesc   : ustring                  read FDefaultImageFileDesc   write FDefaultImageFileDesc;
+      property DefaultAllFileDesc     : ustring                  read FDefaultAllFileDesc     write FDefaultAllFileDesc;
+      property DefaultUnknownFileDesc : ustring                  read FDefaultUnknownFileDesc write FDefaultUnknownFileDesc;
+  end;
+
+implementation
+
+uses
+  uCEFConstants, uCEFMiscFunctions;
+
+constructor TCEFFileDialogInfo.Create;
+begin
+  inherited Create;
+
+  FMode                   := 0;
+  FTitle                  := '';
+  FDefaultFilePath        := '';
+  FSelectedAcceptFilter   := 0;
+  FCallback               := nil;
+  FAcceptFilters          := nil;
+  FDefaultAudioFileDesc   := 'Audio files';
+  FDefaultVideoFileDesc   := 'Video files';
+  FDefaultTextFileDesc    := 'Text files';
+  FDefaultImageFileDesc   := 'Image files';
+  FDefaultAllFileDesc     := 'All files';
+  FDefaultUnknownFileDesc := 'Unknown files';
+end;
+
+destructor TCEFFileDialogInfo.Destroy;
+begin
+  Clear;
+
+  if assigned(FAcceptFilters) then
+    FreeAndNil(FAcceptFilters);
+
+  inherited Destroy;
+end;
+
+procedure TCEFFileDialogInfo.Clear;
+begin
+  FMode                   := 0;
+  FTitle                  := '';
+  FDefaultFilePath        := '';
+  FSelectedAcceptFilter   := 0;
+  FCallback               := nil;
+
+  if assigned(FAcceptFilters) then
+    FAcceptFilters.Clear;
+end;
+
+function TCEFFileDialogInfo.GetOverwritePrompt : boolean;
+begin
+  Result := ((FMode and FILE_DIALOG_OVERWRITEPROMPT_FLAG) <> 0);
+end;
+
+function TCEFFileDialogInfo.GetHideReadonly : boolean;
+begin
+  Result := ((FMode and FILE_DIALOG_HIDEREADONLY_FLAG) <> 0);
+end;
+
+function TCEFFileDialogInfo.GetDialogType : TCEFDialogType;
+begin
+  case (FMode and FILE_DIALOG_TYPE_MASK) of
+    FILE_DIALOG_OPEN          : Result := dtOpen;
+    FILE_DIALOG_OPEN_MULTIPLE : Result := dtOpenMultiple;
+    FILE_DIALOG_OPEN_FOLDER   : Result := dtOpenFolder;
+    FILE_DIALOG_SAVE          : Result := dtSave;
+    else                        Result := dtOpen;
+  end;
+end;
+
+function TCEFFileDialogInfo.GetDefaultMimeTypeDescription(const aMimeType : ustring) : ustring;
+begin
+  if      (CompareStr(copy(aMimeType, 1, 5), 'audio') = 0) then Result := FDefaultAudioFileDesc
+  else if (CompareStr(copy(aMimeType, 1, 5), 'video') = 0) then Result := FDefaultVideoFileDesc
+  else if (CompareStr(copy(aMimeType, 1, 4), 'text')  = 0) then Result := FDefaultTextFileDesc
+  else if (CompareStr(copy(aMimeType, 1, 5), 'image') = 0) then Result := FDefaultImageFileDesc
+  else                                                          Result := FDefaultUnknownFileDesc;
+end;
+
+procedure TCEFFileDialogInfo.SetAcceptFilters(const aAcceptFilters : TStrings);
+begin
+  if assigned(aAcceptFilters) then
+    begin
+      if assigned(FAcceptFilters) then
+        FAcceptFilters.Clear
+       else
+        FAcceptFilters := TStringList.Create;
+
+      if (aAcceptFilters.Count > 0) then
+        FAcceptFilters.AddStrings(aAcceptFilters);
+    end;
+end;
+
+function TCEFFileDialogInfo.GetDialogFilter : ustring;
+var
+  i : integer;
+begin
+  Result := '';
+
+  if assigned(FAcceptFilters) and (FAcceptFilters.Count > 0) then
+    for i := 0 to pred(FAcceptFilters.Count) do
+      if (i = 0) then
+        Result := CEFAcceptFilterToDialogFilter(FAcceptFilters[i])
+       else
+        Result := Result + '|' + CEFAcceptFilterToDialogFilter(FAcceptFilters[i]);
+
+  if (length(Result) > 0) then
+    Result := Result + '|' + FDefaultAllFileDesc + '|*.*'
+   else
+    Result := FDefaultAllFileDesc + '|*.*';
+end;
+
+function TCEFFileDialogInfo.CEFAcceptFilterToDialogFilter(const aAcceptFilter : ustring) : ustring;
+var
+  i : integer;
+  TempDesc, TempExt, TempString : ustring;
+  TempSL : TStringList;
+begin
+  Result := '';
+
+  if (length(aAcceptFilter) = 0) then exit;
+
+  TempSL := nil;
+  i      := pos('|', aAcceptFilter);
+
+  if (i > 0) then
+    begin
+      TempDesc   := copy(aAcceptFilter, 1, pred(i));
+      TempString := copy(aAcceptFilter, succ(i), length(aAcceptFilter));
+
+      for i := 1 to length(TempString) do
+        if (TempString[i] = ';') then TempString[i] := #13;
+
+      TempSL      := TStringList.Create;
+      TempSL.Text := TempString;
+      TempString  := '';
+
+      i := 0;
+      while (i < TempSL.Count) do
+        begin
+          TempExt := TempSL[i];
+          if (length(TempExt) > 1) and (TempExt[1] = '.') then
+            TempString := TempString + '*' + TempExt + ';';
+          inc(i);
+        end;
+
+      i := length(TempString);
+      if (i > 0) then
+        begin
+          if (TempString[i] = ';') then TempString := copy(TempString, 1, pred(i));
+          Result := TempDesc + '|' + TempString;
+        end
+       else
+        Result := aAcceptFilter;
+    end
+   else
+    if (aAcceptFilter[1] = '.') then
+      begin
+        TempDesc := GetFileTypeDescription(aAcceptFilter);
+
+        if (length(TempDesc) = 0) then
+          TempDesc := GetDefaultMimeTypeDescription(CefGetMimeType(aAcceptFilter));
+
+        Result := TempDesc + ' (*' + aAcceptFilter + ')|*' + aAcceptFilter;
+      end
+     else
+      begin
+        TempSL := TStringList.Create;
+        CefGetExtensionsForMimeType(aAcceptFilter, TempSL);
+
+        if (TempSL.Count = 0) then
+          Result := GetDefaultMimeTypeDescription(aAcceptFilter) + '|*.*'
+         else
+          begin
+            for i := 0 to pred(TempSL.Count) do
+              begin
+                TempExt := TempSL[i];
+
+                if (length(TempExt) > 0) and (TempExt[1] = '.') then
+                  TempString := TempString + '*' + TempExt + ';'
+                 else
+                  TempString := TempString + '*.' + TempExt + ';';
+              end;
+
+            TempString := copy(TempString, 1, pred(length(TempString)));
+            TempDesc   := '';
+            i          := 0;
+
+            while (length(TempDesc) = 0) and (i < TempSL.Count) do
+              begin
+                TempDesc := GetFileTypeDescription(TempSL[i]);
+                inc(i);
+              end;
+
+            if (length(TempDesc) = 0) then
+              TempDesc := GetDefaultMimeTypeDescription(CefGetMimeType(aAcceptFilter));
+
+            Result := TempDesc + ' (' + TempString + ')|' + TempString;
+          end;
+      end;
+
+  if assigned(TempSL) then FreeAndNil(TempSL);
+end;
+
+end.

source/uCEFMiscFunctions.pas

@@ -59,14 +59,14 @@ interface
 uses
   {$IFDEF DELPHI16_UP}
     {$IFDEF MSWINDOWS}
-      WinApi.Windows, WinApi.ActiveX,
+      WinApi.Windows, WinApi.ActiveX, Winapi.ShellApi,
     {$ELSE}
       {$IFDEF MACOSX}Macapi.Foundation, FMX.Helpers.Mac, Macapi.AppKit,{$ENDIF}
     {$ENDIF}
     {$IFDEF FMX}FMX.Types, FMX.Platform,{$ENDIF} System.Types, System.IOUtils,
     System.Classes, System.SysUtils, System.UITypes, System.Math,
   {$ELSE}
-    {$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF}
+    {$IFDEF MSWINDOWS}Windows, ActiveX, ShellApi,{$ENDIF}
     {$IFDEF DELPHI14_UP}Types, IOUtils,{$ENDIF} Classes, SysUtils, Math,
     {$IFDEF FPC}LCLType, LazFileUtils,{$IFNDEF MSWINDOWS}InterfaceBase, Forms,{$ENDIF}{$ENDIF}
     {$IFDEF LINUX}{$IFDEF FPC}
@@ -222,6 +222,7 @@ function CheckDLLs(const aFrameworkDirPath : string; var aMissingFiles : string)
 {$IFDEF MSWINDOWS}
 function CheckDLLVersion(const aDLLFile : ustring; aMajor, aMinor, aRelease, aBuild : uint16) : boolean;
 function GetDLLHeaderMachine(const aDLLFile : ustring; var aMachine : integer) : boolean;
+function GetFileTypeDescription(const aExtension : ustring) : ustring;
 {$ENDIF}
 function FileVersionInfoToString(const aVersionInfo : TFileVersionInfo) : string;
 function CheckFilesExist(var aList : TStringList; var aMissingFiles : string) : boolean;
@@ -1339,6 +1340,8 @@ var
 begin
   Result     := 0;
   TempBuffer := nil;
+  TempHandle := 0;
+  TempLen    := 0;
 
   try
     try
@@ -1447,7 +1450,30 @@ begin
   finally
     if (TempStream <> nil) then FreeAndNil(TempStream);
   end;
-end;   
+end;
+
+function GetFileTypeDescription(const aExtension : ustring) : ustring;
+var
+  TempInfo : SHFILEINFOW;
+  TempExt  : ustring;
+begin
+  Result := '';
+
+  if (length(aExtension) > 0) then
+    begin
+      if (aExtension[1] = '.') then
+        TempExt := aExtension
+       else
+        TempExt := '.' + aExtension;
+
+      if (SHGetFileInfoW(@TempExt[1],
+                         FILE_ATTRIBUTE_NORMAL,
+                         TempInfo,
+                         SizeOf(SHFILEINFO),
+                         SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES) <> 0) then
+        Result := TempInfo.szTypeName;
+    end;
+end;
 {$ENDIF}
 
 function FileVersionInfoToString(const aVersionInfo : TFileVersionInfo) : string;

source/uCEFTypes.pas

@@ -492,6 +492,9 @@ type
     hpDisableNonProxiedUDP
   );
 
+  // Used by TCEFFileDialogInfo
+  TCEFDialogType = (dtOpen, dtOpenMultiple, dtOpenFolder, dtSave);
+
   // Used by TCefMediaSinkInfo and TCefMediaSourceInfo
   TCefMediaType = (mtCast, mtDial, mtUnknown);
 

update_CEF4Delphi.json

@@ -2,7 +2,7 @@
   "UpdateLazPackages" : [
     {
       "ForceNotify" : true,
-      "InternalVersion" : 337,
+      "InternalVersion" : 338,
       "Name" : "cef4delphi_lazarus.lpk",
       "Version" : "96.0.16.0"
     }