Changeset 312 for trunk/Packages

Timestamp:

Mar 17, 2021, 10:42:18 AM (4 years ago)

Author:

chronos

Message:

• Modified: TGrExtDescr record changed to class. GrExt changed to dynamic array.

File:

• trunk/Packages/CevoComponents/ScreenTools.pas (modified) (9 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -8 +8 @@
   {$ENDIF}
   StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
-  Forms, Menus, GraphType;
+  Forms, Menus, GraphType, fgl;
 
 type
@@ -106 +106 @@
 
 const
-  nGrExtmax = 64;
   wMainTexture = 640;
   hMainTexture = 480;
@@ -170 +169 @@
 
 type
-  TGrExtDescr = record { don't use dynamic strings here! }
-    Name: string[31];
+
+  { TGrExtDescr }
+
+  TGrExtDescr = class
+    Name: string;
     Data: TBitmap;
     Mask: TBitmap;
-    pixUsed: array [Byte] of Byte;
-  end;
-
-  TGrExtDescrSize = record { for size calculation only - must be the same as
-      TGrExtDescr, but without pixUsed }
-    Name: string[31];
-    Data: TBitmap;
-    Mask: TBitmap;
+    pixUsed: array of Byte;
+    procedure ResetPixUsed;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TGrExtDescrs }
+
+  TGrExtDescrs = class(TFPGObjectList<TGrExtDescr>)
+    function SearchByName(Name: string): TGrExtDescr;
+    function AddNew(Name: string): TGrExtDescr;
   end;
 
@@ -189 +194 @@
   Phrases: TStringTable;
   Phrases2: TStringTable;
-  nGrExt: Integer;
-  GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
+  GrExt: TGrExtDescrs;
   HGrSystem: Integer;
   HGrSystem2: Integer;
@@ -493 +497 @@
 function LoadGraphicSet(const Name: string): Integer;
 var
-  I, x, y, xmax, OriginalColor: Integer;
+  I: Integer;
+  x: Integer;
+  y: Integer;
+  xmax: Integer;
+  OriginalColor: Integer;
   FileName: string;
-  Source: TBitmap;
-  DataPixel, MaskPixel: TPixelPointer;
-begin
-  I := 0;
-  while (I < nGrExt) and (GrExt[i].Name <> Name) do
-    Inc(I);
-  Result := I;
-  if I = nGrExt then begin
-    Source := TBitmap.Create;
-    Source.PixelFormat := pf24bit;
+  DataPixel: TPixelPointer;
+  MaskPixel: TPixelPointer;
+  NewGrExt: TGrExtDescr;
+begin
+  NewGrExt := GrExt.SearchByName(Name);
+  if not Assigned(NewGrExt) then begin
+    NewGrExt := GrExt.AddNew(Name);
     FileName := GetGraphicsDir + DirectorySeparator + Name;
-    if not LoadGraphicFile(Source, FileName) then begin
+    if not LoadGraphicFile(NewGrExt.Data, FileName) then begin
       Result := -1;
       Exit;
     end;
 
-    GetMem(GrExt[nGrExt], SizeOf(TGrExtDescrSize) + Source.Height div 49 * 10);
-    GrExt[nGrExt].Name := Name;
-
-    xmax := Source.Width - 1; // allows 4-byte access even for last pixel
+    NewGrExt.ResetPixUsed;
+
+    xmax := NewGrExt.Data.Width - 1; // allows 4-byte access even for last pixel
     // Why there was that limit?
     //if xmax > 970 then
     //  xmax := 970;
 
-    GrExt[nGrExt].Data := Source;
-    GrExt[nGrExt].Data.PixelFormat := pf24bit;
-    GrExt[nGrExt].Mask := TBitmap.Create;
-    GrExt[nGrExt].Mask.PixelFormat := pf24bit;
-    GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height);
-
-    GrExt[nGrExt].Data.BeginUpdate;
-    GrExt[nGrExt].Mask.BeginUpdate;
-    DataPixel := PixelPointer(GrExt[nGrExt].Data);
-    MaskPixel := PixelPointer(GrExt[nGrExt].Mask);
-    for y := 0 to ScaleToNative(Source.Height) - 1 do begin
+    NewGrExt.Mask.SetSize(NewGrExt.Data.Width, NewGrExt.Data.Height);
+
+    NewGrExt.Data.BeginUpdate;
+    NewGrExt.Mask.BeginUpdate;
+    DataPixel := PixelPointer(NewGrExt.Data);
+    MaskPixel := PixelPointer(NewGrExt.Mask);
+    for y := 0 to ScaleToNative(NewGrExt.Data.Height) - 1 do begin
       for x := 0 to ScaleToNative(xmax) - 1 do begin
         OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
@@ -548 +548 @@
       MaskPixel.NextLine;
     end;
-    GrExt[nGrExt].Data.EndUpdate;
-    GrExt[nGrExt].Mask.EndUpdate;
-
-    FillChar(GrExt[nGrExt].pixUsed, GrExt[nGrExt].Data.Height div 49 * 10, 0);
-    Inc(nGrExt);
-  end;
+    NewGrExt.Data.EndUpdate;
+    NewGrExt.Mask.EndUpdate;
+  end;
+  Result := GrExt.IndexOf(NewGrExt);
 end;
 
@@ -1701 +1699 @@
     UniFont[Section] := TFont.Create;
 
-  nGrExt := 0;
+  GrExt := TGrExtDescrs.Create;
   HGrSystem := LoadGraphicSet('System.png');
   HGrSystem2 := LoadGraphicSet('System2.png');
@@ -1723 +1721 @@
 procedure UnitDone;
 var
-  I: integer;
+  I: Integer;
 begin
   RestoreResolution;
-  for I := 0 to nGrExt - 1 do begin
-    FreeAndNil(GrExt[I].Data);
-    FreeAndNil(GrExt[I].Mask);
-    FreeMem(GrExt[I]);
-  end;
-
+  FreeAndNil(GrExt);
   ReleaseFonts;
-
   FreeAndNil(Phrases);
   FreeAndNil(Phrases2);
@@ -1744 +1736 @@
 end;
 
+{ TGrExtDescr }
+
+procedure TGrExtDescr.ResetPixUsed;
+begin
+  SetLength(pixUsed, Data.Height div 49 * 10);
+  if Length(pixUsed) > 0 then
+    FillChar(pixUsed[0], Length(pixUsed), 0);
+end;
+
+constructor TGrExtDescr.Create;
+begin
+  Data := TBitmap.Create;
+  Data.PixelFormat := pf24bit;
+  Mask := TBitmap.Create;
+  Mask.PixelFormat := pf24bit;
+end;
+
+destructor TGrExtDescr.Destroy;
+begin
+  FreeAndNil(Data);
+  FreeAndNil(Mask);
+  inherited;
+end;
+
+{ TGrExtDescrs }
+
+function TGrExtDescrs.SearchByName(Name: string): TGrExtDescr;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I]
+    else Result := nil;
+end;
+
+function TGrExtDescrs.AddNew(Name: string): TGrExtDescr;
+begin
+  Result := TGrExtDescr.Create;
+  Result.Name := Name;
+  Add(Result);
+end;
+
 end.