ゴール：
私の目標は、Windows スケーリング (125%、150%、200% など) によって台無しにされることなく、選択したサイズ (高さ 400 ピクセルなど) で画像 (bmp ファイル) を RichTextBox に入れることです。 .)、または品質の低下。
これが私のコードです：
<DllImport("user32.dll", EntryPoint:="OpenClipboard")> Private Shared Function OpenClipboard(ByVal hWnd As IntPtr) As Boolean
End Function
<DllImport("user32.dll", EntryPoint:="EmptyClipboard")> Private Shared Function EmptyClipboard() As Boolean
End Function
<DllImport("user32.dll", EntryPoint:="SetClipboardData")> Private Shared Function SetClipboardData(ByVal uFormat As Integer, ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="CloseClipboard")> Private Shared Function CloseClipboard() As Boolean
End Function
<DllImport("gdi32.dll", EntryPoint:="CopyEnhMetaFileA")> Private Shared Function CopyEnhMetaFile(ByVal hemfSrc As IntPtr, ByVal hNULL As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll", EntryPoint:="DeleteEnhMetaFile")> Private Shared Function DeleteEnhMetaFile(ByVal hemfSrc As IntPtr) As Boolean
End Function
Private Sub PasteMeta(imgPathName As String)
'Create a bitmap of the image you want to draw to the metafile
Dim bm As New Bitmap(imgPathName)
'Create a graphics object of the Form and get its hdc handle
Dim me_grx As Graphics = Me.CreateGraphics()
Dim me_hdc As IntPtr = me_grx.GetHdc()
Dim scale = 400 / bm.Height
'Create a new metafile the same size as the image and create a graphics object for it
Dim emf As New Imaging.Metafile("Tmp.emf", me_hdc, New Rectangle(0, 0, bm.Width * scale, 400), Imaging.MetafileFrameUnit.Point)
Dim emf_gr As Graphics = Graphics.FromImage(emf)
emf_gr.DrawImage(bm, 0, 0, CInt(bm.Width * scale) * _windowsScaling, CInt(bm.Height * scale) * _windowsScaling)
'Dispose the bitmap and the metafile graphics object
emf_gr.Dispose()
bm.Dispose()
PutEnhMetafileOnClipboard(Me.Handle, emf)
'Paste the new metafile in the RichTextBox
JournalRichTextBox.Paste()
'Dispose the rest of the objects we created
me_grx.ReleaseHdc(me_hdc)
me_grx.Dispose()
emf.Dispose()
End Sub
Private Shared Function PutEnhMetafileOnClipboard(ByVal hWnd As IntPtr, ByVal mf As Imaging.Metafile) As Boolean
Dim bResult As New Boolean()
bResult = False
Dim hEMF, hEMF2 As IntPtr
hEMF = mf.GetHenhmetafile() ' invalidates mf
If Not hEMF.Equals(New IntPtr(0)) Then
hEMF2 = CopyEnhMetaFile(hEMF, New IntPtr(0))
If Not hEMF2.Equals(New IntPtr(0)) Then
If OpenClipboard(hWnd) Then
If EmptyClipboard() Then
Dim hRes As IntPtr
hRes = SetClipboardData(14, hEMF2) ' 14 == CF_ENHMETAFILE
bResult = hRes.Equals(hEMF2)
CloseClipboard()
End If
End If
End If
DeleteEnhMetaFile(hEMF)
End If
Return bResult
End Function
サブを実行すると、RTB は次のようになります: https://i.imgur.com/rqChD4Q.png
背景と私が試したこと：
私の最初の試みは、ビットマップ サイズ プロパティを使用することだけでしたが、それは実際に品質を台無しにします。まったく役に立ちません。
それから、品質を分類するこの魔法の方法を見つけました。簡単に言うと、これがここでの一番の答えです:一般的な
要約すると、メタファイルとグラフィックを作成し、サイズを変更してクリップボードに入れ、それをリッチテキストボックスに貼り付けます。
私はそれをうまく機能させました。しかし、私は 4K 画面を 200% に拡大しています。つまり、画像は適切なサイズですが、画像が配置されるメタファイルは 2 倍のサイズになります。
これを回避するために、グーグルで約4時間かけて、見つけたすべてのことを試しました。何をしても、フォームまたはフォーム内のコントロールの DPI は常に 96 であるため、DpiX ソリューションの 1 つを使用できません。
私が追加した場合：
<DllImport("User32.dll")>
Private Shared Sub SetProcessDPIAware()
End Sub
Public Sub New()
SetProcessDPIAware()
InitializeComponent()
End Sub
フォームがスケーリングされていないだけです（一部のボタンとラベルはまだスケーリングされています-奇妙です！）
scalecontrol イベントをオーバーライドしようとすると、常に factor.X、factor.Y = 1 が返され、それ以外は返されません。
できれば欲しいもの：
最良の解決策は、倍率の数値を取得することであることに注意してください。125% = 1.25、150% = 1.5 など。その数値があれば、グラフィックの寸法にそれを掛けるだけで、完全に収まります (たとえば)。
私の主な問題は、理解できないコードが多すぎることです。回答の際に心に留めておいていただければ幸いです。疑問点が多すぎると、あなたの回答が理解できない可能性があります。解決策はここにあると思います: https://msdn.microsoft.com/en-us/library/cc250585.aspx
しかし、それは私の頭をはるかに超えています。そのため、どんな助けやアドバイスも本当に感謝しています。
参考までに、私は 3.5 をターゲットにしており、可能であればそれに固執したいと考えています。