v1.3.6 added titlebar dark mode and a few bug fixes.

.gitignore

@@ -32,3 +32,5 @@ ImageViewer.app/Contents/Info.plist
 ImageViewer.app/Contents/PkgInfo
 backup/
 
+*.o
+*.ppu

files/Linux/ImageViewer.desktop

@@ -0,0 +1,8 @@
+[Desktop Entry]
+Version=1.0
+Type=Application
+Terminal=false
+Exec=/home/torum/MyApp/Image-viewer/ImageViewer %U
+Name=ImageViewer
+Icon=/home/torum/MyApp/Image-viewer/ImageViewer.png
+X-Desktop-File-Install-Version=0.26

umain.lfm

@@ -26,7 +26,7 @@ object frmMain: TfrmMain
   OnShow = FormShow
   PopupMode = pmAuto
   Position = poScreenCenter
-  LCLVersion = '2.2.2.0'
+  LCLVersion = '2.2.4.0'
   object Image1: TImage
     Left = 0
     Height = 241

umain.pas

@@ -47,7 +47,9 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
   LclType, LclProc, LclIntf, Menus, StdCtrls, ExtDlgs,
-  strutils, Types, FileCtrl, XMLConf{$ifdef windows}, windirs, Windows, DWMApi{$endif};
+  strutils, Types, FileCtrl, XMLConf
+  {$ifdef windows}, windirs, Windows, DWMApi, win32titlestyler{$endif}
+  ;
 
 type
 
@@ -393,7 +395,7 @@ procedure TfrmMain.FormCreate(Sender: TObject);
   i,f:integer;
   configFile:string;
 begin
-  FstrAppVer:='1.3.5.0';
+  FstrAppVer:='1.3.6.0';
 
   // Init Main form properties.
   self.Caption:=ReplaceStr(ExtractFileName(ParamStr(0)),ExtractFileExt(ParamStr(0)),'');
@@ -908,6 +910,12 @@ procedure TfrmMain.FormShow(Sender: TObject);
 begin
   if Application.Terminated then exit;
 
+  {$ifdef windows}
+    // Apply dark themed title bar.
+    // https://forum.lazarus.freepascal.org/index.php/topic,59172.msg441116.html
+    ApplyFormDarkTitle(self, FoptBackgroundBlack, true);
+  {$endif}
+
   if (FOptFullscreen and (not FisFullscreen) and (not FisStartNormal)) then
   begin
     self.PopupMenu:= nil;
@@ -1307,22 +1315,28 @@ procedure TfrmMain.MenuItemAboutClick(Sender: TObject);
 
 procedure TfrmMain.MenuItemBackgroundBlackClick(Sender: TObject);
 begin
-
   FoptBackgroundBlack:=true;
   self.Color:=clBlack;
   MenuItemBackgroundBlack.Checked:=true;
   MenuItemBackgroundWhite.Checked:=false;
-
+  {$ifdef windows}
+    // Apply dark themed title bar.
+    // https://forum.lazarus.freepascal.org/index.php/topic,59172.msg441116.html
+    ApplyFormDarkTitle(self, FoptBackgroundBlack, true);
+  {$endif}
 end;
 
 procedure TfrmMain.MenuItemBackgroundWhiteClick(Sender: TObject);
 begin
-
   FoptBackgroundBlack:=false;
   self.Color:=clWhite;
   MenuItemBackgroundBlack.Checked:=false;
   MenuItemBackgroundWhite.Checked:=true;
-
+  {$ifdef windows}
+    // Apply dark themed title bar.
+    // https://forum.lazarus.freepascal.org/index.php/topic,59172.msg441116.html
+    ApplyFormDarkTitle(self, FoptBackgroundBlack, true);
+  {$endif}
 end;
 
 procedure TfrmMain.Image1DblClick(Sender: TObject);
@@ -1383,8 +1397,6 @@ procedure TfrmMain.MenuItemSlideshowClick(Sender: TObject);
       Image1.Visible:=true;
       ShowFullScreen(false);
       Screen.Cursor:=crDefault;
-      //if (self.top < 0) then self.top := 0;
-      //if (self.left < -100) then self.left := 0;
     end;
 
   end;
@@ -1575,6 +1587,7 @@ procedure TfrmMain.MenuItemSlideshowInFrameClick(Sender: TObject);
     self.PopupMenu:= nil;
 
     {$ifdef windows}
+    FOrigWndState:=WindowState;
     FOrigBounds:= BoundsRect;
     self.BorderStyle:=bsNone;
     BoundsRect := FOrigBounds;
@@ -1642,8 +1655,15 @@ procedure TfrmMain.DoneInFrame(strCurr :string);
   {$ifdef windows}
   BoundsRect:= FOrigBounds;
   self.BorderStyle:=bsSizeable;
-  BoundsRect:=FOrigBounds;
-
+  //BoundsRect:=FOrigBounds;
+  if (FOrigWndState = wsNormal) then
+  begin
+       BoundsRect:= FOrigBounds;
+  end else
+  if (FOrigWndState = wsMaximized) then
+  begin
+       WindowState:= FOrigWndState;
+  end;
   {$else}
     // https://forum.lazarus.freepascal.org/index.php?topic=38675.0
     self.BorderStyle:=bsSizeable;
@@ -1718,32 +1738,42 @@ procedure TfrmMain.SetStayOnTop(bln:Boolean);
   begin
     self.FormStyle:=fsSystemStayOnTop;
     MenuItemStayOnTop.Checked:=true;
+    self.FoptStayOnTop:=true;
   end else
   begin
-    {$ifdef windows}
-    if FisInFrame then
+    if (self.FormStyle = fsSystemStayOnTop) then
     begin
