Changeset 468 for trunk/Packages

Timestamp:

Dec 3, 2023, 11:28:08 AM (6 months ago)

Author:

chronos

Message:

• Added: High DPI support integrated into trunk branch. It can be enabled by adding DPI define to compiler parameters for main project and packages.

Location:

trunk/Packages

Files:

• CevoComponents/Area.pas (modified) (1 diff)
• CevoComponents/BaseWin.pas (modified) (5 diffs)
• CevoComponents/ButtonA.pas (modified) (2 diffs)
• CevoComponents/ButtonB.pas (modified) (1 diff)
• CevoComponents/ButtonBase.pas (modified) (2 diffs)
• CevoComponents/ButtonN.pas (modified) (2 diffs)
• CevoComponents/CevoComponents.lpk (modified) (1 diff)
• CevoComponents/DrawDlg.pas (modified) (1 diff)
• CevoComponents/EOTButton.pas (modified) (2 diffs)
• CevoComponents/GraphicSet.pas (modified) (2 diffs)
• CevoComponents/ScreenTools.pas (modified) (14 diffs)
• CevoComponents/Texture.pas (modified) (1 diff)
• DpiControls (added)
• DpiControls/Dpi.ComCtrls.pas (added)
• DpiControls/Dpi.Common.pas (added)
• DpiControls/Dpi.Controls.pas (added)
• DpiControls/Dpi.ExtCtrls.pas (added)
• DpiControls/Dpi.Forms.pas (added)
• DpiControls/Dpi.Graphics.pas (added)
• DpiControls/Dpi.Grids.pas (added)
• DpiControls/Dpi.Menus.pas (added)
• DpiControls/Dpi.PixelPointer.pas (added)
• DpiControls/Dpi.Spin.pas (added)
• DpiControls/Dpi.StdCtrls.pas (added)
• DpiControls/DpiControls.lpk (added)
• DpiControls/DpiControls.pas (added)
• DpiControls/DpiControlsPackage.pas (added)
• DpiControls/NativePixelPointer.pas (added)

trunk/Packages/CevoComponents/Area.pas

@@ -4 +4 @@
 
 uses
-  Classes, Graphics, Controls;
+  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}
+  Graphics, Controls,{$ENDIF}
+  Classes;
 
 type

trunk/Packages/CevoComponents/BaseWin.pas

@@ -4 +4 @@
 
 uses
-  ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
-  DrawDlg;
+  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms,{$ELSE}
+  Graphics, Controls, Forms,{$ENDIF}
+  ScreenTools, LCLIntf, LCLType, SysUtils, Classes, DrawDlg, System.UITypes;
 
 type
@@ -133 +134 @@
 begin
   if Key = VK_ESCAPE then begin
-    if fsModal in FormState then
+    if TFormStateType.fsModal in FormState then
       ModalResult := mrCancel;
   end else
   if Key = VK_RETURN then begin
-    if fsModal in FormState then
+    if TFormStateType.fsModal in FormState then
       ModalResult := mrOK;
   end else
@@ -245 +246 @@
   TexOverride := False;
   ModalIndication := True;
-  Canvas.Brush.Style := bsClear;
+  Canvas.Brush.Style := TBrushStyle.bsClear;
   InnerWidth := Width - 2 * SideFrame;
   InnerHeight := Height - TitleHeight - NarrowFrame;
@@ -479 +480 @@
     Exit;
   Offscreen := TBitmap.Create;
-  Offscreen.PixelFormat := pf24bit;
+  Offscreen.PixelFormat := TPixelFormat.pf24bit;
   if Screen.Height - yUnused < 480 then
     Offscreen.SetSize(Screen.Width, 480)
@@ -485 +486 @@
     Offscreen.SetSize(Screen.Width, Screen.Height - yUnused);
   Offscreen.Canvas.FillRect(0, 0, Offscreen.Width, OffScreen.Height);
-  Offscreen.Canvas.Brush.Style := bsClear;
+  Offscreen.Canvas.Brush.Style := TBrushStyle.bsClear;
 end;
 

trunk/Packages/CevoComponents/ButtonA.pas

@@ -4 +4 @@
 
 uses
-  ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools, Types;
+  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
+  ButtonBase, Classes, LCLIntf, LCLType, ScreenTools, Types;
 
 type
@@ -48 +49 @@
       BitBltCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195,
         243 + 26 * Byte(Down));
