mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Native dark mode support (Windows >= 10)

Browse source
This commit is contained in:
Alexander Koblov 2022-02-13 14:43:13 +03:00
commit d2142ef5f8
11 changed files with 2196 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

22
build.bat
View file

@ -30,15 +30,16 @@ if "%1"=="doublecmd" ( call :doublecmd
) else (
if "%1"=="release" ( call :release
) else (
if "%1"=="darkwin" ( call :darkwin
) else (
if "%1"=="debug" ( call :debug
) else (
if "%1"=="" ( call :release
) else (
echo ERROR: Mode not defined: %1
echo Available modes: components, plugins, doublecmd, release, debug
)))))))
echo Available modes: components, plugins, doublecmd, release, darkwin, debug
))))))))
pause
GOTO:EOF
:components
@ -69,6 +70,21 @@ GOTO:EOF
call :replace_old
lazbuild src\doublecmd.lpi --bm=release %DC_ARCH%
call :extract
GOTO:EOF
:darkwin
call :components
call :plugins
rem Build Double Commander
call :replace_old
lazbuild src\doublecmd.lpi --bm=darkwin %DC_ARCH%
call :extract
GOTO:EOF
:extract
rem Build Dwarf LineInfo Extractor
lazbuild tools\extractdwrflnfo.lpi

56
src/doublecmd.lpi
View file

@ -29,7 +29,7 @@
<Attributes pvaPreRelease="True"/>
<StringTable FileDescription="Double Commander is a cross platform open source file manager with two panels side by side" InternalName="DOUBLECMD" LegalCopyright="Copyright (C) 2006-2021 Alexander Koblov" ProductName="Double Commander"/>
</VersionInfo>
<BuildModes Count="4">
<BuildModes Count="5">
<Item1 Name="Debug" Default="True"/>
<Item2 Name="Debug + HeapTrc">
<CompilerOptions>
@ -187,6 +187,60 @@ end;"/>
</Other>
</CompilerOptions>
</Item4>
<Item5 Name="DarkWin">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\doublecmd"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;..\components\DDetours\Source"/>
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<RelocatableUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
</Checks>
<Optimizations>
<OptimizationLevel Value="2"/>
<VariablesInRegisters Value="True"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseLineInfoUnit Value="False"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<PassLinkerOptions Value="True"/>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<Verbosity>
<ShowNotes Value="False"/>
<ShowHints Value="False"/>
</Verbosity>
<CustomOptions Value="-dNIGHTLY_BUILD -dDARKWIN"/>
<ExecuteBefore>
<Command Value="$(ProjPath)\platform\git2revisioninc$(ExeExt).cmd $MakeFile($(ProjOutDir))"/>
<CompileReasons Run="False"/>
</ExecuteBefore>
</Other>
</CompilerOptions>
</Item5>
</BuildModes>
<PublishOptions>
<Version Value="2"/>

9
src/doublecmd.lpr
View file

