Changeset 303 for branches/highdpi/Packages/CevoComponents/ScreenTools.pas

Timestamp:

Mar 9, 2021, 9:19:49 AM (4 years ago)

Author:

chronos

Message:

• Modified: Synced code with current trunk version.

File:

• branches/highdpi/Packages/CevoComponents/ScreenTools.pas (modified) (11 diffs)

branches/highdpi/Packages/CevoComponents/ScreenTools.pas

@@ -13 +13 @@
   TTexture = record
     Image: TDpiBitmap;
-    clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
-    clPage, clCover: TColor;
-  end;
+    clBevelLight: TColor;
+    clBevelShade: TColor;
+    clTextLight: TColor;
+    clTextShade: TColor;
+    clLitText: TColor;
+    clMark: TColor;
+    clPage: TColor;
+    clCover: TColor;
+  end;
+  TLoadGraphicFileOption = (gfNoError, gfNoGamma);
+  TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
+
 
 {$IFDEF WINDOWS}
@@ -28 +37 @@
 procedure EditFrame(ca: TDpiCanvas; p: TRect; const T: TTexture);
 function HexStringToColor(S: string): integer;
-function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: integer = 0): boolean;
+function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean;
 function LoadGraphicSet(const Name: string): integer;
 procedure Dump(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
@@ -91 +100 @@
 function SetMainTextureByAge(Age: integer): boolean;
 procedure LoadPhrases;
-procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);
+procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Cardinal);
 procedure DarkenImage(Bitmap: TDpiBitmap; Change: Integer);
 
@@ -158 +167 @@
   cliWater = 4;
 
-  // LoadGraphicFile options
-  gfNoError = $01;
-  gfNoGamma = $02;
-
 type
   TGrExtDescr = record { don't use dynamic strings here! }
@@ -256 +261 @@
     MenuItem := MenuItems[MenuItems.Count - 1];
     MenuItems.Delete(MenuItems.Count - 1);
-    MenuItem.Free;
+    FreeAndNil(MenuItem);
   end;
 end;
 
 function TurnToYear(Turn: Integer): Integer;
-var
-  I: Integer;
 begin
   Result := -4000;
-  for I := 1 to Turn do
-    if Result < -1000 then Inc(Result, 50) // 0..60
-    else if Result < 0 then Inc(Result, 25) // 60..100
-    else if Result < 1500 then Inc(Result, 20) // 100..175
-    else if Result < 1750 then Inc(Result, 10) // 175..200
-    else if Result < 1850 then Inc(Result, 2) // 200..250
-    else Inc(Result);
+  if Turn <= 0 then Exit;
+
+  // Year -4000..-1000, Turn 0..60
+  Inc(Result, Min(60, Turn) * 50);
+  Dec(Turn, Min(60, Turn));
+  if Turn = 0 then Exit;
+
+  // Year -1000..0, Turn 60..100
+  Inc(Result, Min(40, Turn) * 25);
+  Dec(Turn, Min(40, Turn));
+  if Turn = 0 then Exit;
+
+  // Year 0..1500, Turn 100..175
+  Inc(Result, Min(75, Turn) * 20);
+  Dec(Turn, Min(75, Turn));
+  if Turn = 0 then Exit;
+
+  // Year 1500..1750, Turn 175..200
+  Inc(Result, Min(25, Turn) * 10);
+  Dec(Turn, Min(25, Turn));
+  if Turn = 0 then Exit;
+
+  // Year 1750..1850, Turn 200..250
+  Inc(Result, Min(50, Turn) * 2);
+  Dec(Turn, Min(50, Turn));
+  if Turn = 0 then Exit;
+
+  // Year 1850.., Turn 250..
+  Inc(Result, Turn);
 end;
 
@@ -395 +420 @@
 end;
 
-function LoadGraphicFile(bmp: TDpiBitmap; Path: string; Options: Integer): Boolean;
-var
-  jtex: TDpiJpegImage;
+function LoadGraphicFile(Bmp: TDpiBitmap; FileName: string; Options:
+  TLoadGraphicFileOptions = []): Boolean;
+var
+  Jpeg: TDpiJpegImage;
   Png: TDpiPortableNetworkGraphic;
 begin
-  Result := True;
-  if ExtractFileExt(Path) = '' then
-    Path := Path + '.png';
-  if ExtractFileExt(Path) = '.jpg' then begin
-    jtex := TDpiJpegImage.Create;
-    try
+  Result := False;
+  if ExtractFileExt(FileName) = '' then
+    FileName := FileName + '.png';
+
+  if FileExists(FileName) then begin
+    if ExtractFileExt(FileName) = '.jpg' then begin
+      Jpeg := TDpiJpegImage.Create;
       try
-        jtex.LoadFromFile(Path);
+        Jpeg.LoadFromFile(FileName);
+        if not (gfNoGamma in Options) then
+          Bmp.PixelFormat := pf24bit;
+        Bmp.SetSize(Jpeg.Width, Jpeg.Height);
+        Bmp.Canvas.Draw(0, 0, Jpeg);
+        Result := True;
       except
         Result := False;
       end;
-      if Result then
-      begin
-        if Options and gfNoGamma = 0 then
-          bmp.PixelFormat := pf24bit;
-        Bmp.SetSize(jtex.Width, jtex.Height);
-        Bmp.Canvas.Draw(0, 0, jtex);
-      end;
-    finally
-      FreeAndNil(jtex);
-    end;
-  end
-  else
-  if ExtractFileExt(Path) = '.png' then begin
-    Png := TDpiPortableNetworkGraphic.Create;
-    try
-      Png.PixelFormat := Bmp.PixelFormat;
+      FreeAndNil(Jpeg);
+    end else
+    if ExtractFileExt(FileName) = '.png' then begin
+      Png := TDpiPortableNetworkGraphic.Create;
       try
-        Png.LoadFromFile(Path);
-      except
-        Result := False;
-        end;
-      if Result then begin
-        if Options and gfNoGamma = 0 then
-          bmp.PixelFormat := pf24bit;
-        bmp.SetSize(Png.Width, Png.Height);
+        Png.PixelFormat := Bmp.PixelFormat;
+        Png.LoadFromFile(FileName);
+        if not (gfNoGamma in Options) then
+          Bmp.PixelFormat := pf24bit;
+        Bmp.SetSize(Png.Width, Png.Height);
         if (Png.RawImage.Description.Format = ricfGray) then
         begin
@@ -441 +458 @@
           Bmp.PixelFormat := pf24bit;
           CopyGray8BitTo24bitBitmap(Bmp, Png);
-        end else
-          Bmp.Canvas.draw(0, 0, Png);
+        end
+        else
+          Bmp.Canvas.Draw(0, 0, Png);
+        Result := True;
+      except
+        Result := False;
       end;
-    finally
       FreeAndNil(Png);
-    end;
-  end else
-  if ExtractFileExt(Path) = '.bmp' then begin
-    try
-      bmp.LoadFromFile(Path);
-    except
-      Result := False;
-    end;
-    if Result then begin
-      if Options and gfNoGamma = 0 then
-        bmp.PixelFormat := pf24bit;
-    end;
-  end else
-    raise Exception.Create('Unsupported image file type ' + ExtractFileExt(Path));
+    end else
+    if ExtractFileExt(FileName) = '.bmp' then begin
+      try
+        Bmp.LoadFromFile(FileName);
+        if not (gfNoGamma in Options) then
+          Bmp.PixelFormat := pf24bit;
+        Result := True;
+      except
+        Result := False;
+      end;
+    end else
+      raise Exception.Create('Unsupported image file type ' + ExtractFileExt(FileName));
+  end;
 
   if not Result then begin
-    if Options and gfNoError = 0 then
-      raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [Path]));
-  end;
-
-  if (Options and gfNoGamma = 0) and (Gamma <> 100) then
+    if not (gfNoError in Options) then
+      raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [FileName]));
+  end;
+
+  if (not (gfNoGamma in Options)) and (Gamma <> 100) then
     ApplyGammaToBitmap(Bmp);
 end;
