Hallo Andreas,
das erste Bild habe ich wie folgt ausgelsesen und auch speichern können, DANKE!
var
finfo: TGFL_FILE_INFORMATION;
lp: TGFL_LOAD_PARAMS;
gfl_bmp: PGFL_BITMAP;
e: GFL_ERROR;
filename,zieldunkel: string;
bmp,bmp2: TBitmap;
x, y, k: Integer;
LineSrc: Pointer;
LineDest: Pointer;
LineIn: PLine1;
LineOut: PByteArray;
Mask1: Byte;
Mask: Byte;
pal: PLogPalette;
w1,w2,l1,l2,l3,i, bpp: Integer;
Arect: TRect;
begin
gflEnableLZW(GFL_TRUE);
filename := original.Text;
l1:=length(zieldatei.Text);
gflGetDefaultLoadParams(lp);
lp.ColorModel := GFL_BGR;
lp.LinePadding := 4;
e := gflLoadBitmap(PChar(filename), gfl_bmp, lp, finfo);
if (e <> gfl_no_error) then begin
MessageDlg('File not readable: ' + string(gflGetErrorString(e)), mtError, [mbOK], 0);
exit;
end;
pal := nil;
if (gfl_bmp.Btype = GFL_BINARY) then begin
bpp := 1;
end else begin
bpp := gfl_bmp.BytesPerPixel * 8;
end;
if not (bpp in [1, 4, 8, 24, 32]) then begin
MessageDlg('Only 1, 4, 8, 24 or 32 BitsPerPixel are supported in this demo !', mtError, [mbOK], 0);
gflFreeBitmap(gfl_bmp);
exit;
end;
///////////////////
// Create Delphi Bitmap. If paletted, minimize memory by setting size after pixel format
bmp := TBitmap.Create;
bmp.PixelFormat := IntToPixelFormat(bpp);
bmp.Width := gfl_bmp.Width;
bmp.Height := gfl_bmp.Height;
w1:=round(bmp.Width div 800);
If w1 = 1 then
w1:=2;
dimension.Text:=inttostr(w1);
NewPalette := 0;
//-------------------------------------
//Fixed. I. Scollar
al001@mail1.rrz.uni-koeln.de 6.3.2002
case bmp.PixelFormat of
//-------------------
pf1bit:
begin
try
//pf1bit has a bug. It's palette has only zero entries
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
pal.palVersion := $300;
pal.palNumEntries := 2;
for i := 0 to 1 do with pal.palPalEntry[i] do begin
peRed := i * 255; peGreen := i * 255; peBlue := i * 255;
peFlags := PC_NOCOLLAPSE;
end;
if (NewPalette <> 0) then
DeleteObject(NewPalette);
NewPalette := CreatePalette(pal^);
finally
FreeMem(pal);
end;
DeleteObject(bmp.ReleasePalette);
bmp.Palette := NewPalette;
//set canvas to white, since positive image usually wanted
ARect := Bounds(0, 0, bmp.Width, bmp.Height);
bmp.canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(ARect);
Mask1 := 128; //leftmost bit set
for y := 0 to gfl_bmp.Height - 1 do begin
move( Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
bmp.Scanline[y]^, gfl_bmp.BytesPerLine);
end;
Clipboard.Assign(bmp);
Imageen1.Proc.PasteFromClipboard;
Image.Picture.Bitmap := bmp;
Application.ProcessMessages;
ImageEn5.proc.PasteFromClipboard;
imageen5.Update;
ImageEnIO2.Params.JPEG_Quality:=100;
ImageEnIO2.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO2.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO2.SaveToFile(zieldatei.Text);
while not fileexists(zieldatei.text) do
ImageEnIO2.SaveToFile(zieldatei.Text);
while fileexists(original.text) do
deleteFile(original.Text);
clipboard.Clear;
If dunkelja.Checked = TRUE then begin
If strtoint(dunkel.Text) <> 0 then begin
Application.ProcessMessages;
imageen1.Proc.GammaCorrect(0.1, [iecRed,iecGreen,iecBlue]);
imageen1.Update;
image1.Picture.Bitmap:=imageen1.Bitmap;
ImageEnIO1.Params.JPEG_Quality:=100;
ImageEnIO1.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO1.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO1.SaveToFile(zieldunkel);
clipboard.Clear;
end;
end;
end;
//-------------------
pf4Bit:
begin
try
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
pal.palVersion := $300;
pal.palNumEntries := 16;
for i := 0 to 15 do with pal.palPalEntry[i] do begin
peRed := gfl_bmp.ColorMap^.Red[i];
peGreen := gfl_bmp.ColorMap^.Green[i];
peBlue := gfl_bmp.ColorMap^.Blue[i];
peFlags := PC_NOCOLLAPSE;
end;
if (NewPalette <> 0) then
DeleteObject(NewPalette);
NewPalette := CreatePalette(pal^);
finally
FreeMem(pal);
end;
DeleteObject(bmp.ReleasePalette);
bmp.Palette := NewPalette;
for y := 0 to gfl_bmp.Height - 1 do begin
move( Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
bmp.Scanline[y]^, gfl_bmp.BytesPerLine);
end;
Clipboard.Assign(bmp);
Image.Picture.Bitmap := bmp;
Imageen1.Proc.PasteFromClipboard;
Application.ProcessMessages;
ImageEn5.proc.PasteFromClipboard;
imageen5.Update;
ImageEnIO2.Params.JPEG_Quality:=100;
ImageEnIO2.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO2.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO2.SaveToFile(zieldatei.Text);
while not fileexists(zieldatei.text) do
ImageEnIO2.SaveToFile(zieldatei.Text);
while fileexists(original.text) do
deleteFile(original.Text);
clipboard.Clear;
If dunkelja.Checked = TRUE then begin
If strtoint(dunkel.Text) <> 0 then begin
Application.ProcessMessages;
imageen1.Proc.GammaCorrect(0.1, [iecRed,iecGreen,iecBlue]);
imageen1.Update;
image1.Picture.Bitmap:=imageen1.Bitmap;
ImageEnIO1.Params.JPEG_Quality:=100;
ImageEnIO1.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO1.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO1.SaveToFile(zieldunkel);
clipboard.Clear;
end;
end;
end;
//-------------------
pf8Bit:
begin
if gfl_bmp.ColorMap <> nil then begin
try
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
pal.palVersion := $300;
pal.palNumEntries := 256;
for i := 0 to 255 do with pal.palPalEntry[i] do begin
peRed := gfl_bmp.ColorMap^.Red[i];
peGreen := gfl_bmp.ColorMap^.Green[i];
peBlue := gfl_bmp.ColorMap^.Blue[i];
peFlags := PC_NOCOLLAPSE;
end;
if (NewPalette <> 0) then
DeleteObject(NewPalette);
NewPalette := CreatePalette(pal^);
finally
FreeMem(pal);
end;
end else begin
{PCX bug in GflLib, pcx has no color palette, so make gray palette}
try
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 256);
pal.palVersion := $300;
pal.palNumEntries := 256;
for i := 0 to 255 do begin
pal.palPalEntry[i].peRed := i;
pal.palPalEntry[i].peGreen := i;
pal.palPalEntry[i].peBlue := i;
pal.palPalEntry[i].peFlags := PC_NOCOLLAPSE;
end;
if (NewPalette <> 0) then
DeleteObject(NewPalette);
NewPalette := CreatePalette(pal^);
finally
FreeMem(pal);
end;
end;
DeleteObject(bmp.ReleasePalette);
bmp.Palette := NewPalette;
// Copy Pixel Data
for y := 0 to gfl_bmp.Height - 1 do
// Pointer to Scanline of TGFL_Bitmap
move( Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine))^,
// Pointer to Scanline of TBitmap
bmp.Scanline[y]^, gfl_bmp.BytesPerLine);
Clipboard.Assign(bmp);
Imageen1.Proc.PasteFromClipboard;
Image.Picture.Bitmap := bmp;
Application.ProcessMessages;
ImageEn5.proc.PasteFromClipboard;
imageen5.Update;
ImageEnIO2.Params.JPEG_Quality:=100;
ImageEnIO2.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO2.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO2.SaveToFile(zieldatei.Text);
while not fileexists(zieldatei.text) do
ImageEnIO2.SaveToFile(zieldatei.Text);
while fileexists(original.text) do
deleteFile(original.Text);
clipboard.Clear;
If dunkelja.Checked = TRUE then begin
If strtoint(dunkel.Text) <> 0 then begin
Application.ProcessMessages;
imageen1.Proc.GammaCorrect(0.1, [iecRed,iecGreen,iecBlue]);
imageen1.Update;
image1.Picture.Bitmap:=imageen1.Bitmap;
ImageEnIO1.Params.JPEG_Quality:=100;
ImageEnIO1.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO1.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO1.SaveToFile(zieldunkel);
clipboard.Clear;
end;
end;
end;
//-------------------
// 24 + 32 Bit images
pf24Bit, pf32Bit:
begin
for y := 0 to gfl_bmp.Height - 1 do begin
// get Pointer to Scanlines
lineSrc := Pointer(Integer(gfl_bmp.data) + (y * gfl_bmp.BytesPerLine));
lineDest := bmp.Scanline[y];
// copy Pixel Data
move(lineSrc^, lineDest^, gfl_bmp.BytesPerLine);
end;
Clipboard.Assign(bmp);
Image.Picture.Bitmap := bmp;
Imageen1.Proc.PasteFromClipboard;
Application.ProcessMessages;
ImageEn5.proc.PasteFromClipboard;
imageen5.Update;
ImageEnIO2.Params.JPEG_Quality:=100;
ImageEnIO2.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO2.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO2.SaveToFile(zieldatei.Text);
while not fileexists(zieldatei.text) do
ImageEnIO2.SaveToFile(zieldatei.Text);
while fileexists(original.text) do
deleteFile(original.Text);
clipboard.Clear;
If dunkelja.Checked = TRUE then begin
If strtoint(dunkel.Text) <> 0 then begin
Application.ProcessMessages;
imageen1.Proc.GammaCorrect(0.1, [iecRed,iecGreen,iecBlue]);
imageen1.Update;
image1.Picture.Bitmap:=imageen1.Bitmap;
ImageEnIO1.Params.JPEG_Quality:=100;
ImageEnIO1.Params.JPEG_Progressive:=True;
If strtoInt(glaetten.Text) > 0 then
ImageEnIO1.Params.JPEG_Smooth:=strtoint(glaetten.T ext); //.Params.JPEG_Quality:=100;
ImageEnIO1.SaveToFile(zieldunkel);
clipboard.Clear;
end;
end;
end;
end; {case pixelformat}
end;
// Free Resources
bmp.Free;
gflFreeBitmap(gfl_bmp);