Ignore:
Timestamp:
May 9, 2020, 4:02:07 PM (5 years ago)
Author:
chronos
Message:
  • Modified: Improved HighDPI branch. Imported new changes from trunk branch.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r193 r210  
    44
    55uses
    6   {$IFDEF WINDOWS}
     6  UDpiControls, {$IFDEF WINDOWS}
    77  Windows,
    88  {$ENDIF}
    9   StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls,
    10   Forms, Menus, GraphType, UDpiControls;
     9  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
     10  Forms, Menus, GraphType;
    1111
    1212type
    … …  
    1717  end;
    1818
    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;
    46 
    4719{$IFDEF WINDOWS}
    4820function ChangeResolution(x, y, bpp, freq: integer): boolean;
    4921{$ENDIF}
    5022procedure RestoreResolution;
    51 function Play(Item: string; Index: integer = -1): boolean;
    52 procedure PreparePlay(Item: string; Index: integer = -1);
    5323procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
    5424function TurnToYear(Turn: integer): integer;
    … …  
    6535procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    6636  overload;
    67 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
    68 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: integer);
     37procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer);
     38procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
    6939procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    70   xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
    71 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: integer);
    72 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
    73   SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
     40  xDst, yDst, xSrc, ySrc, Width, Height, Color1, Color2: Integer);
     41procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
     42  Color0, Color2: Integer);
     43procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     44function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer;
     45  SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
     46function DpiBitCanvas(Dest: TDpiCanvas; DestRect: TRect;
     47  Src: TDpiCanvas; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
     48function BitBltBitmap(Dest: TDpiBitmap; X, Y, Width, Height: Integer;
     49  Src: TDpiBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
     50function BitBltBitmap(Dest: TDpiBitmap; DestRect: TRect;
     51  Src: TDpiBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
    7452procedure SLine(ca: TDpiCanvas; x0, x1, y: integer; cl: TColor);
    7553procedure DLine(ca: TDpiCanvas; x0, x1, y: integer; cl0, cl1: TColor);
    … …  
    8260procedure InitOrnament;
    8361procedure InitCityMark(const T: TTexture);
    84 procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer);
     62procedure Fill(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload;
     63procedure Fill(Canvas: TDpiCanvas; Rect: TRect; Offset: TPoint); overload;
    8564procedure FillLarge(ca: TDpiCanvas; x0, y0, x1, y1, xm: integer);
    8665procedure FillSeamless(ca: TDpiCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
    … …  
    8867procedure FillRectSeamless(ca: TDpiCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
    8968  const Texture: TDpiBitmap);
    90 procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: Integer);
     69procedure PaintBackground(Form: TDpiForm; Left, Top, Width, Height: integer);
    9170procedure Corner(ca: TDpiCanvas; x, y, Kind: integer; const T: TTexture);
    9271procedure BiColorTextOut(ca: TDpiCanvas; clMain, clBack: TColor; x, y: integer; s: string);
    … …  
    11190function SetMainTextureByAge(Age: integer): boolean;
    11291procedure LoadPhrases;
     92procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);
     93procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer);
    11394
    11495const
    … …  
    148129  wOrna = 27;
    149130  hOrna = 26; // ornament
    150 
    151   // sound modes
    152   smOff = 0;
    153   smOn = 1;
    154   smOnAlt = 2;
    155131
    156132  // color matrix
    … …  
    188164  TGrExtDescr = record { don't use dynamic strings here! }
    189165    Name: string[31];
    190     Data, Mask: TDpiBitmap;
    191     pixUsed: array [byte] of byte;
     166    Data: TDpiBitmap;
     167    Mask: TDpiBitmap;
     168    pixUsed: array [Byte] of Byte;
    192169  end;
    193170
    … …  
    195172      TGrExtDescr, but without pixUsed }
    196173    Name: string[31];
    197     Data, Mask: TBitmap;
     174    Data: TDpiBitmap;
     175    Mask: TDpiBitmap;
    198176  end;
    199177
    … …  
    201179
    202180var
    203   Phrases, Phrases2, Sounds: TStringTable;
    204   nGrExt: integer;
     181  Phrases: TStringTable;
     182  Phrases2: TStringTable;
     183  nGrExt: Integer;
    205184  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
    206   HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer;
     185  HGrSystem: Integer;
     186  HGrSystem2: Integer;
     187  ClickFrameColor: Integer;
     188  MainTextureAge: Integer;
    207189  MainTexture: TTexture;
    208   Templates, Colors, Paper, BigImp, LogoBuffer: TDpiBitmap;
    209   FullScreen, GenerateNames, InitOrnamentDone, Phrases2FallenBackToEnglish: boolean;
     190  Templates: TDpiBitmap;
     191  Colors: TDpiBitmap;
     192  Paper: TDpiBitmap;
     193  BigImp: TDpiBitmap;
     194  LogoBuffer: TDpiBitmap;
     195  FullScreen: Boolean;
     196  GenerateNames: Boolean;
     197  InitOrnamentDone: Boolean;
     198  Phrases2FallenBackToEnglish: Boolean;
    210199
    211200  UniFont: array [TFontType] of TDpiFont;
    212   AppRegistryKey: string = '\SOFTWARE\C-evo';
    213 
     201  Gamma: Integer; // global gamma correction (cent)
     202
     203procedure LoadAssets;
    214204procedure UnitInit;
    215205procedure UnitDone;
     206procedure InitGammaLookupTable;
     207
    216208
    217209implementation
    218210
    219211uses
    220   Directories, Sound, Registry;
     212  Directories, Sound, UPixelPointer;
    221213
    222214var
    … …  
    226218  {$ENDIF}
    227219
    228   Gamma: Integer; // global gamma correction (cent)
    229   GammaLookupTable: array [0 .. 255] of Byte;
     220  GammaLookupTable: array [0..255] of Byte;
    230221
    231222{$IFDEF WINDOWS}
    … …  
    255246  ResolutionChanged := False;
    256247  {$ENDIF}
    257 end;
    258 
    259 function Play(Item: string; Index: integer = -1): boolean;
    260 {$IFNDEF DEBUG}
    261 var
    262   WavFileName: string;
    263 {$ENDIF}
    264 begin
    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}
    279 end;
    280 
    281 procedure PreparePlay(Item: string; Index: Integer = -1);
    282 {$IFNDEF DEBUG}
    283 var
    284   WavFileName: string;
    285 {$ENDIF}
    286 begin
    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}
    295248end;
    296249
    … …  
    409362begin
    410363  Bitmap.BeginUpdate;
    411   PixelPtr.Init(Bitmap);
     364  PixelPtr := PixelPointer(Bitmap);
    412365  for Y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
    413366    for X := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
    … …  
    420373end;
    421374
    422 procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiBitmap);
     375procedure CopyGray8BitTo24bitBitmap(Dst, Src: TDpiRasterImage);
    423376var
    424377  SrcPtr, DstPtr: TPixelPointer;
    … …  
    426379begin
    427380  //Dst.SetSize(Src.Width, Src.Height);
    428   SrcPtr.Init(Src);
    429   DstPtr.Init(Dst);
     381  SrcPtr := PixelPointer(Src);
     382  DstPtr := PixelPointer(Dst);
    430383  for Y := 0 to ScaleToVcl(Src.Height) - 1 do begin
    431384    for X := 0 to ScaleToVcl(Src.Width) - 1 do begin
    … …  
    441394end;
    442395
    443 procedure ResizeBitmap(Bitmap: TDpiBitmap; const NewWidth, NewHeight: Integer);
    444 var
    445   Buffer: TDpiBitmap;
    446 begin
    447   Buffer := TDpiBitmap.Create;
    448   try
    449     Buffer.SetSize(NewWidth, NewHeight);
    450     Buffer.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), Bitmap);
    451     Bitmap.SetSize(NewWidth, NewHeight);
    452     Bitmap.Canvas.Draw(0, 0, Buffer);
    453   finally
    454     Buffer.Free;
    455   end;
    456 end;
    457 
    458396function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean;
    459397var
    … …  
    465403    Path := Path + '.png';
    466404  if ExtractFileExt(Path) = '.jpg' then begin
    467     jtex := TDpiJpegImage.Create;
     405    jtex := tDpijpegimage.Create;
    468406    try
    469407      jtex.LoadFromFile(Path);
    470       ResizeBitmap(jtex, ScaleToVcl(jtex.Width), ScaleToVcl(jtex.Height));
    471408    except
    472409      Result := False;
    … …  
    487424    try
    488425      Png.LoadFromFile(Path);
    489       ResizeBitmap(Png, ScaleToVcl(Png.Width), ScaleToVcl(Png.Height));
    490426    except
    491427      Result := False;
    … …  
    503439      end
    504440      else
    505         Bmp.Canvas.Draw(0, 0, Png);
     441        Bmp.Canvas.draw(0, 0, Png);
    506442    end;
    507443    Png.Free;
    … …  
    511447    try
    512448      bmp.LoadFromFile(Path);
    513       ResizeBitmap(bmp, ScaleToVcl(bmp.Width), ScaleToVcl(bmp.Height));
    514449    except
    515450      Result := False;
    … …  
    546481    Source := TDpiBitmap.Create;
    547482    Source.PixelFormat := pf24bit;
    548     FileName := HomeDir + 'Graphics' + DirectorySeparator + Name;
     483    FileName := GetGraphicsDir + DirectorySeparator + Name;
    549484    if not LoadGraphicFile(Source, FileName) then begin
    550485      Result := -1;
    … …  
    556491
    557492    xmax := Source.Width - 1; // allows 4-byte access even for last pixel
    558     if xmax > 970 then
    559       xmax := 970;
     493    // Why there was that limit?
     494    //if xmax > 970 then
     495    //  xmax := 970;
    560496
    561497    GrExt[nGrExt].Data := Source;
    … …  
    567503    GrExt[nGrExt].Data.BeginUpdate;
    568504    GrExt[nGrExt].Mask.BeginUpdate;
    569     DataPixel.Init(GrExt[nGrExt].Data);
    570     MaskPixel.Init(GrExt[nGrExt].Mask);
     505    DataPixel := PixelPointer(GrExt[nGrExt].Data);
     506    MaskPixel := PixelPointer(GrExt[nGrExt].Mask);
    571507    for y := 0 to ScaleToVcl(Source.Height) - 1 do begin
    572508      for x := 0 to ScaleToVcl(xmax) - 1 do begin
    … …  
    598534procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    599535begin
    600   DpiBitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    601     GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCCOPY);
    602 end;
    603 
    604 procedure MakeBlue(dst: TDpiBitmap; x, y, w, h: integer);
     536  DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height,
     537    GrExt[HGr].Data.Canvas, xGr, yGr);
     538end;
     539
     540procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer);
    605541var
    606542  XX, YY: integer;
    … …  
    609545  X := ScaleToVcl(X);
    610546  Y := ScaleToVcl(Y);
    611   W := ScaleToVcl(W);
    612   H := ScaleToVcl(H);
     547  Width := ScaleToVcl(Width);
     548  Height := ScaleToVcl(Height);
    613549  Dst.BeginUpdate;
    614   PixelPtr.Init(Dst, X, Y);
    615   for yy := 0 to h - 1 do begin
    616     for xx := 0 to w - 1 do begin
     550  PixelPtr := PixelPointer(Dst, X, Y);
     551  for yy := 0 to Height - 1 do begin
     552    for xx := 0 to Width - 1 do begin
    617553      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    618554      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
    … …  
    625561end;
    626562
    627 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, w, h: Integer);
     563procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
    628564// Src is template
    629565// X channel = background amp (old Dst content), 128=original brightness
    … …  
    638574  xSrc := ScaleToVcl(xSrc);
    639575  ySrc := ScaleToVcl(ySrc);
    640   w := ScaleToVcl(w);
    641   h := ScaleToVcl(h);
     576  Width := ScaleToVcl(Width);
     577  Height := ScaleToVcl(Height);
    642578  //Assert(Src.PixelFormat = pf8bit);
    643579  Assert(dst.PixelFormat = pf24bit);
    644580  if xDst < 0 then begin
    645     w := w + xDst;
     581    Width := Width + xDst;
    646582    xSrc := xSrc - xDst;
    647583    xDst := 0;
    648584  end;
    649585  if yDst < 0 then begin
    650     h := h + yDst;
     586    Height := Height + yDst;
    651587    ySrc := ySrc - yDst;
    652588    yDst := 0;
    653589  end;
    654   if xDst + w > ScaleToVcl(dst.Width) then
    655     w := ScaleToVcl(dst.Width) - xDst;
    656   if yDst + h > ScaleToVcl(dst.Height) then
    657     h := ScaleToVcl(dst.Height) - yDst;
    658   if (w < 0) or (h < 0) then
     590  if xDst + Width > ScaleToVcl(dst.Width) then
     591    Width := ScaleToVcl(dst.Width) - xDst;
     592  if yDst + Height > ScaleToVcl(dst.Height) then
     593    Height := ScaleToVcl(dst.Height) - yDst;
     594  if (Width < 0) or (Height < 0) then
    659595    exit;
    660596
    661597  dst.BeginUpdate;
    662598  Src.BeginUpdate;
    663   PixelDst.Init(Dst, xDst, yDst);
    664   PixelSrc.Init(Src, xSrc, ySrc);
    665   for Y := 0 to h - 1 do begin
    666     for X := 0 to w - 1 do  begin
     599  PixelDst := PixelPointer(Dst, xDst, yDst);
     600  PixelSrc := PixelPointer(Src, xSrc, ySrc);
     601  for Y := 0 to Height - 1 do begin
     602    for X := 0 to Width - 1 do  begin
    667603      Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color
    668604      test := (PixelDst.Pixel^.R * Brightness) shr 7;
    … …  
    691627end;
    692628
    693 procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    694   xDst, yDst, xSrc, ySrc, w, h, Color1, Color2: integer);
     629procedure ImageOp_BCC(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
     630  Color1, Color2: Integer);
    695631// Src is template
    696632// B channel = background amp (old Dst content), 128=original brightness
    … …  
    698634// R channel = Color2 amp, 128=original brightness
    699635var
    700   ix, iy, amp1, amp2, trans, Value: integer;
    701   SrcPixel, DstPixel: TPixelPointer;
     636  ix, iy, amp1, amp2, trans, Value: Integer;
     637  SrcPixel: TPixelPointer;
     638  DstPixel: TPixelPointer;
    702639begin
    703640  xDst := ScaleToVcl(xDst);
    … …  
    705642  xSrc := ScaleToVcl(xSrc);
    706643  ySrc := ScaleToVcl(ySrc);
    707   w := ScaleToVcl(w);
    708   h := ScaleToVcl(h);
     644  Width := ScaleToVcl(Width);
     645  Height := ScaleToVcl(Height);
    709646  if xDst < 0 then begin
    710     w := w + xDst;
     647    Width := Width + xDst;
    711648    xSrc := xSrc - xDst;
    712649    xDst := 0;
    713650  end;
    714651  if yDst < 0 then begin
    715     h := h + yDst;
     652    Height := Height + yDst;
    716653    ySrc := ySrc - yDst;
    717654    yDst := 0;
    718655  end;
    719   if xDst + w > ScaleToVcl(dst.Width) then
    720     w := ScaleToVcl(dst.Width) - xDst;
    721   if yDst + h > ScaleToVcl(dst.Height) then
    722     h := ScaleToVcl(dst.Height) - yDst;
    723   if (w < 0) or (h < 0) then
     656  if xDst + Width > ScaleToVcl(dst.Width) then
     657    Width := ScaleToVcl(dst.Width) - xDst;
     658  if yDst + Height > ScaleToVcl(dst.Height) then
     659    Height := ScaleToVcl(dst.Height) - yDst;
     660  if (Width < 0) or (Height < 0) then
    724661    exit;
    725662
    726663  Src.BeginUpdate;
    727664  dst.BeginUpdate;
    728   SrcPixel.Init(Src, xSrc, ySrc);
    729   DstPixel.Init(Dst, xDst, yDst);
    730   for iy := 0 to h - 1 do begin
    731     for ix := 0 to w - 1 do begin
     665  SrcPixel := PixelPointer(Src, xSrc, ySrc);
     666  DstPixel := PixelPointer(Dst, xDst, yDst);
     667  for iy := 0 to Height - 1 do begin
     668    for ix := 0 to Width - 1 do begin
    732669      trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
    733670      amp1 := SrcPixel.Pixel^.G * 2;
    … …  
    736673        Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) *
    737674          amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF;
    738         if Value < 256 then
    739           DstPixel.Pixel^.B := Value
    740         else
    741           DstPixel.Pixel^.B := 255;
     675        DstPixel.Pixel^.B := Min(Value, 255);
     676
    742677        Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) *
    743678          amp2 + ((Color1 shr 8) and $FF) * amp1) div $FF;
    744         if Value < 256 then
    745           DstPixel.Pixel^.G := Value
    746         else
    747           DstPixel.Pixel^.G := 255;
     679        DstPixel.Pixel^.G := Min(Value, 255);
     680
    748681        Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) *
    749682          amp2 + (Color1 and $FF) * amp1) div $FF;
    750         if Value < 256 then
    751           DstPixel.Pixel^.R := Value
    752         else
    753           DstPixel.Pixel^.R := 255;
     683        DstPixel.Pixel^.R := Min(Value, 255);
     684      end;
     685
     686      SrcPixel.NextPixel;
     687      DstPixel.NextPixel;
     688    end;
     689    SrcPixel.NextLine;
     690    DstPixel.NextLine;
     691  end;
     692  Src.EndUpdate;
     693  dst.EndUpdate;
     694end;
     695
     696procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
     697  Color0, Color2: Integer);
     698// Src is template
     699// B channel = Color0 amp
     700// G channel = background amp (old Dst content), 128=original brightness
     701// R channel = Color2 amp
     702var
     703  ix, iy, amp0, amp1, trans, Value: integer;
     704  SrcPixel: TPixelPointer;
     705  DstPixel: TPixelPointer;
     706begin
     707  xDst := ScaleToVcl(xDst);
     708  yDst := ScaleToVcl(yDst);
     709  xSrc := ScaleToVcl(xSrc);
     710  ySrc := ScaleToVcl(ySrc);
     711  Width := ScaleToVcl(Width);
     712  Height := ScaleToVcl(Height);
     713  Src.BeginUpdate;
     714  Dst.BeginUpdate;
     715  SrcPixel := PixelPointer(Src, xSrc, ySrc);
     716  DstPixel := PixelPointer(Dst, xDst, yDst);
     717  for iy := 0 to Height - 1 do begin
     718    for ix := 0 to Width - 1 do begin
     719      trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
     720      amp0 := SrcPixel.Pixel^.G * 2;
     721      amp1 := SrcPixel.Pixel^.R * 2;
     722      if trans <> $FF then begin
     723        Value := (DstPixel.Pixel^.B * trans + (Color2 shr 16 and $FF) * amp1 +
     724          (Color0 shr 16 and $FF) * amp0) div $FF;
     725        DstPixel.Pixel^.B := Min(Value, 255);
     726
     727        Value := (DstPixel.Pixel^.G * trans + (Color2 shr 8 and $FF) * amp1 +
     728          (Color0 shr 8 and $FF) * amp0) div $FF;
     729        DstPixel.Pixel^.G := Min(Value, 255);
     730
     731        Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * amp1 +
     732          (Color0 and $FF) * amp0) div $FF;
     733        DstPixel.Pixel^.R := Min(Value, 255);
    754734      end;
    755735      SrcPixel.NextPixel;
    … …  
    760740  end;
    761741  Src.EndUpdate;
    762   dst.EndUpdate;
     742  Dst.EndUpdate;
    763743end;
    764744
    … …  
    779759  assert(bmp.PixelFormat = pf24bit);
    780760  h := y + h;
    781   PixelPtr.Init(Bmp, x, y);
     761  PixelPtr := PixelPointer(Bmp, x, y);
    782762  while y < h do begin
    783763    for i := 0 to w - 1 do begin
    … …  
    802782procedure Sprite(Canvas: TDpiCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    803783begin
    804   DpiBitBlt(Canvas.Handle, xDst, yDst, Width, Height,
    805     GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND);
    806   DpiBitBlt(Canvas.Handle, xDst, yDst, Width, Height,
    807     GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT);
     784  DpiBitCanvas(Canvas, xDst, yDst, Width, Height,
     785    GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
     786  DpiBitCanvas(Canvas, xDst, yDst, Width, Height,
     787    GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
    808788end;
    809789
    810790procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    811791begin
    812   DpiBitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    813     GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND);
    814   DpiBitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height,
    815     GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT);
    816 end;
    817 
    818 function BitBltCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: integer;
    819   SrcCanvas: TDpiCanvas; XSrc, YSrc: integer; Rop: DWORD): boolean;
    820 begin
    821   Assert(Rop = SRCCOPY);
    822   DestCanvas.CopyRect(Rect(X, Y, X + Width, Y + Height), SrcCanvas,
    823     Rect(XSrc, YSrc, XSrc + Width, YSrc + Height));
    824   Result := True;
     792  DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height,
     793    GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
     794  DpiBitCanvas(dst.Canvas, xDst, yDst, Width, Height,
     795    GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
     796end;
     797
     798function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer;
     799  SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
     800begin
     801  Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
     802end;
     803
     804function DpiBitCanvas(Dest: TDpiCanvas; DestRect: TRect; Src: TDpiCanvas;
     805  SrcPos: TPoint; Rop: DWORD): Boolean;
     806begin
     807  Result := DpiBitCanvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height,
     808    Src, SrcPos.X, SrcPos.Y, Rop);
     809end;
     810
     811function BitBltBitmap(Dest: TDpiBitmap; X, Y, Width, Height: Integer;
     812  Src: TDpiBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
     813begin
     814  Result := DpiBitCanvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop);
     815end;
     816
     817function BitBltBitmap(Dest: TDpiBitmap; DestRect: TRect; Src: TDpiBitmap;
     818  SrcPos: TPoint; Rop: DWORD): Boolean;
     819begin
     820  Result := DpiBitCanvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop);
    825821end;
    826822
    … …  
    904900  end else
    905901    Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000);
    906   DpiBitBlt(ca.Handle, x, y, Width, Height, Src.Canvas.Handle, xSrc, ySrc,
    907     SRCCOPY);
     902  DpiBitCanvas(ca, x, y, Width, Height, Src.Canvas, xSrc, ySrc);
    908903end;
    909904
    … …  
    920915  Height := ScaleToVcl(Height);
    921916  dst.BeginUpdate;
    922   DstPtr.Init(dst, x0, y0);
     917  DstPtr := PixelPointer(dst, x0, y0);
    923918  for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
    924919    for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
    … …  
    946941      if r = 0 then
    947942        r := 1;
    948       if r < GlowRange then
     943      if r < DpiGlowRange then
    949944        for ch := 0 to 2 do
    950945          DstPtr.Pixel^.Planes[2 - ch] :=
    … …  
    991986          $FF * intensity div $FF shl 16;
    992987      end;
    993   DpiBitBlt(GrExt[HGrSystem].Mask.Canvas.Handle, 77, 47, 10, 10,
    994     GrExt[HGrSystem].Mask.Canvas.Handle, 66, 47, SRCCOPY);
     988  DpiBitCanvas(GrExt[HGrSystem].Mask.Canvas, 77, 47, 10, 10,
     989    GrExt[HGrSystem].Mask.Canvas, 66, 47);
    995990end;
    996991
    … …  
    999994  Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
    1000995    (Top + yOffset >= 0) and (Top + yOffset + Height <= hMainTexture));
    1001   DpiBitBlt(ca.Handle, Left, Top, Width, Height, MainTexture.Image.Canvas.Handle,
    1002     Left + xOffset, Top + yOffset, SRCCOPY);
     996  DpiBitCanvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas,
     997    Left + xOffset, Top + yOffset);
     998end;
     999
     1000procedure Fill(Canvas: TDpiCanvas; Rect: TRect; Offset: TPoint);
     1001begin
     1002  Fill(Canvas, Rect.Left, Rect.Top, Rect.Width, Rect.Height, Offset.X, Offset.Y);
    10031003end;
    10041004
    … …  
    10211021begin
    10221022  for I := 0 to (x1 - xm) div wMainTexture - 1 do
    1023     DpiBitBlt(ca.Handle, xm + I * wMainTexture, y0, wMainTexture, y1 - y0,
    1024       MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + Band(I) *
    1025       (y1 - y0), SRCCOPY);
    1026   DpiBitBlt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
     1023    DpiBitCanvas(ca, xm + I * wMainTexture, y0, wMainTexture, y1 - y0,
     1024      MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band(I) *
     1025      (y1 - y0));
     1026  DpiBitCanvas(ca, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
    10271027    x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0,
    1028     MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + Band(
    1029     (x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY);
     1028    MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band(
     1029    (x1 - xm) div wMainTexture) * (y1 - y0));
    10301030  for I := 0 to (xm - x0) div wMainTexture - 1 do
    1031     DpiBitBlt(ca.Handle, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
    1032       MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 +
    1033       Band(-I - 1) * (y1 - y0), SRCCOPY);
    1034   DpiBitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) *
    1035     wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas.Handle,
     1031    DpiBitCanvas(ca, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
     1032      MainTexture.Image.Canvas, 0, hMainTexture div 2 +
     1033      Band(-I - 1) * (y1 - y0));
     1034  DpiBitCanvas(ca, x0, y0, xm - ((xm - x0) div wMainTexture) *
     1035    wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas,
    10361036    ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0),
    1037     hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0), SRCCOPY);
     1037    hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0));
    10381038end;
    10391039
    … …  
    10651065      if x1cut < 0 then
    10661066        x1cut := 0;
    1067       DpiBitBlt(ca.Handle, x * Texture.Width + x0cut - xOffset,
     1067      DpiBitCanvas(ca, x * Texture.Width + x0cut - xOffset,
    10681068        y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,
    1069         Texture.Height - y0cut - y1cut, Texture.Canvas.Handle, x0cut,
    1070         y0cut, SRCCOPY);
     1069        Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut);
    10711070    end;
    10721071  end;
    … …  
    10871086procedure Corner(ca: TDpiCanvas; x, y, Kind: Integer; const T: TTexture);
    10881087begin
    1089   { DpiBitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle,
     1088  { DpiBitCanvas(ca,x,y,8,8,GrExt[T.HGr].Mask.Canvas,
    10901089    T.xGr+29+Kind*9,T.yGr+89,SRCAND);
    1091     DpiBitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle,
     1090    DpiBitCanvas(ca,x,y,8,8,GrExt[T.HGr].Data.Canvas,
    10921091    T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); }
    10931092end;
    … …  
    10971096  procedure PaintIcon(x, y, Kind: Integer);
    10981097  begin
    1099     DpiBitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas.Handle,
     1098    DpiBitCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas,
    11001099      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND);
    1101     DpiBitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas.Handle,
     1100    DpiBitCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas,
    11021101      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT);
    11031102  end;
    … …  
    13211320      for i := 0 to val mod 10 - 1 do
    13221321      begin
    1323         DpiBitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
    1324           14, GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1322        DpiBitCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
     1323          14, GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
    13251324          70 + Kind div 8 * 15, SRCAND);
    13261325        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    … …  
    13291328      for i := 0 to val div 10 - 1 do
    13301329      begin
    1331         DpiBitBlt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) *
     1330        DpiBitCanvas(dst.Canvas, xIcon + 4 + (val mod 10) *
    13321331          (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1333           GrExt[HGrSystem].Mask.Canvas.Handle, 67 + 7 mod 8 * 15,
     1332          GrExt[HGrSystem].Mask.Canvas, 67 + 7 mod 8 * 15,
    13341333          70 + 7 div 8 * 15, SRCAND);
    13351334        Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) *
    … …  
    13541353      for i := 0 to val div 10 - 1 do
    13551354      begin
    1356         DpiBitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1357           GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15,
     1355        DpiBitCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
     1356          GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
    13581357          70 + Kind div 8 * 15, SRCAND);
    13591358        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    … …  
    13621361      for i := 0 to val mod 10 - 1 do
    13631362      begin
    1364         DpiBitBlt(dst.Canvas.Handle, xIcon + 4 + (val div 10) *
     1363        DpiBitCanvas(dst.Canvas, xIcon + 4 + (val div 10) *
    13651364          (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
    1366           GrExt[HGrSystem].Mask.Canvas.Handle, 66 + Kind mod 11 * 11,
     1365          GrExt[HGrSystem].Mask.Canvas, 66 + Kind mod 11 * 11,
    13671366          115 + Kind div 11 * 11, SRCAND);
    13681367        Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) *
    … …  
    13991398  begin
    14001399    for i := 0 to pos div 8 - 1 do
    1401       DpiBitBlt(Handle, x + i * 8, y, 8, 7,
    1402         GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
    1403     DpiBitBlt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
    1404       GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY);
     1400      DpiBitCanvas(ca, x + i * 8, y, 8, 7,
     1401        GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
     1402    DpiBitCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
     1403      GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
    14051404    if Growth > 0 then
    14061405    begin
    14071406      for i := 0 to Growth div 8 - 1 do
    1408         DpiBitBlt(Handle, x + pos + i * 8, y, 8, 7,
    1409           GrExt[HGrSystem].Data.Canvas.Handle, 112, 9 + 8 * Kind, SRCCOPY);
    1410       DpiBitBlt(Handle, x + pos + 8 * (Growth div 8), y,
    1411         Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas.Handle,
    1412         112, 9 + 8 * Kind, SRCCOPY);
     1407        DpiBitCanvas(ca, x + pos + i * 8, y, 8, 7,
     1408          GrExt[HGrSystem].Data.Canvas, 112, 9 + 8 * Kind);
     1409      DpiBitCanvas(ca, x + pos + 8 * (Growth div 8), y,
     1410        Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas,
     1411        112, 9 + 8 * Kind);
    14131412    end
    14141413    else if Growth < 0 then
    14151414    begin
    14161415      for i := 0 to -Growth div 8 - 1 do
    1417         DpiBitBlt(Handle, x + pos + i * 8, y, 8, 7,
    1418           GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
    1419       DpiBitBlt(Handle, x + pos + 8 * (-Growth div 8), y, -Growth -
     1416        DpiBitCanvas(ca, x + pos + i * 8, y, 8, 7,
     1417          GrExt[HGrSystem].Data.Canvas, 104, 1);
     1418      DpiBitCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth -
    14201419        8 * (-Growth div 8), 7,
    1421         GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY);
     1420        GrExt[HGrSystem].Data.Canvas, 104, 1);
    14221421    end;
    14231422    Brush.Color := $000000;
    … …  
    14441443procedure PaintLogo(ca: TDpiCanvas; x, y, clLight, clShade: Integer);
    14451444begin
    1446   BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x,
    1447     y, SRCCOPY);
     1445  // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
     1446  LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
     1447  DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, y);
    14481448  ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
    14491449    clLight, clShade);
    1450   DpiBitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0,
    1451     0, SRCCOPY);
     1450  DpiBitCanvas(ca, x, y, wLogo, hLogo, LogoBuffer.Canvas, 0, 0);
    14521451end;
    14531452
    … …  
    14571456    with MainTexture do begin
    14581457      MainTextureAge := Age;
    1459       LoadGraphicFile(Image, HomeDir + 'Graphics' + DirectorySeparator +
     1458      LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator +
    14601459        'Texture' + IntToStr(Age + 1) + '.jpg');
    14611460      clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
    … …  
    14731472end;
    14741473
    1475 { TPixelPointer }
    1476 
    1477 procedure TPixelPointer.NextLine; inline;
    1478 begin
    1479   Line := Pointer(Line) + BytesPerLine;
    1480   Pixel := Line;
    1481 end;
    1482 
    1483 procedure TPixelPointer.NextPixel; inline;
    1484 begin
    1485   Pixel := Pointer(Pixel) + BytesPerPixel;
    1486 end;
    1487 
    1488 procedure TPixelPointer.SetXY(X, Y: Integer); inline;
    1489 begin
    1490   Line := Pointer(Base) + Y * BytesPerLine;
    1491   SetX(X);
    1492 end;
    1493 
    1494 procedure TPixelPointer.SetX(X: Integer); inline;
    1495 begin
    1496   Pixel := Pointer(Line) + X * BytesPerPixel;
    1497 end;
    1498 
    1499 procedure TPixelPointer.Init(Bitmap: TDpiRasterImage; BaseX: Integer = 0;
    1500   BaseY: integer = 0); inline;
    1501 begin
    1502   BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
    1503   BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
    1504   Base := PPixel32(Bitmap.RawImage.Data + BaseX * BytesPerPixel + BaseY * BytesPerLine);
    1505   SetXY(0, 0);
    1506 end;
    1507 
    15081474procedure LoadPhrases;
    15091475begin
    1510   if Phrases = nil then
    1511     Phrases := TStringTable.Create;
    1512   if Phrases2 = nil then
    1513     Phrases2 := TStringTable.Create;
     1476  if Phrases = nil then Phrases := TStringTable.Create;
     1477  if Phrases2 = nil then Phrases2 := TStringTable.Create;
    15141478  Phrases2FallenBackToEnglish := False;
    15151479  if FileExists(LocalizedFilePath('Language.txt')) then
    15161480  begin
    1517     Phrases.loadfromfile(LocalizedFilePath('Language.txt'));
     1481    Phrases.LoadFromFile(LocalizedFilePath('Language.txt'));
    15181482    if FileExists(LocalizedFilePath('Language2.txt')) then
    1519       Phrases2.loadfromfile(LocalizedFilePath('Language2.txt'))
     1483      Phrases2.LoadFromFile(LocalizedFilePath('Language2.txt'))
    15201484    else
    15211485    begin
    1522       Phrases2.loadfromfile(HomeDir + 'Language2.txt');
     1486      Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
    15231487      Phrases2FallenBackToEnglish := True;
    15241488    end;
    … …  
    15261490  else
    15271491  begin
    1528     Phrases.loadfromfile(HomeDir + 'Language.txt');
    1529     Phrases2.loadfromfile(HomeDir + 'Language2.txt');
    1530   end;
    1531 
    1532   if Sounds = nil then
    1533     Sounds := TStringTable.Create;
    1534   if not Sounds.loadfromfile(HomeDir + 'Sounds' + DirectorySeparator + 'sound.txt') then
     1492    Phrases.LoadFromFile(HomeDir + 'Language.txt');
     1493    Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
     1494  end;
     1495
     1496  if Sounds = nil then Sounds := TStringTable.Create;
     1497  if not Sounds.LoadFromFile(GetSoundsDir + DirectorySeparator + 'sound.txt') then
    15351498  begin
    15361499    FreeAndNil(Sounds);
    15371500  end;
     1501end;
     1502
     1503procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);
     1504var
     1505  SrcPixel, DstPixel: TPixelPointer;
     1506  X, Y: Integer;
     1507  TexWidth, TexHeight: Integer;
     1508begin
     1509  // texturize background
     1510  Dest.BeginUpdate;
     1511  TexWidth := ScaleToVcl(Texture.Width);
     1512  TexHeight := ScaleToVcl(Texture.Height);
     1513  DstPixel := PixelPointer(Dest);
     1514  SrcPixel := PixelPointer(Texture);
     1515  for Y := 0 to ScaleToVcl(Dest.Height) - 1 do begin
     1516    for X := 0 to ScaleToVcl(Dest.Width) - 1 do begin
     1517      if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin
     1518        SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
     1519        DstPixel.Pixel^.B := SrcPixel.Pixel^.B;
     1520        DstPixel.Pixel^.G := SrcPixel.Pixel^.G;
     1521        DstPixel.Pixel^.R := SrcPixel.Pixel^.R;
     1522      end;
     1523      DstPixel.NextPixel;
     1524    end;
     1525    DstPixel.NextLine;
     1526  end;
     1527  Dest.EndUpdate;
     1528end;
     1529
     1530procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer);
     1531var
     1532  x, y: integer;
     1533  PicturePixel: TPixelPointer;
     1534begin
     1535  Bitmap.BeginUpdate;
     1536  PicturePixel := PixelPointer(Bitmap);
     1537  for y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
     1538    for x := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
     1539      PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
     1540      PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
     1541      PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - Change, 0);
     1542      PicturePixel.NextPixel;
     1543    end;
     1544    PicturePixel.NextLine;
     1545  end;
     1546  Bitmap.EndUpdate;
    15381547end;
    15391548
    … …  
    15471556  P: integer;
    15481557begin
    1549   for Section := Low(TFontType) to High(TFontType) do
    1550     UniFont[Section] := TDpiFont.Create;
    1551 
    15521558  Section := ftNormal;
    15531559  AssignFile(FontScript, LocalizedFilePath('Fonts.txt'));
    15541560  try
    1555     Reset(fontscript);
    1556     while not EOF(FontScript) do begin
     1561    Reset(FontScript);
     1562    while not Eof(FontScript) do begin
    15571563      ReadLn(FontScript, s);
    15581564      if s <> '' then
    15591565        if s[1] = '#' then begin
    15601566          s := TrimRight(s);
    1561           if s = '#SMALL' then
    1562             Section := ftSmall
    1563           else if s = '#TINY' then
    1564             Section := ftTiny
    1565           else if s = '#CAPTION' then
    1566             Section := ftCaption
    1567           else if s = '#BUTTON' then
    1568             Section := ftButton
    1569           else
    1570             Section := ftNormal;
     1567          if s = '#SMALL' then Section := ftSmall
     1568          else if s = '#TINY' then Section := ftTiny
     1569          else if s = '#CAPTION' then Section := ftCaption
     1570          else if s = '#BUTTON' then Section := ftButton
     1571          else Section := ftNormal;
    15711572        end else begin
    15721573          p := Pos(',', s);
    15731574          if p > 0 then begin
    1574             UniFont[Section].Name := Trim(Copy(s, 1, p - 1));
     1575            UniFont[section].Name := Trim(Copy(s, 1, p - 1));
    15751576            Size := 0;
    15761577            for i := p + 1 to Length(s) do
    … …  
    15851586            // 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
    15861587            UniFont[section].Size :=
    1587               Round(Size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch);
     1588              Round(size * DpiScreen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
    15881589          end;
    15891590        end;
    … …  
    16151616end;
    16161617
     1618procedure LoadAssets;
     1619begin
     1620  LoadPhrases;
     1621  LoadFonts;
     1622  LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator +
     1623    'Templates.png', gfNoGamma);
     1624  LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
     1625  LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');
     1626  LoadGraphicFile(BigImp, GetGraphicsDir + DirectorySeparator + 'Icons.png');
     1627end;
     1628
    16171629procedure UnitInit;
    16181630var
    1619   Reg: TRegistry;
    1620 begin
    1621   Reg := TRegistry.Create;
    1622   with Reg do
    1623     try
    1624       OpenKey(AppRegistryKey, True);
    1625       if ValueExists('Gamma') then
    1626         Gamma := ReadInteger('Gamma')
    1627       else
    1628       begin
    1629         Gamma := 100;
    1630         WriteInteger('Gamma', Gamma);
    1631       end;
    1632       if ValueExists('Locale') then
    1633         LocaleCode := ReadString('Locale')
    1634       else
    1635         LocaleCode := '';
    1636     finally
    1637       Free;
    1638     end;
    1639 
    1640   if Gamma <> 100 then InitGammaLookupTable;
     1631  Section: TFontType;
     1632begin
     1633  Gamma := 100;
     1634  InitGammaLookupTable;
    16411635
    16421636  {$IFDEF WINDOWS}
    … …  
    16451639  {$ENDIF}
    16461640
    1647   LoadPhrases;
    1648 
    16491641  LogoBuffer := TDpiBitmap.Create;
    16501642  LogoBuffer.PixelFormat := pf24bit;
    16511643  LogoBuffer.SetSize(wBBook, hBBook);
    16521644
    1653   LoadFonts;
     1645  for Section := Low(TFontType) to High(TFontType) do
     1646    UniFont[Section] := TDpiFont.Create;
    16541647
    16551648  nGrExt := 0;
    … …  
    16581651  Templates := TDpiBitmap.Create;
    16591652  Templates.PixelFormat := pf24bit;
    1660   LoadGraphicFile(Templates, HomeDir + 'Graphics' + DirectorySeparator +
    1661     'Templates.png', gfNoGamma);
    16621653  Colors := TDpiBitmap.Create;
    16631654  Colors.PixelFormat := pf24bit;
    1664   LoadGraphicFile(Colors, HomeDir + 'Graphics' + DirectorySeparator + 'Colors.png');
    16651655  Paper := TDpiBitmap.Create;
    16661656  Paper.PixelFormat := pf24bit;
    1667   LoadGraphicFile(Paper, HomeDir + 'Graphics' + DirectorySeparator + 'Paper.jpg');
    16681657  BigImp := TDpiBitmap.Create;
    16691658  BigImp.PixelFormat := pf24bit;
    1670   LoadGraphicFile(BigImp, HomeDir + 'Graphics' + DirectorySeparator + 'Icons.png');
    16711659  MainTexture.Image := TDpiBitmap.Create;
    16721660  MainTextureAge := -2;
    … …  
    16741662  InitOrnamentDone := False;
    16751663  GenerateNames := True;
     1664
     1665  LoadAssets;
    16761666end;
    16771667
    16781668procedure UnitDone;
    16791669var
    1680   Reg: TRegistry;
    16811670  I: integer;
    16821671begin
    1683   Reg := TRegistry.Create;
    1684   with Reg do
    1685     try
    1686       OpenKey(AppRegistryKey, True);
    1687       WriteString('Locale', LocaleCode);
    1688       WriteInteger('Gamma', Gamma);
    1689     finally
    1690       Free;
    1691     end;
    1692 
    16931672  RestoreResolution;
    16941673  for I := 0 to nGrExt - 1 do begin
    … …  
    17021681  FreeAndNil(Phrases);
    17031682  FreeAndNil(Phrases2);
    1704   if Sounds <> nil then
    1705     FreeAndNil(Sounds);
    17061683  FreeAndNil(LogoBuffer);
    17071684  FreeAndNil(BigImp);
Note: See TracChangeset for help on using the changeset viewer.