Ignore:
Timestamp:
Jun 23, 2019, 3:15:29 PM (5 years ago)
Author:
chronos
Message:
  • Modified: Use DpiControls package for High DPI support.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/Packages/CevoComponents/ScreenTools.pas

    r173 r178  
    88  {$ENDIF}
    99  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls,
    10   Forms, Menus, GraphType;
     10  Forms, Menus, GraphType, UDpiControls;
    1111
    1212type
    1313  TTexture = record
    14     Image: TBitmap;
     14    Image: TDpiBitmap;
    1515    clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
    1616    clPage, clCover: TColor;
    1717  end;
     18
     19  TColor32 = type cardinal;
     20  TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
     21  TPixel32 = packed record
     22    case integer of
     23      0: (B, G, R, A: byte);
     24      1: (ARGB: TColor32);
     25      2: (Planes: array[0..3] of byte);
     26      3: (Components: array[TColor32Component] of byte);
     27  end;
     28  PPixel32 = ^TPixel32;
     29
     30  { TPixelPointer }
     31
     32  TPixelPointer = record
     33    Base: PPixel32;
     34    Pixel: PPixel32;
     35    Line: PPixel32;
     36    RelLine: PPixel32;
     37    BytesPerPixel: integer;
     38    BytesPerLine: integer;
     39    procedure NextLine; inline; // Move pointer to start of new base line
     40    procedure NextPixel; inline; // Move pointer to next pixel
     41    procedure SetXY(X, Y: integer); inline; // Set pixel position relative to base
     42    procedure SetX(X: integer); inline; // Set horizontal pixel position relative to base
     43    procedure Init(Bitmap: TDpiRasterImage; BaseX: integer = 0; BaseY: integer = 0); inline;
     44  end;
     45  PPixelPointer = ^TPixelPointer;
    1846
    1947{$IFDEF WINDOWS}
    … …  
    2149{$ENDIF}
    2250procedure RestoreResolution;
     51function Play(Item: string; Index: integer = -1): boolean;
     52procedure PreparePlay(Item: string; Index: integer = -1);
    2353procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
    2454function TurnToYear(Turn: integer): integer;
    2555function TurnToString(Turn: integer): string;
    2656function MovementToString(Movement: integer): string;
    27 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
    28 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     57procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
     58procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    2959function HexStringToColor(S: string): integer;
    30 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer = 0): boolean;
     60function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: integer = 0): boolean;
    3161function LoadGraphicSet(const Name: string): integer;
    32 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    33 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     62procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     63procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    3464  overload;
    35 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     65procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    3666  overload;
    37 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
    38 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
    39 procedure ImageOp_BCC(dst, Src: TBitmap;
     67procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
     68procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     69procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    4070  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    41 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: integer);
    42 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
    43   SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    44 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
    45 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    46 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    47 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    48 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    49 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     71procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: integer);
     72function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
     73  SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
     74procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);
     75procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     76procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     77procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     78procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     79procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap;
    5080  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    51 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
     81procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);
    5282procedure InitOrnament;
    5383procedure InitCityMark(const T: TTexture);
    54 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
    55 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
    56 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
    57   const Texture: TBitmap);
    58 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
    59   const Texture: TBitmap);
    60 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
    61 procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
    62 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    63 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     84procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
     85procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: integer);
     86procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
     87  const Texture: TDpiBitmap);
     88procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
     89  const Texture: TDpiBitmap);
     90procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);
     91procedure Corner(ca: TDpiCanvas; x, y, Kind: integer; const T: TTexture);
     92procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string);
     93procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture;
    6494  x, y: integer; s: string);
    65 function BiColorTextWidth(ca: TCanvas; s: string): integer;
    66 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
    67 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
    68 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
    69 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
    70 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
    71 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
     95function BiColorTextWidth(ca: TDpiCanvas; s: string): integer;
     96procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string);
     97procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: integer);
     98procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: integer);
     99procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: integer);
     100procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: integer);
     101procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string; val: integer;
    72102  const T: TTexture);
    73 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
     103procedure CountBar(dst: TDpiBitmap; x, y, w: integer; Kind: integer;
    74104  Cap: string; val: integer; const T: TTexture);
    75 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
     105procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: integer;
    76106  const T: TTexture);
    77 procedure PaintRelativeProgressBar(ca: TCanvas;
     107procedure PaintRelativeProgressBar(ca: TDpiCanvas;
    78108  Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
    79109  const T: TTexture);
    80 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
     110procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: integer);
    81111function SetMainTextureByAge(Age: integer): boolean;
    82112procedure LoadPhrases;
    … …  
    118148  wOrna = 27;
    119149  hOrna = 26; // ornament
     150
     151  // sound modes
     152  smOff = 0;
     153  smOn = 1;
     154  smOnAlt = 2;
    120155
    121156  // color matrix
    … …  
    153188  TGrExtDescr = record { don't use dynamic strings here! }
    154189    Name: string[31];
    155     Data, Mask: TBitmap;
     190    Data, Mask: TDpiBitmap;
    156191    pixUsed: array [byte] of byte;
    157192  end;
    … …  
    166201
    167202var
    168   Phrases: TStringTable;
    169   Phrases2: TStringTable;
    170   nGrExt: Integer;
     203  Phrases, Phrases2, Sounds: TStringTable;
     204  nGrExt: integer;
    171205  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
    172   HGrSystem, HGrSystem2, ClickFrameColor, MainTextureAge: Integer;
     206  HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
    173207  MainTexture: TTexture;
    174   Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap;
    175   FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: Boolean;
    176 
    177   UniFont: array [TFontType] of TFont;
     208  Templates, Colors, Paper, BigImp, LogoBuffer: TDpiBitmap;
     209  FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean;
     210
     211  UniFont: array [TFontType] of TDpiFont;
    178212  AppRegistryKey: string = '\SOFTWARE\C-evo';
    179213
    … …  
    184218
    185219uses
    186   Directories, Sound, Registry, PixelPointer;
     220  Directories, Sound, Registry;
    187221
    188222var
    … …  
    221255  ResolutionChanged := False;
    222256  {$ENDIF}
     257end;
     258
     259function Play(Item: string; Index: integer = -1): boolean;
     260{$IFNDEF DEBUG}
     261var
     262  WavFileName: string;
     263{$ENDIF}
     264begin
     265  Result := False;
     266{$IFNDEF DEBUG}
     267  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     268  begin
     269    Result := True;
     270    Exit;
     271  end;
     272  WavFileName := Sounds.Lookup(Item, Index);
     273  Assert(WavFileName[1] <> '[');
     274  Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
     275  if Result then
     276    // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)
     277    PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
     278{$ENDIF}
     279end;
     280
     281procedure PreparePlay(Item: string; Index: Integer = -1);
     282{$IFNDEF DEBUG}
     283var
     284  WavFileName: string;
     285{$ENDIF}
     286begin
     287{$IFNDEF DEBUG}
     288  if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
     289    Exit;
     290  WavFileName := Sounds.Lookup(Item, Index);
     291  Assert(WavFileName[1] <> '[');
     292  if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
     293    PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
     294{$ENDIF}
    223295end;
    224296
    … …  
    284356end;
    285357
    286 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
     358procedure BtnFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    287359begin
    288360  RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade,
    … …  
    290362end;
    291363
    292 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
     364procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
    293365begin
    294366  Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);
    … …  
    331403end;
    332404
    333 procedure ApplyGammaToBitmap(Bitmap: TBitmap);
     405procedure ApplyGammaToBitmap(Bitmap: TDpiBitmap);
    334406var
    335407  PixelPtr: TPixelPointer;
    … …  
    348420end;
    349421
    350 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TRasterImage);
     422procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiBitmap);
    351423var
    352424  SrcPtr, DstPtr: TPixelPointer;
    … …  
    369441end;
    370442
    371 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: Integer): Boolean;
    372 var
    373   jtex: TJpegImage;
    374   Png: TPortableNetworkGraphic;
     443function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean;
     444var
     445  jtex: TDpiJpegImage;
     446  Png: TDpiPortableNetworkGraphic;
    375447begin
    376448  Result := True;
    … …  
    378450    Path := Path + '.png';
    379451  if ExtractFileExt(Path) = '.jpg' then begin
    380     jtex := tjpegimage.Create;
     452    jtex := TDpiJpegImage.Create;
    381453    try
    382454      jtex.LoadFromFile(Path);
    … …  
    395467  else
    396468  if ExtractFileExt(Path) = '.png' then begin
    397     Png := TPortableNetworkGraphic.Create;
     469    Png := TDpiPortableNetworkGraphic.Create;
    398470    Png.PixelFormat := Bmp.PixelFormat;
    399471    try
    … …  
    414486      end
    415487      else
    416         Bmp.Canvas.draw(0, 0, Png);
     488        Bmp.Canvas.Draw(0, 0, Png);
    417489    end;
    418490    Png.Free;
    … …  
    446518  I, x, y, xmax, OriginalColor: Integer;
    447519  FileName: string;
    448   Source: TBitmap;
     520  Source: TDpiBitmap;
    449521  DataPixel, MaskPixel: TPixelPointer;
    450522begin
    … …  
    454526  Result := I;
    455527  if I = nGrExt then begin
    456     Source := TBitmap.Create;
     528    Source := TDpiBitmap.Create;
    457529    Source.PixelFormat := pf24bit;
    458530    FileName := HomeDir + 'Graphics' + DirectorySeparator + Name;
    … …  
    471543    GrExt[nGrExt].Data := Source;
    472544    GrExt[nGrExt].Data.PixelFormat := pf24bit;
    473     GrExt[nGrExt].Mask := TBitmap.Create;
     545    GrExt[nGrExt].Mask := TDpiBitmap.Create;
    474546    GrExt[nGrExt].Mask.PixelFormat := pf24bit;
    475547    GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height);
    … …  
    506578end;
    507579
    508 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     580procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    509581begin
    510582  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    512584end;
    513585
    514 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer);
     586procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
    515587var
    516588  XX, YY: integer;
    … …  
    531603end;
    532604
    533 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
     605procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
    534606// Src is template
    535607// X channel = background amp (old Dst content), 128=original brightness
    … …  
    591663end;
    592664
    593 procedure ImageOp_BCC(dst, Src: TBitmap;
     665procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    594666  xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    595667// Src is template
    … …  
    657729end;
    658730
    659 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     731procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
    660732// Bmp is template
    661733// B channel = Color0 amp, 128=original brightness
    … …  
    690762end;
    691763
    692 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     764procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    693765begin
    694766  BitBlt(Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    698770end;
    699771
    700 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     772procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    701773begin
    702774  BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    … …  
    706778end;
    707779
    708 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: integer;
    709   SrcCanvas: TCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
     780function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
     781  SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    710782begin
    711783  Assert(Rop = SRCCOPY);
    … …  
    715787end;
    716788
    717 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
     789procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);
    718790begin
    719791  with ca do begin
    … …  
    724796end;
    725797
    726 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
     798procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    727799begin
    728800  with ca do begin
    … …  
    738810end;
    739811
    740 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     812procedure Frame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    741813begin
    742814  with ca do begin
    … …  
    751823end;
    752824
    753 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
     825procedure RFrame(ca: TDpiCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
    754826begin
    755827  with ca do begin
    … …  
    767839end;
    768840
    769 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
     841procedure CFrame(ca: TDpiCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
    770842begin
    771843  with ca do begin
    … …  
    786858end;
    787859
    788 procedure FrameImage(ca: TCanvas; Src: TBitmap;
     860procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap;
    789861  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    790862begin
    … …  
    798870end;
    799871
    800 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
     872procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor);
    801873var
    802874  x, y, ch, r: Integer;
    … …  
    879951end;
    880952
    881 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
     953procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
    882954begin
    883955  Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
    … …  
    887959end;
    888960
    889 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
     961procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: Integer);
    890962
    891963  function Band(I: Integer): Integer;
    … …  
    922994end;
    923995
    924 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
    925   const Texture: TBitmap);
     996procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
     997  const Texture: TDpiBitmap);
    926998var
    927999  x, y, x0cut, y0cut, x1cut, y1cut: Integer;
    … …  
    9571029end;
    9581030
    959 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    960   const Texture: TBitmap);
     1031procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
     1032  const Texture: TDpiBitmap);
    9611033begin
    9621034  FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
    9631035end;
    9641036
    965 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
     1037procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);
    9661038begin
    9671039  Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div
    … …  
    9691041end;
    9701042
    971 procedure Corner(ca: TCanvas; x, y, Kind: Integer; const T: TTexture);
     1043procedure Corner(ca: TDpiCanvas; x, y, Kind: Integer; const T: TTexture);
    9721044begin
    9731045  { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
    … …  
    9771049end;
    9781050
    979 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
     1051procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
    9801052
    9811053  procedure PaintIcon(x, y, Kind: Integer);
    … …  
    10381110end;
    10391111
    1040 function BiColorTextWidth(ca: TCanvas; s: string): Integer;
     1112function BiColorTextWidth(ca: TDpiCanvas; s: string): Integer;
    10411113var
    10421114  P: Integer;
    … …  
    10621134end;
    10631135
    1064 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
     1136procedure LoweredTextOut(ca: TDpiCanvas; cl: TColor; const T: TTexture;
    10651137  x, y: Integer; s: string);
    10661138begin
    … …  
    10741146end;
    10751147
    1076 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
     1148procedure RisedTextOut(ca: TDpiCanvas; x, y: integer; s: string);
    10771149begin
    10781150  BiColorTextOut(ca, $FFFFFF, $000000, x, y, s);
    10791151end;
    10801152
    1081 procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: Integer;
     1153procedure Gradient(ca: TDpiCanvas; x, y, dx, dy, Width, Height, Color: Integer;
    10821154  Brightness: array of integer);
    10831155var
    … …  
    11131185end;
    11141186
    1115 procedure LightGradient(ca: TCanvas; x, y, Width, Color: Integer);
     1187procedure LightGradient(ca: TDpiCanvas; x, y, Width, Color: Integer);
    11161188const
    11171189  Brightness: array [0 .. 15] of integer =
    … …  
    11211193end;
    11221194
    1123 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: Integer);
     1195procedure DarkGradient(ca: TDpiCanvas; x, y, Width, Kind: Integer);
    11241196const
    11251197  Brightness: array [0 .. 15] of integer =
    … …  
    11301202end;
    11311203
    1132 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: Integer);
     1204procedure VLightGradient(ca: TDpiCanvas; x, y, Height, Color: Integer);
    11331205const
    11341206  Brightness: array [0 .. 15] of integer =
    … …  
    11381210end;
    11391211
    1140 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: Integer);
     1212procedure VDarkGradient(ca: TDpiCanvas; x, y, Height, Kind: Integer);
    11411213const
    11421214  Brightness: array [0 .. 15] of integer =
    … …  
    11471219end;
    11481220
    1149 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;
     1221procedure NumberBar(dst: TDpiBitmap; x, y: integer; Cap: string;
    11501222  val: Integer; const T: TTexture);
    11511223var
    … …  
    11631235end;
    11641236
    1165 procedure CountBar(dst: TBitmap; x, y, w: Integer; Kind: Integer;
     1237procedure CountBar(dst: TDpiBitmap; x, y, w: Integer; Kind: Integer;
    11661238  Cap: string; val: Integer; const T: TTexture);
    11671239var
    … …  
    12591331end;
    12601332
    1261 procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: Integer;
     1333procedure PaintProgressBar(ca: TDpiCanvas; Kind, x, y, pos, Growth, max: Integer;
    12621334  const T: TTexture);
    12631335var
    … …  
    13121384
    13131385// pos and growth are relative to max, set size independent
    1314 procedure PaintRelativeProgressBar(ca: TCanvas;
     1386procedure PaintRelativeProgressBar(ca: TDpiCanvas;
    13151387  Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;
    13161388  const T: TTexture);
    … …  
    13261398end;
    13271399
    1328 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: Integer);
     1400procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: Integer);
    13291401begin
    13301402  BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
    … …  
    13571429end;
    13581430
     1431{ TPixelPointer }
     1432
     1433procedure TPixelPointer.NextLine; inline;
     1434begin
     1435  Line := Pointer(Line) + BytesPerLine;
     1436  Pixel := Line;
     1437end;
     1438
     1439procedure TPixelPointer.NextPixel; inline;
     1440begin
     1441  Pixel := Pointer(Pixel) + BytesPerPixel;
     1442end;
     1443
     1444procedure TPixelPointer.SetXY(X, Y: Integer); inline;
     1445begin
     1446  Line := Pointer(Base) + Y * BytesPerLine;
     1447  SetX(X);
     1448end;
     1449
     1450procedure TPixelPointer.SetX(X: Integer); inline;
     1451begin
     1452  Pixel := Pointer(Line) + X * BytesPerPixel;
     1453end;
     1454
     1455procedure TPixelPointer.Init(Bitmap: TDpiRasterImage; BaseX: Integer = 0;
     1456  BaseY: integer = 0); inline;
     1457begin
     1458  BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
     1459  BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
     1460  Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine);
     1461  SetXY(0, 0);
     1462end;
     1463
    13591464procedure LoadPhrases;
    13601465begin
    1361   if Phrases = nil then Phrases := TStringTable.Create;
    1362   if Phrases2 = nil then Phrases2 := TStringTable.Create;
     1466  if Phrases = nil then
     1467    Phrases := TStringTable.Create;
     1468  if Phrases2 = nil then
     1469    Phrases2 := TStringTable.Create;
    13631470  Phrases2FallenBackToEnglish := False;
    13641471  if FileExists(LocalizedFilePath('Language.txt')) then
    13651472  begin
    1366     Phrases.LoadFromFile(LocalizedFilePath('Language.txt'));
     1473    Phrases.loadfromfile(LocalizedFilePath('Language.txt'));
    13671474    if FileExists(LocalizedFilePath('Language2.txt')) then
    1368       Phrases2.LoadFromFile(LocalizedFilePath('Language2.txt'))
     1475      Phrases2.loadfromfile(LocalizedFilePath('Language2.txt'))
    13691476    else
    13701477    begin
    1371       Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
     1478      Phrases2.loadfromfile(HomeDir + 'Language2.txt');
    13721479      Phrases2FallenBackToEnglish := True;
    13731480    end;
    … …  
    13751482  else
    13761483  begin
    1377     Phrases.LoadFromFile(HomeDir + 'Language.txt');
    1378     Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
    1379   end;
    1380 
    1381   if Sounds = nil then Sounds := TStringTable.Create;
    1382   if not Sounds.LoadFromFile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
     1484    Phrases.loadfromfile(HomeDir + 'Language.txt');
     1485    Phrases2.loadfromfile(HomeDir + 'Language2.txt');
     1486  end;
     1487
     1488  if Sounds = nil then
     1489    Sounds := TStringTable.Create;
     1490  if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
    13831491  begin
    13841492    FreeAndNil(Sounds);
    … …  
    13961504begin
    13971505  for Section := Low(TFontType) to High(TFontType) do
    1398     UniFont[Section] := TFont.Create;
     1506    UniFont[Section] := TDpiFont.Create;
    13991507
    14001508  Section := ftNormal;
    … …  
    14071515        if s[1] = '#' then begin
    14081516          s := TrimRight(s);
    1409           if s = '#SMALL' then Section := ftSmall
    1410           else if s = '#TINY' then Section := ftTiny
    1411           else if s = '#CAPTION' then Section := ftCaption
    1412           else if s = '#BUTTON' then Section := ftButton
    1413           else Section := ftNormal;
     1517          if s = '#SMALL' then
     1518            Section := ftSmall
     1519          else if s = '#TINY' then
     1520            Section := ftTiny
     1521          else if s = '#CAPTION' then
     1522            Section := ftCaption
     1523          else if s = '#BUTTON' then
     1524            Section := ftButton
     1525          else
     1526            Section := ftNormal;
    14141527        end else begin
    14151528          p := Pos(',', s);
    14161529          if p > 0 then begin
    1417             UniFont[section].Name := Trim(Copy(s, 1, p - 1));
     1530            UniFont[Section].Name := Trim(Copy(s, 1, p - 1));
    14181531            Size := 0;
    14191532            for i := p + 1 to Length(s) do
    … …  
    14281541            // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
    14291542            UniFont[section].Size :=
    1430               Round(size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
     1543              Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
    14311544          end;
    14321545        end;
    … …  
    14901603  LoadPhrases;
    14911604
    1492   LogoBuffer := TBitmap.Create;
     1605  LogoBuffer := TDpiBitmap.Create;
    14931606  LogoBuffer.PixelFormat := pf24bit;
    14941607  LogoBuffer.SetSize(wBBook, hBBook);
    … …  
    14991612  HGrSystem := LoadGraphicSet('System.png');
    15001613  HGrSystem2 := LoadGraphicSet('System2.png');
    1501   Templates := TBitmap.Create;
     1614  Templates := TDpiBitmap.Create;
    15021615  Templates.PixelFormat := pf24bit;
    15031616  LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator +
    15041617    'Templates.png', gfNoGamma);
    1505   Colors := TBitmap.Create;
     1618  Colors := TDpiBitmap.Create;
    15061619  Colors.PixelFormat := pf24bit;
    15071620  LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors.png');
    1508   Paper := TBitmap.Create;
     1621  Paper := TDpiBitmap.Create;
    15091622  Paper.PixelFormat := pf24bit;
    15101623  LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper.jpg');
    1511   BigImp := TBitmap.Create;
     1624  BigImp := TDpiBitmap.Create;
    15121625  BigImp.PixelFormat := pf24bit;
    15131626  LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons.png');
    1514   MainTexture.Image := TBitmap.Create;
     1627  MainTexture.Image := TDpiBitmap.Create;
    15151628  MainTextureAge := -2;
    15161629  ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];
    … …  
    15301643      WriteString('Locale', LocaleCode);
    15311644      WriteInteger('Gamma', Gamma);
    1532       if FullScreen then WriteInteger('ScreenMode', 1)
    1533         else WriteInteger('ScreenMode', 0);
    15341645    finally
    15351646      Free;
    … …  
    15471658  FreeAndNil(Phrases);
    15481659  FreeAndNil(Phrases2);
     1660  if Sounds <> nil then
     1661    FreeAndNil(Sounds);
    15491662  FreeAndNil(LogoBuffer);
    15501663  FreeAndNil(BigImp);
Note: See TracChangeset for help on using the changeset viewer.