'===========================================================================
'    ファイル名    : basToolBar.bas
'    ファイル説明  : ツールバー関連の関数群
'    作成者        : Uz
'                    E-Mail   : uz@violet.plala.or.jp
'                    HomePage : http://www1.plala.or.jp/uz/
'    作成日        : 1998/03/08 (Sun)
'    修正日        : 1998/03/08 (Sun)
'    備考          : なし
'===========================================================================
Option Explicit

'-- API 定数
Private Const GW_CHILD = 5

Private Const TBSTYLE_FLAT = &H800
Private Const WM_USER = &H400
Private Const TB_SETSTYLE = (WM_USER + 56)
Private Const TB_GETSTYLE = (WM_USER + 57)

'-- API 関数
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long _
) As Long

Private Declare Function GetWindow Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal wCmd As Long _
) As Long

'////////////////////////////////////////////////////////////
'      関数名    : SetFlatToolBar
'      目的説明  : ツールバーをフラットにする
'      前提条件  : なし
'      結果      : なし
'      引数      : tbToolBar        ツールバーコントロール
'      戻り値    : なし
'////////////////////////////////////////////////////////////
Public Sub SetFlatToolBar(ByRef tbToolBar As Toolbar)
    Dim lnghWnd As Long
    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    
    'ウィンドウハンドルを取得
    lnghWnd = GetWindow(tbToolBar.hwnd, GW_CHILD)
    '今のスタイルの取得
    lngOldStyle = SendMessageLong(lnghWnd, TB_GETSTYLE, 0&, 0&)
    'フラットのスタイルを付加
    lngNewStyle = lngOldStyle Or TBSTYLE_FLAT
    '新しいスタイルを設定
    Call SendMessageLong(lnghWnd, TB_SETSTYLE, 0&, lngNewStyle)
    '再描画
    tbToolBar.Refresh
End Sub

'===========================================================================
'    ファイル名    : frmMain.frm
'    ファイル説明  : フラットツールバーのテストフォーム
'    作成者        : Uz
'                    E-Mail   : uz@violet.plala.or.jp
'                    HomePage : http://www1.plala.or.jp/uz/
'    作成日        : 1998/03/08 (Sun)
'    修正日        : 1998/03/08 (Sun)
'    備考          : なし
'===========================================================================
Option Explicit

Private Sub Form_Load()
    'ツールバーのオブジェクトを引数に渡すだけ(^_^)
    Call SetFlatToolBar(tlbToolbar)
End Sub