S
Skybuck Flying
// Code is crashing XP x64 Pro in Delphi 2010 with Blue Screen of Death
// MiniDump will follow shortly.
// This has happened many times by now on different occasionals trying to do
stuff like this.
// Getting sick of it.
// Try to get this working:
// *********
unit unit_TPixelMap_version_001;
interface
uses
ExtCtrls;
type
PPixel = ^TPixel;
TPixel = packed record
case integer of
0 :
(
mRed : byte;
mGeen : byte;
mBlue : byte;
mAlpha : byte;
);
1 :
(
mInteger : integer;
);
2 :
(
mLongword : longword;
);
3 :
(
mValue : integer;
);
4 :
(
// mColor : TColor;
);
5 :
(
mLowWord : word;
mHighWord : word;
);
end;
TPixelMap = class
private
protected
mMemory : packed array of byte;
mWidth : integer;
mHeight : integer;
function GetPixel( ParaX, ParaY : integer ) : PPixel; // can be inlined
later on.
public
constructor Create;
destructor Destroy; override;
procedure CopyFromImageBitmap( ParaImage : TImage );
procedure CopyToImageBitmap( var ParaImage : TImage );
property Width : integer read mWidth;
property Height : integer read mHeight;
property Pixel[ ParaX, ParaY : integer ] : PPixel read GetPixel;
end;
implementation
uses
Windows, Classes, Controls;
constructor TPixelMap.Create;
begin
inherited Create;
end;
destructor TPixelMap.Destroy;
begin
inherited Destroy;
end;
// LEARN FROM THIS YOU NOOBS
function TPixelMap.GetPixel( ParaX, ParaY : integer ) : PPixel;
begin
result := @mMemory[ (ParaY * mWidth * SizeOf(TPixel)) + (ParaX *
SizeOf(TPixel)) ];
end;
procedure TPixelMap.CopyFromImageBitmap( ParaImage : TImage );
var
vBitmapInfo : TBitmapInfo;
begin
mWidth := ParaImage.Picture.Bitmap.Width;
mHeight := ParaImage.Picture.Bitmap.Height;
SetLength( mMemory, mWidth * mHeight * SizeOf(TPixel) );
with vBitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := ParaImage.Picture.Bitmap.Width;
biHeight := -ParaImage.Picture.Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biSizeImage := 0;
biXPelsPerMeter := 1; //dont care
biYPelsPerMeter := 1; //dont care
biClrUsed := 0;
biClrImportant := 0;
end;
GetDIBits
(
ParaImage.Picture.Bitmap.Canvas.Handle,
ParaImage.Picture.Bitmap.Handle,
0,
ParaImage.Picture.Bitmap.Height,
// mMemory, // ?
@mMemory[0], // <- suspicious
vBitmapInfo,
DIB_RGB_COLORS
);
end;
procedure TPixelMap.CopyToImageBitmap( var ParaImage : TImage );
var
vBitmapInfo : TBitmapInfo;
vOwner : Tcomponent;
vParent : TwinControl;
vTop : integer;
vLeft : integer;
begin
if ParaImage <> nil then
begin
vOwner := ParaImage.Owner;
vParent := ParaImage.Parent;
ParaImage.Free;
ParaImage := TImage.Create( vOwner );
ParaImage.Parent := vParent;
ParaImage.Top := vTop;
ParaImage.Left := vLeft;
end;
ParaImage.Width := mWidth;
ParaImage.Height := mHeight;
ParaImage.ClientWidth := mWidth;
ParaImage.ClientHeight := mHeight;
with vBitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := ParaImage.Picture.Bitmap.Width;
biHeight := -ParaImage.Picture.Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biSizeImage := 0;
biXPelsPerMeter := 1; //dont care
biYPelsPerMeter := 1; //dont care
biClrUsed := 0;
biClrImportant := 0;
end;
SetDIBits
(
ParaImage.Picture.Bitmap.Canvas.Handle,
ParaImage.Picture.Bitmap.Handle,
0,
mHeight,
// mMemory, ?
@mMemory[0], // <- suspicious
vBitmapInfo,
DIB_RGB_COLORS
);
end;
end.
// *********
Bye,
Sybuck
// MiniDump will follow shortly.
// This has happened many times by now on different occasionals trying to do
stuff like this.
// Getting sick of it.
// Try to get this working:
// *********
unit unit_TPixelMap_version_001;
interface
uses
ExtCtrls;
type
PPixel = ^TPixel;
TPixel = packed record
case integer of
0 :
(
mRed : byte;
mGeen : byte;
mBlue : byte;
mAlpha : byte;
);
1 :
(
mInteger : integer;
);
2 :
(
mLongword : longword;
);
3 :
(
mValue : integer;
);
4 :
(
// mColor : TColor;
);
5 :
(
mLowWord : word;
mHighWord : word;
);
end;
TPixelMap = class
private
protected
mMemory : packed array of byte;
mWidth : integer;
mHeight : integer;
function GetPixel( ParaX, ParaY : integer ) : PPixel; // can be inlined
later on.
public
constructor Create;
destructor Destroy; override;
procedure CopyFromImageBitmap( ParaImage : TImage );
procedure CopyToImageBitmap( var ParaImage : TImage );
property Width : integer read mWidth;
property Height : integer read mHeight;
property Pixel[ ParaX, ParaY : integer ] : PPixel read GetPixel;
end;
implementation
uses
Windows, Classes, Controls;
constructor TPixelMap.Create;
begin
inherited Create;
end;
destructor TPixelMap.Destroy;
begin
inherited Destroy;
end;
// LEARN FROM THIS YOU NOOBS
function TPixelMap.GetPixel( ParaX, ParaY : integer ) : PPixel;
begin
result := @mMemory[ (ParaY * mWidth * SizeOf(TPixel)) + (ParaX *
SizeOf(TPixel)) ];
end;
procedure TPixelMap.CopyFromImageBitmap( ParaImage : TImage );
var
vBitmapInfo : TBitmapInfo;
begin
mWidth := ParaImage.Picture.Bitmap.Width;
mHeight := ParaImage.Picture.Bitmap.Height;
SetLength( mMemory, mWidth * mHeight * SizeOf(TPixel) );
with vBitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := ParaImage.Picture.Bitmap.Width;
biHeight := -ParaImage.Picture.Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biSizeImage := 0;
biXPelsPerMeter := 1; //dont care
biYPelsPerMeter := 1; //dont care
biClrUsed := 0;
biClrImportant := 0;
end;
GetDIBits
(
ParaImage.Picture.Bitmap.Canvas.Handle,
ParaImage.Picture.Bitmap.Handle,
0,
ParaImage.Picture.Bitmap.Height,
// mMemory, // ?
@mMemory[0], // <- suspicious
vBitmapInfo,
DIB_RGB_COLORS
);
end;
procedure TPixelMap.CopyToImageBitmap( var ParaImage : TImage );
var
vBitmapInfo : TBitmapInfo;
vOwner : Tcomponent;
vParent : TwinControl;
vTop : integer;
vLeft : integer;
begin
if ParaImage <> nil then
begin
vOwner := ParaImage.Owner;
vParent := ParaImage.Parent;
ParaImage.Free;
ParaImage := TImage.Create( vOwner );
ParaImage.Parent := vParent;
ParaImage.Top := vTop;
ParaImage.Left := vLeft;
end;
ParaImage.Width := mWidth;
ParaImage.Height := mHeight;
ParaImage.ClientWidth := mWidth;
ParaImage.ClientHeight := mHeight;
with vBitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := ParaImage.Picture.Bitmap.Width;
biHeight := -ParaImage.Picture.Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biSizeImage := 0;
biXPelsPerMeter := 1; //dont care
biYPelsPerMeter := 1; //dont care
biClrUsed := 0;
biClrImportant := 0;
end;
SetDIBits
(
ParaImage.Picture.Bitmap.Canvas.Handle,
ParaImage.Picture.Bitmap.Handle,
0,
mHeight,
// mMemory, ?
@mMemory[0], // <- suspicious
vBitmapInfo,
DIB_RGB_COLORS
);
end;
end.
// *********
Bye,
Sybuck