pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-11-23 21:34:53 +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
Download Patch File Download Diff File Expand all files Collapse all files

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