こんにちは 以前、 https://dobon.net/cgi-bin/vbbbs/cbbs.cgi?mode=al2&namber=35233&rev=&no=0 でLEDモニタの件で画像にすればと提案頂いて格闘していましたが玉砕気味です。 現状は Dim img As Bitmap img = New Bitmap(Me.RichTextBox1.Width, Me.RichTextBox1.Height) Using g As Graphics = Graphics.FromImage(img) g.CopyFromScreen(Me.PointToScreen(Me.RichTextBox1.Location), New Point(0, 0), Me.RichTextBox1.Size) End Using Me.PictureBox1.Image = img
2022/12/09(Fri) 04:27:45 編集(投稿者)
■No35275に返信(ま〜さんの記事)
>>高 DPI 環境で実行している場合は、ズレる可能性がありますね。> まさにこれが原因でした。凄いです感激です。
これ動きますか?
ちょっと問題があって、画像を縮小するせいか、少しぼやけた感じになります。
,NET Framework 4.7 以上なら RichTextBox の DrawToBitmap を使ったほうがいいかもしれません。
Imports System.Runtime.InteropServices
Public Class Form1
<DllImport("User32.dll")>
Public Shared Function LogicalToPhysicalPointForPerMonitorDPI(ByVal hwnd As IntPtr, ByRef point As Point) As Boolean
End Function
Private Shared Function LogicalToPhysicalRectangleForPerMonitorDPI(ByVal hwnd As IntPtr, ByVal r As Rectangle) As Rectangle
Dim p1 As Point = r.Location
Dim p2 As Point = New Point(r.Right, r.Bottom)
LogicalToPhysicalPointForPerMonitorDPI(hwnd, p1)
LogicalToPhysicalPointForPerMonitorDPI(hwnd, p2)
Return Rectangle.FromLTRB(p1.X, p1.Y, p2.X, p2.Y)
End Function
Private Function LogicalToPhysicalRectangleForPerMonitorDPI(ByVal r As Rectangle) As Rectangle
Return LogicalToPhysicalRectangleForPerMonitorDPI(Handle, r)
End Function
Public Sub New()
InitializeComponent()
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
PictureBox1.Size = RichTextBox1.Size
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim rectangle1 = RectangleToScreen(RichTextBox1.Bounds)
Dim rectangle2 = LogicalToPhysicalRectangleForPerMonitorDPI(rectangle1)
Dim bmp = New Bitmap(rectangle2.Width, rectangle2.Height)
Using g = Graphics.FromImage(bmp)
g.CopyFromScreen(rectangle2.Location, Point.Empty, rectangle2.Size)
End Using
If PictureBox1.Image IsNot Nothing Then
PictureBox1.Image.Dispose()
End If
PictureBox1.Image = bmp
End Sub
End Class
■No35280に返信(ま〜さんの記事)
> こんにちは、体調を崩して回答が遅れました。すみません。
お大事に。
> ですがTabPage環境化ではズレました。> Parentをと思って色々やってみましたが中々上手くいかずTabPage下の座標知る方法はないのでしょうか?
むむむ、やっかいですね高DPI。
スクリーン座標を取るのが目的でないなら、以下のコードでキャプチャはできると思います。
Imports System.Runtime.InteropServices
Public Class Form1
Public Sub New()
InitializeComponent()
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
PictureBox1.Size = RichTextBox1.Size
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim bmp = CreateBitmapFromControl(RichTextBox1)
If PictureBox1.Image IsNot Nothing Then
PictureBox1.Image.Dispose()
End If
PictureBox1.Image = bmp
End Sub
Private Const SRCCOPY As Integer = &HCC0020
<DllImport("User32.dll")>
Private Shared Function GetWindowDC(hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")>
Private Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Boolean
End Function
<DllImport("gdi32.dll")>
Private Shared Function BitBlt(hdcDest As IntPtr,
nXDest As Integer, nYDest As Integer,
nWidth As Integer, nHeight As Integer,
hdcSrc As IntPtr,
nXSrc As Integer, nYSrc As Integer,
dwRop As Integer) As Boolean
End Function
Private Shared Function CreateBitmapFromControl(con As Control) As Bitmap
Dim cs = con.Size
Dim bmp As New Bitmap(cs.Width, cs.Height)
Using g = Graphics.FromImage(bmp)
Dim hdcDest = g.GetHdc()
Dim hdcSrc = GetWindowDC(con.Handle)
BitBlt(hdcDest, 0, 0, cs.Width, cs.Height, hdcSrc, 0, 0, SRCCOPY)
ReleaseDC(con.Handle, hdcSrc)
g.ReleaseHdc()
End Using
Return bmp
End Function
End Class