Tbitmap初始化(100分)

  • 主题发起人 Hgu Chientung
  • 开始时间
H

Hgu Chientung

Unregistered / Unconfirmed
GUEST, unregistred user!
Tbitmap.create 后 我希望用Tbitmap.Scanline来赋值,但首先需要对Bitmap
初始化,我现在的方法是先装入一个图片(LoadFromFile),请教各位高手,如何直接初始化TBitmap,然后直接可以用ScanLine赋值?
 
直接初始化很简单,只要指定Bitmap的Width,Height和PixelFormat就可以了。
看看如下的例子:

procedure TForm1.Button1Click(Sender: TObject);
var x,y:Integer;p:pByteArray;
begin
Bitmap:=TBitmap.Create;
Bitmap.Width:=100;
Bitmap.Height:=100;
Bitmap.PixelFormat:= pf8bit;
for y := 0 to BitMap.Height -1 do
begin
P := BitMap.ScanLine[y];
for x := 0 to BitMap.Width -1 do
P[x] := y;
end;
canvas.draw(0,0,BitMap);
end;
 
需先初始化调色板(Palette)及象素格式(PixelFormat),
当然还有Bitmap.width & Bitmap.Height, 可如下例:
var
pal: TLogPalette;
procedure TForm1.Button1Click(Sender: TObject);
var
x,y : integer;
BitMap : TBitMap;
begin
BitMap := TBitMap.create;
Bitmap.PixelFormat:= pf8bit;//第象素一字节
BitMap.width:=256;
Bitmap.height:=256;

pal.palVersion := $300;
pal.palNumEntries := 256;
for x := 0 to 255 do begin
pal.palPalEntry[x].peRed := x;
pal.palPalEntry[x].peGreen := x;
pal.palPalEntry[x].peBlue := x;
end;
Bitmap.Palette := CreatePalette(pal);

for x := 0 to 255 do
for y := 0 to 255 do
PByteArray(BitMap.ScanLine[y])[x]:=x*y;
canvas.draw(0,0,BitMap);//form.canvas, just for a look:)
end;
 
如果把Project->Options->Compile->Range Checking打开,运行时会出错,查询
Delphi帮助文件LogPalette,发现pal.palPalEntry[1],数组大小只为1,是不是只
初始化了一个?
 
Sherwin的示例程序有一点小问题,那就是他直接用TLogPalette了。
其实,在程序中需要先为调色板分配内存。下面这个例子绝对没有问题。

procedure TForm1.Button1Click(Sender: TObject);
var
x,y : integer;
BitMap : TBitMap;
lplogpal:pLogPalette;//pointer of TLogPalette
begin
BitMap := TBitMap.create;
Bitmap.Width:=256;
Bitmap.Height:=256;
Bitmap.PixelFormat:= pf8bit;
GetMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
lpLogPal.palVersion := $0300;
lpLogPal.palNumEntries := 256;
for x := 0 to 255 do
begin
lpLogPal.palPalEntry[x].peRed := x;
lpLogPal.palPalEntry[x].peGreen := x;
lpLogPal.palPalEntry[x].peBlue := x;
end;
Bitmap.Palette := CreatePalette(lpLogPal^);
FreeMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
for x := 0 to 255 do for y := 0 to 255 do
PByteArray(BitMap.ScanLine[y])[x]:=x*y;
canvas.draw(0,0,BitMap);//form.canvas, just for a look:)
end;
 
tqz,请问Why Range Checking打开会出错?
 
没有为其分配内存,就直接以数组方式读写,当然会出错,因为非法地使用了内存。
Delphi Range Checking打开后就会监测到数组引用越出了边界。就算不打开,
运行中也会出问题的。
 
分配了内存后同样边界出错.
单独例子可以正常运行,但是加到应用程序中却不能得到如期效果(程序中另外打开了
一个1280X960X24Bit BMP),所以不得不仔细检查.
 
