1:

Textur := LoadTexture('dateiname.ext');					

1:

{$DEFINE BILINEAR}					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:

// TGA-Support basiert auf Textures.pas von Jan Horn
// www.sulaco.co.za

{$DEFINE BILINEAR}
unit Textures;

interface

uses
  Windows, Types, OpenGL, ActiveX;

const
 IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';

function LoadTexture(filename: string): Cardinal;

implementation

function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external glu32;
procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32;
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;

// Von Jan Horn, wandelt BGR in RGB um
procedure SwapRGB(data : Pointer; Size : Integer);
asm
        mov     ebx, eax
        mov     ecx, size
@@loop:
        mov     al, [ebx+0]
        mov     ah, [ebx+2]
        mov     [ebx+2], al
        mov     [ebx+0], ah
        add     ebx, 3
        dec     ecx
        jnz     @@loop
end;

function FileExists(fn: string): boolean;
var
 fd: TWIN32FindData;
 fh: THandle;
begin
 fh := FindFirstFile(pchar(fn), fd);
 result := fh <> INVALID_HANDLE_VALUE;
 FindClose(fh);
end;

// Erstellt die Textur
// Basiert auf Fkt von Jan Horn
function CreateTexture(Width, Height, Format: Word; pData: Pointer) : GluInt;
begin
 glGenTextures(1, Result);
 glBindTexture(GL_TEXTURE_2D, Result);
 glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, {$IFDEF BILINEAR}GL_LINEAR{$ELSE}GL_NEAREST{$ENDIF});
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, {$IFDEF BILINEAR}GL_LINEAR_MIPMAP_LINEAR{$ELSE}GL_NEAREST{$ENDIF}); 
 if Format = GL_RGBA then
  gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
 else
  gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
end;

// Liefert Informationen über ein HBITMAP
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
var
 bmp: Windows.TBitmap;
begin
 GetObject(Bitmap, SizeOf(bmp), @bmp);
 FillChar(BI, sizeof(TBitmapInfoHeader), #0);
 with BI do
 begin
  biSize := SizeOf(BI);
  biWidth := bmp.bmWidth;
  biHeight := bmp.bmHeight;
  biPlanes := 1;
  biCompression := BI_RGB;
  biBitCount := 24;
  biSizeImage := (((biWidth * biBitCount) + 31) div 32) * 4 * biHeight;
 end;
end;

// Lädt ein Bild nach pPicture
function LoadPicture(Filename: string; var pPicture: IPicture):Boolean;
var
 hFile, hMem: DWORD;
 dwFileSize,dwBytesRead: DWORD;
 pData: pointer;
 bRead: boolean;
 hRes: HRESULT;
 pStream: IStream;
begin
 Result := false;
 hFile := CreateFile(PChar(Filename), GENERIC_READ, 0 ,nil, OPEN_EXISTING, 0, 0);
 if (hFile <> INVALID_HANDLE_VALUE) then
 try
  dwFileSize := GetFileSize(hFile, nil);
  if (dwFileSize < INVALID_FILE_SIZE) then
  begin
   hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_NODISCARD, dwFileSize);
   if hMem > 0 then
   try
    pData := GlobalLock(hMem);
    if pData <> nil then
    begin
     bRead:=ReadFile(hFile, pData^ , dwFileSize, dwBytesRead, nil);
     if bRead then
     begin
      pStream := nil;
      hRes := CreateStreamOnHGlobal(hMem, true, pStream);
      if not FAILED(hRes) and (pStream <> nil) then
      begin
       hRes := OleLoadPicture(pStream, dwFileSize, false, IID_IPicture, pPicture);
       Result := (hRes=S_OK) and (pPicture <> nil);
      end;
     end;
    end;
   finally
    GlobalUnlock(hMem);
   end;
  end;
 finally
  CloseHandle(hFile);
 end;
 pStream := nil;
end;

// Lädt von Windows unterstützte Dateiformate (BMP,JPG,...)
// für eine spätere Verwendung mit OpenGL
function LoadSTDTexture(filename: string): GLUint;
var
 hDC: windows.HDC;
 pPicture: IPicture;
 hmWidth,hmHeight: longint;
 nWidth, nHeight: integer;
 rc: TRect;
 data: pointer;

 bmp: HBITMAP;
 info: TBitmapInfo;
begin
 result := 0;
 try
  hDC := CreateCompatibleDC(0);
  // Bild laden
  if LoadPicture(filename, pPicture) then
  begin
   // Höhe / Breite ermitteln
   pPicture.get_Width(hmWidth);
   pPicture.get_Height(hmHeight);
   nWidth  := MulDiv(hmWidth, GetDeviceCaps(hDC, LOGPIXELSX), 2540);
   nHeight := MulDiv(hmHeight, GetDeviceCaps(hDC, LOGPIXELSY), 2540);
   rc := rect(0,0,nWidth,nHeight);
   // Bitmap erzeugen
   bmp := CreateBitmap(nWidth,nHeight,1,GetDeviceCaps(hDC, BITSPIXEL),nil);
   if bmp <> 0 then
   try
    SelectObject(hDC, bmp);
    pPicture.Render(hDC, 0, 0, nWidth, nHeight, 0, hmHeight, hmWidth, -hmHeight, rc);
    InitializeBitmapInfoHeader(bmp, info.bmiHeader);
    getmem(data, info.bmiHeader.biSizeImage);
    try
     if GetDIBits(hDC, bmp, 0, info.bmiHeader.biHeight, data,
      Info, DIB_RGB_COLORS)=0 then exit;
     SwapRGB(data, info.bmiHeader.biWidth * info.bmiHeader.biHeight);
     // Textur erzeugen
     result := CreateTexture(nWidth, nHeight, GL_RGB, data)
    finally
     freemem(data);
    end;
   finally
    DeleteObject(bmp);
   end;
  end;
 finally
  pPicture := nil;
 end;
