Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];

Вниз

Модуль   Найти похожие ветки 

 
ЫШО ©   (2004-06-05 20:42) [0]

Народ, у кого есть PowerDraw то скиньте на мыло пожалуйста модуль, который отвечает за поддержку изображений *.tga
Вроде называется tgareader.pas

mailto:grei@balabanovo.ru


 
ЫШО ©   (2004-06-05 21:01) [1]

Ну пожалуйста! Жалко 6 мег трафика ради модуля на 20 кило!


 
lyeh ©   (2004-06-06 00:25) [2]

Лень отсылать, забирай так: (да простят меня админы :) )

unit TGAReader;

interface

uses SYSUtils, Graphics;

type
TBitmapEx = class(TBitmap)
public
 procedure LoadFromFile(const FileName: String); override;
 procedure SaveToFile(const FileName: String); override;
end;

implementation

type
TTGAHeader = packed record
 tfIDLength: Byte;
 tfColorMapType: Byte;
 tfImageType: Byte;
 tfColorMapSpec: Array[0..4] of Byte;
 tfOrigX: Word;
 tfOrigY: Word;
 tfWidth: Word;
 tfHeight: Word;
 tfBpp: Byte;
 tfImageDesc: Byte;
 end;

procedure TBitmapEx.LoadFromFile(const FileName: String);
var
F: File;
Header: TTGAHeader;
Bpp, I: Integer;
Flip: Boolean;

RLE: Boolean;    // RLE flag
p,               // pointer to move trough data
Data: Pointer;   // temp store for imagedata, used for unpacking RLE data
BytePP: Integer; // Bytes Per Pixels
b,               // RLE BlockLength
RLEHeader: Byte; // RLE blockheader
RLEBuf: Cardinal;// Temp store for one pixel
TSize: Integer;
begin
if (CompareText(ExtractFileExt(FileName), ".tga") <> 0) then
 begin
  inherited LoadFromFile(FileName);
  Exit;
 end;

AssignFile(F, FileName);
Reset(F, 1);

BlockRead(F, Header, SizeOf(Header));

RLE:= Header.tfImageType = 10;
// checking if True-Color format is present
if (Header.tfImageType <> 2)and(not RLE) then
 begin
  CloseFile(F);
  raise Exception.Create("TGA graphics is not in True-Color");
 end;

// checking is colormapping present
if (Header.tfColorMapType <> 0) then
 begin
  CloseFile(F);
  raise Exception.Create("Color-mapped TGA is not supported");
 end;

// checking bit-depth
Bpp:= Header.tfBpp;
if (Bpp <> 32)and(Bpp <> 24) then
 begin
  CloseFile(F);
  raise Exception.Create("Invalid TGA Bit-depth!");
 end;

// checking if the image is mirrored
if (Header.tfImageDesc and $10 = $10) then
 begin
  CloseFile(F);
  raise Exception.Create("Mirrored TGA is not supported!");
 end;
Flip:= (Header.tfImageDesc and $20 <> $20);

// skip Image ID field
if (Header.tfIDLength <> 0) then
 Seek(F, FilePos(F) + Header.tfIDLength);

Width:= Header.tfWidth;
Height:= Header.tfHeight;

BytePP:= Bpp div 8;
TSize:= Width * Height * BytePP;
GetMem(Data, TSize);

if (RLE) then
 begin
  i:= 0;
  while (i < TSize) do
   begin
    // read the RLE header
    BlockRead(F, RLEHeader, 1);
    // RLE Block length
    b:= RLEHeader and $7F + 1;
    if (RLEHeader and $80) = $80 then
     begin
      // If highest bit is set, the read one pixel and repeat it b times
      BlockRead(F, RLEBuf, BytePP); // read the pixel
      while (b > 0) do
       begin
        Move(RLEBuf, Pointer(Integer(Data) + i)^, BytePP); // repeat the pixel, one at a time
        Inc(i, BytePP);  // inc "read pointer"
        Dec(b);          // dec remaining pixels
       end; // while (b > 0)
     end else
     begin
      // read b pixels
      BlockRead(f,Pointer(Integer(Data)+i)^,BytePP*b);
      // inc "read pointer"
      Inc(i,BytePP*b);
     end; // if (RLEHeader and $80) = $80 ...
   end; // while (i < TSize)
 end else
  BlockRead(F, Data^, TSize); // Not RunLengthEncoded, just read it all

p:= data;
if (Bpp = 32) then PixelFormat:= pf32bit
 else PixelFormat:= pf24bit;

// move the picture from data to scanlines
if (Flip) then
 begin
  for I:= Height - 1 downto 0 do
   begin
    Move(p^, ScanLine[I]^,Width * BytePP);
    p:= Pointer(Integer(p) + Width * BytePP);
   end;
 end else
 begin
  for I:= 0 to Height - 1 do
   begin
    Move(p^,ScanLine[I]^,Width * BytePP);
    p:= Pointer(Integer(p) + Width * BytePP);
  end;
end;

// clean up
FreeMem(Data);
CloseFile(F);
end;

procedure TBitmapEx.SaveToFile(const FileName: String);
Var F: File;
   Header: TTGAHeader;
   I: Integer;
begin
if (CompareText(ExtractFileExt(FileName), ".tga") <> 0) then
 begin
  inherited SaveToFile(FileName);
  Exit;
 end;

if (PixelFormat <> pf24bit)and(PixelFormat <> pf32bit) then
 raise Exception.Create("Invalid pixel format!");

AssignFile(F, FileName);
ReWrite(F, 1);

FillChar(Header, SizeOf(Header), 0);

Header.tfImageType:= 2; // True-color
Header.tfColorMapType:= 0; // No colormapping

Header.tfImageDesc:= $20; // the image is not flipped

Header.tfWidth:= Width;
Header.tfHeight:= Height;

Header.tfBpp:= 32;
if (PixelFormat = pf24bit) then
 Header.tfBpp:= 24;

BlockWrite(F, Header, SizeOf(Header));

Case Header.tfBpp of
 32: begin
      PixelFormat:= pf32bit;

      for I:= 0 to Height - 1 do
       BlockWrite(F, ScanLine[I]^, Width * 4);
     end;
 24: begin
      PixelFormat:= pf24bit;

      for I:= 0 to Height - 1 do
       BlockWrite(F, ScanLine[I]^, Width * 3);
     end;
end;

CloseFile(F);
end;

end.


 
Amoeba ©   (2004-06-07 11:45) [3]

Поможет библиотека GraphicEx (бесплатно, с исходниками):
http://www.delphi-gems.com



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.053 c
4-1085052879
ekap
2004-05-20 15:34
2004.06.27
Как выдернуть информацию из другой программы..?


1-1087202445
PenguinX
2004-06-14 12:40
2004.06.27
структура BMP-файла


1-1086887027
nester
2004-06-10 21:03
2004.06.27
Как зашифровать exe-шник и расшифровать его на лету.


1-1087061010
Supreme
2004-06-12 21:23
2004.06.27
Как прочитать содержимое памяти, занятое другой прогой


1-1087208125
alexa
2004-06-14 14:15
2004.06.27
Выделение в listbox





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский