画像拡大時のタイルを円滑化
解決Delphi6パーソナル＋XP
写真画像をStretchBltで拡大して見た時にタイル状のモザイクが目立つのでこれを円滑化したいと試行錯誤しています。SetStretchBltModeを試しましたがタイルは変わらずに出るためGDI＋を試してみたら滑らかな画像が表示されました。しかし原画のある部分を切り出して拡大、縮小するStretchBltのような方法がわかりません。どのような方法があるのか教えてください。
//GDI+のテスト例
bmp := TGPBitmap.Create('C:\test.jpg');
try
w :=bmp.GetWidth * 20;
h :=bmp.GetHeight * 20;
graphics.SetInterpolationMode(InterpolationModeNearestNeighbor);
graphics.DrawImage(bmp, MakeRect(10, 10, w, h));
finally
bmp.Free;
graphics.Free;
end;
ここの
http://www.asahi-net.or.jp/~ha3t-nkmr/deldown.htm
TNkDIBはどうでしょうか？
あの有名な中村さんのサイトです。
先に切り抜いて、そのあと拡大すれば良いんじゃないですかね？
deldel様、早速ありがとうございます。
TNkDIBをDLしてPhotoDemoを試してみましたがNKDIB.dcuが見つかりません、というメッセージが出て起動できませんでした。コード（回転やミラー）を見てみましたがどれも1ピクセルずつ色を拾って描画するように見受けられました。これでStretchBltに匹敵する速度を得ることができるのでしょうか？
初心者のためこのソフトの持つ力がわかりませんがこれを工夫すればStretchBltみたいに使えるようになるのでしょうか？ よろしくご指導ください。
> しかし原画のある部分を切り出して拡大、縮小するStretchBltのような方法がわかりません。
DrawImageには何種類かオーバーロードがあって、中には転送元矩形をとるものもあったと思いますが。
http://msdn.microsoft.com/en-us/library/ms535746.aspx
graphics.DrawImage(bmp, 転送先, 転送元, UnitPixel) みたいな感じでいけませんか？
yamaさん、ありがとうございます。投稿が前後していて失礼しました。
転写する先の位置とサイズは指定できるわけですから確かに事前に切り取っておけばできるかもしれないと次のように試してみました。
TBitMapを切り取って準備できたのですがそれをTGPBitMapに入れる方法がわかりませんので教えてください。 初心者で申し訳ありませんがよろしくお願いします。
procedure TForm1.Button3Click(Sender: TObject);
var
graphics : TGPGraphics;
Jpg0: TJpegImage;
bmp0,bmp1:tbitmap;
tgpbmp: TGPBitmap;
w0,h0,w1,h1: double;
l0,t0,l1,t1: double;
begin
Jpg0 :=TJpegImage.Create ;
jpg0.LoadFromFile('C:\test.jpg');
Bmp0 :=TBitmap.Create;
Bmp0.Assign(jpg0);
jpg0.Free;
//BitBltで切り取ってBmp1に描画
l0:=10; t0:=10; w0:=10; h0:=10; //原画の抜き取り位置とサイズ
bmp1:=TBitmap.Create;
bmp1.width:=w0; bmp1.Height:=h0;
BitBlt(bmp1.Canvas.Handle,0,0,w0,h0,bmp0.Canvas.Handle,l0, t0,SRCCOPY);
bmp0.Free;
// *********************TGPbmpにbmp1をAssignしたい*****************************
tgpbmp := TGPBitmap.Create;
//?????????????????????????
bmp1.free;
graphics := TGPGraphics.Create(Canvas.Handle);
try
l1:=50; t1:=50; w1:=100; h1:=100;
graphics.SetInterpolationMode(InterpolationModeNearestNeighbor);
graphics.DrawImage(tgpbmp, MakeRect(l1, t1, w1, h1));
finally
tgpbmp.Free;
graphics.Free;
end;
end;
tor様、ありがとうございます。投稿が前後したようで失礼しました。
確かにご紹介のサイトで見ると「The Graphics::DrawImage method draws a specified portion of an image at a specified location.」というのがありました。コードは（恐らく）CのようですがこれをDelphiで使えれば複雑なプロセスなしで一発で目的が達成できる可能性を感じました。Delphiで転送元のRectを指定する方法などご存知でしたら教えてください。
こんちには，Mr.XRAYです．
>転送元のRectを指定する方法などご存知でしたら教えてください。
ということですが，転送元は直接，値で設定しています．
転送先のRectは使用しました．
動作確認環境が違うので，うまくいかなかったらゴメンなさい．
動作確認環境
Windows XP(SP3) + Delphi 2010 Pro
Delphi GDI+ Library for use with Delphi 2009 (version 1.2)
//=============================================================================
// .NET互換のGDI+ライブラリなので，そうでない場合は以下の修正が必要
// GPGraphics : IGPGraphics; --> TGPGraphics
// bmp : IGPBitmap; --> TGPBitmap
// これらの解放処理も必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
GPGraphics : IGPGraphics;
bmp : IGPBitmap;
DestRect : TGPRectF;
begin
GPgraphics := TGPGraphics.Create(Image1.Canvas.Handle);
bmp := TGPBitmap.Create('002.jpg');
DestRect := TGPRectF.Create(50, 50, 300, 400);
//bmpのRect(50, 30, 100, 100)の範囲をDestRectに描画
GPGraphics.DrawImage(bmp, DestRect, 50 ,30, 100, 100, UnitPixel);
end;
Mr.XRAY様、ありがとうございました。遅くなってしまい失礼いたしました。
ご提示いただいたコードのUsesにgdipapi,gdipobj,jpegを加え、またIGP***をTGP***に変えて何度も試しましたが DestRect := TGPRectF.Create(50, 50, 300, 400); のラインで「オブジェクトまたはクラス型が必要です」とのエラーが出て進みませんでした。これはD6パーソナルが原因でしょうか？
D6で上手くいくとありがたいのですが。
>DestRect := TGPRectF.Create(50, 50, 300, 400); のラインで「オブジェクトまたはクラス型が必要です」とのエラーが出て進みませんでした。
TGPRectF はクラスではなく構造体なんだから、Create はないよ。
GDIPAPI.pasの中身を自分で確認すれば直ぐに分かるはず。
また、整数指定でよければ、TGPRectFでなく TGPRectを使えばいい。
DestRect := MakeRect(50, 50, 300, 400);
こんにちは．
>DestRect := TGPRectF.Create(50, 50, 300, 400); のラインで「オブジェクトまた>>はクラス型が必要です」とのエラーが出て
スミマセン．決して故意でも意地悪でもありません．
単に，ここの修正も必要なことを忘れただけです．ゴメンなさい．
やっぱり手抜きレスはいけないという見本です．
GDI+のライブラリとして http://www.progdigy.com/?page_id=7 を使用したコードです．
Delphi 6 Pro + Windows XP(SP3) で動作確認しました．
パーソナル版を使用していると，VCL関係のソースコードが付いていませんが，
このGDI+のライブラリにはソースコードが付いています．
ソースコードの，DrawImageのところを見ると，
「DrawImageって関数はいくつもあって，いろいろな引数が使えるんだ」
ということが分かります．引数の名前や型から，おおよその動作を知ることもできます．
ソースコードの存在は強力です．活用するといいと思います．
また，このGDI+ライブラリには，デモプログラムがあります．このようなデモプログラムを
実際にコンパイルして動作させるみると，いろいろなことが見えてきます．
手間はかかりますが，「急がば回れ」ということもあります．
せっかく作者が作成したデモプログラムですので，これも活用するといいと思います．
implementation
uses GDIPAPI, GDIPOBJ;
procedure TForm1.Button3Click(Sender: TObject);
var
GPGraphics : TGPGraphics;
bmp : TGPBitmap;
DestRect : TGPRect;
begin
GPgraphics := TGPGraphics.Create(Image1.Canvas.Handle);
bmp := TGPBitmap.Create('002.JPG');
DestRect := MakeRect(0, 0, 800, 800);
try
//bmpのRect(50, 30, 100, 100)の範囲をDestRectに描画
GPGraphics.DrawImage(bmp, DestRect, 250 ,230, 400, 400, UnitPixel);
finally
GPGraphics.Free;
bmp.Free;
end;
end;
> //bmpのRect(50, 30, 100, 100)の範囲をDestRectに描画
間違いです．コード内の(250, 230, 400, 400)のことです．
D6は原因にあらず 様 、Mr.XRAY様 そして皆様ありがとうごじました。
HINTを頂き、試してみましたらうまくいきました。朝から解決の結果のソースコードをまとめてここに出させていただこうとしていたら既に完璧なものをお出しいただいておりました。ありがとうございました。
DGIPAPI.PASのソースも見ましたがVB6から移行したばかりなのでかなりしきいが高く感じますが具体的に動かして慣れていこうと思いますのでよろしくお願いします。
これにちょっと書き加えて速度テストをしてみましたところ（Destが）650ｘ650ピクセルの絵1000枚を15秒で描くことができました（PCは1.6GHz）ので速度的にも問題なく実装できるのではないかと思います。 ありがとうございました。
（既に解決のチェックをいれさせていただき、あとは工夫で何とか実装できると思いますが付随して疑問がわきましたので書かせていただきます）
try
for i:=1 to 1000 do begin //複数枚
L1:= Random(1000);
T1:= Random(1000);
DestRect:=makerect(L1,T1,w1,h1);
gpgraphics.DrawImage(bmp,destrect, L0, T0, w0-50, h0-50,UnitPixel);
end;
finally
beep;
bmp.Free;
gpgraphics.Free;
end;
としてForm1に描かせるとパラパラと描画するのが見えるのですが1000枚終了すると消えてしまいます。1枚だけだと消えません。 何が違うのでしょうか？
>1000枚終了すると消えてしまいます
オバケのように消えているわけではありませんよ．きっと．
w0やh0の値を変えてテストしてみてください．
それから，質問の時に提示するコードは，できるだけ，コピペして，他の人がすぐ実行できるものにするとよいのです．
そうすれば，誰かがやってくれるかも知れません．コピペしてすぐできないなら
「や〜めた」
となってしまいます．
回答する人に手間をかけさせるのか，質問する人が手間をかけるのかの違いですけどね．
>w0やh0の値を変えてテストしてみてください．
おおっと，またまた書き忘れました．他の値もです．
Mr.XRAY様 ありがとうございました。
W1,H1を毎回変化させてみましたら全て描画され、また1000枚目が終了した時点でも画像が残りました。理由はわかりませんが、これで連続してこのテクニックが使用できる確信が持てました。改めて御礼申し上げます。
>それから，質問の時に提示するコードは，できるだけ，コピペして，他の人がすぐ実行できるものにするとよいのです．
これは特に私のような初心者にとって重要で、Uses節に何を加えたらよいかなどで苦戦することが多いためできるだけコピペで動くものを解決時にはお示しするように心がけます。無駄なラインも含まれておりサーバーの容量を消費してしまい申し訳ありませんが今回成功したものをコピペさせていただきました。
procedure TForm1.Button6Click(Sender: TObject);
//uses
// Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
// Dialogs, StdCtrls,gdipapi,gdipobj,jpeg, ExtCtrls;
var
gpgraphics : TGPGraphics;
bmp: TGPBitmap;
DestRect:TGPrect;
w,h,w0,h0,L0,T0,W1,H1,L1,T1,I: integer;
begin
gpgraphics := TGPGraphics.Create(Canvas.Handle);
bmp := TGPBitmap.Create('C:\test.jpg');
w0 :=bmp.GetWidth; h0 :=bmp.GetHeight; L0:=50; T0:=50;
w1:=w0*5; h1:=h0*5; L1:=120; T1:=100;
DestRect:=makerect(L1,T1,w1,h1);
try
gpgraphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
gpgraphics.DrawImage(bmp,destrect, L0, T0, w0-50, h0-50,UnitPixel); //1枚だけ
for i:=1 to 1000 do begin //複数枚
L1:= Random(image1.Width); T1:= Random(image1.Height); w1:=round(random(w0)); h1:=round(random(h0));
DestRect:=makerect(L1,T1,w1,h1);
gpgraphics.DrawImage(bmp,destrect, L0, T0, w0-50, h0-50,UnitPixel);
end;
finally
beep;
bmp.Free;
gpgraphics.Free;
end;
end;
>理由はわかりませんが、
う〜む．そのうち理解できる時がくるでしょう!
ともかく順調に行っているようですので，いいのではないかと思います．
がんばってくださいませ．
Mr.XRAY様
>う〜む．そのうち理解できる時がくるでしょう!
早くそうありたいと、とにかく書いて慣れたいと思います。
>ともかく順調に行っているようですので，いいのではないかと思います．
前回のコードをよく見ると型がおかしい箇所があると思いましたが何故か動いていました。正しくは
（誤）L1:= Random(image1.Width); T1:= Random(image1.Height);
（正）L1:= Round(Random(image1.Width)); T1:= Round(Random(image1.Height)); ではないかと思います。
ありがとうございました。
| ツイート |  |