pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-02-02 10:25:26 +02:00
Code Issues Actions Releases Activity

Added TCEFFileDialogInfo

Browse Source 
MiniBrowser now uses TCEFFileDialogInfo to show custom open and save dialogs.
This commit is contained in:
salvadordf 2021-11-28 20:16:49 +01:00
parent 8b9a2871e2
commit 25edba76e8
16 changed files with 702 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
demos/Delphi_VCL/MiniBrowser/MiniBrowser.dpr
View File

@ -42,17 +42,16 @@ program MiniBrowser;
uses
{$IFDEF DELPHI16_UP}
WinApi.Windows,
Vcl.Forms,
Vcl.Forms, WinApi.Windows,
{$ELSE}
Forms,
Windows,
Forms, 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}

4
demos/Delphi_VCL/MiniBrowser/MiniBrowser.dproj
View File

@ -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>

92
demos/Delphi_VCL/MiniBrowser/uDirectorySelector.dfm Normal file
View File

@ -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

85
demos/Delphi_VCL/MiniBrowser/uDirectorySelector.pas Normal file
View File

@ -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.

12
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm
View File

@ -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

154
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas
View File

@ -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);

3
packages/CEF4Delphi.dpk
View File

@ -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.

3
packages/CEF4Delphi_D7.dpk
View File

@ -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.

3
packages/CEF4Delphi_FMX.dpk
View File

@ -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.

1
packages/CEF4Delphi_FMX.dproj
View File

@ -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>

6
packages/cef4delphi_lazarus.lpk
View File

@ -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>

3
packages/cef4delphi_lazarus.pas
View File

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

308
source/uCEFFileDialogInfo.pas Normal file
View File

@ -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.

32
source/uCEFMiscFunctions.pas
View File

@ -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;

3
source/uCEFTypes.pas
View File

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

2
update_CEF4Delphi.json
View File

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