ピクチャボックスの解像度？を良くする方法

解決

グラフ 2007-06-06 20:26:10 No: 136629

先日、
「ピクチャボックスにＢＭＰの表示(ＢＭＰファイルをストレッチしたい)」
の質問でお世話になったグラフです。
よろしくお願いいたします。

環境はＷｉｎＸＰ,ＶＢ６です。

さて、前回の質問で、
ピクチャボックスに、ＢＭＰファイルをストレッチして表示する
ことができたわけですが、
ピクチャボックスに表示した画像が汚いのです。

そこで、いろいろ調べた結果、
・縦横の比率を変更してストレッチすると、画像が汚くなると聞きましたので、
→縦横の比率は、ストレッチ後も同じになるようにしました。
・また、ストレッチ(縮小・拡大)が悪いのかと思い、
ピクチャボックスは、リソースＢＭＰのサイズに合わせています。
・リソースのＢＭＰの解像度(dpi)の数値が高いものを使ってみました。
が、あまり、改善されません。

ご助言、ご教授いただけないでしょうか。

通り巣鴨 2007-06-06 22:03:11 No: 136630

描画もstretchblt使う事になると思いますが
APIのsetstretchbltmodeを調べてみてください。

魔界の仮面弁士 2007-06-06 22:11:49 No: 136631

> の質問でお世話になったグラフです。
元の 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

>・縦横の比率を変更してストレッチすると、画像が汚くなると聞きましたので、
比率を変更すると、縦長・横長に伸びたりするので、比率は合わせた方が良いでしょうね。

>ピクチャボックスは、リソースＢＭＰのサイズに合わせています。
描画先は、PictureBox ではなく Form でも良いのですけれどね。
で、コントロール側のサイズは、あまり関係無いと思います。
(描画結果を画像ファイル化したいのであれば、関係してきますけど)

>・リソースのＢＭＰの解像度(dpi)の数値が高いものを使ってみました。
これも関係ないかも。

魔界の仮面弁士 2007-06-06 23:21:46 No: 136632

サンプルを書いてみました。
複数の方式に対応させたので、少し長くなりましたけど。

以下のコントロールを貼っておいてください。

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

グラフ 2007-06-12 20:50:47 No: 136633

確認が遅くなり申し訳ございませんでした。

確認がとれました。
曲線の部分が綺麗になっているように思います。
ありがとうございました。

解決といたします。