Changeset 314
- Timestamp:
- Mar 18, 2021, 9:46:52 PM (4 years ago)
- Location:
- trunk
- Files:
-
- 4 added
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/IsoEngine.pas
r313 r314 6 6 uses 7 7 Protocol, ClientTools, ScreenTools, Tribes, {$IFNDEF SCR}Term, {$ENDIF} 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer ;8 LCLIntf, LCLType, SysUtils, Classes, Graphics, UPixelPointer, UGraphicSet; 9 9 10 10 type … … 51 51 procedure FillRect(x, y, Width, Height, Color: integer); 52 52 procedure Textout(x, y, Color: integer; const s: string); 53 procedure Sprite(HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);53 procedure Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 54 54 procedure TSprite(xDst, yDst, grix: integer; PureBlack: boolean = false); 55 55 … … 144 144 xSrc: Integer; 145 145 ySrc: Integer; 146 HGrTerrainNew: TGr ExtDescr;147 HGrCitiesNew: TGr ExtDescr;146 HGrTerrainNew: TGraphicSet; 147 HGrCitiesNew: TGraphicSet; 148 148 Age: Integer; 149 149 Size: Integer; … … 534 534 end; 535 535 536 procedure TIsoMap.Sprite(HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);536 procedure TIsoMap.Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 537 537 begin 538 538 BitBltBitmap(HGr.Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); … … 640 640 var 641 641 age: Integer; 642 cHGr: TGr ExtDescr;642 cHGr: TGraphicSet; 643 643 cpix: Integer; 644 644 xGr: Integer; -
trunk/LocalPlayer/Term.pas
r313 r314 13 13 Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase, 14 14 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; 16 17 17 18 const … … 445 446 SoundPreloadDone: Integer; 446 447 MarkCityLoc: Integer; 447 HGrTerrain: TGr ExtDescr;448 HGrCities: TGr ExtDescr;448 HGrTerrain: TGraphicSet; 449 HGrCities: TGraphicSet; 449 450 MovieSpeed: Integer; 450 451 CityRepMask: Cardinal; … … 4314 4315 Sprite(Panel, HGrSystem, xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) 4315 4316 + (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) 4318 4319 else if ywmax <= 0 then 4319 4320 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2, -
trunk/LocalPlayer/Tribes.pas
r313 r314 5 5 6 6 uses 7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global; 7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global, 8 UGraphicSet; 8 9 9 10 type … … 14 15 15 16 TModelPicture = record 16 HGr: TGr ExtDescr;17 HGr: TGraphicSet; 17 18 pix: Integer; 18 19 xShield: Integer; … … 29 30 30 31 TTribe = class 31 symHGr: TGr ExtDescr;32 symHGr: TGraphicSet; 32 33 sympix: Integer; 33 faceHGr: TGr ExtDescr;34 faceHGr: TGraphicSet; 34 35 facepix: Integer; 35 cHGr: TGr ExtDescr;36 cHGr: TGraphicSet; 36 37 cpix: Integer; 37 38 // symbol and city graphics … … 62 63 var 63 64 Tribe: array [0 .. nPl - 1] of TTribe; 64 HGrStdUnits: TGr ExtDescr;65 HGrStdUnits: TGraphicSet; 65 66 66 67 procedure Init; … … 70 71 procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string); 71 72 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean; 72 procedure FindPosition(HGr: TGr ExtDescr; x, y, xmax, ymax: Integer; Mark: TColor;73 procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor; 73 74 var xp, yp: Integer); 74 75 … … 82 83 TChosenModelPictureInfo = record 83 84 Hash: Integer; 84 HGr: TGr ExtDescr;85 HGr: TGraphicSet; 85 86 pix: Integer; 86 87 ModelName: ShortString; … … 328 329 end; 329 330 330 procedure FindPosition(HGr: TGr ExtDescr; x, y, xmax, ymax: Integer; Mark: TColor;331 procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor; 331 332 var xp, yp: Integer); 332 333 begin … … 560 561 i: Integer; 561 562 Cnt: Integer; 562 HGr: TGr ExtDescr;563 HGr: TGraphicSet; 563 564 Used: Integer; 564 565 LeastUsed: Integer; -
trunk/Packages/CevoComponents/CevoComponents.lpk
r287 r314 37 37 <Description Value="C-evo components"/> 38 38 <Version Major="1" Minor="2"/> 39 <Files Count="1 5">39 <Files Count="17"> 40 40 <Item1> 41 41 <Filename Value="Area.pas"/> … … 106 106 <UnitName Value="AsyncProcess2"/> 107 107 </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> 108 116 </Files> 109 117 <RequiredPkgs Count="2"> -
trunk/Packages/CevoComponents/CevoComponents.pas
r287 r314 10 10 uses 11 11 Area, ButtonA, ButtonB, ButtonC, ButtonN, EOTButton, ButtonBase, DrawDlg, 12 Sound, BaseWin, UPixelPointer, AsyncProcess2, LazarusPackageIntf; 12 Sound, BaseWin, UPixelPointer, AsyncProcess2, UGraphicSet, UXMLUtils, 13 LazarusPackageIntf; 13 14 14 15 implementation -
trunk/Packages/CevoComponents/ScreenTools.pas
r313 r314 8 8 {$ENDIF} 9 9 StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math, 10 Forms, Menus, GraphType, fgl ;10 Forms, Menus, GraphType, fgl, UGraphicSet, LazFileUtils; 11 11 12 12 type … … 24 24 TLoadGraphicFileOption = (gfNoError, gfNoGamma); 25 25 TLoadGraphicFileOptions = set of TLoadGraphicFileOption; 26 27 { TGrExtDescr }28 29 TGrExtDescr = class30 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;45 26 46 27 TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton); … … 58 39 function HexStringToColor(S: string): integer; 59 40 function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean; 60 function LoadGraphicSet(const Name: string): TGr ExtDescr;61 procedure Dump(dst: TBitmap; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);62 procedure Sprite(Canvas: TCanvas; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);41 function LoadGraphicSet(const Name: string): TGraphicSet; 42 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 43 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 63 44 overload; 64 procedure Sprite(dst: TBitmap; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);45 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 65 46 overload; 66 47 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer); … … 155 136 EmptySpaceColor = $101010; 156 137 157 // template positions in System2.bmp158 xOrna = 156;159 yOrna = 1;160 wOrna = 27;161 hOrna = 26; // ornament162 163 138 // color matrix 164 139 clkAge0 = 1; … … 191 166 Phrases: TStringTable; 192 167 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; 196 174 ClickFrameColor: Integer; 197 175 MainTextureAge: Integer; … … 492 470 end; 493 471 494 function LoadGraphicSet(const Name: string): TGr ExtDescr;472 function LoadGraphicSet(const Name: string): TGraphicSet; 495 473 var 496 474 x: Integer; … … 510 488 Exit; 511 489 end; 490 491 FileName := ExtractFileNameWithoutExt(FileName) + GraphicSetFileExt; 492 if FileExists(FileName) then 493 Result.LoadFromFile(FileName); 512 494 513 495 Result.ResetPixUsed; … … 548 530 end; 549 531 550 procedure Dump(dst: TBitmap; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);532 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 551 533 begin 552 534 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, … … 814 796 end; 815 797 816 procedure Sprite(Canvas: TCanvas; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);798 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 817 799 begin 818 800 BitBltCanvas(Canvas, xDst, yDst, Width, Height, … … 822 804 end; 823 805 824 procedure Sprite(dst: TBitmap; HGr: TGr ExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);806 procedure Sprite(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer); 825 807 begin 826 808 BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height, … … 1002 984 Shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 + 1003 985 MainTexture.clBevelLight and $FCFCFC shr 2; 1004 for x := 0 to wOrna- 1 do1005 for y := 0 to hOrna- 1 do begin1006 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]; 1007 989 if p = $0000FF then 1008 HGrSystem2.Data.Canvas.Pixels[ xOrna + x, yOrna+ y] := Light990 HGrSystem2.Data.Canvas.Pixels[Ornament.Left + x, Ornament.Top + y] := Light 1009 991 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; 1011 993 end; 1012 994 InitOrnamentDone := True; … … 1015 997 procedure InitCityMark(const T: TTexture); 1016 998 var 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; 1002 begin 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 1022 1006 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 and1027 $FF * intensity div $FF shl 8 + T.clMark shr 16 and1028 $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; 1029 1013 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); 1032 1018 end; 1033 1019 … … 1693 1679 UniFont[Section] := TFont.Create; 1694 1680 1695 GrExt := TGrExtDescrs.Create; 1681 GrExt := TGraphicSets.Create; 1682 1696 1683 HGrSystem := LoadGraphicSet('System.png'); 1684 CityMark1 := HGrSystem.GetItem('CityMark1'); 1685 CityMark2 := HGrSystem.GetItem('CityMark2'); 1686 1697 1687 HGrSystem2 := LoadGraphicSet('System2.png'); 1688 Ornament := HGrSystem2.GetItem('Ornament'); 1689 1698 1690 Templates := TBitmap.Create; 1699 1691 Templates.PixelFormat := pf24bit; … … 1730 1722 end; 1731 1723 1732 { TGrExtDescr }1733 1734 procedure TGrExtDescr.ResetPixUsed;1735 begin1736 SetLength(pixUsed, Data.Height div 49 * 10);1737 if Length(pixUsed) > 0 then1738 FillChar(pixUsed[0], Length(pixUsed), 0);1739 end;1740 1741 constructor TGrExtDescr.Create;1742 begin1743 Data := TBitmap.Create;1744 Data.PixelFormat := pf24bit;1745 Mask := TBitmap.Create;1746 Mask.PixelFormat := pf24bit;1747 end;1748 1749 destructor TGrExtDescr.Destroy;1750 begin1751 FreeAndNil(Data);1752 FreeAndNil(Mask);1753 inherited;1754 end;1755 1756 { TGrExtDescrs }1757 1758 function TGrExtDescrs.SearchByName(Name: string): TGrExtDescr;1759 var1760 I: Integer;1761 begin1762 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 begin1770 Result := TGrExtDescr.Create;1771 Result.Name := Name;1772 Add(Result);1773 end;1774 1775 1724 end. -
trunk/Start.pas
r313 r314 906 906 if (i < 13) or (i > 17) then 907 907 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); 912 912 end; 913 913 PaintLogo(Canvas, 69 + 11 * 27, yLogo, MainTexture.clBevelLight, … … 990 990 if (i < 2) or (i > 6) then 991 991 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); 996 996 end; 997 997 PaintLogo(Canvas, 69, yLogo, MainTexture.clBevelLight,
Note:
See TracChangeset
for help on using the changeset viewer.