Ignore:
Timestamp:
Dec 3, 2023, 11:28:08 AM (12 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/CevoComponents
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/Area.pas

    r184 r468  
    44
    55uses
    6   Classes, Graphics, Controls;
     6  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}
     7  Graphics, Controls,{$ENDIF}
     8  Classes;
    79
    810type

  • trunk/Packages/CevoComponents/BaseWin.pas

    r464 r468  
    44
    55uses
    6   ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
    7   DrawDlg;
     6  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms,{$ELSE}
     7  Graphics, Controls, Forms,{$ENDIF}
     8  ScreenTools, LCLIntf, LCLType, SysUtils, Classes, DrawDlg, System.UITypes;
    89
    910type
    … …  
    133134begin
    134135  if Key = VK_ESCAPE then begin
    135     if fsModal in FormState then
     136    if TFormStateType.fsModal in FormState then
    136137      ModalResult := mrCancel;
    137138  end else
    138139  if Key = VK_RETURN then begin
    139     if fsModal in FormState then
     140    if TFormStateType.fsModal in FormState then
    140141      ModalResult := mrOK;
    141142  end else
    … …  
    245246  TexOverride := False;
    246247  ModalIndication := True;
    247   Canvas.Brush.Style := bsClear;
     248  Canvas.Brush.Style := TBrushStyle.bsClear;
    248249  InnerWidth := Width - 2 * SideFrame;
    249250  InnerHeight := Height - TitleHeight - NarrowFrame;
    … …  
    479480    Exit;
    480481  Offscreen := TBitmap.Create;
    481   Offscreen.PixelFormat := pf24bit;
     482  Offscreen.PixelFormat := TPixelFormat.pf24bit;
    482483  if Screen.Height - yUnused < 480 then
    483484    Offscreen.SetSize(Screen.Width, 480)
    … …  
    485486    Offscreen.SetSize(Screen.Width, Screen.Height - yUnused);
    486487  Offscreen.Canvas.FillRect(0, 0, Offscreen.Width, OffScreen.Height);
    487   Offscreen.Canvas.Brush.Style := bsClear;
     488  Offscreen.Canvas.Brush.Style := TBrushStyle.bsClear;
    488489end;
    489490

  • trunk/Packages/CevoComponents/ButtonA.pas

    r431 r468  
    44
    55uses
    6   ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools, Types;
     6  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
     7  ButtonBase, Classes, LCLIntf, LCLType, ScreenTools, Types;
    78
    89type
    … …  
    4849      BitBltCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195,
    4950        243 + 26 * Byte(Down));
    50       Canvas.Brush.Style := bsClear;
     51      Canvas.Brush.Style := TBrushStyle.bsClear;
    5152      TextSize := TextExtent(FCaption);
    5253      TextOut(50 - (TextSize.Width + 1) div 2,

  • trunk/Packages/CevoComponents/ButtonB.pas

    r462 r468  
    44
    55uses
    6   ButtonBase, Classes, Graphics, LCLIntf, LCLType;
     6  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
     7  ButtonBase, Classes, LCLIntf, LCLType;
    78
    89type

  • trunk/Packages/CevoComponents/ButtonBase.pas

    r464 r468  
    44
    55uses
    6   Classes, Graphics, Controls;
     6  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}
     7  Graphics, Controls,{$ENDIF}
     8  Classes;
    79
    810type
    … …  
    8486        DownChangedProc(self);
    8587    end;
    86     if (Button = mbLeft) and (@ClickProc <> nil) then
     88    if (Button = TMouseButton.mbLeft) and (@ClickProc <> nil) then
    8789      ClickProc(self);
    8890  end

  • trunk/Packages/CevoComponents/ButtonN.pas

    r447 r468  
    44
    55uses
    6   Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools;
     6  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls,{$ELSE}Graphics, Controls,{$ENDIF}
     7  Classes, LCLIntf, LCLType, ScreenTools;
    78
    89type
    … …  
    8586  X, Y: Integer);
    8687begin
    87   if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then
     88  if FPossible and (Button = TMouseButton.mbLeft) and (@ChangeProc <> nil) then
    8889    ChangeProc(Self);
    8990end;

  • trunk/Packages/CevoComponents/CevoComponents.lpk

    r456 r468  
    112112    </Files>
    113113    <CompatibilityMode Value="True"/>
    114     <RequiredPkgs Count="3">
     114    <RequiredPkgs Count="4">
    115115      <Item1>
    116         <PackageName Value="Common"/>
     116        <PackageName Value="DpiControls"/>
    117117      </Item1>
    118118      <Item2>
    119         <PackageName Value="LCL"/>
     119        <PackageName Value="Common"/>
    120120      </Item2>
    121121      <Item3>
     122        <PackageName Value="LCL"/>
     123      </Item3>
     124      <Item4>
    122125        <PackageName Value="FCL"/>
    123       </Item3>
     126      </Item4>
    124127    </RequiredPkgs>
    125128    <UsageOptions>

  • trunk/Packages/CevoComponents/DrawDlg.pas

    r460 r468  
    44
    55uses
    6   Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF}
     6  {$IFDEF DPI}Dpi.Forms, Dpi.Common,{$ELSE}
     7  Forms,{$ENDIF}
     8  Classes, SysUtils, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF}
    79  Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools
    810  {$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF};

  • trunk/Packages/CevoComponents/EOTButton.pas

    r447 r468  
    44
    55uses
    6   ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType;
     6  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
     7  ButtonBase, Classes, SysUtils, LCLIntf, LCLType;
    78
    89const
    … …  
    5354  inherited;
    5455  Buffer := TBitmap.Create;
    55   Buffer.PixelFormat := pf24bit;
     56  Buffer.PixelFormat := TPixelFormat.pf24bit;
    5657  Buffer.SetSize(48, 48);
    5758  Buffer.Canvas.FillRect(0, 0, Buffer.Width, Buffer.Height);
    5859  Back := TBitmap.Create;
    59   Back.PixelFormat := pf24bit;
     60  Back.PixelFormat := TPixelFormat.pf24bit;
    6061  Back.SetSize(48, 48);
    6162  Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);

  • trunk/Packages/CevoComponents/GraphicSet.pas

    r464 r468  
    44
    55uses
    6   Classes, SysUtils, Graphics, Generics.Collections, LCLType, DOM,
     6  {$IFDEF DPI}Dpi.Graphics,{$ELSE}
     7  Graphics,{$ENDIF}
     8  Classes, SysUtils, Generics.Collections, LCLType, DOM,
    79  XMLRead, XMLWrite, XML;
    810
    … …  
    228230begin
    229231  Data := TBitmap.Create;
    230   Data.PixelFormat := pf24bit;
     232  Data.PixelFormat := TPixelFormat.pf24bit;
    231233  Mask := TBitmap.Create;
    232   Mask.PixelFormat := pf24bit;
     234  Mask.PixelFormat := TPixelFormat.pf24bit;
    233235  Items := TGraphicSetItems.Create;
    234236  Items.GraphicSet := Self;

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r456 r468  
    77  Windows,
    88  {$ENDIF}
    9   StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
    10   Forms, Menus, GraphType, GraphicSet, LazFileUtils, Texture;
     9  StringTables, LCLIntf, LCLType, SysUtils, Classes, Math,
     10  GraphType, GraphicSet, LazFileUtils, Texture,
     11  {$IFDEF DPI}Dpi.Forms, Dpi.Menus, Dpi.Graphics, Dpi.Controls, Dpi.Common{$ELSE}
     12  Forms, Menus, Graphics, Controls{$ENDIF};
    1113
    1214type
    … …  
    9698procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Cardinal);
    9799procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
     100{$IFNDEF DPI}
    98101function ScaleToNative(Value: Integer): Integer;
    99102function ScaleFromNative(Value: Integer): Integer;
     103{$ENDIF}
    100104procedure UnshareBitmap(Bitmap: TBitmap);
    101105procedure Gtk2Fix;
    … …  
    199203
    200204uses
    201   Directories, Sound, PixelPointer;
     205  {$IFDEF DPI}Dpi.PixelPointer,{$ELSE}PixelPointer,{$ENDIF}
     206  Directories, Sound;
    202207
    203208var
    … …  
    419424        Jpeg.LoadFromFile(FileName);
    420425        if not (gfNoGamma in Options) then
    421           Bmp.PixelFormat := pf24bit;
     426          Bmp.PixelFormat := TPixelFormat.pf24bit;
    422427        Bmp.SetSize(Jpeg.Width, Jpeg.Height);
    423428        Bmp.Canvas.Draw(0, 0, Jpeg);
    … …  
    434439        Png.LoadFromFile(FileName);
    435440        if not (gfNoGamma in Options) then
    436           Bmp.PixelFormat := pf24bit;
     441          Bmp.PixelFormat := TPixelFormat.pf24bit;
    437442        Bmp.SetSize(Png.Width, Png.Height);
    438443        if (Png.RawImage.Description.Format = ricfGray) then
    439444        begin
    440445          // LCL doesn't support 8-bit colors properly. Use 24-bit instead.
    441           Bmp.PixelFormat := pf24bit;
     446          Bmp.PixelFormat := TPixelFormat.pf24bit;
    442447          CopyGray8BitTo24bitBitmap(Bmp, Png);
    443448        end
    … …  
    454459        Bmp.LoadFromFile(FileName);
    455460        if not (gfNoGamma in Options) then
    456           Bmp.PixelFormat := pf24bit;
     461          Bmp.PixelFormat := TPixelFormat.pf24bit;
    457462        Result := True;
    458463      except
    … …  
    634639  Height := ScaleToNative(Height);
    635640  //Assert(Src.PixelFormat = pf8bit);
    636   Assert(dst.PixelFormat = pf24bit);
     641  Assert(dst.PixelFormat = TPixelFormat.pf24bit);
    637642  if xDst < 0 then begin
    638643    Width := Width + xDst;
    … …  
    821826  Height := ScaleToNative(Height);
    822827  bmp.BeginUpdate;
    823   Assert(bmp.PixelFormat = pf24bit);
     828  Assert(bmp.PixelFormat = TPixelFormat.pf24bit);
    824829  Height := Y + Height;
    825830  PixelPtr := TPixelPointer.Create(Bmp, X, Y);
    … …  
    15241529    Brush.Color := $000000;
    15251530    FillRect(Rect(X + Pos + abs(Growth), Y, X + Max, Y + 7));
    1526     Brush.Style := bsClear;
     1531    Brush.Style := TBrushStyle.bsClear;
    15271532  end;
    15281533end;
    … …  
    16271632end;
    16281633
     1634{$IFNDEF DPI}
    16291635function ScaleToNative(Value: Integer): Integer;
    16301636begin
    … …  
    16361642  Result := Value;
    16371643end;
     1644{$ENDIF}
    16381645
    16391646procedure UnshareBitmap(Bitmap: TBitmap);
    … …  
    16911698                  Size := Size * 10 + Byte(S[I]) - 48;
    16921699                'B', 'b':
    1693                   UniFont[section].Style := UniFont[section].Style + [fsBold];
     1700                  UniFont[section].Style := UniFont[section].Style + [TFontStyle.fsBold];
    16941701                'I', 'i':
    1695                   UniFont[section].Style := UniFont[section].Style + [fsItalic];
     1702                  UniFont[section].Style := UniFont[section].Style + [TFontStyle.fsItalic];
    16961703              end;
    1697             UniFont[section].Size := Round(Size * 72 / UniFont[section].PixelsPerInch);
     1704            UniFont[section].Size := Round(Size * ScaleToNative(72) / UniFont[section].PixelsPerInch);
    16981705          end;
    16991706        end;
    … …  
    17831790
    17841791  Colors := TBitmap.Create;
    1785   Colors.PixelFormat := pf24bit;
     1792  Colors.PixelFormat := TPixelFormat.pf24bit;
    17861793  Paper := TBitmap.Create;
    1787   Paper.PixelFormat := pf24bit;
     1794  Paper.PixelFormat := TPixelFormat.pf24bit;
    17881795  BigImp := TBitmap.Create;
    1789   BigImp.PixelFormat := pf24bit;
     1796  BigImp.PixelFormat := TPixelFormat.pf24bit;
    17901797  MainTexture := TTexture.Create;
    17911798  ClickFrameColor := HGrSystem.Data.Canvas.Pixels[187, 175];
    … …  
    17961803
    17971804  LogoBuffer := TBitmap.Create;
    1798   LogoBuffer.PixelFormat := pf24bit;
     1805  LogoBuffer.PixelFormat := TPixelFormat.pf24bit;
    17991806  LogoBuffer.SetSize(BigBook.Width, BigBook.Height);
    18001807end;

  • trunk/Packages/CevoComponents/Texture.pas

    r456 r468  
    44
    55uses
    6   Classes, SysUtils, Graphics;
     6  {$IFDEF DPI}Dpi.Graphics,{$ELSE}Graphics,{$ENDIF}
     7  Classes, SysUtils;
    78
    89type
Note: See TracChangeset for help on using the changeset viewer.