@ -37,14 +37,19 @@ uses
{$ENDIF}
{$ENDIF}
DCConvertEncoding,
{$IF DEFINED(LCLWIN32) and DEFINED(DARKWIN)}
uWin32WidgetSetDark,
{$ENDIF}
Interfaces,
{$IFDEF LCLGTK2}
uGtk2FixCursorPos,
{$ENDIF}
{$IFDEF LCLWIN32}
uDClass,
{$IF NOT DEFINED(DARKWIN)}
uWin32WidgetSetFix,
{$ENDIF}
{$ENDIF}
LCLProc,
Classes,
SysUtils,
@ -139,7 +144,7 @@ begin
// which is called by Application.Initialize.
uKeyboard.InitializeKeyboard;
{$IF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
{$IF DEFINED(MSWINDOWS) and (DEFINED(LCLQT5) or DEFINED(DARKWIN))}
ApplyDarkStyle;
{$ENDIF}
@ -229,6 +234,8 @@ begin
frmStartingSplash.Release;
end;
frmMain.ShowOnTop;
Application.Run;
if not UniqueInstance.isAnotherDCRunningWhileIamRunning then

5
src/fFindDlg.pas
View file

@ -43,7 +43,7 @@ const
type
{ TfrmFindDlg }
TfrmFindDlg = class(TAloneForm, IFormCommands)
TfrmFindDlg = class(TModalForm, IFormCommands)
actIntelliFocus: TAction;
actCancel: TAction;
actClose: TAction;
@ -972,9 +972,11 @@ begin
FFrmAttributesEdit.OnOk := @OnAddAttribute;
end;
FFrmAttributesEdit.Reset;
{$IFNDEF DARKWIN}
if not (fsModal in FormState) then
FFrmAttributesEdit.Show
else
{$ENDIF}
begin
FFrmAttributesEdit.ShowModal;
end;
@ -2817,6 +2819,7 @@ end;
{ TfrmFindDlg.cm_Close }
procedure TfrmFindDlg.cm_Close(const Params: array of string);
begin
Hide;
Close;
end;

1
src/fattributesedit.lfm
View file

@ -5,7 +5,6 @@ object frmAttributesEdit: TfrmAttributesEdit
Width = 329
AutoSize = True
BorderIcons = [biSystemMenu]
BorderStyle = bsSizeToolWin
Caption = 'Choose attributes'
ClientHeight = 284
ClientWidth = 329

1
src/fmain.lfm
View file

@ -21,7 +21,6 @@ object frmMain: TfrmMain
ShowHint = True
ShowInTaskBar = stAlways
LCLVersion = '1.8.4.0'
Visible = True
object MainToolbar: TKASToolBar
AnchorSideTop.Control = Owner
Left = 0

10
src/platform/uosforms.pas
View file

@ -333,7 +333,15 @@ begin
EnableWindow(FParentWindow, False);
// If window already created then recreate it to force
// call CreateParams with appropriate parent window
if HandleAllocated then RecreateWnd(Self);
if HandleAllocated then
begin
{$IF NOT DEFINED(LCLWIN32)}
RecreateWnd(Self);
{$ELSE}
SetWindowLongPtr(Handle, GWL_STYLE, GetWindowLongPtr(Handle, GWL_STYLE) or LONG_PTR(WS_POPUP));
SetWindowLongPtr(Handle, GWL_HWNDPARENT, FParentWindow);
{$ENDIF}
end;
Show;
try
EnableWindow(Handle, True);

15
src/platform/win/udclass.pas
View file

@ -3,7 +3,7 @@
-------------------------------------------------------------------------
Setup unique window class name for main form
Copyright (C) 2016-2019 Alexander Koblov (alexx2000@mail.ru)
Copyright (C) 2016-2022 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -32,6 +32,7 @@ uses
Classes, SysUtils, Win32Int, WSLCLClasses, Forms, Windows, Win32Proc,
Controls, LCLType, fMain, Win32WSControls, uImport;
{$IF NOT DEFINED(DARKWIN)}
const
ClassNameW: PWideChar = 'TTOTAL_CMD'; // for compatibility with plugins
@ -53,11 +54,14 @@ begin
end;
Result := Windows.RegisterClassW(@WindowClassW) <> 0;
end;
{$ENDIF}
var
__GetProp: function(hWnd: HWND; lpString: LPCSTR): HANDLE; stdcall;
__SetProp: function(hWnd: HWND; lpString: LPCSTR; hData: HANDLE): WINBOOL; stdcall;
{$IF NOT DEFINED(DARKWIN)}
__CreateWindowExW: function(dwExStyle: DWORD; lpClassName: LPCWSTR; lpWindowName: LPCWSTR; dwStyle: DWORD; X: longint; Y: longint; nWidth: longint; nHeight: longint; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: LPVOID): HWND; stdcall;
{$ENDIF}
function _GetProp(hWnd: HWND; lpString: LPCSTR): HANDLE; stdcall;
var
@ -79,6 +83,7 @@ begin
Result:= __SetProp(hWnd, lpString, hData);
end;
{$IF NOT DEFINED(DARKWIN)}
function _CreateWindowExW(dwExStyle: DWORD; lpClassName: LPCWSTR; lpWindowName: LPCWSTR; dwStyle: DWORD; X: longint; Y: longint; nWidth: longint; nHeight: longint; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: LPVOID): HWND; stdcall;
var
AParams: PNCCreateParams absolute lpParam;
@ -86,24 +91,26 @@ begin
if (hWndParent = 0) and Assigned(AParams) and (AParams^.WinControl is TfrmMain) then lpClassName:= ClassNameW;
Result:= __CreateWindowExW(dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam);
end;
{$ENDIF}
procedure Initialize;
var
hModule: THandle;
pLibrary, pFunction: PPointer;
begin
WinRegister;
pLibrary:= FindImportLibrary(MainInstance, user32);
if Assigned(pLibrary) then
begin
hModule:= GetModuleHandle(user32);
{$IF NOT DEFINED(DARKWIN)}
pFunction:= FindImportFunction(pLibrary, GetProcAddress(hModule, 'CreateWindowExW'));
if Assigned(pFunction) then
begin
WinRegister;
Pointer(__CreateWindowExW):= ReplaceImportFunction(pFunction, @_CreateWindowExW);
end;
{$ENDIF}
// Prevent plugins written in Lazarus from crashing by changing the name for
// GetProp/SetProp to store control data from 'WinControl' to 'WinControlDC'
@ -127,8 +134,10 @@ end;
initialization
Initialize;
{$IF NOT DEFINED(DARKWIN)}
finalization
Windows.UnregisterClassW(PWideChar(ClassNameW), System.HInstance);
{$ENDIF}
end.

61
src/platform/win/uimport.pas
View file

@ -11,6 +11,10 @@ function FindImportLibrary(hModule: THandle; pLibName: PAnsiChar): PPointer;
function FindImportFunction(pLibrary: PPointer; pFunction: Pointer): PPointer;
function ReplaceImportFunction(pOldFunction: PPointer; pNewFunction: Pointer): Pointer;
function FindDelayImportLibrary(hModule: THandle; pLibName: PAnsiChar): Pointer;
function FindDelayImportFunction(hModule: THandle; pImpDesc: PIMAGE_DELAYLOAD_DESCRIPTOR; pFuncName: PAnsiChar): PPointer;
procedure ReplaceDelayImportFunction(hModule: THandle; pImpDesc: PIMAGE_DELAYLOAD_DESCRIPTOR; pFuncName: PAnsiChar; pNewFunction: Pointer);
implementation
type
@ -85,5 +89,62 @@ begin
end;
end;
function FindDelayImportLibrary(hModule: THandle; pLibName: PAnsiChar): Pointer;
var
pEnd: PByte;
pImpDir: PIMAGE_DATA_DIRECTORY;
pImpDesc: PIMAGE_DELAYLOAD_DESCRIPTOR;
pModule: PAnsiChar absolute hModule;
begin
pImpDesc := FindImageDirectory(hModule, IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT, pImpDir);
if pImpDesc = nil then Exit(nil);
pEnd := PByte(pImpDesc) + pImpDir^.Size;
while (PByte(pImpDesc) < pEnd) and (pImpDesc^.DllNameRVA > 0) do
begin
if StrIComp(@pModule[pImpDesc^.DllNameRVA], pLibName) = 0 then
Exit(pImpDesc);
Inc(pImpDesc);
end;
Result := nil;
end;
function FindDelayImportFunction(hModule: THandle;
pImpDesc: PIMAGE_DELAYLOAD_DESCRIPTOR; pFuncName: PAnsiChar): PPointer;
var
pImpName: PIMAGE_IMPORT_BY_NAME;
pImgThunkName: PIMAGE_THUNK_DATA;
pImgThunkAddr: PIMAGE_THUNK_DATA;
pModule: PAnsiChar absolute hModule;
begin
pImgThunkName:= @pModule[pImpDesc^.ImportNameTableRVA];
pImgThunkAddr:= @pModule[pImpDesc^.ImportAddressTableRVA];
while (pImgThunkName^.u1.Ordinal <> 0) do
begin
if not (IMAGE_SNAP_BY_ORDINAL(pImgThunkName^.u1.Ordinal)) then
begin
pImpName:= @pModule[pImgThunkName^.u1.AddressOfData];
if (StrIComp(pImpName^.Name, pFuncName) = 0) then
Exit(PPointer(@pImgThunkAddr^.u1._Function));
end;
Inc(pImgThunkName);
Inc(pImgThunkAddr);
end;
Result:= nil;
end;
procedure ReplaceDelayImportFunction(hModule: THandle;
pImpDesc: PIMAGE_DELAYLOAD_DESCRIPTOR; pFuncName: PAnsiChar;
pNewFunction: Pointer);
var
pOldFunction: PPointer;
begin
pOldFunction:= FindDelayImportFunction(hModule, pImpDesc, pFuncName);
if Assigned(pOldFunction) then ReplaceImportFunction(pOldFunction, pNewFunction);
end;
end.

2026
src/platform/win/uwin32widgetsetdark.pas Normal file
View file

File diff suppressed because it is too large Load diff

4
src/uwlxmodule.pas
View file

@ -45,7 +45,7 @@ uses
{$IFDEF LCLQT5}
, qt5, qtwidgets
{$ENDIF}
{$IF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
{$IF DEFINED(MSWINDOWS) and (DEFINED(LCLQT5) or DEFINED(DARKWIN))}
, uDarkStyle
{$ENDIF}
;
@ -339,7 +339,7 @@ function TWlxModule.CallListLoad(ParentWin: HWND; FileToLoad: String; ShowFlags:
begin
WlxPrepareContainer(ParentWin);
{$IF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
{$IF DEFINED(MSWINDOWS) and (DEFINED(LCLQT5) or DEFINED(DARKWIN))}
if g_darkModeEnabled then
begin
ShowFlags:= ShowFlags or lcp_darkmode;