-      Canvas.Brush.Style := bsClear;
+      Canvas.Brush.Style := TBrushStyle.bsClear;
       TextSize := TextExtent(FCaption);
       TextOut(50 - (TextSize.Width + 1) div 2,

trunk/Packages/CevoComponents/ButtonB.pas

@@ -4 +4 @@
 
 uses
-  ButtonBase, Classes, Graphics, LCLIntf, LCLType;
+  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
+  ButtonBase, Classes, LCLIntf, LCLType;
 
 type

trunk/Packages/CevoComponents/ButtonBase.pas

@@ -4 +4 @@
 
 uses
-  Classes, Graphics, Controls;
+  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}
+  Graphics, Controls,{$ENDIF}
+  Classes;
 
 type
@@ -84 +86 @@
         DownChangedProc(self);
     end;
-    if (Button = mbLeft) and (@ClickProc <> nil) then
+    if (Button = TMouseButton.mbLeft) and (@ClickProc <> nil) then
       ClickProc(self);
   end

trunk/Packages/CevoComponents/ButtonN.pas

@@ -4 +4 @@
 
 uses
-  Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools;
+  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}Graphics, Controls,{$ENDIF}
+  Classes, LCLIntf, LCLType, ScreenTools;
 
 type
@@ -85 +86 @@
   X, Y: Integer);
 begin
-  if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then
+  if FPossible and (Button = TMouseButton.mbLeft) and (@ChangeProc <> nil) then
     ChangeProc(Self);
 end;

trunk/Packages/CevoComponents/CevoComponents.lpk

@@ -112 +112 @@
     </Files>
     <CompatibilityMode Value="True"/>
-    <RequiredPkgs Count="3">
+    <RequiredPkgs Count="4">
       <Item1>
-        <PackageName Value="Common"/>
+        <PackageName Value="DpiControls"/>
       </Item1>
       <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="Common"/>
       </Item2>
       <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+      <Item4>
         <PackageName Value="FCL"/>
-      </Item3>
+      </Item4>
     </RequiredPkgs>
     <UsageOptions>

trunk/Packages/CevoComponents/DrawDlg.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF}
+  {$IFDEF DPI}Dpi.Forms, Dpi.Common,{$ELSE}
+  Forms,{$ENDIF}
+  Classes, SysUtils, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF}
   Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools
   {$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF};

trunk/Packages/CevoComponents/EOTButton.pas

@@ -4 +4 @@
 
 uses
-  ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType;
+  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
+  ButtonBase, Classes, SysUtils, LCLIntf, LCLType;
 
 const
@@ -53 +54 @@
   inherited;
   Buffer := TBitmap.Create;
-  Buffer.PixelFormat := pf24bit;
+  Buffer.PixelFormat := TPixelFormat.pf24bit;
   Buffer.SetSize(48, 48);
   Buffer.Canvas.FillRect(0, 0, Buffer.Width, Buffer.Height);
   Back := TBitmap.Create;
-  Back.PixelFormat := pf24bit;
+  Back.PixelFormat := TPixelFormat.pf24bit;
   Back.SetSize(48, 48);
   Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);

trunk/Packages/CevoComponents/GraphicSet.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Graphics, Generics.Collections, LCLType, DOM,
+  {$IFDEF DPI}Dpi.Graphics,{$ELSE}
+  Graphics,{$ENDIF}
+  Classes, SysUtils, Generics.Collections, LCLType, DOM,
   XMLRead, XMLWrite, XML;
 
@@ -228 +230 @@
 begin
   Data := TBitmap.Create;
-  Data.PixelFormat := pf24bit;
+  Data.PixelFormat := TPixelFormat.pf24bit;
   Mask := TBitmap.Create;
-  Mask.PixelFormat := pf24bit;
+  Mask.PixelFormat := TPixelFormat.pf24bit;
   Items := TGraphicSetItems.Create;
   Items.GraphicSet := Self;

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -7 +7 @@
   Windows,
   {$ENDIF}
-  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
-  Forms, Menus, GraphType, GraphicSet, LazFileUtils, Texture;
+  StringTables, LCLIntf, LCLType, SysUtils, Classes, Math,
+  GraphType, GraphicSet, LazFileUtils, Texture,
+  {$IFDEF DPI}Dpi.Forms, Dpi.Menus, Dpi.Graphics, Dpi.Controls, Dpi.Common{$ELSE}
+  Forms, Menus, Graphics, Controls{$ENDIF};
 
 type
@@ -96 +98 @@
 procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Cardinal);
 procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
+{$IFNDEF DPI}
 function ScaleToNative(Value: Integer): Integer;
 function ScaleFromNative(Value: Integer): Integer;
+{$ENDIF}
 procedure UnshareBitmap(Bitmap: TBitmap);
 procedure Gtk2Fix;
@@ -199 +203 @@
 
 uses
