paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-26 13:41:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

examples: opengl: clean up

Browse Source 
git-svn-id: trunk@36355 -
This commit is contained in:
mattias 2012-03-26 20:01:10 +00:00
parent bf130773b8
commit e3f65d9470
1 changed files with 0 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
examples/openglcontrol/exampleform.pp
View File

@ -113,8 +113,6 @@ var direction: boolean;
LastMsecs: integer;
function LoadFileToMemStream(const Filename: string): TMemoryStream;
function LoadglTexImage2DFromBitmapFile(Filename:string;
var Image: TglTexture): boolean;
function LoadglTexImage2DFromPNG(PNGFilename:string;
Image: TglTexture): boolean;
@ -139,125 +137,6 @@ begin
end;
end;
function LoadglTexImage2DFromBitmapFile(Filename:string;
var Image:TglTexture): boolean;
type
TBITMAPFILEHEADER = packed record
bfType: Word;
bfSize: DWORD;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: DWORD;
end;
BITMAPINFOHEADER = packed record
biSize : DWORD;
biWidth : Longint;
biHeight : Longint;
biPlanes : WORD;
biBitCount : WORD;
biCompression : DWORD;
biSizeImage : DWORD;
biXPelsPerMeter : Longint;
biYPelsPerMeter : Longint;
biClrUsed : DWORD;
biClrImportant : DWORD;
end;
RGBQUAD = packed record
rgbBlue : BYTE;
rgbGreen : BYTE;
rgbRed : BYTE;
// rgbReserved : BYTE;
end;
BITMAPINFO = packed record
bmiHeader : BITMAPINFOHEADER;
bmiColors : array[0..0] of RGBQUAD;
end;
PBITMAPINFO = ^BITMAPINFO;
TRawImage = packed record
p:array[0..0] of byte;
end;
PRawImage = ^TRawImage;
const
BI_RGB = 0;
var
MemStream: TMemoryStream;
BmpHead: TBitmapFileHeader;
BmpInfo:PBitmapInfo;
ImgSize:longint;
InfoSize, PixelCount, i:integer;
BitsPerPixel:integer;
AnRGBQuad: RGBQUAD;
begin
Result:=false;
MemStream:=LoadFileToMemStream(Filename);
if MemStream=nil then exit;
try
if (MemStream.Read(BmpHead, sizeof(BmpHead))<sizeof(BmpHead))
or (BmpHead.bfType <> $4D42) then begin
writeln('Invalid windows bitmap (header)');
exit;
end;
InfoSize:=BmpHead.bfOffBits-SizeOf(BmpHead);
GetMem(BmpInfo,InfoSize);
try
if MemStream.Read(BmpInfo^,InfoSize)<>InfoSize then begin
writeln('Invalid windows bitmap (info)');
exit;
end;
if BmpInfo^.bmiHeader.biSize<>sizeof(BitmapInfoHeader) then begin
writeln('OS2 bitmaps are not supported yet');
exit;
end;
if BmpInfo^.bmiHeader.biCompression<>bi_RGB then begin
writeln('RLE compression is not supported yet');
exit;
end;
BitsPerPixel:=BmpInfo^.bmiHeader.biBitCount;
if BitsPerPixel<>24 then begin
writeln('Only truecolor bitmaps supported yet');
exit;
end;
ImgSize:=BmpInfo^.bmiHeader.biSizeImage;
if MemStream.Size-MemStream.Position<ImgSize then begin
writeln('Invalid windows bitmap (bits)');
exit;
end;
Image.Width:=BmpInfo^.bmiHeader.biWidth;
Image.Height:=BmpInfo^.bmiHeader.biHeight;
PixelCount:=Image.Width*Image.Height;
GetMem(Image.Data,PixelCount * 3);
try
for i:=0 to PixelCount-1 do begin
MemStream.Read(AnRGBQuad,sizeOf(RGBQuad));
with PRawImage(Image.Data)^ do begin
p[i*3+0]:=AnRGBQuad.rgbRed;
p[i*3+1]:=AnRGBQuad.rgbGreen;
p[i*3+2]:=AnRGBQuad.rgbBlue;
end;
end;
except
writeln('Error converting bitmap');
FreeMem(Image.Data);
Image.Data:=nil;
exit;
end;
finally
FreeMem(BmpInfo);
end;
Result:=true;
finally
MemStream.Free;
end;
Result:=true;
end;
function LoadglTexImage2DFromPNG(PNGFilename: string; Image: TglTexture
): boolean;
var