AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

[DelphiX] Sprites

Ein Thema von 3_of_8 · begonnen am 4. Jul 2006 · letzter Beitrag vom 6. Jul 2006
 
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, 20: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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz