Thema: Delphi [DelphiX] Sprites

Einzelnen Beitrag anzeigen

Benutzerbild von 3_of_8
3_of_8

Registriert seit: 22. Mär 2005
Ort: Dingolfing
4.129 Beiträge
 
Turbo Delphi für Win32
 
#30

Re: [DelphiX] Sprites

  Alt 5. Jul 2006, 21:07
Geht trotzdem ned...

Delphi-Quellcode:
unit Tiles;

interface

uses SysUtils, Classes, Targa, DXDraws, Graphics, Dialogs;

type
  TTiles=class
  protected
    imglst: TDXImageList;
    FTileWidth, FTileHeight: Cardinal;
    function GetTile(Index: Cardinal): TPictureCollectionItem;
    function GetCount: Integer;
  public
    constructor Create(DXDraw: TDXDraw);
    destructor Destroy; override;
    procedure LoadFromFile(FileName: string);
    property TileWidth: Cardinal read FTileWidth;
    property TileHeight: Cardinal read FTileHeight;
    property Tiles[Index: Cardinal]: TPictureCollectionItem
          read GetTile; default;
    property Count: Integer read GetCount;
  end;

implementation

function TTiles.GetTile(Index: Cardinal): TPictureCOllectionItem;
begin
  Result:=imglst.Items.Items[Index];
end;

constructor TTiles.Create(DXDraw: TDXDraw);
begin
  inherited Create;
  FTileWidth:=32;
  FTileHeight:=32;
  imglst:=TDXImageList.Create(DXDraw);
end;

destructor TTiles.Destroy;
begin
  imglst.free;
  inherited Destroy;
end;

function TTiles.GetCount: Integer;
begin
  result:=imglst.items.Count;
end;

procedure TTiles.LoadFromFile(FileName: string);
var fs: TFileStream;
  memstr: TMemoryStream;
  size: Cardinal;
  buf: array of Byte;
  tgaimg: TTarga;
begin
  imglst.Items.Clear;
  fs:=TFileStream.Create(FileName, fmOpenRead);
  memstr:=TMemoryStream.Create;
  tgaimg:=TTarga.Create;
  fs.Read(FTileWidth, sizeof(Cardinal));
  fs.Read(FTileHeight, sizeof(Cardinal));
  while true do
  begin
    if fs.Read(size, sizeof(Cardinal))<sizeof(Cardinal) then break;
    setlength(buf, size);
    if Cardinal(fs.Read(buf[0], size))<size then break;
    memstr.Write(buf[0], size);
    memstr.position:=0;
    tgaimg.LoadFromStream(memstr);
    with imglst.Items.Items[imglst.Items.Add.Index] do
    begin
       Picture.Bitmap:=TBitmap.Create;
       Picture.Bitmap.Assign(tgaimg.Bitmap);
      Picture.Bitmap.Canvas.Pen.Style:=psDash; ;
        Picture.Bitmap.Canvas.Pen.Color:=clWhite;
      Picture.Bitmap.Canvas.Brush.Style:=bsClear;
      Picture.Bitmap.Canvas.Rectangle(0, 0, Picture.Bitmap.Width-1,
            Picture.Bitmap.Height-1);
    end;
    memstr.Clear;
  end;
  imglst.Items.Restore;
  setlength(buf, 0);
  fs.free;
  memstr.free;
  tgaimg.free;
end;

end.
Manuel Eberl
„The trouble with having an open mind, of course, is that people will insist on coming along and trying to put things in it.“
- Terry Pratchett
  Mit Zitat antworten Zitat