@@ -1247 +1266 @@
   i, r, g, b: Integer;
 begin
-  begin
-    for i := 0 to 15 do
-    begin // gradient
-      r := Color and $FF + Brightness[i];
-      if r < 0 then
-        r := 0
-      else if r >= 256 then
-        r := 255;
-      g := Color shr 8 and $FF + Brightness[i];
-      if g < 0 then
-        g := 0
-      else if g >= 256 then
-        g := 255;
-      b := Color shr 16 and $FF + Brightness[i];
-      if b < 0 then
-        b := 0
-      else if b >= 256 then
-        b := 255;
-      ca.Pen.Color := r + g shl 8 + b shl 16;
-      ca.MoveTo(x + dx * i, y + dy * i);
-      ca.LineTo(x + dx * i + Width, y + dy * i + Height);
-    end;
-    ca.Pen.Color := $000000;
-    ca.MoveTo(x + 1, y + 16 * dy + Height);
-    ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
-    ca.LineTo(x + 16 * dx + Width, y);
-  end;
+  for i := 0 to Length(Brightness) - 1 do begin // gradient
+    r := Color and $FF + Brightness[i];
+    if r < 0 then
+      r := 0
+    else if r >= 256 then
+      r := 255;
+    g := Color shr 8 and $FF + Brightness[i];
+    if g < 0 then
+      g := 0
+    else if g >= 256 then
+      g := 255;
+    b := Color shr 16 and $FF + Brightness[i];
+    if b < 0 then
+      b := 0
+    else if b >= 256 then
+      b := 255;
+    ca.Pen.Color := r + g shl 8 + b shl 16;
+    ca.MoveTo(x + dx * i, y + dy * i);
+    ca.LineTo(x + dx * i + Width, y + dy * i + Height);
+  end;
+  ca.Pen.Color := $000000;
+  ca.MoveTo(x + 1, y + 16 * dy + Height);
+  ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
+  ca.LineTo(x + 16 * dx + Width, y);
 end;
 
@@ -1549 +1565 @@
 end;
 
-procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Integer);
+procedure Texturize(Dest, Texture: TDpiBitmap; TransparentColor: Cardinal);
 var
   SrcPixel, DstPixel: TPixelPointer;
@@ -1645 +1661 @@
             UniFont[section].Size :=
               Round(size * DpiScreen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
+            //UniFont[section].Size := Round(Size * 72 / UniFont[section].PixelsPerInch);
           end;
         end;
@@ -1679 +1696 @@
   LoadFonts;
   LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator +
-    'Templates.png', gfNoGamma);
+    'Templates.png', [gfNoGamma]);
   LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
   LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');