タイトルバーの描画とフォーム移動 <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