'================================================================
'= コマンドボタンを描画
'=   フォーカス点線無し
'=   (DrawFrameControl4.bas)    
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type
 
#define LF_FACESIZE 32

Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    lfWeight         As Long
    lfItalic         As byte
    lfUnderline      As byte
    lfStrikeOut      As byte
    lfCharSet        As byte
    lfOutPrecision   As byte
    lfClipPrecision  As byte
    lfQuality        As byte
    lfPitchAndFamily As byte
    lfFaceName(LF_FACESIZE) As byte
End Type

' 論理フォントを作成
Declare Function Api_CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' システムの背景色を取得
Declare Function Api_GetSysColor& Lib "user32" Alias "GetSysColor" (ByVal nIndex&)

' デバイスコンテキストの背景色を設定
Declare Function Api_SetBkColor& Lib "gdi32" Alias "SetBkColor" (ByVal hDC&, ByVal crColor&)

' 指定されたタイプとスタイルを備える、ボタンやスクロールバーなどのフレームコントロールを描画
Declare Function Api_DrawFrameControl& Lib "user32" Alias "DrawFrameControl" (ByVal hDC&, lpRect As RECT, ByVal un1&, ByVal un2&)

' 文字列を指定領域に出力
Declare Function Api_DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC&, ByVal lpStr$, ByVal nCount&, lpRect As RECT, ByVal wFormat&)

' 指定のウィンドウにマウスキャプチャを設定
Declare Function Api_SetCapture& Lib "user32" Alias "SetCapture" (ByVal hWnd&)

' マウスのキャプチャを解放
Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" ()

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define DT_CENTER &H1                   'テキストを水平方向に中央揃えで表示します。
#define DT_VCENTER &H4                  'テキストを垂直方向の中央揃え。DT_SINGLELINEと同時に指定する必要がある
#define DT_SINGLELINE &H20              'テキストを改行せず、一行で表示
#define BDR_RAISEDOUTER &H1             '外側エッジが凸
#define BDR_SUNKENOUTER &H2             '外側エッジが凹
#define BDR_RAISEDINNER &H4             '内側が凸
#define BDR_SUNKENINNER &H8             '内側が凹
#define BDR_OUTER &H3                   '
#define BDR_INNER &HC                   '
#define BF_RECT &HF                     '(BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

#define DFC_BUTTON 4                    'ボタンコントロールを描画
#define DFCS_BUTTONPUSH &H10            'プッシュボタン
#define DFCS_PUSHED &H200               '押された状態
#define COLOR_BTNFACE 15                'コマンドボタンの表面色

Var Shared Pushed As Integer

Var Shared Picture1 As Object
Picture1.Attach GetDlgItem("Picture1")

'================================================================
'=
'================================================================
Declare Sub ButtonDraw edecl ()
Sub ButtonDraw()
    Var rc As RECT
    Var lf As LOGFONT
    Var hDC As Long
    Var State As Long
    Var Caption As String
    Var rFont As Long
    Var BkCol As Long

    'Picture1のハンドルを取得    
    hDC = Api_GetDC(Picture1.GethWnd)

    'ボタンの色をシステムより取得
    BkCol = Api_GetSysColor(COLOR_BTNFACE)

    'バックカラーに指定
    Ret = Api_SetBkColor(hDC, BkCol)

    'ボタンの凹凸を設定
    State = DFCS_BUTTONPUSH
    If Pushed = True Then
        State = State Or DFCS_PUSHED
    End If

    'キャプションを設定
    Caption = "ButtonEx"

    'フォントサイズ14P、日本語、イタリック指定
    lf.lfHeight = 14
    lf.lfCharSet = 128
    lf.lfItalic = 1
    rFont = Api_CreateFontIndirect(lf)
    Ret = Api_SelectObject(hDC, rFont)

    'ボタンのサイズを設定
    rc.Left = 0
    rc.Top = 0
    rc.Right = Picture1.GetWidth
    rc.Bottom = Picture1.GetHeight

    'ボタンを描画
    Ret = Api_DrawFrameControl(hDC, rc, DFC_BUTTON, State)

    '押されている状態の時は2ドットずらす
    If Pushed = True Then
        rc.Left = 2
        rc.Top = 2
    End If

    'ボタンのテキストの表示
    Ret = Api_DrawText(hDC, Caption, Len(Caption), rc, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)

    'デバイスコンテキストの解放
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Ret = Api_SetCapture(Picture1.GethWnd)
    ButtonDraw
End Sub

'================================================================
'= マウスを動かしたとき
'================================================================
Declare Sub Picture1_MouseMove edecl(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Sub Picture1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Var Ret As Long

    'マウスが Picture 上にあるとき
    If x >= 0 And y >= 0 And x <= Picture1.GetWidth And y <= Picture1.GetHeight Then
        Ret = Api_SetCapture(Picture1.GethWnd)
        ButtonDraw

    'マウスが Picture1 を外れたとき
    Else
        Ret = Api_ReleaseCapture
        Pushed = False
        ButtonDraw
    End If
End Sub

'================================================================
'= マウスを押したとき
'================================================================
Declare Sub Picture1_MouseDown edecl (Button As Integer, Shift As Integer, x As Single, y As Single)
Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Var Ret As Long

    Ret = Api_SetCapture(Picture1.GethWnd)
    Pushed = True
    ButtonDraw
    SetFocus
End Sub

'================================================================
'= マウスを離したとき
'================================================================
Declare Sub Picture1_MouseUp edecl (Button As Integer, Shift As Integer, x As Single, y As Single)
Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Var Ret As Long

    Ret = Api_ReleaseCapture
    Pushed = False
    ButtonDraw
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End