タイトルバーなしウィンドウの作成
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
タスクバーにアイコンとキャプションを残したままタイトルバーを 外す方法  　　（０６１）
ゆう(U)さんから投稿頂きました。
　　　　　 Option Explicit　　 'SampleNo=061　WindowsXP VB6.0(SP5) 2002.05.14

Private Declare Function SetWindowPos Lib "user32" _
　　　　　　　　　　　 (ByVal hWnd As Long, _
　　　　　　　　　　　　ByVal hWndInsertAfter As Long, _
　　　　　　　　　　　　ByVal X As Long, ByVal Y As Long, _
　　　　　　　　　　　　ByVal cx As Long, ByVal cy As Long, _
　　　　　　　　　　　　ByVal wFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
　　　　　　　　　　　　Alias "GetWindowLongA" _
　　　　　　　　　　　 (ByVal hWnd As Long, _
　　　　　　　　　　　　ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
　　　　　　　　　　　　Alias "SetWindowLongA" _
　　　　　　　　　　　 (ByVal hWnd As Long, _
　　　　　　　　　　　　ByVal nIndex As Long, _
　　　　　　　　　　　　ByVal dwNewLong As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
　　　　　　　　　　　 (ByVal nIndex As Long) As Long


Private Sub Command2_Click()
　　'タイトルバーを外す
　　Call sTitleReleace2(Form1, True)
End Sub


Private Sub Command3_Click()
　　'タイトルバーを付ける
　　Call sTitleReleace2(Form1, False)
End Sub


'==========================================================
'タイトルバーを付ける・外す sTitleReleace2　
'==========================================================
' Call sTitleReleace2(myForm, [blnMenu])
' 引数　myForm ：フォーム
' 　　　blnMenu ：表示されているメニュー
' 　　　 　有 True
' 　　　 　無 False
'----------------------------------------------------------
'MDI親フォームは対象外です
'----------------------------------------------------------
'外したタイトルバーのスタイルにウィンドウサイズを合わせる
'フォームの内部作業領域が変わらない様にサイズ修正
'タイトルバーを表示していないフォームは無処理です
'----------------------------------------------------------
Private Sub sTitleReleace2(ByRef myForm As Form, _
　　　　　　　　　　　　　　　　　　Optional ByVal blnMenu _
　　　　　　　　　　　　　　　　　　As Boolean = False)
　　Const GWL_STYLE = (-16&)
　　Const SWP_NOSIZE = &H1&
　　Const SWP_NOMOVE = &H2&
　　Const SWP_NOZORDER = &H4&
　　Const SWP_FRAMECHANGED = &H20&
　　Const SWP_DRAWFRAME = SWP_FRAMECHANGED
　　Const WS_CAPTION = &HC00000
　　Const SM_CYCAPTION = 4&　　　　'タイトル部の高さ
　　Const SM_CYSMCAPTION = 51&　　 '小さいタイトル部の高さ
　　Const SM_CXBORDER = 5&　　　　 '非立体表示の枠幅
　　Const SM_CYBORDER = 6&　　　　 '非立体表示の枠高さ
　　Const SM_CXDLGFRAME = 7&　　　 'タイトル付き変更不可の枠幅
　　Const SM_CYDLGFRAME = 8&　　　 'タイトル付き変更不可の枠高さ
　　Const SM_CXFRAME = 32&　　　　 'サイズ変更可の枠幅
　　Const SM_CYFRAME = 33&　　　　 'サイズ変更可の枠高さ
　　Dim intBorderStyle As Integer
　　Dim lngWidth　　　 As Long
　　Dim lngHeight　　　As Long
　　Dim lngTitleHeight As Long
　　Dim lngFrame_X　　 As Long
　　Dim lngFrame_Y　　 As Long
　　Dim lngResult　　　As Long

　　With myForm
　　　　intBorderStyle = .BorderStyle
　　　　If intBorderStyle = vbBSNone Then
　　　　　　If blnMenu Then
　　　　　　　　intBorderStyle = vbFixedSingle
　　　　　　Else
　　　　　　　　Exit Sub　　 '枠なし
　　　　　　End If
　　　　ElseIf (.ControlBox = False) And (Len(.Caption) = 0&) Then
　　　　　　Exit Sub　　　　 '枠なし
　　　　End If
　　　　lngWidth = .ScaleX(.Width, vbTwips, vbPixels)
　　　　lngHeight = .ScaleX(.Height, vbTwips, vbPixels)
　　　　lngResult = GetWindowLong(.hWnd, GWL_STYLE)
　　　　lngResult = lngResult Xor WS_CAPTION
　　　　'3D枠とフラット枠(この辺の枠幅算出は若干疑問(不安)が残る)
　　　　Select Case intBorderStyle
　　　　　　Case vbFixedDialog　　 'タイトルのみでOK
　　　　　　'フラットスタイルへ
　　　　　　Case vbFixedSingle, vbFixedToolWindow
　　　　　　　'非立体表示の枠ではなく、枠なしが採用されている
　　　　　　　　lngFrame_X = GetSystemMetrics(SM_CXDLGFRAME)
　　　　　　　　lngFrame_Y = GetSystemMetrics(SM_CYDLGFRAME)
　　　　　　　　If (lngResult And WS_CAPTION) = WS_CAPTION Then
　　　　　　　　　　lngWidth = lngWidth + (lngFrame_X * 2&)
　　　　　　　　　　lngHeight = lngHeight + (lngFrame_X * 2&)
　　　　　　　　Else
　　　　　　　　　　lngWidth = lngWidth - (lngFrame_X * 2&)
　　　　　　　　　　lngHeight = lngHeight - (lngFrame_X * 2&)
　　　　　　　　End If
　　　　　　Case vbSizable, vbSizableToolWindow '3Dスタイルのまま
　　　　　　　　'タイトルをなくすとタイトル付き変更不可の
　　　　　　　　'枠が採用されているようなので・・・
　　　　　　　　lngFrame_X = (GetSystemMetrics(SM_CXFRAME) _
　　　　　　　　　　　　　　　　- GetSystemMetrics(SM_CXDLGFRAME))
　　　　　　　　lngFrame_Y = (GetSystemMetrics(SM_CYFRAME) _
　　　　　　　　　　　　　　　　- GetSystemMetrics(SM_CYDLGFRAME))
　　　　　　　　If (lngResult And WS_CAPTION) = WS_CAPTION Then
　　　　　　　　　　lngWidth = lngWidth + (lngFrame_X * 2&)
　　　　　　　　　　lngHeight = lngHeight + (lngFrame_Y * 2&)
　　　　　　　　Else
　　　　　　　　　　lngWidth = lngWidth - (lngFrame_X * 2&)
　　　　　　　　　　lngHeight = lngHeight - (lngFrame_Y * 2&)
　　　　　　　　End If
　　　　End Select
　　　　'タイトルバーの高さ調整
　　　　Select Case intBorderStyle
　　　　　　Case vbFixedSingle, vbSizable, vbFixedDialog
　　　　　　　　lngTitleHeight = GetSystemMetrics(SM_CYCAPTION)
　　　　　　Case vbFixedToolWindow, vbSizableToolWindow
　　　　　　　　lngTitleHeight = GetSystemMetrics(SM_CYSMCAPTION)
　　　　End Select
　　　　If (lngResult And WS_CAPTION) = WS_CAPTION Then
　　　　　　lngHeight = lngHeight + lngTitleHeight
　　　　Else
　　　　　　lngHeight = lngHeight - lngTitleHeight
　　　　End If
　　　　lngResult = SetWindowLong(.hWnd, GWL_STYLE, lngResult)

　　　　lngResult = SetWindowPos(.hWnd, 0&, 0&, 0&, _
　　　　　　　　　　　　　　　　　　　　　　　　lngWidth, lngHeight, _
　　　　　　　　　　　　　　　　　　　　　　　　SWP_DRAWFRAME Or _
　　　　　　　　　　　　　　　　　　　　　　　　SWP_NOZORDER Or _
　　　　　　　　　　　　　　　　　　　　　　　　SWP_NOMOVE)
　　End With
End Sub
※　MDI親フォームは対象外です。
　　実行するとおかしくなると思いますので、MDI親フォームでは使用しないで下さい。
　　１９９９年３月３１日（No.294)と１９９９年２月２０日（No.２０９）の掲示板も合せて確認願います




2002/05/14