From 483a3227ccbeb78fc52d371f1ae36b22db07becc Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sun, 17 Nov 2013 18:41:15 +0100 Subject: [PATCH] * added Delphi Support --- glBitmap.pas | 377 ++++++++++++++++++++++++++++------------------------------- 1 file changed, 181 insertions(+), 196 deletions(-) diff --git a/glBitmap.pas b/glBitmap.pas index debcd36..38ddefd 100644 --- a/glBitmap.pas +++ b/glBitmap.pas @@ -241,7 +241,7 @@ unit glBitmap; {.$DEFINE GLB_DELPHI} // activate to enable the support for TLazIntfImage from Lazarus -{$DEFINE GLB_LAZARUS} +{.$DEFINE GLB_LAZARUS} // activate to enable the support of SDL_image to load files. (READ ONLY) @@ -286,16 +286,16 @@ unit glBitmap; {$ENDIF} // Operation System -{$IF DEFINED(WIN32) or DEFINED(WIN64)} +{$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)} {$DEFINE GLB_WIN} {$ELSEIF DEFINED(LINUX)} {$DEFINE GLB_LINUX} -{$ENDIF} +{$IFEND} // native OpenGL Support {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)} {$DEFINE GLB_NATIVE_OGL} -{$ENDIF} +{$IFEND} // checking define combinations //SDL Image @@ -362,7 +362,7 @@ unit glBitmap; // native OpenGL {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)} {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'} -{$ENDIF} +{$IFEND} // general options {$EXTENDEDSYNTAX ON} @@ -377,7 +377,7 @@ interface uses {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF} {$IF DEFINED(GLB_WIN) AND - DEFINED(GLB_NATIVE_OGL)} windows, {$ENDIF} + DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND} {$IFDEF GLB_SDL} SDL, {$ENDIF} {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, {$ENDIF} @@ -393,20 +393,6 @@ uses Classes, SysUtils; -{$IFNDEF GLB_DELPHI} -type - HGLRC = Cardinal; - DWORD = Cardinal; - PDWORD = ^DWORD; - - TRGBQuad = packed record - rgbBlue: Byte; - rgbGreen: Byte; - rgbRed: Byte; - rgbReserved: Byte; - end; -{$ENDIF} - {$IFDEF GLB_NATIVE_OGL} const GL_TRUE = 1; @@ -524,13 +510,13 @@ const GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; -{$ifdef LINUX} - libglu = 'libGLU.so.1'; - libopengl = 'libGL.so.1'; -{$else} +{$IF DEFINED(GLB_WIN)} libglu = 'glu32.dll'; libopengl = 'opengl32.dll'; -{$endif} +{$ELSEIF DEFINED(GLB_LINUX)} + libglu = 'libGLU.so.1'; + libopengl = 'libGL.so.1'; +{$IFEND} type GLboolean = BYTEBOOL; @@ -550,6 +536,13 @@ type TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} +{$IF DEFINED(GLB_WIN)} + TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall; +{$ELSEIF DEFINED(GLB_LINUX)} + TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl; + TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl; +{$IFEND} + {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)} TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} @@ -579,13 +572,6 @@ type TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} - {$IFDEF GLB_LINUX} - TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl; - TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl; - {$ELSE} - TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall; - {$ENDIF} - {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)} procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl; @@ -614,7 +600,7 @@ type function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu; function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu; -{$ENDIF} +{$IFEND} var GL_VERSION_1_2, @@ -641,6 +627,13 @@ var glCompressedTexImage2D: TglCompressedTexImage2D; glGetCompressedTexImage: TglGetCompressedTexImage; +{$IF DEFINED(GLB_WIN)} + wglGetProcAddress: TwglGetProcAddress; +{$ELSEIF DEFINED(GLB_LINUX)} + glXGetProcAddress: TglXGetProcAddress; + glXGetProcAddressARB: TglXGetProcAddress; +{$IFEND} + {$IFDEF GLB_NATIVE_OGL_DYNAMIC} glEnable: TglEnable; glDisable: TglDisable; @@ -669,22 +662,7 @@ var gluBuild1DMipmaps: TgluBuild1DMipmaps; gluBuild2DMipmaps: TgluBuild2DMipmaps; - - {$IF DEFINED(GLB_WIN)} - wglGetProcAddress: TwglGetProcAddress; - {$ELSEIF DEFINED(GLB_LINUX)} - glXGetProcAddress: TglXGetProcAddress; - glXGetProcAddressARB: TglXGetProcAddressARB; - {$ENDIF} -{$ENDIF} - -(* -{$IFDEF GLB_DELPHI} -var - gLastContext: HGLRC; {$ENDIF} -*) - {$ENDIF} type @@ -1132,6 +1110,14 @@ uses Math, syncobjs, typinfo; type +{$IFNDEF fpc} + QWord = System.UInt64; + PQWord = ^QWord; + + PtrInt = Longint; + PtrUInt = DWord; +{$ENDIF} + //////////////////////////////////////////////////////////////////////////////////////////////////// TShiftRec = packed record case Integer of @@ -1186,8 +1172,8 @@ type procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract; procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract; - function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload; - function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload; + function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual; + function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual; function CreateMappingData: Pointer; virtual; procedure FreeMappingData(var aMappingData: Pointer); virtual; @@ -1842,8 +1828,6 @@ var function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer; begin - result := nil; - if not Assigned(aLibHandle) then aLibHandle := GL_LibHandle; @@ -1868,7 +1852,7 @@ begin end; result := dlsym(aLibHandle, aProcName); -{$ENDIF} +{$IFEND} if not Assigned(result) then raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName); end; @@ -1891,7 +1875,7 @@ procedure glbInitOpenGL; result := dlopen(Name, RTLD_LAZY); {$ELSE} result := nil; - {$ENDIF} + {$IFEND} end; //////////////////////////////////////////////////////////////////////////////// @@ -1905,7 +1889,7 @@ procedure glbInitOpenGL; Result := FreeLibrary({%H-}HINST(aLibHandle)); {$ELSEIF DEFINED(GLB_LINUX)} Result := dlclose(aLibHandle) = 0; - {$ENDIF} + {$IFEND} end; begin @@ -1928,8 +1912,8 @@ begin wglGetProcAddress := glbGetProcAddress('wglGetProcAddress'); {$ELSEIF DEFINED(GLB_LINUX)} glXGetProcAddress := glbGetProcAddress('glXGetProcAddress'); - glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB'); - {$ENDIF} + glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB'); + {$IFEND} glEnable := glbGetProcAddress('glEnable'); glDisable := glbGetProcAddress('glDisable'); @@ -1963,9 +1947,6 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure glbReadOpenGLExtensions; var - {$IFDEF GLB_DELPHI} - Context: HGLRC; - {$ENDIF} Buffer: AnsiString; MajorVersion, MinorVersion: Integer; @@ -2024,61 +2005,52 @@ begin end; {$ENDIF} -{$IFDEF GLB_DELPHI} - Context := wglGetCurrentContext; - if (Context <> gLastContext) then begin - gLastContext := Context; -{$ENDIF} - - // Version - Buffer := glGetString(GL_VERSION); - TrimVersionString(Buffer, MajorVersion, MinorVersion); + // Version + Buffer := glGetString(GL_VERSION); + TrimVersionString(Buffer, MajorVersion, MinorVersion); - GL_VERSION_1_2 := false; - GL_VERSION_1_3 := false; - GL_VERSION_1_4 := false; - GL_VERSION_2_0 := false; - if MajorVersion = 1 then begin - if MinorVersion >= 2 then - GL_VERSION_1_2 := true; - - if MinorVersion >= 3 then - GL_VERSION_1_3 := true; - - if MinorVersion >= 4 then - GL_VERSION_1_4 := true; - end else if MajorVersion >= 2 then begin + GL_VERSION_1_2 := false; + GL_VERSION_1_3 := false; + GL_VERSION_1_4 := false; + GL_VERSION_2_0 := false; + if MajorVersion = 1 then begin + if MinorVersion >= 2 then GL_VERSION_1_2 := true; + + if MinorVersion >= 3 then GL_VERSION_1_3 := true; - GL_VERSION_1_4 := true; - GL_VERSION_2_0 := true; - end; - // Extensions - Buffer := glGetString(GL_EXTENSIONS); - GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp'); - GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two'); - GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle'); - GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat'); - GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp'); - GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic'); - GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle'); - GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle'); - GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat'); - GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap'); - - if GL_VERSION_1_3 then begin - glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D'); - glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D'); - glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage'); - end else begin - glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB'); - glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB'); - glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB'); - end; -{$IFDEF GLB_DELPHI} + if MinorVersion >= 4 then + GL_VERSION_1_4 := true; + end else if MajorVersion >= 2 then begin + GL_VERSION_1_2 := true; + GL_VERSION_1_3 := true; + GL_VERSION_1_4 := true; + GL_VERSION_2_0 := true; + end; + + // Extensions + Buffer := glGetString(GL_EXTENSIONS); + GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp'); + GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two'); + GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle'); + GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat'); + GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp'); + GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic'); + GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle'); + GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle'); + GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat'); + GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap'); + + if GL_VERSION_1_3 then begin + glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D'); + glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D'); + glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage'); + end else begin + glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB'); + glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB'); + glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB'); end; -{$ENDIF} end; {$ENDIF} @@ -3798,7 +3770,7 @@ begin aData^ := 0; d := LuminanceWeight(aPixel) and Range.r; aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData))); - inc(aMapData, 4); + inc(PByte(aMapData), 4); if ({%H-}PtrUInt(aMapData) >= 8) then begin inc(aData); aMapData := nil; @@ -3848,10 +3820,10 @@ begin aPixel.Data.b := b; aPixel.Data.a := a; end; - inc(aMapData, bits); + inc(PByte(aMapData), bits); if ({%H-}PtrUInt(aMapData) >= 8) then begin inc(aData, 1); - dec(aMapData, 8); + dec(PByte(aMapData), 8); end; inc(aData, s); end; @@ -4621,7 +4593,27 @@ end; {$ENDIF} {$IFDEF GLB_DELPHI} -//TODO rework & test +////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function CreateGrayPalette: HPALETTE; +var + Idx: Integer; + Pal: PLogPalette; +begin + GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256)); + + Pal.palVersion := $300; + Pal.palNumEntries := 256; + + for Idx := 0 to Pal.palNumEntries - 1 do begin + Pal.palPalEntry[Idx].peRed := Idx; + Pal.palPalEntry[Idx].peGreen := Idx; + Pal.palPalEntry[Idx].peBlue := Idx; + Pal.palPalEntry[Idx].peFlags := 0; + end; + Result := CreatePalette(Pal^); + FreeMem(Pal); +end; + ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean; var @@ -4635,35 +4627,30 @@ begin aBitmap.Height := Height; case Format of - tfAlpha8, ifLuminance, ifDepth8: - begin - Bitmap.PixelFormat := pf8bit; - Bitmap.Palette := CreateGrayPalette; - end; - ifRGB5A1: - Bitmap.PixelFormat := pf15bit; - ifR5G6B5: - Bitmap.PixelFormat := pf16bit; - ifRGB8, ifBGR8: - Bitmap.PixelFormat := pf24bit; - ifRGBA8, ifBGRA8: - Bitmap.PixelFormat := pf32bit; - else - raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.'); + tfAlpha8, tfLuminance8: begin + aBitmap.PixelFormat := pf8bit; + aBitmap.Palette := CreateGrayPalette; + end; + tfRGB5A1: + aBitmap.PixelFormat := pf15bit; + tfR5G6B5: + aBitmap.PixelFormat := pf16bit; + tfRGB8, tfBGR8: + aBitmap.PixelFormat := pf24bit; + tfRGBA8, tfBGRA8: + aBitmap.PixelFormat := pf32bit; + else + raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.'); end; pSource := Data; for Row := 0 to FileHeight -1 do begin - pData := Bitmap.Scanline[Row]; - + pData := aBitmap.Scanline[Row]; Move(pSource^, pData^, fRowSize); Inc(pSource, fRowSize); - - // swap RGB(A) to BGR(A) - if InternalFormat in [ifRGB8, ifRGBA8] then - SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8); + if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A) + SwapRGB(pData, FileWidth, Format = tfRGBA8); end; - result := true; end; end; @@ -4674,46 +4661,40 @@ function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean; var pSource, pData, pTempData: PByte; Row, RowSize, TempWidth, TempHeight: Integer; - IntFormat: TglBitmapInternalFormat; + IntFormat: TglBitmapFormat; begin result := false; - if (Assigned(Bitmap)) then begin - case Bitmap.PixelFormat of + if (Assigned(aBitmap)) then begin + case aBitmap.PixelFormat of pf8bit: - IntFormat := ifLuminance; + IntFormat := tfLuminance8; pf15bit: - IntFormat := ifRGB5A1; + IntFormat := tfRGB5A1; pf16bit: - IntFormat := ifR5G6B5; + IntFormat := tfR5G6B5; pf24bit: - IntFormat := ifBGR8; + IntFormat := tfBGR8; pf32bit: - IntFormat := ifBGRA8; - else - raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.'); + IntFormat := tfBGRA8; + else + raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.'); end; - TempWidth := Bitmap.Width; - TempHeight := Bitmap.Height; - - RowSize := Trunc(TempWidth * FormatGetSize(IntFormat)); - + TempWidth := aBitmap.Width; + TempHeight := aBitmap.Height; + RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1); GetMem(pData, TempHeight * RowSize); try pTempData := pData; - for Row := 0 to TempHeight -1 do begin - pSource := Bitmap.Scanline[Row]; - + pSource := aBitmap.Scanline[Row]; if (Assigned(pSource)) then begin Move(pSource^, pTempData^, RowSize); Inc(pTempData, RowSize); end; end; - SetDataPointer(pData, IntFormat, TempWidth, TempHeight); - result := true; except FreeMem(pData); @@ -4731,17 +4712,17 @@ begin result := false; if Assigned(Data) then begin - if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin - if Assigned(Bitmap) then begin - Bitmap.PixelFormat := pf8bit; - Bitmap.Palette := CreateGrayPalette; - Bitmap.Width := Width; - Bitmap.Height := Height; - - case InternalFormat of - ifLuminanceAlpha: + if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin + if Assigned(aBitmap) then begin + aBitmap.PixelFormat := pf8bit; + aBitmap.Palette := CreateGrayPalette; + aBitmap.Width := Width; + aBitmap.Height := Height; + + case Format of + tfLuminance8Alpha8: AlphaInterleave := 1; - ifRGBA8, ifBGRA8: + tfRGBA8, tfBGRA8: AlphaInterleave := 3; else AlphaInterleave := 0; @@ -4751,8 +4732,7 @@ begin pSource := Data; for Row := 0 to Height -1 do begin - pDest := Bitmap.Scanline[Row]; - + pDest := aBitmap.Scanline[Row]; if Assigned(pDest) then begin for Col := 0 to Width -1 do begin Inc(pSource, AlphaInterleave); @@ -4761,8 +4741,7 @@ begin Inc(pSource); end; end; - end; - + end; result := true; end; end; @@ -4770,14 +4749,14 @@ begin end; ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean; +function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean; var tex: TglBitmap2D; begin tex := TglBitmap2D.Create; try - tex.AssignFromBitmap(Bitmap); - result := AddAlphaFromglBitmap(tex, Func, CustomData); + tex.AssignFromBitmap(ABitmap); + result := AddAlphaFromglBitmap(tex, aFunc, aArgs); finally tex.Free; end; @@ -5765,7 +5744,7 @@ begin end; end; end; -{$ENDIF} +{$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_PNG_WRITE} @@ -5931,7 +5910,7 @@ begin FreeAndNil(Png); end; end; -{$ENDIF} +{$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -6219,9 +6198,9 @@ begin result := false; // reading first two bytes to test file and set cursor back to begin - StreamPos := Stream.Position; - Stream.Read(Temp[0], 2); - Stream.Position := StreamPos; + StreamPos := aStream.Position; + aStream.Read(Temp[0], 2); + aStream.Position := StreamPos; // if Bitmap then read file. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin @@ -6229,7 +6208,7 @@ begin try jpg := TJPEGImage.Create; try - jpg.LoadFromStream(Stream); + jpg.LoadFromStream(aStream); bmp.Assign(jpg); result := AssignFromBitmap(bmp); finally @@ -6240,7 +6219,7 @@ begin end; end; end; -{$ENDIF} +{$IFEND} {$ENDIF} {$IFDEF GLB_SUPPORT_JPEG_WRITE} @@ -6351,25 +6330,25 @@ end; {$ELSEIF DEFINED(GLB_DELPHI_JPEG)} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TglBitmap.SaveJPEG(Stream: TStream); +procedure TglBitmap.SaveJPEG(const aStream: TStream); var Bmp: TBitmap; Jpg: TJPEGImage; begin - if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then - raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT); + if not (ftJPEG in FormatGetSupportedFiles(Format)) then + raise EglBitmapUnsupportedFormat.Create(Format); Bmp := TBitmap.Create; try Jpg := TJPEGImage.Create; try AssignToBitmap(Bmp); - if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin - Jpg.Grayscale := true; + if (Format in [tfAlpha8, tfLuminance8]) then begin + Jpg.Grayscale := true; Jpg.PixelFormat := jf8Bit; end; Jpg.Assign(Bmp); - Jpg.SaveToStream(Stream); + Jpg.SaveToStream(aStream); finally FreeAndNil(Jpg); end; @@ -6377,7 +6356,7 @@ begin FreeAndNil(Bmp); end; end; -{$ENDIF} +{$IFEND} {$ENDIF} ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -6844,13 +6823,15 @@ const begin buf := nil; if (Counter.X.dir < 0) then - buf := GetMem(LineSize); + GetMem(buf, LineSize); try while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin - tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart + tmp1 := ImageData; + inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart if (Counter.X.dir < 0) then begin //flip X aStream.Read(buf^, LineSize); - tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line + tmp2 := buf; + inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line for i := 0 to Header.Width-1 do begin //for all pixels in line for j := 0 to PixelSize-1 do begin //for all bytes in pixel tmp1^ := tmp2^; @@ -6881,9 +6862,10 @@ const if (LinePixelsRead >= Header.Width) then begin LinePixelsRead := 0; inc(Counter.Y.low, Counter.Y.dir); //next line index - TmpData := ImageData + Counter.Y.low * LineSize; //set line + TmpData := ImageData; + inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then - TmpData := TmpData + LineSize - PixelSize; //set last pixel + inc(TmpData, LineSize - PixelSize); //set last pixel end; end; @@ -6961,9 +6943,10 @@ const GetMem(Cache, CACHE_SIZE); try - TmpData := ImageData + Counter.Y.low * LineSize; //set line + TmpData := ImageData; + inc(TmpData, Counter.Y.low * LineSize); //set line if (Counter.X.dir < 0) then //if x flipped then - TmpData := TmpData + LineSize - PixelSize; //set last pixel + inc(TmpData, LineSize - PixelSize); //set last pixel repeat //read CommandByte @@ -7012,6 +6995,7 @@ begin if Header.ImageID <> 0 then // skip image ID aStream.Position := aStream.Position + Header.ImageID; + tgaFormat := tfEmpty; case Header.Bpp of 8: if IsGrayFormat then case (Header.ImageDesc and $F) of 0: tgaFormat := tfLuminance8; @@ -7156,7 +7140,7 @@ begin if Assigned(Converter) then begin LineSize := FormatDesc.GetSize(Width, 1); - LineBuf := GetMem(LineSize); + GetMem(LineBuf, LineSize); SourceMD := FormatDesc.CreateMappingData; DestMD := Converter.CreateMappingData; try @@ -7364,7 +7348,8 @@ begin DestMD := FormatDesc.CreateMappingData; try for y := 0 to Header.dwHeight-1 do begin - TmpData := NewImage + y * LineSize; + TmpData := NewImage; + inc(TmpData, y * LineSize); SrcData := RowData; aStream.Read(SrcData^, RowSize); for x := 0 to Header.dwWidth-1 do begin -- 2.1.4