Ignore:
Timestamp:
Mar 17, 2021, 11:11:55 AM (3 years ago)
Author:
chronos
Message:
  • Modified: LoadGraphicSet now returns TGrExtDescr reference. Replaced integer index references to GrExt with with direct class reference to TGrExtDescr.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r312 r313  
    2525  TLoadGraphicFileOptions = set of TLoadGraphicFileOption;
    2626
     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;
     45
     46  TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    2747
    2848{$IFDEF WINDOWS}
    … …  
    3858function HexStringToColor(S: string): integer;
    3959function LoadGraphicFile(Bmp: TBitmap; FileName: string; Options: TLoadGraphicFileOptions = []): boolean;
    40 function LoadGraphicSet(const Name: string): integer;
    41 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    42 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     60function LoadGraphicSet(const Name: string): TGrExtDescr;
     61procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
     62procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    4363  overload;
    44 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     64procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    4565  overload;
    4666procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
    … …  
    168188  cliWater = 4;
    169189
    170 type
    171 
    172   { TGrExtDescr }
    173 
    174   TGrExtDescr = class
    175     Name: string;
    176     Data: TBitmap;
    177     Mask: TBitmap;
    178     pixUsed: array of Byte;
    179     procedure ResetPixUsed;
    180     constructor Create;
    181     destructor Destroy; override;
    182   end;
    183 
    184   { TGrExtDescrs }
    185 
    186   TGrExtDescrs = class(TFPGObjectList<TGrExtDescr>)
    187     function SearchByName(Name: string): TGrExtDescr;
    188     function AddNew(Name: string): TGrExtDescr;
    189   end;
    190 
    191   TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
    192 
    193190var
    194191  Phrases: TStringTable;
    195192  Phrases2: TStringTable;
    196193  GrExt: TGrExtDescrs;
    197   HGrSystem: Integer;
    198   HGrSystem2: Integer;
     194  HGrSystem: TGrExtDescr;
     195  HGrSystem2: TGrExtDescr;
    199196  ClickFrameColor: Integer;
    200197  MainTextureAge: Integer;
    … …  
    495492end;
    496493
    497 function LoadGraphicSet(const Name: string): Integer;
    498 var
    499   I: Integer;
     494function LoadGraphicSet(const Name: string): TGrExtDescr;
     495var
    500496  x: Integer;
    501497  y: Integer;
    … …  
    505501  DataPixel: TPixelPointer;
    506502  MaskPixel: TPixelPointer;
    507   NewGrExt: TGrExtDescr;
    508 begin
    509   NewGrExt := GrExt.SearchByName(Name);
    510   if not Assigned(NewGrExt) then begin
    511     NewGrExt := GrExt.AddNew(Name);
     503begin
     504  Result := GrExt.SearchByName(Name);
     505  if not Assigned(Result) then begin
     506    Result := GrExt.AddNew(Name);
    512507    FileName := GetGraphicsDir + DirectorySeparator + Name;
    513     if not LoadGraphicFile(NewGrExt.Data, FileName) then begin
    514       Result := -1;
     508    if not LoadGraphicFile(Result.Data, FileName) then begin
     509      Result := nil;
    515510      Exit;
    516511    end;
    517512
    518     NewGrExt.ResetPixUsed;
    519 
    520     xmax := NewGrExt.Data.Width - 1; // allows 4-byte access even for last pixel
     513    Result.ResetPixUsed;
     514
     515    xmax := Result.Data.Width - 1; // allows 4-byte access even for last pixel
    521516    // Why there was that limit?
    522517    //if xmax > 970 then
    523518    //  xmax := 970;
    524519
    525     NewGrExt.Mask.SetSize(NewGrExt.Data.Width, NewGrExt.Data.Height);
    526 
    527     NewGrExt.Data.BeginUpdate;
    528     NewGrExt.Mask.BeginUpdate;
    529     DataPixel := PixelPointer(NewGrExt.Data);
    530     MaskPixel := PixelPointer(NewGrExt.Mask);
    531     for y := 0 to ScaleToNative(NewGrExt.Data.Height) - 1 do begin
     520    Result.Mask.SetSize(Result.Data.Width, Result.Data.Height);
     521
     522    Result.Data.BeginUpdate;
     523    Result.Mask.BeginUpdate;
     524    DataPixel := PixelPointer(Result.Data);
     525    MaskPixel := PixelPointer(Result.Mask);
     526    for y := 0 to ScaleToNative(Result.Data.Height) - 1 do begin
    532527      for x := 0 to ScaleToNative(xmax) - 1 do begin
    533528        OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
    … …  
    548543      MaskPixel.NextLine;
    549544    end;
    550     NewGrExt.Data.EndUpdate;
    551     NewGrExt.Mask.EndUpdate;
    552   end;
    553   Result := GrExt.IndexOf(NewGrExt);
    554 end;
    555 
    556 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     545    Result.Data.EndUpdate;
     546    Result.Mask.EndUpdate;
     547  end;
     548end;
     549
     550procedure Dump(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    557551begin
    558552  BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
    559     GrExt[HGr].Data.Canvas, xGr, yGr);
     553    HGr.Data.Canvas, xGr, yGr);
    560554end;
    561555
    … …  
    820814end;
    821815
    822 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     816procedure Sprite(Canvas: TCanvas; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    823817begin
    824818  BitBltCanvas(Canvas, xDst, yDst, Width, Height,
    825     GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
     819    HGr.Mask.Canvas, xGr, yGr, SRCAND);
    826820  BitBltCanvas(Canvas, xDst, yDst, Width, Height,
    827     GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
    828 end;
    829 
    830 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
     821    HGr.Data.Canvas, xGr, yGr, SRCPAINT);
     822end;
     823
     824procedure Sprite(dst: TBitmap; HGr: TGrExtDescr; xDst, yDst, Width, Height, xGr, yGr: integer);
    831825begin
    832826  BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
    833     GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
     827    HGr.Mask.Canvas, xGr, yGr, SRCAND);
    834828  BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
    835     GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
     829    HGr.Data.Canvas, xGr, yGr, SRCPAINT);
    836830end;
    837831
    … …  
    10101004  for x := 0 to wOrna - 1 do
    10111005    for y := 0 to hOrna - 1 do begin
    1012       p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y];
     1006      p := HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y];
    10131007      if p = $0000FF then
    1014         GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light
     1008        HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light
    10151009      else if p = $FF0000 then
    1016         GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;
     1010        HGrSystem2.Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;
    10171011    end;
    10181012  InitOrnamentDone := True;
    … …  
    10251019  for x := 0 to 9 do
    10261020    for y := 0 to 9 do
    1027       if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
     1021      if HGrSystem.Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
    10281022      begin
    1029         intensity := GrExt[HGrSystem].Data.Canvas.Pixels[66 +
     1023        intensity := HGrSystem.Data.Canvas.Pixels[66 +
    10301024          x, 47 + y] and $FF;
    1031         GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] :=
     1025        HGrSystem.Data.Canvas.Pixels[77 + x, 47 + y] :=
    10321026          T.clMark and $FF * intensity div $FF + T.clMark shr 8 and
    10331027          $FF * intensity div $FF shl 8 + T.clMark shr 16 and
    10341028          $FF * intensity div $FF shl 16;
    10351029      end;
    1036   BitBltCanvas(GrExt[HGrSystem].Mask.Canvas, 77, 47, 10, 10,
    1037     GrExt[HGrSystem].Mask.Canvas, 66, 47);
     1030  BitBltCanvas(HGrSystem.Mask.Canvas, 77, 47, 10, 10,
     1031    HGrSystem.Mask.Canvas, 66, 47);
    10381032end;
    10391033
    … …  
    11441138  procedure PaintIcon(x, y, Kind: Integer);
    11451139  begin
    1146     BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas,
     1140    BitBltCanvas(ca, x, y + 6, 10, 10, HGrSystem.Mask.Canvas,
    11471141      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND);
    1148     BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas,
     1142    BitBltCanvas(ca, x, y + 6, 10, 10, HGrSystem.Data.Canvas,
    11491143      66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT);
    11501144  end;
    … …  
    12861280    (16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
    12871281begin
    1288   Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels
     1282  Gradient(ca, x, y, 0, 1, Width, 0, HGrSystem.Data.Canvas.Pixels
    12891283    [187, 137 + Kind], Brightness);
    12901284end;
    … …  
    13041298begin
    13051299  Gradient(ca, x, y, 1, 0, 0, Height,
    1306     GrExt[HGrSystem].Data.Canvas.Pixels[187, 137 + Kind], Brightness);
     1300    HGrSystem.Data.Canvas.Pixels[187, 137 + Kind], Brightness);
    13071301end;
    13081302
    … …  
    13661360      begin
    13671361        BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
    1368           14, GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
     1362          14, HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15,
    13691363          70 + Kind div 8 * 15, SRCAND);
    13701364        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    … …  
    13751369        BitBltCanvas(dst.Canvas, xIcon + 4 + (val mod 10) *
    13761370          (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1377           GrExt[HGrSystem].Mask.Canvas, 67 + 7 mod 8 * 15,
     1371          HGrSystem.Mask.Canvas, 67 + 7 mod 8 * 15,
    13781372          70 + 7 div 8 * 15, SRCAND);
    13791373        Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) *
    … …  
    13991393      begin
    14001394        BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
    1401           GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
     1395          HGrSystem.Mask.Canvas, 67 + Kind mod 8 * 15,
    14021396          70 + Kind div 8 * 15, SRCAND);
    14031397        Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
    … …  
    14081402        BitBltCanvas(dst.Canvas, xIcon + 4 + (val div 10) *
    14091403          (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
    1410           GrExt[HGrSystem].Mask.Canvas, 66 + Kind mod 11 * 11,
     1404          HGrSystem.Mask.Canvas, 66 + Kind mod 11 * 11,
    14111405          115 + Kind div 11 * 11, SRCAND);
    14121406        Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) *
    … …  
    14441438    for i := 0 to pos div 8 - 1 do
    14451439      BitBltCanvas(ca, x + i * 8, y, 8, 7,
    1446         GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
     1440        HGrSystem.Data.Canvas, 104, 9 + 8 * Kind);
    14471441    BitBltCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
    1448       GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
     1442      HGrSystem.Data.Canvas, 104, 9 + 8 * Kind);
    14491443    if Growth > 0 then
    14501444    begin
    14511445      for i := 0 to Growth div 8 - 1 do
    14521446        BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,
    1453           GrExt[HGrSystem].Data.Canvas, 112, 9 + 8 * Kind);
     1447          HGrSystem.Data.Canvas, 112, 9 + 8 * Kind);
    14541448      BitBltCanvas(ca, x + pos + 8 * (Growth div 8), y,
    1455         Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas,
     1449        Growth - 8 * (Growth div 8), 7, HGrSystem.Data.Canvas,
    14561450        112, 9 + 8 * Kind);
    14571451    end
    … …  
    14601454      for i := 0 to -Growth div 8 - 1 do
    14611455        BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,
    1462           GrExt[HGrSystem].Data.Canvas, 104, 1);
     1456          HGrSystem.Data.Canvas, 104, 1);
    14631457      BitBltCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth -
    14641458        8 * (-Growth div 8), 7,
    1465         GrExt[HGrSystem].Data.Canvas, 104, 1);
     1459        HGrSystem.Data.Canvas, 104, 1);
    14661460    end;
    14671461    Brush.Color := $000000;
    … …  
    17121706  MainTexture.Image := TBitmap.Create;
    17131707  MainTextureAge := -2;
    1714   ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];
     1708  ClickFrameColor := HGrSystem.Data.Canvas.Pixels[187, 175];
    17151709  InitOrnamentDone := False;
    17161710  GenerateNames := True;
Note: See TracChangeset for help on using the changeset viewer.