'================================================================
'= コマンドボタンとアイコン描画
'=   フォーカス用点線も描画
'=   (DrawFrameControl5.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&)

' EXE･DLLから大きいアイコン･小さいアイコンを取得
Declare Function Api_ExtractIconEx& Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile$, ByVal nIconIndex&, phiconLarge&, phiconSmall&, ByVal nIcons&)

' アイコンを描画
Declare Function Api_DrawIconEx& Lib "user32" Alias "DrawIconEx" (ByVal hDC&, ByVal xLeft&, ByVal yTop&, ByVal hIcon&, ByVal cxWidth&, ByVal cyWidth&, ByVal istepIfAniCur&, ByVal hbrFlickerFreeDraw&, ByVal diFlags&)

' 矩形に3D効果を与える
Declare Function Api_DrawEdge& Lib "user32" Alias "DrawEdge" (ByVal hDC&, qrc As RECT, ByVal edge&, ByVal grfFlags&)

' フォーカスを得た時の点線の枠を描く
Declare Function Api_DrawFocusRect& Lib "user32" Alias "DrawFocusRect" (ByVal hDC&, lpRect As RECT)

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

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

' アイコンのハンドルを解放
Declare Function Api_DestroyIcon& Lib "user32" Alias "DestroyIcon" (ByVal hIcon&)

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

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

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

#define DFC_BUTTON 4                    'ボタンコントロールを描画
#define DFCS_BUTTONPUSH &H10            'プッシュボタン
#define DFCS_PUSHED &H200               '押された状態
#define DT_RIGHT &H2                    'テキストを右揃え
#define DT_LEFT &H0                     'テキストを左揃え
#define DT_CENTER &H1                   'テキストを水平方向に中央揃えで表示します。
#define DT_VCENTER &H4                  'テキストを垂直方向の中央揃え。DT_SINGLELINEと同時に指定する必要がある
#define DT_SINGLELINE &H20              'テキストを改行せず、一行で表示
#define COLOR_BTNFACE 15                'コマンドボタンの表面色
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define DST_BITMAP &H4                  'ビットマップ
#define DI_NORMAL 3                     'DI_IMAGEとDI_MASKの組み合わせ
#define BF_RECT (&H1 Or &H2 Or &H4 Or &H8) '(BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

#define RDW_ALLCHILDREN &H80            '子ウィンドウがあるときは、それらも再描画の対象とする
#define RDW_ERASE &H4                   'ウィンドウの再描画時に、WM_ERASEBKGNDを送る。RDW_INVALIDATEフラグと同時に指定する必要がある
#define RDW_ERASENOW &H200              '必要であれば、関数が制御を返す前に、影響を受けたウィンドウ(RDW_ALLCHILDRENまたはRDW_NOCHILDRENのフラ
#define RDW_FRAME &H400                 '更新領域と交差する非クライアント領域の部分にも、WM_NCPAINTを送る。RDW_INVALIDATEフラグと同時に指定す
#define RDW_INTERNALPAINT &H2           'ウィンドウが無効な領域を持つか持たないかに関わらず、WM_PAINTメッセージをウィンドウにポストする
#define RDW_INVALIDATE &H2              '指定したウィンドウ内の領域を無効化する
#define RDW_NOCHILDREN &H40             '子ウィンドウがあるときは、それらを再描画の対象から外す
#define RDW_NOERASE &H20                '未処理 WM_ERASEBKGNDを送らないようにする
#define RDW_NOFRAME &H800               '未処理のWM_NCPAINTを送らないようにする。RDW_VALIDATEフラグと同時に指定する必要がる
#define RDW_NOINTERNALPAINT &H10        '未処理の内部 WM_PAINTを送らないようにします。
#define RDW_UPDATENOW &H100             '必要であれば、関数が制御を返す前に、影響を受けたウィンドウ(RDW_ALLCHILDRENフラグまたはRDW_NOCHILDREN
#define RDW_VALIDATE &H8                '指定したウィンドウ内の領域を有効化する

Var Shared mPushed As Integer
Var Shared mFocus As Integer
Var Shared rc As RECT

Var Shared Picture1 As Object
Var Shared Button1 As Object
Var Shared Timer1 As Object 

Picture1.Attach GetDlgItem("Picture1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Timer1.Attach GetDlgItem("Timer1")

'================================================================
'= コマンドボタンを描画
'================================================================
Declare Sub ButtonDraw edecl ()
Sub ButtonDraw()
    Var rc2 As RECT
    Var hDC As Long
    Var hIcon As Long
    Var lIcon As Long
    Var sIcon As Long
    Var State As Long
    Var Caption As String
    Var lf As LOGFONT
    Var rFont As Long
    Var Size As Integer
    Var BkCol As Long
    Var Edge As Long
    Var Ret As Long
    
    'Picture1のデバイスコンテキストを取得
    hDC = Api_GetDC(Picture1.GethWnd)

    'ハンドルを取得
    'Iconの場合(32ｘ32、16ｘ16の合成)
    hIcon = Api_ExtractIconEx("favicon.ico", 0, lIcon, sIcon, 1)

    'Bmpの場合(16ｘ16)
'   hIcon = Api_ExtractIconEx("fbtip16.bmp", 0, lIcon, sIcon, 1)

    'キャプションを設定
    Caption = "    F-Basic Tips"

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

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

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

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

    'ボタンの矩形領域を指定
    rc.Left = 0 : x = 0
    rc.Top = 0 : y = 0
    rc.Right = Picture1.GetWidth
    rc.Bottom = Picture1.GetHeight

    'フォーカス用の矩形領域を指定
    rc2.Left = rc.Left + 4
    rc2.Top = rc.Top + 4
    rc2.Right = rc.Right - 4
    rc2.Bottom = rc.Bottom - 4

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

    '押された場合、キャプションをずらす
    If mPushed = True Then
        rc.Left = 2 : x = 2
        rc.Top = 2 : y = 2
    End If

    'ボタンの外形
    Ret = Api_DrawEdge(hDC, rc, Edge, BF_RECT)

    'キャプションを描画
    Ret = Api_DrawText(hDC, Caption, Len(Caption), rc, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE)

    'Iconを描画
    Ret = Api_DrawIconEx(hDC, x + 4, y + 4, sIcon, 0, 0, ByVal 0, 0, DI_NORMAL)

    'フォーカス用の矩形を描く
    If mFocus = True Then
        Ret = Api_DrawFocusRect(hDC, rc2)
    End If

    'デバイスコンテキスト、ハンドルの解放
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC)
    Ret = Api_DestroyIcon(hIcon)
    Ret = Api_DeleteObject(rFont)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Timer1.SetInterval 5
    Timer1.Enable -1
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
        mPushed = False
        mFocus = 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)
    mPushed = True
    mFocus = 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
    mPushed = False
    ButtonDraw
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    ButtonDraw
End Sub

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