-      // "FormStyle:=fsNormal" causes window pos to move to 0,0 so..
-      BeforeBounds:= BoundsRect;
-    end;
-    {$endif}
 
-    self.FormStyle:=fsNormal;
-    MenuItemStayOnTop.Checked:=false;
+      {$ifdef windows}
+      if FisInFrame then
+      begin
+        // "FormStyle:=fsNormal" causes window pos to move to 0,0 so..
+        BeforeBounds:= BoundsRect;
+      end;
+      {$endif}
+
+      // TODO: This isn't working... calling this(SetStayOnTop) procedure twice from MenuItemStayOnTopClick works...
+      self.FormStyle:=fsNormal;
+
+      MenuItemStayOnTop.Checked:=false;
+      self.FoptStayOnTop:=false;
+
+      {$ifdef windows}
+      if FisInFrame then
+      begin
+        self.BorderStyle:=bsNone;
+        // Blur again
+        DoubleBuffered := True;
+        EnableBlur;
+        // re-set position.
+        BoundsRect := BeforeBounds;
+      end;
+      {$endif}
 
-    {$ifdef windows}
-    if FisInFrame then
-    begin
-      self.BorderStyle:=bsNone;
-      // Blur again
-      DoubleBuffered := True;
-      EnableBlur;
-      // re-set position.
-      BoundsRect := BeforeBounds;
     end;
-    {$endif}
   end;
-  self.FoptStayOnTop:=bln;
+  //self.FoptStayOnTop:=bln;
+  //MenuItemStayOnTop.Checked:=bln;
 end;
 
 procedure TfrmMain.ApplicationProperties1Exception(Sender: TObject; E: Exception);
@@ -1998,9 +2028,12 @@ procedure TfrmMain.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
 
 procedure TfrmMain.MenuItemStayOnTopClick(Sender: TObject);
 begin
-  if (self.FormStyle = fsSystemStayOnTop) then
+  //if (self.FormStyle = fsSystemStayOnTop) then
+  if (self.FoptStayOnTop) then
   begin
     SetStayOnTop(false);
+    // TODO: somehow, this works.
+    if (self.FormStyle = fsSystemStayOnTop) then SetStayOnTop(false);
   end else
   begin
     SetStayOnTop(true);
@@ -2244,11 +2277,18 @@ procedure TfrmMain.SetFullScreen_Win32(blnOn: boolean);
   end else
   begin
     WindowState:= FOrigWndState;
-    BoundsRect:= FOrigBounds;
+    if (FOrigWndState = wsNormal) then
+    begin
+         BoundsRect:= FOrigBounds;
+    end;
     BorderStyle:= bsSizeable;
 
     // ShowWindow(Handle, SW_SHOWNORMAL);
-    BoundsRect:= FOrigBounds;
+    WindowState:= FOrigWndState;
+    if (FOrigWndState = wsNormal) then
+    begin
+         BoundsRect:= FOrigBounds;
+    end;
   end;
 end;
 

win32titlestyler.pas

@@ -0,0 +1,77 @@
+(*
+This Source Code Form is subject to the terms of the Mozilla Public
+License, v. 2.0. If a copy of the MPL was not distributed with this
+file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+Copyright (c) Alexey Torgashin
+*)
+unit win32titlestyler;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Windows, SysUtils, Forms, Graphics;
+
+procedure ApplyFormDarkTitle(AForm: TForm; ADarkMode: bool; AForceApply: bool);
+
+implementation
+
+const
+  //DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1: Integer = 19;
+  DWMWA_USE_IMMERSIVE_DARK_MODE: Integer = 20;
+
+type
+  TDwmSetWindowAttribute = function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
+  // https://docs.microsoft.com/en-us/windows/win32/api/dwmapi/nf-dwmapi-dwmsetwindowattribute
+
+var
+  hLib: THandle = 0;
+  DwmSetWindowAttribute: TDwmSetWindowAttribute = nil;
+
+  LastFormHandle: THandle = 0;
+  LastDarkMode: bool = false;
+
+procedure ApplyFormDarkTitle(AForm: TForm; ADarkMode: bool; AForceApply: bool);
+begin
+  //require Windows Vista
+  if Win32MajorVersion<6 then exit;
+
+  if not AForceApply then
+    if (LastFormHandle=AForm.Handle) and
+      (LastDarkMode=ADarkMode) then exit;
+
+  if hLib=0 then
+  begin
+    hLib:= LoadLibrary('dwmapi.dll');
+    if hLib<>0 then
+      Pointer(DwmSetWindowAttribute):= GetProcAddress(hLib, 'DwmSetWindowAttribute');
+  end;
+
+  if Assigned(DwmSetWindowAttribute) then
+  begin
+    LastFormHandle:= AForm.Handle;
+    LastDarkMode:= ADarkMode;
+
+    DwmSetWindowAttribute(AForm.Handle, DWMWA_USE_IMMERSIVE_DARK_MODE, @ADarkMode, SizeOf(ADarkMode));
+
+    if AForceApply and (AForm.WindowState=wsNormal) then
+    begin
+      AForm.Width:= AForm.Width+1;
+      AForm.Width:= AForm.Width-1;
+    end;
+      {
+      //this doesn't help: titlebar is not repainted after returning from full-screen, and maximized state is lost
+      SetWindowPos(AForm.Handle, 0,
+        0, 0, 0, 0,
+        SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_NOSENDCHANGING or SWP_DRAWFRAME);
+        }
+  end;
+end;
+
+finalization
+  if hLib<>0 then
+    FreeLibrary(hLib);
+
+end.