Ignore:
Timestamp:
Mar 18, 2021, 9:46:52 PM (4 years ago)
Author:
chronos
Message:
  • Added: Graphic set can now load dimensions of its graphic set items from a file. This effort should help with elimination of hardcoded graphic items dimensions in graphics sets. Gradually all graphic sets should have description of their items.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r313 r314  
    88  {$ENDIF}
    99  StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
    10   Forms, Menus, GraphType, fgl;
     10  Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils;
    1111
    1212type
    … …  
    2424  TLoadGraphicFileOption = (gfNoError, gfNoGamma);
    2525  TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
    26 
    27   { TGrExtDescr }
    28 
    29   TGrExtDescr = class
    30     Name: string;
    31     Data: TBitmap;
    32     Mask: TBitmap;
    33     pixUsed: array of Byte;
    34     procedure ResetPixUsed;
    35     constructor Create;
    36     destructor Destroy; override;
    37   end;
    38 
    39   { TGrExtDescrs }
    40 
    41   TGrExtDescrs = class(TFPGObjectList<TGrExtDescr>)
    42     function SearchByName(Name: string): TGrExtDescr;
    43     function AddNew(Name: string): TGrExtDescr;
    44   end;
    4526
    4627  TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    … …  
    5839function HexStringToColor(S: string): integer;
    5940function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean;
    60 function LoadGraphicSet(const Name: string): TGrExtDescr;
    61 procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    62 procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     41function LoadGraphicSet(const Name: string): TGraphicSet;
     42procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
     43procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    6344  overload;
    64 procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     45procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    6546  overload;
    6647procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
    … …  
    155136  EmptySpaceColor = $101010;
    156137
    157   // template positions in System2.bmp
    158   xOrna = 156;
    159   yOrna = 1;
    160   wOrna = 27;
    161   hOrna = 26; // ornament
    162 
    163138  // color matrix
    164139  clkAge0 = 1;
    … …  
    191166  Phrases: TStringTable;
    192167  Phrases2: TStringTable;
    193   GrExt: TGrExtDescrs;
    194   HGrSystem: TGrExtDescr;
    195   HGrSystem2: TGrExtDescr;
     168  GrExt: TGraphicSets;
     169  HGrSystem: TGraphicSet;
     170  HGrSystem2: TGraphicSet;
     171  CityMark1: TGraphicSetItem;
     172  CityMark2: TGraphicSetItem;
     173  Ornament: TGraphicSetItem;
    196174  ClickFrameColor: Integer;
    197175  MainTextureAge: Integer;
    … …  
    492470end;
    493471
    494 function LoadGraphicSet(const Name: string): TGrExtDescr;
     472function LoadGraphicSet(const Name: string): TGraphicSet;
    495473var
    496474  x: Integer;
    … …  
    510488      Exit;
    511489    end;
     490
     491    FileName := ExtractFileNameWithoutExt(FileName) + GraphicSetFileExt;
     492    if FileExists(FileName) then
     493      Result.LoadFromFile(FileName);
    512494
    513495    Result.ResetPixUsed;
    … …  
    548530end;
    549531
    550 procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     532procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    551533begin
    552534  BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
    … …  
    814796end;
    815797
    816 procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     798procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    817799begin
    818800  BitBltCanvas(Canvas, xDst, yDst, Width, Height,
    … …  
    822804end;
    823805
    824 procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     806procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    825807begin
    826808  BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
    … …  
    1002984  Shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
    1003985    MainTexture.clBevelLight and $FCFCFC shr 2;
    1004   for x := 0 to wOrna - 1 do
    1005     for y := 0 to hOrna - 1 do begin
    1006       p := HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y];
     986  for x := 0 to Ornament.Width - 1 do
     987    for y := 0 to Ornament.Height - 1 do begin
     988      p := HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y];
    1007989      if p = $0000FF then
    1008         HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light
     990        HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y] := Light
    1009991      else if p = $FF0000 then
    1010         HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;
     992        HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y] := Shade;
    1011993    end;
    1012994  InitOrnamentDone := True;
    … …  
    1015997procedure InitCityMark(const T: TTexture);
    1016998var
    1017   x, y, intensity: Integer;
    1018 begin
    1019   for x := 0 to 9 do
    1020     for y := 0 to 9 do
    1021       if HGrSystem.Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
     999  x: Integer;
     1000  y: Integer;
     1001  Intensity: Integer;
     1002begin
     1003  for x := 0 to CityMark1.Width - 1 do begin
     1004    for y := 0 to CityMark1.Height - 1 do begin
     1005      if HGrSystem.Mask.Canvas.Pixels[CityMark1.Left + x, CityMark1.Top + y] = 0 then
    10221006      begin
    1023         intensity := HGrSystem.Data.Canvas.Pixels[66 +
    1024           x, 47 + y] and $FF;
    1025         HGrSystem.Data.Canvas.Pixels[77 + x, 47 + y] :=
    1026           T.clMark and $FF * intensity div $FF + T.clMark shr 8 and
    1027           $FF * intensity div $FF shl 8 + T.clMark shr 16 and
    1028           $FF * intensity div $FF shl 16;
     1007        Intensity := HGrSystem.Data.Canvas.Pixels[CityMark1.Left +
     1008          x, CityMark1.Top + y] and $FF;
     1009        HGrSystem.Data.Canvas.Pixels[CityMark2.Left + x, CityMark2.Top + y] :=
     1010          T.clMark and $FF * Intensity div $FF + T.clMark shr 8 and
     1011          $FF * Intensity div $FF shl 8 + T.clMark shr 16 and
     1012          $FF * Intensity div $FF shl 16;
    10291013      end;
    1030   BitBltCanvas(HGrSystem.Mask.Canvas, 77, 47, 10, 10,
    1031     HGrSystem.Mask.Canvas, 66, 47);
     1014    end;
     1015  end;
     1016  BitBltCanvas(HGrSystem.Mask.Canvas, CityMark2.Left, CityMark2.Top, CityMark1.Width, CityMark1.Width,
     1017    HGrSystem.Mask.Canvas, CityMark1.Left, CityMark1.Top);
    10321018end;
    10331019
    … …  
    16931679    UniFont[Section] := TFont.Create;
    16941680
    1695   GrExt := TGrExtDescrs.Create;
     1681  GrExt := TGraphicSets.Create;
     1682
    16961683  HGrSystem := LoadGraphicSet('System.png');
     1684  CityMark1 := HGrSystem.GetItem('CityMark1');
     1685  CityMark2 := HGrSystem.GetItem('CityMark2');
     1686
    16971687  HGrSystem2 := LoadGraphicSet('System2.png');
     1688  Ornament := HGrSystem2.GetItem('Ornament');
     1689
    16981690  Templates := TBitmap.Create;
    16991691  Templates.PixelFormat := pf24bit;
    … …  
    17301722end;
    17311723
    1732 { TGrExtDescr }
    1733 
    1734 procedure TGrExtDescr.ResetPixUsed;
    1735 begin
    1736   SetLength(pixUsed, Data.Height div 49 * 10);
    1737   if Length(pixUsed) > 0 then
    1738     FillChar(pixUsed[0], Length(pixUsed), 0);
    1739 end;
    1740 
    1741 constructor TGrExtDescr.Create;
    1742 begin
    1743   Data := TBitmap.Create;
    1744   Data.PixelFormat := pf24bit;
    1745   Mask := TBitmap.Create;
    1746   Mask.PixelFormat := pf24bit;
    1747 end;
    1748 
    1749 destructor TGrExtDescr.Destroy;
    1750 begin
    1751   FreeAndNil(Data);
    1752   FreeAndNil(Mask);
    1753   inherited;
    1754 end;
    1755 
    1756 { TGrExtDescrs }
    1757 
    1758 function TGrExtDescrs.SearchByName(Name: string): TGrExtDescr;
    1759 var
    1760   I: Integer;
    1761 begin
    1762   I := 0;
    1763   while (I < Count) and (Items[I].Name <> Name) do Inc(I);
    1764   if I < Count then Result := Items[I]
    1765     else Result := nil;
    1766 end;
    1767 
    1768 function TGrExtDescrs.AddNew(Name: string): TGrExtDescr;
    1769 begin
    1770   Result := TGrExtDescr.Create;
    1771   Result.Name := Name;
    1772   Add(Result);
    1773 end;
    1774 
    17751724end.
Note: See TracChangeset for help on using the changeset viewer.