先日、
「ピクチャボックスにBMPの表示(BMPファイルをストレッチしたい)」
の質問でお世話になったグラフです。
よろしくお願いいたします。
環境はWinXP,VB6です。
さて、前回の質問で、
ピクチャボックスに、BMPファイルをストレッチして表示する
ことができたわけですが、
ピクチャボックスに表示した画像が汚いのです。
そこで、いろいろ調べた結果、
・縦横の比率を変更してストレッチすると、画像が汚くなると聞きましたので、
→縦横の比率は、ストレッチ後も同じになるようにしました。
・また、ストレッチ(縮小・拡大)が悪いのかと思い、
ピクチャボックスは、リソースBMPのサイズに合わせています。
・リソースのBMPの解像度(dpi)の数値が高いものを使ってみました。
が、あまり、改善されません。
ご助言、ご教授いただけないでしょうか。
描画もstretchblt使う事になると思いますが
APIのsetstretchbltmodeを調べてみてください。
> の質問でお世話になったグラフです。
元の URL を示してもらえると、他の人が参照しやすいかと。
> ピクチャボックスに表示した画像が汚いのです。
PaintPicture には、拡大/縮小時の品質(補間方法)を指定する機能はありません。
「GDI+」を使って描画すれば、補間方法まで指定しての描画が可能なので、
VB6 から、GDI+ API を直接呼ぶといった対処法がありますね。
(GdipSetInterpolationMode API や GdipDrawImageRectI API など)
または VB.NET に変更して、InterpolationMode を指定して描画するか…。
http://dobon.net/vb/dotnet/graphics/interpolationmode.html
http://www.atmarkit.co.jp/fdotnet/dotnettips/023resize/resize.html
>・縦横の比率を変更してストレッチすると、画像が汚くなると聞きましたので、
比率を変更すると、縦長・横長に伸びたりするので、比率は合わせた方が良いでしょうね。
>ピクチャボックスは、リソースBMPのサイズに合わせています。
描画先は、PictureBox ではなく Form でも良いのですけれどね。
で、コントロール側のサイズは、あまり関係無いと思います。
(描画結果を画像ファイル化したいのであれば、関係してきますけど)
>・リソースのBMPの解像度(dpi)の数値が高いものを使ってみました。
これも関係ないかも。
サンプルを書いてみました。
複数の方式に対応させたので、少し長くなりましたけど。
以下のコントロールを貼っておいてください。
TextBox を 2 つ「Text1」「Text2」と、
PictureBox を 6 つ「Picture1」「Picture2(0〜5) 」
CommandButton を 1 つ「Command1」
--------
Picture1は、比較のためのPaintPicture法。
Picture2(0)は、双一次補間(バイリニア)。
Picture2(1)は、双三次補間(バイキュービック)。
Picture2(2)は、最近傍補間(ニアレストレイバー)。
Picture2(3)は、高品質双一次補間(バイリニア/高)。
Picture2(4)は、高品質双三次補間(バイキュービック/高)。
Picture1 は、VBの基本機能だけで描いているので、png ファイル等は表示できません。
Picture2(n) の方は、GDI+ を用いています。
--------
Option Explicit
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal fileName As Long, image As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, Graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, height As Long) As Long
Private Declare Function GdipDrawImageRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal X As Long, ByVal Y As Long, ByVal width As Long, ByVal height As Long) As Long
Private Enum InterpolationMode
Bilinear
Bicubic
NearestNeighbor
HighQualityBilinear
HighQualityBicubic
End Enum
Private Declare Function GdipSetInterpolationMode Lib "gdiplus" (ByVal Graphics As Long, ByVal InterpolationMode As Long) As Long
Private token As Long
Private Sub Form_Load()
'元画像
Text1.Text = "C:\sample.bmp"
'拡大率
Text2.Text = "1.5"
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
'Picture2(0〜5)
Dim box As PictureBox
For Each box In Picture2
box.AutoRedraw = True
box.ScaleMode = vbPixels
Next
End Sub
Private Sub Command1_Click()
Dim status As Long
Dim fileName As String
fileName = Text1.Text
Dim zoom As Single
zoom = CSng(Text2.Text)
'---------
Dim pic As Picture
On Error Resume Next
Set pic = LoadPicture(fileName)
If Err.Number = 0 Then
Picture1.PaintPicture pic, 0, 0, _
Picture1.ScaleX(pic.width, vbHimetric, vbPixels) * zoom, _
Picture1.ScaleY(pic.height, vbHimetric, vbPixels) * zoom
End If
On Error GoTo 0
'---------
'---------
Dim typGPInput As GdiplusStartupInput
typGPInput.GdiplusVersion = 1
status = GdiplusStartup(token, typGPInput)
If status <> 0 Then
Exit Sub
End If
Dim img As Long
status = GdipLoadImageFromFile(StrPtr(fileName), img)
If status = 0 Then
Dim box As PictureBox
For Each box In Picture2
box.Cls
Dim g As Long
status = GdipCreateFromHDC(box.hdc, g)
If status = 0 Then
Dim mode As InterpolationMode
mode = box.Index '★補間方法の指定★
status = GdipSetInterpolationMode(g, mode)
Dim newWidth As Long
status = GdipGetImageWidth(img, newWidth)
newWidth = CLng(newWidth * zoom)
Dim newHeight As Long
status = GdipGetImageHeight(img, newHeight)
newHeight = CLng(newHeight * zoom)
status = GdipDrawImageRectI(g, img, 0, 0, newWidth, newHeight)
Call GdipDeleteGraphics(g)
End If
box.Refresh
Next
Call GdipDisposeImage(img)
End If
Call GdiplusShutdown(token)
token = 0
End Sub
確認が遅くなり申し訳ございませんでした。
確認がとれました。
曲線の部分が綺麗になっているように思います。
ありがとうございました。
解決といたします。
ツイート | ![]() |