Главная » Delphi » Графика » Читаем и отображаем TGA с альфа-каналом.

Читаем и отображаем TGA с альфа-каналом.

16:30
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    BH: HBITMAP;
    alphachannel: boolean;
    b_width, b_height: integer;
  public
    { Public declarations }
  end;
 
type TGA_Header = packed record // http://allrussweb.com.ru/delphi/filesystem/formatfile/005.php
    IDLength: byte; // Длина ID-поля (ID Field Length)
    ColorMapType: byte; // TТип цветовой карты (Color-map Type)
    ImageType: byte; // Тип изображения (Image Type)
    FirstEntryIndex: WORD; //Первое включение цветовой карты (First Color-map Entry)
    Length: WORD; //Длина цветовой карты (Color-map Length)
    EntrySize: byte; //Размер цветовой карты (Color-map Entry Size)
    xOrigin, //Горизонтальная координата начала изображения (Image X Origin)
      yOrigin, //Вертикальная координата начала изображения (Image Y Origin)
      Width, //Ширина изображения (Image Width)
      Height: WORD; //Высота изображения (Image Height)
    PixelDepth, //Бит на пиксел (Bits-Per-Pixel)
      ImageDescriptor: byte; // Биты дескриптора изображения (Image-Descriptor Bits)
  end;
 
type
  TCByte = array[0..3] of byte;
  PColorBytes = ^TColorBytes;
  TColorBytes = array[0..0] of TCByte;
var
  Form1: TForm1;
implementation
 
{$R *.dfm}
 
function Load32bitTGA2(pFileName: PChar; var alpha: boolean; var b_width, b_height: integer): HBITMAP;
var
  handle: HWND;
  header: TGA_Header;
  dwRead: DWORD;
  bmp: BITMAPINFO;
  pBits: PColorBytes;
  hBmp: HBITMAP;
  y: integer;
begin
  result := 0;
 
  handle := CreateFile(pFileName, GENERIC_READ, FILE_SHARE_READ,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 
  if handle = INVALID_HANDLE_VALUE then begin
    result := 0;
    exit;
  end;
 
  dwRead := 0;
  ReadFile(handle, header, sizeof(header), dwRead, nil);
 
  if ((header.IDLength <> 0) or (header.ColorMapType <> 0) or (header.ImageType <> 2) {<--RLE}
   { or(header.PixelDepth = 32)or (header.ImageDescriptor <> 8)}) then
  begin
    CloseHandle(handle);
    result := 0;
    exit;
  end;
 
  fillchar(bmp, sizeof(BITMAPINFO), 0);
  bmp.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
 
  if header.ImageDescriptor and $10 = $10 then
    bmp.bmiHeader.biWidth := -header.Width
  else
    bmp.bmiHeader.biWidth := header.Width;
 
  b_width := header.Width;
 
  if header.ImageDescriptor and $20 = $20 then
    bmp.bmiHeader.biHeight := -header.Height
  else
    bmp.bmiHeader.biHeight := header.Height;
 
  b_height := header.Height;
  bmp.bmiHeader.biPlanes := 1;
  bmp.bmiHeader.biBitCount := header.PixelDepth;
  bmp.bmiHeader.biCompression := 0;
  hBmp := CreateDIBSection(0, bmp, DIB_RGB_COLORS, Pointer(pBits), 0, 0);
 
  if (hBmp = 0) then begin
    CloseHandle(handle);
    result := 0;
    exit;
  end;
  alpha := false;
 
  case header.PixelDepth of
    32: begin
        ReadFile(handle, pBits^, header.Width * header.Height * 4, dwRead, nil);
        alpha := true;
      end;
    24: ReadFile(handle, pBits^, header.Width * header.Height * 3, dwRead, nil);
    16: ReadFile(handle, pBits^, header.Width * header.Height * 2, dwRead, nil);
  end;
 
  CloseHandle(handle);
 
  if alpha then
    for y := 0 to header.Width * header.Height - 2 do
    begin
      pBits^[y][0] := pBits^[y][0] * pBits^[y][3] div 255;
      pBits^[y][1] := pBits^[y][1] * pBits^[y][3] div 255;
      pBits^[y][2] := pBits^[y][2] * pBits^[y][3] div 255;
    end;
 
  result := hBmp;
end;
 
procedure AlphaDraw(HDC: hDC; x, y, width, height: integer; hBmp: HBITMAP; alpha: boolean);
var
  hMemDC: LongWord;
  hOld: HGDIOBJ;
  pixelblend: _BLENDFUNCTION;
begin
  hMemDC := CreateCompatibleDC(hDC);
  hOld := SelectObject(hMemDC, hBmp);
  pixelblend.BlendOp := AC_SRC_OVER;
  pixelblend.BlendFlags := 0;
  pixelblend.SourceConstantAlpha := 255;
 
  if alpha then
    pixelblend.AlphaFormat := AC_SRC_ALPHA
  else
    pixelblend.AlphaFormat := 0;
 
  AlphaBlend(hDC, x, y,
    width, height,
    hMemDC, 0, 0, width, height, pixelblend);
 
  SelectObject(hMemDC, hOld);
  DeleteObject(hMemDC);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenDialog1.Filter := 'TGA files (*.tga)|*.TGA';
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  if BH <> 0 then begin
    AlphaDraw(Canvas.Handle, 0, 0,
      b_width,
      b_height,
      BH, alphachannel);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    BH := Load32bitTGA2(pchar(OpenDialog1.FileName), alphachannel, b_width, b_height);
    Invalidate;
  end;
end;
 
end.