[Pythianproject-cvsmail] CVS: PythianProject/Source/Units Textures.pas,1.8,1.9

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv7247

Modified Files:
	Textures.pas 
Log Message:
rearranged code. now supports PNG loading, FastDIB loading and TBitmap loading

Index: Textures.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/Units/Textures.pas,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** Textures.pas	2000/11/20 20:38:57	1.8
--- Textures.pas	2000/12/01 18:34:56	1.9
***************
*** 22,25 ****
--- 22,26 ----
  
  
+ // -Can load data from a TBitmap, a TFastDIB, a BMP file (direct), or a PNG file (untested) 
  // -Checks if it is a bitmap.
  // -Gets bitmap size from offset $12.
***************
*** 36,40 ****
  interface
  
! uses BaseObjects, OpenGL, Points, TaggedStreams;
  
  type
--- 37,42 ----
  interface
  
! uses BaseObjects, OpenGL, Points, TaggedStreams,
!      FastDIB, FastFiles, PNGImage, SysUtils, Graphics; // added -mike
  
  type
***************
*** 42,45 ****
--- 44,51 ----
    PTextureData = ^TTextureData;
  
+   // we use this to store the pixel data from a bitmap -mike
+   TPixelData = TByteArray;
+   PPixelData = ^TPixelData;
+ 
    TBitDepth = (bd16bits, bd24bits, bd32bits);
  
***************
*** 60,63 ****
--- 66,71 ----
      procedure SetUseAlpha(const Value: Boolean);
      procedure SetBitDepth(const Value: TBitDepth);
+ 
+     procedure GenTexFromBMP(BMP:TFastDIB; useTransparency:boolean; transparentColor:TFColor);
    public
      constructor Create; override;
***************
*** 67,70 ****
--- 75,80 ----
      procedure LoadFromFile(const FileName: string); override;
      procedure LoadFromStream(Stream: TTaggedStream); override;
+     procedure LoadFromBitmap(B:TFastDIB); overload;
+     procedure LoadFromBitmap(B:Graphics.TBitmap); overload ;
  
      property AlphaColor: TByteColor read FAlphaColor write SetAlphaColor;
***************
*** 76,80 ****
      property UseMipmaps: Boolean read FUseMipmaps write SetMipmap;
      property Width: Integer read FWidth;
!     property TexID: TGLuInt read FTexID;
    end;
  
--- 86,90 ----
      property UseMipmaps: Boolean read FUseMipmaps write SetMipmap;
      property Width: Integer read FWidth;
!     property TexID: TGLuInt read FTexID write FTexID;
    end;
  
***************
*** 83,87 ****
  implementation
  
! uses Windows, SysUtils, Profiler;
  
  var
--- 93,97 ----
  implementation
  
! uses Windows, Profiler;
  
  var
***************
*** 314,320 ****
  var
    TestColor: TByteColor;
  // Main loader routine:
  begin
! //  Result := False;
  
    // Try to open file
--- 324,341 ----
  var
    TestColor: TByteColor;
+   Picture :TPicture;
  // Main loader routine:
  begin
! 
!   // decide whether file is a bitmap (open directly)
!   // or a PNG image (open using a TPicture)
!   if ExtractFileExt(FileName) = '.png' then
!   begin
!     Picture := TPicture.Create;
!     Picture.LoadFromFile(FileName);
!     LoadFromBitmap(Picture.Bitmap);
!     Picture.Free;
!     exit;
!   end;
  
    // Try to open file
***************
*** 404,407 ****
--- 425,516 ----
    FUseAlpha := Value;
  end;
+ 
+ procedure TTexture.GenTexFromBMP(BMP: TFastDIB;
+   useTransparency: boolean; transparentColor: TFColor);
+ var
+   pd :PPixelData;
+   x,y:integer;
+   c:TFColor;
+   pxWidth, pxHeight,os:integer;
+ 
+   function XYToOffset(ox,oy:integer):integer;
+   var pxoffset:integer;
+   begin
+     {
+        0 1 2 3 4 5 6 7 8 9      PxWidth=10
+      0 X X X X X X X X X X      PxHeight=3
+      1 X X X X X X X X X X
+      2 X X X X X X X X X X   }
+     oy := (PxHeight-1) - oy; // now y is OK
+     pxoffset := ox;
+     if oy > 0 then
+     begin
+       pxoffset := pxoffset + (oy*(PxWidth){-1}) {+ 1};
+     end;
+     pxoffset := pxoffset * 4; // move into position for RGBA data
+     Result := pxoffset;
+   end;
+ 
+ begin
+   if bmp.Bpp <> 24 then raise Exception.Create('TTexture.GenTexFromBMP: Don''t support non 24bit pixel formats! (image is '+IntToStr(bmp.bpp)+')');
+   pxWidth := bmp.Width;
+   pxHeight := bmp.Height;
+   // allocate memory for it, assume RGBA data (4 components)
+   pd := AllocMem( (bmp.Width*bmp.Height)*4 );
+   for y := 0 to pxHeight-1 do
+   begin
+     for x := 0 to pxWidth-1 do
+     begin
+       c := bmp.Pixels24[y,x];
+       os := XYToOffset(x,y);
+ 
+       pd^[ os + 0 ] := c.r;
+       pd^[ os + 1 ] := c.g;
+       pd^[ os + 2 ] := c.b;
+       // alpha transparency here
+       if useTransparency = false then
+         pd^[ os + 3 ] := 255
+       else if (c.r = transparentColor.r) and
+               (c.g = transparentColor.g) and
+               (c.b = transparentColor.b) then
+            pd^[ os + 3 ] := 0 else pd^[ os + 3 ] := 255;
+     end;
+   end;
+ 
+   // now we have pixel data generate the texture
+   Pointer(FImage) := pd;
+   FWidth := bmp.Width;
+   FHeight := bmp.Height;
+   Initialize;
+ end;
+ 
+ procedure TTexture.LoadFromBitmap(B: TFastDIB);
+ begin
+   GenTexFromBMP(B,FUseAlpha,FRGB(FAlphaColor[0],FAlphaColor[1],FAlphaColor[2]));
+ end;
+ 
+ procedure TTexture.LoadFromBitmap(B: Graphics.TBitmap);
+ type
+   TBArray = array[Word] of byte;
+   PBarray = ^TBArray;
+ var
+   tmpdib:TFastDIB;
+   x,y:integer;
+   scanline :PBarray;
+ begin
+   // load into a TFastDIB
+   tmpdib := TFastDIB.Create;
+   case b.PixelFormat of
+     pf8bit:tmpdib.SetSize(b.width,b.height,8,0);
+     pf16bit:tmpdib.SetSize(b.width,b.height,16,0);
+     pf24bit:tmpdib.SetSize(b.width,b.height,24,0);
+   end;
+ 
+   for y := 0 to B.Height-1 do
+     CopyMemory(tmpDib.Scanlines[y],b.ScanLine[y],(b.width*tmpdib.bpp) div 8);
+   LoadFromBitmap(tmpDib);
+   tmpDib.Free;
+ end;
+ 
  
  end.