タイトルバーの描画とフォーム移動          <TOP>


DrawCaption 指定のウィンドウのキャプションを指定のデバイスコンテキストに描画
DrawFrameControl 指定されたタイプとスタイルを備える、ボタンやスクロールバーなどのフレームコントロールを描画
SetRect RECT構造体の値を設定
SendMessage ウィンドウにメッセージを送信
ReleaseCapture マウスのキャプチャを解放
GetDC 指定されたウィンドウのデバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

通常のプロパティ設定では、アイコンを表示できないためリソースを下記のとおり書き換えています。

__CREATE3, XWT_FORM, 0x80080115L, 0x0L

(カットアンドトライで目的を達成できただけであり、自己責任で・・・)


 

'================================================================
'= タイトルバーの描画とフォーム移動
'=   (DrawFrameControl6.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

' 指定のウィンドウのキャプションを指定のデバイスコンテキストに描画
Declare Function Api_DrawCaption& Lib "user32" Alias "DrawCaption" (ByVal hWnd&, ByVal hDC&, pcRect As RECT, ByVal un&)

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

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' ウィンドウにメッセージを送信
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

' マウスのキャプチャを解放
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 DC_ACTIVE 1                     'アクティブなときの色
#define DC_ICON 4                       'アイコン付き
#define DC_TEXT 8                       'タイトルテキスト付き
#define DC_GRADIENT &H20                'グラデーション
#define WM_NCLBUTTONDOWN &HA1           '非クライアント領域で左マウスボタンを押す
#define HTCAPTION 2                     'タイトルバーをクリックしたことを示す

Var Shared Check1 As Object
Var Shared Check2 As Object
Var Shared Button1 As Object

Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14
Check2.Attach GetDlgItem("Check2") : Check2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Form_Paint ()
Sub Form_Paint()
    Var rc As RECT
    Var hDC As Long
    Var Ret As Long

    hDC = Api_GetDC(GethWnd)

    Cls

    If Check1.GetCheck = 1 Then
        Ret = Api_SetRect(rc, 4, 3, GetWidth - 4, 26)
        Ret = Api_DrawCaption(GethWnd, hDC, rc, DC_ACTIVE Or DC_ICON Or DC_TEXT Or DC_GRADIENT)
    End If

    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Sub MainForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Var Ret As Long

    If Button = 1 And Check2.GetCheck = 1 Then
        Ret = Api_ReleaseCapture
        Ret = Api_SendMessage(GethWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Check1_on edecl ()
Sub Check1_on()
    Form_Paint
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    End
End Sub

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