tagCANDY CGI VBレスキュー(花ちゃん) - タイトルバーなしウインドウ(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
タイトルバーなしウインドウ(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

タイトルバーなしウインドウ(VB6.0) [No.8の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2007/07/15 15:16
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[フォーム][][]                                                      *
* キーワード:ウィンドウ,Form,キャプション,ControlBox,BorderStyle,        *
***********************************************************************************

-----------------------------------------------------------------------------
Re:タイトルバーなしウインドウ  投稿者:ゆう(U) [1999/02/20(土)16:49分]
-----------------------------------------------------------------------------

タスクバーにアイコンとキャプションを残したままタイトルバーを
外す方法は、APIを使用することで出来ますよ。

Call sTitleReleace(Me)で付けたり外したり・・・

ゆー太郎さんに教わった方法です
※関数にアレンジは私がしてますけど・・・

標準モジュール
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 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

'==========================================================
'タイトルバーを付ける・外す sTitleReleace
'==========================================================
' Call sTitleReleace(myForm)
' 引数 myForm   :フォーム
'----------------------------------------------------------
Public Sub sTitleReleace(ByRef myForm As Form)
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
  Dim Result As Long

  With myForm
    Result = GetWindowLong(.hWnd, GWL_STYLE)
    Result = Result Xor WS_CAPTION
    Result = SetWindowLong(.hWnd, GWL_STYLE, Result)

    Result = SetWindowPos(.hWnd, 0&, 0&, 0&, 0&, 0&, _
                          SWP_DRAWFRAME Or _
                          SWP_NOZORDER Or _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE)
  End With
End Sub


Private Sub Form_Load()
  Call sTitleReleace(Me)
End Sub

※花ちゃん(さん)へ
 逆引きへ載せておくといいかも・・・

メンテ

Page: 1 |

タイトルバーなしウインドウ(VB6.0)_1  (No.1の個別表示) [スレッド一覧へ]
日時: 2011/04/05 13:13
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[フォーム][][]                                                      *
* キーワード:ウィンドウ,Form,キャプション,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
    '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
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