Changeset 315 for trunk/Packages

Timestamp:

Mar 18, 2021, 10:58:28 PM (4 years ago)

Author:

chronos

Message:

• Fixed: Gamma was incorrectly applied to images with transparency colors.
• Modified: Change Templates to GraphicSet so it can also have description of its items.
• Modified: Use TextExtent instead of both TextWidth and TextHeight.

Location:

trunk/Packages/CevoComponents

Files:

• ButtonA.pas (modified) (2 diffs)
• ScreenTools.pas (modified) (16 diffs)
• UGraphicSet.pas (modified) (2 diffs)

trunk/Packages/CevoComponents/ButtonA.pas

@@ -4 +4 @@
 
 uses
-  ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools;
+  ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools, Types;
 
 type
@@ -41 +41 @@
 
 procedure TButtonA.Paint;
+var
+  TextSize: TSize;
 begin
   with Canvas do
-    if FGraphic <> nil then
-    begin
+    if FGraphic <> nil then begin
       BitBltCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195,
         243 + 26 * Byte(Down));
       Canvas.Brush.Style := bsClear;
-      Textout(50 - (TextWidth(FCaption) + 1) div 2, 12 - textheight(FCaption)
-        div 2, FCaption);
-    end
-    else
-    begin
+      TextSize := TextExtent(FCaption);
+      TextOut(50 - (TextSize.Width + 1) div 2,
+        12 - TextSize.Height div 2, FCaption);
+    end else begin
       Brush.Color := $0000FF;
       FrameRect(Rect(0, 0, 100, 25))

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -40 +40 @@
 function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean;
 function LoadGraphicSet(const Name: string): TGraphicSet;
+function LoadGraphicSet2(const Name: string): TGraphicSet;
 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
@@ -107 +108 @@
 
 const
+  TransparentColor1 = $FF00FF;
+  TransparentColor2 = $7F007F;
+
   wMainTexture = 640;
   hMainTexture = 480;
 
-  // template positions in Template.bmp
+  // template positions in Templates.png
   xLogo = 1;
   yLogo = 1;
@@ -172 +176 @@
   CityMark2: TGraphicSetItem;
   Ornament: TGraphicSetItem;
+  Logo: TGraphicSetItem;
   ClickFrameColor: Integer;
   MainTextureAge: Integer;
   MainTexture: TTexture;
-  Templates: TBitmap;
+  Templates: TGraphicSet;
   Colors: TBitmap;
   Paper: TBitmap;
@@ -474 +479 @@
   x: Integer;
   y: Integer;
-  xmax: Integer;
   OriginalColor: Integer;
   FileName: string;
@@ -484 +488 @@
     Result := GrExt.AddNew(Name);
     FileName := GetGraphicsDir + DirectorySeparator + Name;
-    if not LoadGraphicFile(Result.Data, FileName) then begin
+    // Do not apply gamma during file load as it would affect also transparency colors
+    if not LoadGraphicFile(Result.Data, FileName, [gfNoGamma]) then begin
       Result := nil;
       Exit;
@@ -494 +499 @@
 
     Result.ResetPixUsed;
-
-    xmax := Result.Data.Width - 1; // allows 4-byte access even for last pixel
-    // Why there was that limit?
-    //if xmax > 970 then
-    //  xmax := 970;
 
     Result.Mask.SetSize(Result.Data.Width, Result.Data.Height);
@@ -507 +507 @@
     MaskPixel := PixelPointer(Result.Mask);
     for y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin
-      for x := 0 to ScaleToNative(xmax) - 1 do begin
+      for x := 0 to ScaleToNative(Result.Data.Width) - 1 do begin
         OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
-        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
-        begin // transparent
-          MaskPixel.Pixel^.ARGB := $FFFFFF;
-          DataPixel.Pixel^.ARGB := DataPixel.Pixel^.ARGB and $FF000000;
-        end
-        else begin
-          MaskPixel.Pixel^.ARGB := $000000; // non-transparent
-          if Gamma <> 100 then
-            DataPixel.Pixel^ := ApplyGammaToPixel(DataPixel.Pixel^);
+        if (OriginalColor = TransparentColor1) or (OriginalColor = TransparentColor2) then begin
+          MaskPixel.Pixel^.R := $FF;
+          MaskPixel.Pixel^.G := $FF;
+          MaskPixel.Pixel^.B := $FF;
+          DataPixel.Pixel^.R := 0;
+          DataPixel.Pixel^.G := 0;
+          DataPixel.Pixel^.B := 0;
+        end else begin
+          MaskPixel.Pixel^.R := $00;
+          MaskPixel.Pixel^.G := $00;
+          MaskPixel.Pixel^.B := $00;
         end;
         DataPixel.NextPixel;
