画像をimage1にロードしてimage2に縮小するところでうまくいかなくてお助けを。下記のコードでやってみると「ビットマップを持っている時のみイメージの変更が可能です」と出てしまいます。 ソースの元ネタはhttp://delphi.livedoor.biz/archives/50602241.html
なのですが同じようにやっても動きません。（画像のロードだけはできています） 何が原因か教えてください。（D6 パーソナル）
procedure TForm1.Button1Click(Sender: TObject);
var
w,h,w1,h1:integer;
kfile:string;
begin
kfile:='c:\mypictures\2008\801\thumbnail\t_imgp2597.jpg';
image1.picture.LoadFromFile(kfile);
w:=form1.image1.picture.Width;
h:=form1.image1.picture.Height;
w1:=round(w*0.8);
h1:=round(h*0.8);
SetStretchBltMode(form1.image2.Canvas.Handle, HALFTONE);
StretchBlt(form1.image2.Canvas.Handle,
0, 0, w1, h1,
form1.image1.Canvas.Handle,
0, 0, w, h,
SRCCOPY);
end;
>何が原因か教えてください。（D6 パーソナル）
ロードしている画像が JPEG だから
KHE00221様、回答をありがとうございました。
確かにサンプルのコードはBMPでした。これと同じようなものをいくつか作ってみたのですがいずれも失敗でしたが原因は画像がJPEGであるとは知りませんでした。JPEGをBMPのように縮小して保存するのが最終目的なのですがどのようにすれば良いか教えてください。
参考になれば。
http://homepage1.nifty.com/ht_deko/tech001.html#tech018
DEKO様、ご回答をありがとうございました。サンプルを試した結果見事画像の縮小はできました。
しかし縮小された画像は電線などが途切れ途切れになっておりました。できれば画質向上のためHALFTONEモードを入れたい、多数の画像をバッチで処理したいので進行がわかるように作業中の画像を表示するようにしたい、などを希望しております。方法がありましたらよろしくお願いします。
>方法がありましたらよろしくお願いします。
他人のサンプルを丸写ししてるだけじゃ、いつまでも初心者マークは取れないよ。
その程度の応用は、まず自分でやってみたらどう？
画像を滑らかに縮小・拡大するには、ピクセルの間を補間する必要があります。
有名なのは、バイリニア・バイキュービックなどです。参考になるページを
挙げておきます。
http://junki.lix.jp/delphigr/041Resize1.htm
http://junki.lix.jp/delphigr/042Resize2.htm
http://junki.lix.jp/delphigr/044Resize3.htm
辛口一献様、junki様 ご回答をありがとうございました。
ご紹介いただいたサイトを拝見し、各ピクセルの周囲の情報を取り入れて補完する方法は勉強になりました。
計画しているソフトは最近のデジカメで撮った写真のサイズがあまりにも大きいのであまり重要ではないものはバッチで縮小して保存して整理しようとVBで作り、上手く動いています。かなりコンパクトなものなのでランタイムが不要なDELPHIに移植しようと挑戦を始めたものです。縮小の場合はSet StretchBltMode をHALFTONEに指定するとスムーズな画像となりほぼ満足できるのでStretchBltをこのAPIを使えば簡単にできるのではないかと思って試したのですが理解不足でした。VBのようにPicture（Image)に一度ロードしてしまえばBMPでもJPGでも同じように処理できるものと思っていたのが間違いでした。補完方法に関しては開発言語に係わらず普遍的な技術ですので勉強になりました。お手数をお掛けしました。
HALFTONEを使ったFunc_Aの縮小方法でもかなりイケルけど、
髪の毛や眼など、線や細かい部分では、Func_Bの方がイイね。
type
PAryRGBTr = ^TAryRGBTr;
TAryRGBTr = array[0..$1FFF] of TRGBTriple;
const
RATE = 0.3000; // 縮小率
PATH = 'C:\My Documents\My Pictures\';
// HALFTONEを指定してStretchBlt関数
procedure TForm1.Func_A(Jpg: TJPEGImage);
var
w, h, w1, h1: Integer;
begin
Image1.Picture.Bitmap.Assign(Jpg);
w := Image1.Picture.Width;
h := Image1.Picture.Height;
w1 := Round(w * RATE);
h1 := Round(h * RATE);
Image2.Picture.Bitmap.Width := w1;
Image2.Picture.Bitmap.Height := h1;
SetStretchBltMode(Image2.Canvas.Handle, HALFTONE);
StretchBlt(Image2.Canvas.Handle, 0, 0, w1, h1, Image1.Canvas.Handle, 0, 0, w, h, SRCCOPY);
Image2.Invalidate;
end;
// 独自のリサイズ関数
procedure TForm1.Func_B(Jpg: TJPEGImage);
//------------------------------------------
procedure ResizeBmp(SrcBmp, DstBmp: TBitmap);
var
x, y: Integer;
xP, yP, xD, yD: Integer;
w1, w2, w3, w4: Integer;
zz, nz, iz, tt: Integer;
DstGaps: Integer;
SrcLine1, SrcLine2, DstLine: PAryRGBTr;
begin
SrcBmp.PixelFormat := pf24Bit;
DstBmp.PixelFormat := pf24Bit;
if (SrcBmp.Width = DstBmp.Width) and (SrcBmp.Height = DstBmp.Height) then begin
DstBmp.Assign(SrcBmp);
end else begin
DstLine := DstBmp.ScanLine[0];
DstGaps := PChar(DstBmp.ScanLine[1]) - PChar(DstLine);
xD := MulDiv(Pred(SrcBmp.Width), $10000, DstBmp.Width);
yD := MulDiv(Pred(SrcBmp.Height), $10000, DstBmp.Height);
yP := 0;
for y := 0 to Pred(DstBmp.Height) do begin
xP := 0;
SrcLine1 := SrcBmp.ScanLine[yP shr 16];
if (yP shr 16 < Pred(SrcBmp.Height)) then begin
SrcLine2 := SrcBmp.ScanLine[Succ(yP shr 16)]
end else begin
SrcLine2 := SrcBmp.ScanLine[yP shr 16];
end;
nz := Succ(yP and $FFFF);
iz := Succ((not yP) and $FFFF);
for x := 0 to Pred(DstBmp.Width) do begin
tt := xP shr 16;
zz := xP and $FFFF;
w2 := MulDiv(zz, iz, $10000);
w1 := iz - w2;
w4 := MulDiv(zz, nz, $10000);
w3 := nz - w4;
DstLine[x].rgbtRed := (SrcLine1[tt].rgbtRed * w1 + SrcLine1[tt + 1].rgbtRed * w2
+ SrcLine2[tt].rgbtRed * w3 + SrcLine2[tt + 1].rgbtRed * w4) shr 16;
DstLine[x].rgbtGreen := (SrcLine1[tt].rgbtGreen * w1 + SrcLine1[tt + 1].rgbtGreen * w2
+ SrcLine2[tt].rgbtGreen * w3 + SrcLine2[tt + 1].rgbtGreen * w4) shr 16;
DstLine[x].rgbtBlue := (SrcLine1[tt].rgbtBlue * w1 + SrcLine1[tt + 1].rgbtBlue * w2
+ SrcLine2[tt].rgbtBlue * w3 + SrcLine2[tt + 1].rgbtBlue * w4) shr 16;
Inc(xP, xD);
end;
Inc(yP, yD);
DstLine := PAryRGBTr(PChar(DstLine) + DstGaps);
end;
end;
end;
//------------------------------------------
var
w, h: Integer;
begin
Image1.Picture.Bitmap.Assign(Jpg);
w := Image1.Picture.Width;
h := Image1.Picture.Height;
Image2.Picture.Bitmap.Width := Round(w * RATE);
Image2.Picture.Bitmap.Height := Round(h * RATE);
ResizeBmp(Image1.Picture.Bitmap, Image2.Picture.Bitmap);
Image2.Invalidate;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Jpg: TJPEGImage;
sr: TSearchRec;
begin
Jpg := TJPEGImage.Create;
try
if FindFirst(PATH +'*.jpg', faArchive, sr) <> 0 then exit;
repeat
Caption := sr.Name;
Jpg.LoadFromFile(PATH + sr.Name);
Func_A(Jpg);
Application.ProcessMessages; Sleep(1000);
Func_B(Jpg);
Jpg.Assign(Image2.Picture.Bitmap);
// Jpg.SaveToFile('T_'+ sr.Name);
Application.ProcessMessages; Sleep(1000);
if GetKeyState(VK_ESCAPE) < 0 then break;
until FindNext(sr) <> 0;
FindClose(sr);
finally
Jpg.Free;
end;
end;
叩けよさらば開かれん様 大変な労作をありがとうございました。
まずFunc_AでJpegをStretchBltで変形するという所期の目的が達成でき、おかげさまで永い間試行錯誤してきたバッチ処理のソフトができました。Jpegを読み込んで変形するという基本動作に必要なプロセスが習得できました。現時点ではFunc_Bは「アドレス違反」というメッセージが出てしまっていますが縮小が目的ですのでとりあえずはStretchBltで十分満足する結果が得られておりますのでFunc_Bは今後の勉強課題にしたいと思います。ありがとうございました。ご親切に感謝します。