呵呵,搞定!
这是由于Pascal语法本身的问题造成的。TLogPalette的定义如下:
PLogPalette = ^TLogPalette;
TLogPalette = packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array[0..0] of TPaletteEntry;
end;
palPalEntry定义为长度为1的数组,所以当数组元素引用超过此范围时
Range Check就会报错。Delphi的解决方案如下,定义了一个TMaxLogPalette:
PMaxLogPalette = ^TMaxLogPalette;
TMaxLogPalette = packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [Byte] of TPaletteEntry;
end;
注意这里的palPalEntry为可变数组,所以使用这个结构不会有Range Checking
的问题,当然先要分配内存,CreatePalette的时候还要把PMaxLogPalette 强制
转换为PLogPalette。VCL的源代码中Graphics单元里创建Palette就是这么做的。
新的范例如下:
procedure TForm1.Button1Click(Sender: TObject);
var
x,y : integer;
BitMap : TBitMap;
lplogpal:pMaxLogPalette;//pointer of TMaxLogPalette
p:pByteArray;
begin
BitMap := TBitMap.create;
Bitmap.Width:=256;
Bitmap.Height:=256;
Bitmap.PixelFormat:= pf8bit;
GetMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
lpLogPal.palVersion := $0300;
lpLogPal.palNumEntries := 256;
for x := 0 to 255 do
begin
lpLogPal.palPalEntry[x].peRed := x;//没问题了!
lpLogPal.palPalEntry[x].peGreen := x;
lpLogPal.palPalEntry[x].peBlue := x;
end;
Bitmap.Palette := CreatePalette(pLogPalette(lpLogPal)^);//要转换
FreeMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
for y := 0 to BitMap.Height -1 do
begin
P := BitMap.ScanLine[y];
for x := 0 to BitMap.Width -1 do
P[x] := Byte(x*y);//这里不类型转换一下也会Range Checking错
end;
canvas.draw(0,0,BitMap);//form.canvas, just for a look:)
end;

给~~分~~吧~~~~@_@
 
Tqz,本来运行结果是灰度的,但加入一个JPG后图像有色(加入以下三行),
务必请赐教!

procedure TForm1.Button1Click(Sender: TObject);
var x,y : integer;
BitMap : TBitMap;
lplogpal:pMaxLogPalette;//pointer of TMaxLogPalette
p:pByteArray;
Jpg:TJpegImage; //By Hgu
begin
Jpg:=TJpegImage.Create; // By Hgu
Jpg.LoadfromFile('pict1.jpg'); //24Bit JPG By Hgu
BitMap := TBitMap.create;
Bitmap.Width:=256;
Bitmap.Height:=256;
Bitmap.PixelFormat:= pf8bit;
GetMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
lpLogPal.palVersion := $0300;
lpLogPal.palNumEntries := 256;
for x := 0 to 255 do
begin
lpLogPal.palPalEntry[x].peRed := x;//没问题了!
lpLogPal.palPalEntry[x].peGreen := x;
lpLogPal.palPalEntry[x].peBlue := x;
end;
Bitmap.Palette := CreatePalette(pLogPalette(lpLogPal)^);//要转换
FreeMem(lpLogPal,sizeof(TLOGPALETTE) + ((255) * sizeof(TPALETTEENTRY)));
for y := 0 to BitMap.Height -1 do
begin
P := BitMap.ScanLine[y];
for x := 0 to BitMap.Width -1 do
P[x] := Byte(x*y);//这里不类型转换一下也会Range Checking错
end;
canvas.draw(0,0,BitMap);//form.canvas, just for a look:)
end;
 
我把你的程序copy到我的Delphi中运行,一点错都没有呀!Delphi 3 ,4都试过了。
 
显示器分辨率为增强色(16位)时,有时会出错,而256色时不会。
 
我的分辨率就是16位的,没有问题呀。我相信这种生成TBitmap的方法没有问题,
除非Delphi的TBitmap类有问题。
 
在JPEG.Create之后GetMem要出问题, Jpeg.Create之前GetMem一切正常
我认为:Tbitmap,TJpegImage,Getmem之中肯定有一个有问题!
 
在TJpegImage.Create之后Getmem后要出问题,JpegImage.Create之前Getmem
一切正常,我认为Delphi的 Tbitmap,TJpegImage,Getmem中肯定有一个有问题
不是吗?我的Email地址是Hgu@188.net,那位有进一步的发现,请告诉我,谢谢!
 
要错就只能是TJPEGImage错了。但是我尚未发现有你说的问题。我用的是Delphi 4,
你是不是Delphi 3?
 
顶部