１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"画像のSaveToFileメソッド自作"
｢画像のSaveToFileメソッド自作｣について
初めての発言ということで、ご挨拶を兼ねて概要を談話室にUpLoadしました
が、数日してどういう訳か消去されてしまってますので、こちらに出します。
なお、談話室では、ペイントブラシで異状が発生すると書きましたが、これ
は間違いです。Delphi,ＶＢ,ペイントブラシでは問題ありません。
☆ 画像データを自分でセーブするには、こんなプログラムが必要ですという
感じで見ていただきたいと思います。
いりいろやっているうちに、疑問も沢山発生しました。報告と質問がごっ
ちゃになり、まとまりのない文章になりましたが、具体策をお教えいただけ
たら幸いです。
1998/5/19(火) 堀 彰男(BYR17235)
----------------------------------------------------------------------
BitmapへBMP画像をロードして、別のBitmapへBitBltやDrawメソッドで転送
することによってこれを加工します。それをSaveToFileでファイルに出力しま
す。このファイルを画像処理ソフトに読込みます。
私の実験ではBitmap1.SaveToFileを使っています。画像をロードしたビット
マップであるBitmap1に書き戻しているわけですが、こうしないと、下記の
Ｃ−2.1 やHALOは｢画像パラメータが異状です｣とか"Error Opening"とかの
メッセージが出て、まったく画像を読込んでくれません。なぜでしょうか????
☆ Delphi,ＶＢ,ペイントブラシはどんな場合も正常に読んでくれます。
----------------------------------------------------------------------
異常を確認しているのは、マイナーなソフトばかりですが、
HALO ：インプレス社のクリップアーツの付録ソフト
Graphic WorkShop ：海外の有名シェアウエア
Ｃ−2.1 Ｗ９５ ：オリンパスのCamediaに付属するソフト
Daisy Collage Ver1.0 ：市川ソフトラボラトリーの画像処理ソフト
GWViewer ：ちょっと古いフリーウエア
画像の大きさを加工した場合に異常が発生します。DelphiやＶＢ、それにペ
イントブラシでは異常は発生しませんが、上記のソフトでは色が反転し、水平
同期がずれたような(折り返したような)画像が表示されます。
いろいろと調べてみましたが、結論は...........
・通常の画像ファイルの場合は、水平ラインについてはワード境界(DWORDです)
になっていますが、Delphiで画像の大きさを加工して、ファイルに描き出すと
ワード境界が守られていないようです。
・異常が発生しないソフトでは、ワード境界は無視して、別のパラメータを使
用して読込んでいるようです。BitmapInfoHeaderは融通の効く内容ですが、そ
のために読めない画像が発生することがあります。これは、Windows3.1の時代
から悩まされてきた問題でした。ある画像データをあるプログラムで読むと
エラーになるという現象に悩まされた方は多いと思います。
私の場合は止むを得ず、BitmapFileHeaderとBitmapInfoHeaderを作り、
VirtualAllocでメモリーを確保し、GetDIBでBitmapをメモリーに書き出し、
ワード境界をきちんと作った上でBlockWriteでファイルに落としました。その
結果、どのソフトでもうまく読んでくれるようになりました。
以下にコードの主要な部分を掲載します。試作品のままですので、かなりい
い加減なプログラムです。おかしなところがあるかもしれません。
なお24ビット画像のみに対応しています。
まだ詳しくは調べていませんが、Delphi 3.1のGraphics.pasを見てみると
良いように思われます。
蛇足ですが、ＶＢ５では大きさを加工した画像をセーブしようとするとエ
ラーになりました。これも、もう少し詳しく調べたいと思っています。
★まず、異常な場合のプログラムの抜粋です。いろんな都合で何度も転写し
ていますが、プログラムとしては問題はなく動作します。
--------------------------------------------------------------------
var
Bitmap1, Bitmap2: TBitmap;
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Bitmap1.LoadFromFile(OpenDialog1.FileName);
Image1.Picture.Bitmap.Width := Bitmap1.Width;
Image1.Picture.Bitmap.Height := Bitmap1.Height;
Image1.Canvas.Draw(0, 0, Bitmap1);
end;
end;
procedure TForm1.SaveAs1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Bitmap1.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Cut1Click(Sender: TObject); // ここで355×200にカット
var
a, b: Integer;
begin
a := 355;// Bitmap1から切り取る
b := 200;
Bitmap2.Width := a;
Bitmap2.Height := b;
BitBlt(Bitmap2.Canvas.Handle, 0, 0, a, b,
Bitmap1.Canvas.Handle, 0, 0, SrcCopy);
// Bitmap2に転写する
Image1.Picture.Bitmap.Width := a;
Image1.Picture.Bitmap.Height := b;
Image1.Canvas.Draw(0, 0, Bitmap2);
Bitmap1.Width := a;
Bitmap1.Height := b;
Bitmap1.Canvas.Draw(0, 0, Image1.Picture.Bitmap);
// なぜか?? Bitmap1に移してからセーブした方が
// 穏やかな異常になる．
end;
☆SaveToFileの部分を自作したら、問題はなくなった。その抜粋です。
---------------------------------------------------------------
implementation
{$R *.DFM}
var
Bitmap1: TBitmap;
Path1: string;
procedure TForm1.Save1Click(Sender: TObject);// 上書き保存
var
i, j, k: Integer;
fp: file;
buf: array[0..3840] of Byte;// 画像の水平は1280ﾋﾟｸｾﾙまで
BitmapFileHeader: TBitmapFileHeader;
BitmapInfoHeader: TBitmapInfoHeader;
ImageSize: Integer;
LnWidth, LnPad: Integer;
InfoSize1: Integer;
ImageSize1: Integer;
info1: PBitmapInfo;
Image1: PByte;
Image2: PByte;
begin
if Path1 = '' then SaveAs1Click(Sender);
if Bitmap1 = nil then exit;
Screen.Cursor := crHourGlass;
try
LnWidth := Bitmap1.Width;
LnPad := 0;
if ((LnWidth * 3) mod SizeOf(LongInt)) <> 0 then
LnPad := SizeOf(LongInt) - ((LnWidth * 3) mod SizeOf(LongInt));
ImageSize := (LnWidth * Bitmap1.height * 3) + LnPad;
AssignFile(fp, Path1);
Rewrite(fp, 1);
BitmapFileHeader.bfType := word($4d42);
BitmapFileHeader.bfSize := Integer(54 + ImageSize);
BitmapFileHeader.bfReserved1 := 0;
BitmapFileHeader.bfreserved2 := 0;
BitmapFileHeader.bfOffBits := Integer(54);
BlockWrite(fp, BitmapFileHeader, 14);
BitmapInfoHeader.biSize := Integer(40);
BitmapInfoHeader.biWidth := Integer(Bitmap1.Width);
BitmapInfoHeader.biHeight := Integer(Bitmap1.Height);
BitmapInfoHeader.biPlanes := SmallInt(1);
BitmapInfoHeader.biBitCount := SmallInt(24);
BitmapInfoHeader.biCompression:= Integer(0);
BitmapInfoHeader.biSizeImage := Integer(0);
BitmapInfoHeader.biXPelsPerMeter := Integer(0);
BitmapInfoHeader.biYPelsPerMeter := Integer(0);
BitmapInfoHeader.biClrUsed := Integer(0);
BitmapInfoHeader.biClrImportant := Integer(0);
BlockWrite(fp, BitmapInfoHeader, 40);
GetDIBSizes(Bitmap1.Handle, InfoSize1, ImageSize1);
Info1 := VirtualAlloc(nil, InfoSize1,
mem_Commit or mem_Reserve, Page_ReadWrite);
Image1 := VirtualAlloc(nil, ImageSize1,
mem_Commit or mem_Reserve, Page_ReadWrite);
Image2 := Image1;
GetDIB(Bitmap1.Handle, Bitmap1.Palette, info1^, Image1^);
if Info1.bmiHeader.biBitCount <> 24 then
begin
ShowMessage('これは24ﾋﾞｯﾄ･ｶﾗｰでありません');
VirtualFree(Image1, 0, mem_Release);
VirtualFree(Info1, 0, mem_Release);
CloseFile(fp);
exit;
end;
for j := BitmapInfoHeader.biHeight -1 downto 0 do
begin
for i := 0 to BitmapInfoHeader.biWidth -1 do
begin
k := i * 3;
buf[k] := Image2^; // blue
inc(Image2);
buf[k + 1] := Image2^;// green
inc(Image2);
buf[k + 2] := Image2^;// red
inc(Image2);
end;
BlockWrite(fp, buf, BitmapInfoHeader.biWidth * 3);
for i := 0 to LnPad - 1 do
begin
buf[i] := 0;
inc(Image2);
end;
BlockWrite(fp, buf, LnPad);
end;
VirtualFree(Image1, 0, mem_Release);
VirtualFree(Info1, 0, mem_Release);
CloseFile(fp);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.SaveAs1Click(Sender: TObject);// 名前を付けて保存
begin
if SaveDialog1.Execute then
begin
Path1 := SaveDialog1.FileName;
Save1Click(Sender);
end;
end;
Original document by 堀 彰男 氏 ID:(BYR17235)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。