end;

// Lädt eien TGA-Textur
// Basiert auf Fkt von Jan Horn
function LoadTGATexture(Filename: String): GLUInt;
var
  TGAHeader : packed record   // Header type for TGA images
    FileType     : Byte;
    ColorMapType : Byte;
    ImageType    : Byte;
    ColorMapSpec : array[0..4] of Byte;
    OrigX  : array[0..1] of Byte;
    OrigY  : array[0..1] of Byte;
    Width  : array[0..1] of Byte;
    Height : array[0..1] of Byte;
    BPP    : Byte;
    imageinfo : Byte;
  end;
  TGAFile: file;
  bytesRead: integer;
  image, CompImage: pointer;
  Width, Height: integer;
  ImageSize: integer;
  BufferIndex: integer;
  CurrentByte, CurrentPixel: integer;
  i: integer;
  Front, Back: ^Byte;
  Temp: byte;

  // Copy a pixel from source to dest and Swap the RGB color values
  procedure CopySwapPixel(const Source, Destination : Pointer);
  asm
    push ebx
    mov bl,[eax+0]
    mov bh,[eax+1]
    mov [edx+2],bl
    mov [edx+1],bh
    mov bl,[eax+2]
    mov bh,[eax+3]
    mov [edx+0],bl
    mov [edx+3],bh
    pop ebx
  end;

begin
 result := 0;
 if FileExists(Filename) then
 begin
  AssignFile(TGAFile, Filename);
  Reset(TGAFile, 1);
  // Read in the TGA file header
  BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
 end
 else
 begin
  MessageBox(0, PChar('File not found  - ' + Filename), PChar('TGA Texture'), MB_OK);
  exit;
 end;

 // Only support 24, 32 bit images
 if (not TGAHeader.ImageType in [2, 10]) or
    (TGAHeader.ColorMapType <> 0) or
    (not TGAHeader.BPP in [24,32]) then
 begin
  CloseFile(tgaFile);
  MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Only 24 and 32 bit TGA files supported.'), PChar('TGA File Error'), MB_OK);
  exit;
 end;

 // Get the width, height, and color depth
 Width  := TGAHeader.Width[0] + TGAHeader.Width[1] shl 8;
 Height := TGAHeader.Height[0] + TGAHeader.Height[1] shl 8;
 TGAHeader.BPP := TGAHeader.BPP div 8;
 ImageSize  := Width*Height*(TGAHeader.BPP);

 GetMem(Image, ImageSize);
 try
  case TGAHeader.ImageType of
   // Standard 24, 32 bit TGA file
   2: begin
       BlockRead(TGAFile, image^, ImageSize, bytesRead);
       if bytesRead <> ImageSize then
       begin
        CloseFile(TGAFile);
        MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
        exit;
       end;
       // TGAs are stored BGR and not RGB, so swap the R and B bytes.
       Front := pointer(integer(image)-TGAHeader.BPP);
       Back := pointer(integer(image)-TGAHeader.BPP+2);
       for i := 0 to Width*Height-1 do
       begin                          
        inc(Front, TGAHeader.BPP);
        inc(Back, TGAHeader.BPP);
        Temp := Front^;
        Front^ := Back^;
        Back^ := Temp;
       end;
       Result := CreateTexture(Width, Height, GL_RGBA - byte(TGAHeader.BPP=3), Image);
      end;
  // Compressed 24, 32 bit TGA files
  10: begin
       CurrentByte := 0;
       CurrentPixel := 0;
       BufferIndex := 0;
       GetMem(CompImage, FileSize(TGAFile)-sizeOf(TGAHeader));
       try
        BlockRead(TGAFile, CompImage^, FileSize(TGAFile)-sizeOf(TGAHeader), BytesRead);   // load compressed data into memory
        if bytesRead <> FileSize(TGAFile)-sizeOf(TGAHeader) then
        begin
         CloseFile(TGAFile);
         MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
         exit;
        end;
        // Extract pixel information from compressed data
        repeat
         Front := Pointer(integer(CompImage) + BufferIndex);
         inc(BufferIndex);
         case Front^ of
          0..127: begin
                   for i := 0 to Front^ do
                   begin
                    CopySwapPixel(Pointer(integer(CompImage)+BufferIndex+i*TGAHeader.BPP), Pointer(integer(image)+CurrentByte));
                    inc(CurrentByte, TGAHeader.BPP);
                    inc(CurrentPixel);
                   end;
                   inc(BufferIndex, (Front^+1)*TGAHeader.BPP);
                  end
          else    begin
                   for I := 0 to Front^-128 do
                   begin
                    CopySwapPixel(Pointer(Integer(CompImage)+BufferIndex), Pointer(Integer(image)+CurrentByte));
                    inc(CurrentByte, TGAHeader.BPP);
                    inc(CurrentPixel);
                   end;
                   inc(BufferIndex, TGAHeader.BPP);
                  end;
         end; {case}
        until CurrentPixel >= Width*Height;
        Result := CreateTexture(Width, Height, GL_RGBA - byte(TGAHeader.BPP = 3), Image);
       finally
        freemem(CompImage);
       end;
      end;
  end; {case}
 finally
  FreeMem(Image);
 end;
end;

function LoadTexture(Filename: string): GLUint;
begin
 if copy(AnsiUpper(pchar(filename)), length(filename)-3, 4) = '.TGA' then
  result := LoadTGATexture(Filename)
 else
  result := LoadSTDTexture(filename);
end;

end.