@@ -527 +529 @@
     Result.Data.EndUpdate;
     Result.Mask.EndUpdate;
+
+    if Gamma <> 100 then
+      ApplyGammaToBitmap(Result.Data);
+  end;
+end;
+
+function LoadGraphicSet2(const Name: string): TGraphicSet;
+var
+  FileName: string;
+begin
+  Result := GrExt.SearchByName(Name);
+  if not Assigned(Result) then begin
+    Result := GrExt.AddNew(Name);
+    FileName := GetGraphicsDir + DirectorySeparator + Name;
+    if not LoadGraphicFile(Result.Data, FileName, [gfNoGamma]) then begin
+      Result := nil;
+      Exit;
+    end;
+
+    FileName := ExtractFileNameWithoutExt(FileName) + GraphicSetFileExt;
+    if FileExists(FileName) then
+      Result.LoadFromFile(FileName);
+
+    Result.ResetPixUsed;
   end;
 end;
@@ -1114 +1140 @@
 procedure Corner(ca: TCanvas; x, y, Kind: Integer; const T: TTexture);
 begin
-  { BitBltCanvas(ca,x,y,8,8,GrExt[T.HGr].Mask.Canvas,
+  { BitBltCanvas(ca,x,y,8,8,T.HGr.Mask.Canvas,
     T.xGr+29+Kind*9,T.yGr+89,SRCAND);
-    BitBltCanvas(ca,x,y,8,8,GrExt[T.HGr].Data.Canvas,
+    BitBltCanvas(ca,x,y,8,8,T.HGr.Data.Canvas,
     T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); }
 end;
@@ -1134 +1160 @@
   sp: string;
   shadow: Boolean;
+  Text: string;
 begin
   Inc(x);
@@ -1157 +1184 @@
           else
           begin
-            Textout(xp, y, copy(sp, 1, p - 1));
-            Inc(xp, ca.TextWidth(copy(sp, 1, p - 1)));
+            Text := Copy(sp, 1, p - 1);
+            Textout(xp, y, Text);
+            Inc(xp, ca.TextWidth(Text));
             if not shadow then
               case sp[p + 1] of
@@ -1471 +1499 @@
   LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
   BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, y);
-  ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
+  ImageOp_BCC(LogoBuffer, Templates.Data, 0, 0, 1, 1, wLogo, hLogo,
     clLight, clShade);
   BitBltCanvas(ca, x, y, wLogo, hLogo, LogoBuffer.Canvas, 0, 0);
@@ -1653 +1681 @@
   LoadPhrases;
   LoadFonts;
-  LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator +
-    'Templates.png', [gfNoGamma]);
+  Templates := LoadGraphicSet2('Templates.png');
   LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
   LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');
@@ -1688 +1715 @@
   Ornament := HGrSystem2.GetItem('Ornament');
 
-  Templates := TBitmap.Create;
-  Templates.PixelFormat := pf24bit;
   Colors := TBitmap.Create;
   Colors.PixelFormat := pf24bit;
@@ -1706 +1731 @@
 
 procedure UnitDone;
-var
-  I: Integer;
 begin
   RestoreResolution;
@@ -1717 +1740 @@
   FreeAndNil(BigImp);
   FreeAndNil(Paper);
-  FreeAndNil(Templates);
   FreeAndNil(Colors);
   FreeAndNil(MainTexture.Image);

trunk/Packages/CevoComponents/UGraphicSet.pas

@@ -60 +60 @@
     function SearchByName(Name: string): TGraphicSet;
     function AddNew(Name: string): TGraphicSet;
+    procedure ResetPixUsed;
   end;
 
@@ -259 +260 @@
 end;
 
+procedure TGraphicSets.ResetPixUsed;
+var
+  I: Integer;
+begin
+  for I := 0 to Count - 1 do
+    Items[I].ResetPixUsed;
+end;
+
 end.