Changeset 314 for trunk


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.
Location:
trunk
Files:
4 added
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/LocalPlayer/IsoEngine.pas

    r313 r314  
    66uses
    77  Protocol, ClientTools, ScreenTools, Tribes, {$IFNDEF SCR}Term, {$ENDIF}
    8   LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer;
     8  LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer, UGraphicSet;
    99
    1010type
    … …  
    5151    procedure FillRect(x, y, Width, Height, Color: integer);
    5252    procedure Textout(x, y, Color: integer; const s: string);
    53     procedure Sprite(HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     53    procedure Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    5454    procedure TSprite(xDst, yDst, grix: integer; PureBlack: boolean = false);
    5555
    … …  
    144144  xSrc: Integer;
    145145  ySrc: Integer;
    146   HGrTerrainNew: TGrExtDescr;
    147   HGrCitiesNew: TGrExtDescr;
     146  HGrTerrainNew: TGraphicSet;
     147  HGrCitiesNew: TGraphicSet;
    148148  Age: Integer;
    149149  Size: Integer;
    … …  
    534534end;
    535535
    536 procedure TIsoMap.Sprite(HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     536procedure TIsoMap.Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
    537537begin
    538538  BitBltBitmap(HGr.Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND);
    … …  
    640640var
    641641  age: Integer;
    642   cHGr: TGrExtDescr;
     642  cHGr: TGraphicSet;
    643643  cpix: Integer;
    644644  xGr: Integer;

  • trunk/LocalPlayer/Term.pas

    r313 r314  
    1313  Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase,
    1414  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, DrawDlg, Types,
    15   Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area;
     15  Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area,
     16  UGraphicSet;
    1617
    1718const
    … …  
    445446  SoundPreloadDone: Integer;
    446447  MarkCityLoc: Integer;
    447   HGrTerrain: TGrExtDescr;
    448   HGrCities: TGrExtDescr;
     448  HGrTerrain: TGraphicSet;
     449  HGrCities: TGraphicSet;
    449450  MovieSpeed: Integer;
    450451  CityRepMask: Cardinal;
    … …  
    43144315    Sprite(Panel, HGrSystem, xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx)
    43154316      + (G.lx - MapWidth div (xxt * 2)) - 2 * xwd) mod (2 * G.lx) +
    4316       MarkCityLoc div G.lx and 1, yMini - 3 + MarkCityLoc div G.lx, 10,
    4317       10, 77, 47)
     4317      MarkCityLoc div G.lx and 1, yMini - 3 + MarkCityLoc div G.lx, CityMark2.Width,
     4318      CityMark2.Height, CityMark2.Left, CityMark2.Top)
    43184319  else if ywmax <= 0 then
    43194320    Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2,

  • trunk/LocalPlayer/Tribes.pas

    r313 r314  
    55
    66uses
    7   Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global;
     7  Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global,
     8  UGraphicSet;
    89
    910type
    … …  
    1415
    1516  TModelPicture = record
    16     HGr: TGrExtDescr;
     17    HGr: TGraphicSet;
    1718    pix: Integer;
    1819    xShield: Integer;
    … …  
    2930
    3031  TTribe = class
    31     symHGr: TGrExtDescr;
     32    symHGr: TGraphicSet;
    3233    sympix: Integer;
    33     faceHGr: TGrExtDescr;
     34    faceHGr: TGraphicSet;
    3435    facepix: Integer;
    35     cHGr: TGrExtDescr;
     36    cHGr: TGraphicSet;
    3637    cpix: Integer;
    3738    // symbol and city graphics
    … …  
    6263var
    6364  Tribe: array [0 .. nPl - 1] of TTribe;
    64   HGrStdUnits: TGrExtDescr;
     65  HGrStdUnits: TGraphicSet;
    6566
    6667procedure Init;
    … …  
    7071procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string);
    7172function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean;
    72 procedure FindPosition(HGr: TGrExtDescr; x, y, xmax, ymax: Integer; Mark: TColor;
     73procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;
    7374  var xp, yp: Integer);
    7475
    … …  
    8283  TChosenModelPictureInfo = record
    8384    Hash: Integer;
    84     HGr: TGrExtDescr;
     85    HGr: TGraphicSet;
    8586    pix: Integer;
    8687    ModelName: ShortString;
    … …  
    328329end;
    329330
    330 procedure FindPosition(HGr: TGrExtDescr; x, y, xmax, ymax: Integer; Mark: TColor;
     331procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;
    331332  var xp, yp: Integer);
    332333begin
    … …  
    560561  i: Integer;
    561562  Cnt: Integer;
    562   HGr: TGrExtDescr;
     563  HGr: TGraphicSet;
    563564  Used: Integer;
    564565  LeastUsed: Integer;

  • trunk/Packages/CevoComponents/CevoComponents.lpk

    r287 r314  
    3737    <Description Value="C-evo components"/>
    3838    <Version Major="1" Minor="2"/>
    39     <Files Count="15">
     39    <Files Count="17">
    4040      <Item1>
    4141        <Filename Value="Area.pas"/>
    … …  
    106106        <UnitName Value="AsyncProcess2"/>
    107107      </Item15>
     108      <Item16>
     109        <Filename Value="UGraphicSet.pas"/>
     110        <UnitName Value="UGraphicSet"/>
     111      </Item16>
     112      <Item17>
     113        <Filename Value="UXMLUtils.pas"/>
     114        <UnitName Value="UXMLUtils"/>
     115      </Item17>
    108116    </Files>
    109117    <RequiredPkgs Count="2">

  • trunk/Packages/CevoComponents/CevoComponents.pas

    r287 r314  
    1010uses
    1111  Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg,
    12   Sound, BaseWin, UPixelPointer, AsyncProcess2, LazarusPackageIntf;
     12  Sound, BaseWin, UPixelPointer, AsyncProcess2, UGraphicSet, UXMLUtils,
     13  LazarusPackageIntf;
    1314
    1415implementation

  • 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.

  • trunk/Start.pas

    r313 r314  
    906906        if (i < 13) or (i > 17) then
    907907        begin
    908           BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna,
    909             HGrSystem2.Mask.Canvas, xOrna, yOrna, SRCAND);
    910           BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna,
    911             HGrSystem2.Data.Canvas, xOrna, yOrna, SRCPAINT);
     908          BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, Ornament.Width, Ornament.Height,
     909            HGrSystem2.Mask.Canvas, Ornament.Left, Ornament.Top, SRCAND);
     910          BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, Ornament.Width, Ornament.Height,
     911            HGrSystem2.Data.Canvas, Ornament.Left, Ornament.Top, SRCPAINT);
    912912        end;
    913913      PaintLogo(Canvas, 69 + 11 * 27, yLogo, MainTexture.clBevelLight,
    … …  
    990990        if (i < 2) or (i > 6) then
    991991        begin
    992           BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna,
    993             HGrSystem2.Mask.Canvas, xOrna, yOrna, SRCAND);
    994           BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, wOrna, hOrna,
    995             HGrSystem2.Data.Canvas, xOrna, yOrna, SRCPAINT);
     992          BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, Ornament.Width, Ornament.Height,
     993            HGrSystem2.Mask.Canvas, Ornament.Left, Ornament.Top, SRCAND);
     994          BitBltCanvas(Canvas, 9 + i * 27, yLogo - 2, Ornament.Width, Ornament.Height,
     995            HGrSystem2.Data.Canvas, Ornament.Left, Ornament.Top, SRCPAINT);
    996996        end;
    997997      PaintLogo(Canvas, 69, yLogo, MainTexture.clBevelLight,
Note: See TracChangeset for help on using the changeset viewer.