-  Directories, Sound, PixelPointer;
+  {$IFDEF DPI}Dpi.PixelPointer,{$ELSE}PixelPointer,{$ENDIF}
+  Directories, Sound;
 
 var
@@ -419 +424 @@
         Jpeg.LoadFromFile(FileName);
         if not (gfNoGamma in Options) then
-          Bmp.PixelFormat := pf24bit;
+          Bmp.PixelFormat := TPixelFormat.pf24bit;
         Bmp.SetSize(Jpeg.Width, Jpeg.Height);
         Bmp.Canvas.Draw(0, 0, Jpeg);
@@ -434 +439 @@
         Png.LoadFromFile(FileName);
         if not (gfNoGamma in Options) then
-          Bmp.PixelFormat := pf24bit;
+          Bmp.PixelFormat := TPixelFormat.pf24bit;
         Bmp.SetSize(Png.Width, Png.Height);
         if (Png.RawImage.Description.Format = ricfGray) then
         begin
           // LCL doesn't support 8-bit colors properly. Use 24-bit instead.
-          Bmp.PixelFormat := pf24bit;
+          Bmp.PixelFormat := TPixelFormat.pf24bit;
           CopyGray8BitTo24bitBitmap(Bmp, Png);
         end
@@ -454 +459 @@
         Bmp.LoadFromFile(FileName);
         if not (gfNoGamma in Options) then
-          Bmp.PixelFormat := pf24bit;
+          Bmp.PixelFormat := TPixelFormat.pf24bit;
         Result := True;
       except
@@ -634 +639 @@
   Height := ScaleToNative(Height);
   //Assert(Src.PixelFormat = pf8bit);
-  Assert(dst.PixelFormat = pf24bit);
+  Assert(dst.PixelFormat = TPixelFormat.pf24bit);
   if xDst < 0 then begin
     Width := Width + xDst;
@@ -821 +826 @@
   Height := ScaleToNative(Height);
   bmp.BeginUpdate;
-  Assert(bmp.PixelFormat = pf24bit);
+  Assert(bmp.PixelFormat = TPixelFormat.pf24bit);
   Height := Y + Height;
   PixelPtr := TPixelPointer.Create(Bmp, X, Y);
@@ -1524 +1529 @@
     Brush.Color := $000000;
     FillRect(Rect(X + Pos + abs(Growth), Y, X + Max, Y + 7));
-    Brush.Style := bsClear;
+    Brush.Style := TBrushStyle.bsClear;
   end;
 end;
@@ -1627 +1632 @@
 end;
 
+{$IFNDEF DPI}
 function ScaleToNative(Value: Integer): Integer;
 begin
@@ -1636 +1642 @@
   Result := Value;
 end;
+{$ENDIF}
 
 procedure UnshareBitmap(Bitmap: TBitmap);
@@ -1691 +1698 @@
                   Size := Size * 10 + Byte(S[I]) - 48;
                 'B', 'b':
-                  UniFont[section].Style := UniFont[section].Style + [fsBold];
+                  UniFont[section].Style := UniFont[section].Style + [TFontStyle.fsBold];
                 'I', 'i':
-                  UniFont[section].Style := UniFont[section].Style + [fsItalic];
+                  UniFont[section].Style := UniFont[section].Style + [TFontStyle.fsItalic];
               end;
-            UniFont[section].Size := Round(Size * 72 / UniFont[section].PixelsPerInch);
+            UniFont[section].Size := Round(Size * ScaleToNative(72) / UniFont[section].PixelsPerInch);
           end;
         end;
@@ -1783 +1790 @@
 
   Colors := TBitmap.Create;
-  Colors.PixelFormat := pf24bit;
+  Colors.PixelFormat := TPixelFormat.pf24bit;
   Paper := TBitmap.Create;
-  Paper.PixelFormat := pf24bit;
+  Paper.PixelFormat := TPixelFormat.pf24bit;
   BigImp := TBitmap.Create;
-  BigImp.PixelFormat := pf24bit;
+  BigImp.PixelFormat := TPixelFormat.pf24bit;
   MainTexture := TTexture.Create;
   ClickFrameColor := HGrSystem.Data.Canvas.Pixels[187, 175];
@@ -1796 +1803 @@
 
   LogoBuffer := TBitmap.Create;
-  LogoBuffer.PixelFormat := pf24bit;
+  LogoBuffer.PixelFormat := TPixelFormat.pf24bit;
   LogoBuffer.SetSize(BigBook.Width, BigBook.Height);
 end;

trunk/Packages/CevoComponents/Texture.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Graphics;
+  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
+  Classes, SysUtils;
 
 type