- 日時： 2011/04/05 13:13
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[フォーム][][] *
* キーワード：ウィンドウ,Ｆｏｒｍ,キャプション,ControlBox,BorderStyle, *
***********************************************************************************
------------------------------------------------------------------------------
No.294 タイトルバーなしのウインドウ 投稿者：ゆう(U) [1999/03/31(水)14：59分]
------------------------------------------------------------------------------
前のsTitleReleaceはゆー太郎さんのソースとほとんど違わないので
ゆー太郎さんに申し訳ないので・・・
※シンプル(ベスト)なコードなのでほとんど変化しない
ゆう(U)オリジナルにする為にちょっと機能を追加しました
以前のままではフォームの作業領域の大きさが変化(タイトルバーのサイズ＋α幅)
してしまうので自分で、「サイズ変更をしておくか」「無視するか」なので
作業領域の変更が変化しないようにフォームサイズを自動調整する仕様にしました。
※作業領域・・・フォーム内部の大きさ(ScaleWidth/ScaleHeight)です
●MDI親フォームは対象外です
実行するとおかしくなると思いますのでMDI親フォームでは
使用しないで下さい。
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
'==========================================================
'タイトルバーを付ける・外す sTitleReleace2
'==========================================================
' Call sTitleReleace2(myForm, [blnMenu])
' 引数 myForm ：フォーム
' blnMenu ：表示されているメニュー
' 有 True
' 無 False
'----------------------------------------------------------
'MDI親フォームは対象外です
'----------------------------------------------------------
'外したタイトルバーのスタイルにウインドウサイズを合わせる
'フォームの内部作業領域が変わらない様にサイズ修正
'タイトルバーを表示していないフォームは無処理です
'----------------------------------------------------------
Public 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
'３Ｄ枠とフラット枠(この辺の枠幅算出は若干疑問(不安)が残る)
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 '３Ｄスタイルのまま
'タイトルをなくすとタイトル付き変更不可の
'枠が採用されているようなので・・・
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
 |
タイトルバーなしウインドウ(VB6.0)_1