如何将屏幕保存为256级灰度的图形文件?(50分)

  • 主题发起人 主题发起人 lilor
  • 开始时间 开始时间
L

lilor

Unregistered / Unconfirmed
GUEST, unregistred user!
看了一下以前的帖子,好象都不行。
要求速度要快。
 
不要多次提问。
 
procedure ConvertToGrayGraphic(var Bmp: TBitmap);
var
p :PByteArray;
Gray,x,y :Integer;
begin
for y:=0 to Bmp.Height-1 do
begin
p:=Bmp.scanline[y];
for x:=0 to Bmp.Width-1 do
begin
Gray:=Round(p[x*3+2]*0.3+p[x*3+1]*0.59+p[x*3]*0.11);
p[x*3]:=Gray;
p[x*3+1]:=Gray;
p[x*3+2]:=Gray;
end;
end;
end;
 
这个我知道,我想问的是如何保存为256级灰度图形。这样图形会比较小一些。
在ACDSEE中可以看到图形的颜色数,是否为灰度或彩色。
 
procedure ConvertToGrayGraphic(var Bmp: TBitmap);
var
p :PByteArray;
Gray,x,y :Integer;
begin
for y:=0 to Bmp.Height-1 do
begin
p:=Bmp.scanline[y];
for x:=0 to Bmp.Width-1 do
begin
Gray:=Round(p[x*3+2]*0.3+p[x*3+1]*0.59+p[x*3]*0.11);
p[x*3]:=Gray;
p[x*3+1]:=Gray;
p[x*3+2]:=Gray;
end;
end;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
Bmp1: TBitmap;
begin
Bmp1 :=TBitmap.Create;
Bmp1.Assign(Image3.Picture.Bitmap);

ConvertToGrayGraphic(Bmp1);
Image3.Picture.Bitmap.Assign(Bmp1);
Image3.Picture.SaveToFile('c:/sf.bmp');
Bmp1.Free;
end;
 
创建位图对象时,制定像素格式,然后用Canvas.CopyRect就可以了
 
是pf8bit吗? 我试了一下,不行。
 
你没说清楚,这样就行了:

procedure TForm1.Button7Click(Sender: TObject);
var
Bmp1: TBitmap;
begin
Bmp1 :=TBitmap.Create;
Bmp1.Assign(Image3.Picture.Bitmap);
ConvertToGrayGraphic(Bmp1);

Bmp1.pixelformat := pf8bit;
Bmp1.SaveToFile('c:/sss.bmp');
Bmp1.Free;
end;
 
我从网上查到了下面的程序,问题解决了,最后成功保存为256级灰度(不是256色)图形了:
function GammaConv(Value: double; Gamma: double): double;
begin
if Value <> 0 then Result := Exp(Ln(Value)/Gamma) else Result := 0;
end;

function CreateGrayPalette(Num: integer; Gamma: double): HPalette;
var
lPal: PLogPalette;
i: integer;
begin
// Add the Grayscale palette
lPal :=AllocMem(sizeof(TLogPalette) + Num * sizeof(TPaletteEntry));
lPal.palVersion := $300;
lPal.palNumEntries := Num;
for i := 0 to Num-1 do
with lPal.palPalEntry do
begin
peRed:=Round(255*GammaConv(i/(Num-1),Gamma));
peGreen:=Round(255*GammaConv(i/(Num-1),Gamma));
peBlue:=Round(255*GammaConv(i/(Num-1),Gamma));
peFlags:=0;
end;
Result:=CreatePalette(lPal^);
FreeMem(lPal);
Win32Check(longbool(Result));
end;

procedure ConvertToGray_256(bmp: TBitmap);
var
gm : TBitmap; // Destination grayscale bitmap
x, y : integer;
p1 : PRGBArray;
p2 : PByteArray;
begin
bmp.PixelFormat := pf24bit;
gm := TBitmap.Create;
gm.PixelFormat:=pf8bit; gm.Width:=bmp.Width; gm.Height:=bmp.Height;
gm.Palette := CreateGrayPalette(256, 1.4);
for y := 0 to bmp.Height-1 do
begin
p1 := bmp.ScanLine[y];
p2 := gm.ScanLine[y];
for x:=0 to bmp.Width-1 do with p1^[x] do p2^[x]:=(Red*3+Grn*4+Blu) div 8; //得到灰度值
end;
bmp.Assign(gm);
gm.Free;
end;
多谢各位!
 
后退
顶部