C#で動作するコードをvbに移植したら動作しません
以下のサイトのC#のサンプルコードを、vbに移植しました。
しかし、正常動作しません。
C#で正常動作するのは、確認しました。
とても悩んでします。
どなたか、教えていただけませんか。
よろしくお願いします。
https://tzeditor.blogspot.com/2020/02/customtitlebar.html
不具合内容は、以下になります。
・非クライアント領域が緑になりません。白色です。
・ウィンドウリフレッシュ（※）が動作すると、白色も消え、
普通のフォームの外観になります。
※他のウィンドウをアクティブにする。
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Public Class Form1
<StructLayout(Runtime.InteropServices.LayoutKind.Sequential)>
Public Structure RECT
Public Left As Int32
Public Top As Int32
Public Right As Int32
Public Bottom As Int32
Public ReadOnly Property Size As Size
Get
Return New Size(Right - Left, Bottom - Top)
End Get
End Property
End Structure
Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr
Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Int32
Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal nLeftRect As Integer, ByVal nTopRect As Integer, ByVal nRightRect As Integer, ByVal nBottomRect As Integer) As IntPtr
Declare Function DeleteObject Lib "gdi32.dll" (hObject As IntPtr) As Boolean
<System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")>
Protected Overrides Sub WndProc(ByRef m As Message)
Const WM_ACTIVATE As Int32 = &H6
Const WM_NCPAINT As Int32 = &H85
Const WM_NCACTIVATE As Int32 = &H86
'Dim handle As HandleRef = New HandleRef(Nothing, m.HWnd)
Select Case (m.Msg)
Case WM_ACTIVATE
Case WM_NCPAINT
Case WM_NCACTIVATE
'非クライアント領域を含むデバイスコンテキストを取得
Dim hdc As IntPtr = GetWindowDC(m.HWnd)
Try
' デバイスコンテキストからGraphicsを生成
' Regionはクリッピングに使用
Using g As Graphics = Graphics.FromHdc(hdc)
Using rgn As Region = New Region()
Dim rect As RECT
' ウィンドウサイズを取得
' Sizeプロパティでは正確な値が取れないので
GetWindowRect(m.HWnd, rect)
' コントロールの矩形
Dim clientRect As Rectangle = New Rectangle(Point.Empty, rect.Size)
' 境界線の太さ分収縮した矩形を描画対象から外す
rgn.Union(clientRect)
rgn.Xor(New Rectangle(8, 31, clientRect.Width - 16, clientRect.Height - 39))
g.Clip = rgn
' タイトルバー領域の塗りつぶし
g.FillRectangle(Brushes.Green, clientRect)
g.FillEllipse(Brushes.Red, New Rectangle(200, 8, 20, 20))
' WParamにはクリッピング領域のリージョンハンドルを設定
' OSによる描画範囲を境界線の太さ分だけ収縮した矩形とする
Dim wParam As IntPtr = CreateRectRgn(rect.Left + 8, rect.Top + 31, rect.Right - 8, rect.Bottom - 39)
Dim m2 As Message = Message.Create(m.HWnd, m.Msg, wParam, m.LParam)
MyBase.WndProc(m2)
End Using
End Using
Catch
' 例外が発生したらOSに描画させる
MyBase.WndProc(m)
Finally
'取得したデバイスコンテキストを解放
ReleaseDC(m.HWnd, hdc)
End Try
Return
Case Else
MyBase.WndProc(m)
Return
End Select
End Sub
End Class
お手数をお掛けします。
よろしくお願いします。
補足
ありがとうございます FrameWorkは２．０ ＯＳは ＸＰ です 「Sendkeyでの画面印刷は不安定」ということですが、どういうときにエラーになるのか教えて頂けると助かるんですが・・ 「＃ちょっと待ってみるとか・・」の意見を取り入れて 0.1秒Sleepさせて、さらにDoEventも入れてみて試して見ます 不具合再現実機（これでは必ずエラーになります→ＰＣの設定が違うんではないかと疑ってこの質問をしたのですが・・）が手元にないため、すぐには結果が出ないです。 それでだめなら、指摘ＨＰに乗っている 別のAPIを試して見ます