ウィンドウを2つに分割
Posted: 2006年6月23日(金) 22:19
ウィンドウを2つに分割したいのですがどのような関数でできるでしょうか教えてください。（いみはIEのお気に入りとメイン部分との境を分けるコントロールのことです）
コード: 全て選択
Function CreateSplitBase(hParent As HWND,Rate As Long,lpBaseInfo As LPBASEINFO) As Long
Dim hWndLeft As HWND , hWndRight As HWND
Dim rc As RECT
Dim LeftWidth As Long , RightWidth As Long , Height As Long
GetClientRect(hParent,rc)
LeftWidth=rc.right*Rate/100
RightWidth=rc.right-LeftWidth
Height=rc.bottom
'左側のベースウインドウ作成
hWndLeft=CreateWindowEx(0,
szSplitClassName,
szSplitAppName,
WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN,
0,
0,
LeftWidth,
Height,
hParent,
NULL,
Instance,
NULL)
If hWndLeft=0 Then Return FALSE
'右側のベースウインドウ作成
hWndRight=CreateWindowEx(0,
szSplitClassName,
szSplitAppName,
WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN,
LeftWidth,
0,
RightWidth,
Height,
hParent,
NULL,
Instance,
NULL)
If hWndRight=N0 Then Return FALSE
'ベースウインドウ情報を設定
ZeroMemory(&g_LeftInfo,SizeOf(g_LeftInfo))
g_LeftInfo.hWnd=hWndLeft
g_LeftInfo.hParent=hParent
g_LeftInfo.hRight=hWndRight
SetWindowLong(hWndLeft,GWL_USERDATA,(LONG)&g_LeftInfo)
'ベースウインドウ情報を設定
ZeroMemory(g_RightInfo,SizeOf(g_RightInfo))
g_RightInfo.hWnd=hWndRight
g_RightInfo.hParent=hParent
SetWindowLong(hWndRight,GWL_USERDATA,(LONG)&g_RightInfo)
'呼び出したプログラムに、ウインドウハンドルと子ウインドウの大きさを返す
lpBaseInfo->hLeft=hWndLeft
lpBaseInfo->rcLeft.left=0
lpBaseInfo->rcLeft.right=LeftWidth-BORDERWIDTH
lpBaseInfo->rcLeft.top=0
lpBaseInfo->rcLeft.bottom=rc.bottom
lpBaseInfo->hRight=hWndRight
lpBaseInfo->rcRight.left=0
lpBaseInfo->rcRight.right=RightWidth
lpBaseInfo->rcRight.top=0
lpBaseInfo->rcRight.bottom=rc.bottom
Return TRUE
End Functionコード: 全て選択
Function CreateSplitBase(hParent As HWND,Rate As Long,lpBaseInfo As *BASEINFO) As Longコード: 全て選択
'http://hp.vector.co.jp/authors/VA016117/splitwnd.html
#strict
#define IDI_ICON1
Dim Instance As HINSTANCE
Const szAppName="SplitWindow Test"
Const szClassName="SplitMain Class"
Const szChildAppName=""
Const szChildClassName="SplitChid Class"
Type BWNDINFO
Dim hWnd As HWND 'ベースウインドウのハンドル
Dim hParent As HWND '親ウインドウのハンドル
Dim hChild As HWND 'ベースウインドウにのっている子ウインドウのハンドル
Dim hRight As HWND '右隣のベースウインドウのハンドル（無ければNULL)
Dim hDown As HWND '下のベースウインドウのハンドル（無ければNULL)
End Type
Type BASEINFO
hLeft As HWND
rcLeft As RECT
hRight As HWND
rcRight As RECT
End Type
/**************************************************************
スプリットウインドウ関係
/**************************************************************/
Const szSplitAppName=""
Const szSplitClassName="SplitBase Class"
Const BORDERWIDTH=4
Const MINWIDTH=BORDERWIDTH
Const CT_TATE=1
Const CT_YOKO=2
Function WndProc(hWnd As HWND,wMessage As DWord,wParam As WPARAM,lParam As LPARAM) As Long
Dim hdc As HDC
Dim ps As PAINTSTRUCT
Dim BaseInfo As BASEINFO
Select Case wMessage
Case WM_CREATE
CenterWindow(hWnd)
'ベースウインドウを作る
If CreateSplitBase(hWnd,30,&BaseInfo)=FALSE Then Return -1
'左側の子ウインドウを作る
If CreateChild(BaseInfo.hLeft,&BaseInfo.rcLeft)=NULL Then Return -1
'右側の子ウインドウを作る
If CreateChild(BaseInfo.hRight,&BaseInfo.rcRight)=NULL Then Return -1
Return 0;
Case WM_DESTROY:
PostQuitMessage(0)
Return 0
Case WM_SIZE
'サイズの変更
SetSplitSize(hWnd)
Return 0
Case WM_PAINT
hdc = BeginPaint (hWnd, &ps)
EndPaint (hWnd, &ps)
Return 0
End Select
Return DefWindowProc(hWnd, wMessage, wParam, lParam)
End Function
Function InitSplitWindow() As Long
Dim WndClass As WNDCLASSEX
With WndClass
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = (WNDPROC) SplitBaseProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = Instance
.hIcon = NULL
.hCursor = NULL
.hbrBackground = (HBRUSH)(COLOR_BTNFACE+1)
.lpszMenuName = NULL
.lpszClassName = szSplitClassName
End With
If RegisterClassEx(WndClass)=0 Then Return FALSE
Return TRUE
End Function
Function CreateSplitBase(hParent As HWND,Rate As Long,lpBaseInfo As *BASEINFO) As Long
Dim hWndLeft As HWND , hWndRight As HWND
Dim rc As RECT
Dim LeftWidth As Long , RightWidth As Long , Height As Long
GetClientRect(hParent,rc)
LeftWidth=rc.right*Rate/100
RightWidth=rc.right-LeftWidth
Height=rc.bottom
'左側のベースウインドウ作成
hWndLeft=CreateWindowEx(0,
szSplitClassName,
szSplitAppName,
WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN,
0,
0,
LeftWidth,
Height,
hParent,
NULL,
Instance,
NULL)
If hWndLeft=0 Then Return FALSE
'右側のベースウインドウ作成
hWndRight=CreateWindowEx(0,
szSplitClassName,
szSplitAppName,
WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN,
LeftWidth,
0,
RightWidth,
Height,
hParent,
NULL,
Instance,
NULL)
If hWndRight=0 Then Return FALSE
'ベースウインドウ情報を設定
ZeroMemory(&g_LeftInfo,SizeOf(g_LeftInfo))
g_LeftInfo.hWnd=hWndLeft
g_LeftInfo.hParent=hParent
g_LeftInfo.hRight=hWndRight
SetWindowLong(hWndLeft,GWL_USERDATA,(LONG)&g_LeftInfo)
'ベースウインドウ情報を設定
ZeroMemory(g_RightInfo,SizeOf(g_RightInfo))
g_RightInfo.hWnd=hWndRight
g_RightInfo.hParent=hParent
SetWindowLong(hWndRight,GWL_USERDATA,(LONG)&g_RightInfo)
'呼び出したプログラムに、ウインドウハンドルと子ウインドウの大きさを返す
lpBaseInfo->hLeft=hWndLeft
lpBaseInfo->rcLeft.left=0
lpBaseInfo->rcLeft.right=LeftWidth-BORDERWIDTH
lpBaseInfo->rcLeft.top=0
lpBaseInfo->rcLeft.bottom=rc.bottom
lpBaseInfo->hRight=hWndRight
lpBaseInfo->rcRight.left=0
lpBaseInfo->rcRight.right=RightWidth
lpBaseInfo->rcRight.top=0
lpBaseInfo->rcRight.bottom=rc.bottom
Return TRUE
End Function
Sub SetChildToBase(hBase As HWND,hChild As HWND)
Dim lpBWndInfo As LPBWNDINFO
lpBWndInfo=(LPBWNDINFO)GetWindowLong(hBase,GWL_USERDATA)
lpBWndInfo->hChild=hChild
End Sub
Sub SetSplitSize(hParent As HWND)
Dim rc As RECT,rc2 As RECT
Dim LeftWidth As Long,RightWidth As Long,Height As Long
GetClientRect(hParent,&rc)
GetWindowRect(g_LeftInfo.hWnd,&rc2)
LeftWidth=rc2.right-rc2.left
RightWidth=rc.right-LeftWidth
Height=rc.bottom-rc.top
If RightWidth<0 Then RightWidth=0
SetWindowPos(g_LeftInfo.hWnd,NULL,0,0,LeftWidth,Height,SWP_NOZORDER)
SetWindowPos(g_RightInfo.hWnd,NULL,LeftWidth,0,RightWidth,Height,SWP_NOZORDER)
End Sub
Function SplitBaseProc(hWnd As HWND,wMessage As DWord,wParam As WPARAM,lParam As LPARAM) As Long
Dim hWnd2 As HWND
Dim hdc As HDC
Dim ps As PAINTSTRUCT
Dim x As Long,y As Long,cx As Long,cy As Long,x2 As Long,y2 As Long,cx2 As Long,cy2 As Long
Dim lpBWndInfo As LPBWNDINFO 'ベースウインドウ情報へのポインタ
Dim pt As POINT
Dim rc As RECT,rc2 As RECT
Dim Cursor As LPCTSTR
Dim s_Capture=0 As Long 'サイズ変更中かどうかのフラグ
Dim s_Gap=0 As Long 'ウインドウ端からのカーソルのずれ
lpBWndInfo=(LPBWNDINFO)GetWindowLong(hWnd,GWL_USERDATA) 'ベースウインドウ情報を得る
Select Case wMessage
Case WM_CREATE
Return 0
Case WM_DESTROY
Return 0
Case WM_SETCURSOR
'マウスカーソルの形を左右矢印か上下矢印のどちらかにする
GetCursorPos(pt)
GetClientRect(hWnd,rc)
ScreenToClient(hWnd,pt)
'下側にベースあり＆カーソルがウインドウの下部 → 上下矢印
'左にベースウインドウがある → 左右矢印にする
'それ以外は標準カーソル
If lpBWndInfo->hDown and pt.y>=rc.bottom-BORDERWIDTH Then
Cursor=IDC_SIZENS '上下矢印
Else If lpBWndInfo->hRight Then
Cursor=IDC_SIZEWE '左右矢印
Else
Cursor=IDC_ARROW '標準
End If
SetCursor(LoadCursor(NULL,Cursor)) 'カーソルの設定
Return 0
Case WM_SIZE
If lpBWndInfo Then
'子ウインドウのサイズを決めます
x=0
y=0
cx=LOWORD(lParam)
cy=HIWORD(lParam)
'境界線が必要ならその分の長さを引く
If lpBWndInfo->hRight Then cx-=BORDERWIDTH
If lpBWndInfo->hDown Then cy-=BORDERWIDTH
'子ウインドウのサイズを変更する
If(lpBWndInfo->hChild) SetWindowPos(lpBWndInfo->hChild,NULL,x,y,cx,cy,SWP_NOZORDER) Then
End If
Return 0
Case WM_PAINT
hdc = BeginPaint (hWnd,ps)
EndPaint (hWnd,ps)
Return 0
Case WM_LBUTTONDOWN
'境界がクリックされたら、サイズ変更モードに移行します
GetClientRect(hWnd,rc)
If lpBWndInfo->hDown && MAKEPOINTS(lParam).y>=rc.bottom-BORDERWIDTH Then '高さ変更モード
s_Capture=CT_TATE
s_Gap=rc.bottom-MAKEPOINTS(lParam).y
Else If(lpBWndInfo->hRight) Then '幅変更モード
s_Capture=CT_YOKO
s_Gap=rc.right-MAKEPOINTS(lParam).x
Else
break '何もしない
End If
SetCapture(hWnd)
break
Case WM_LBUTTONUP
'サイズ変更モードの終了
If s_Capture Then
ReleaseCapture()
s_Capture=0
End If
break
Case WM_MOUSEMOVE:
'サイズ変更モードになっていた場合、ベースウインドウのサイズを変更する
If s_Capture Then
'ベースウインドウの大きさを取得
GetWindowRect(hWnd,&rc)
pt.x=rc.left
pt.y=rc.top
'ベースウインドウの親ウインドウ内での座標に変換
ScreenToClient(lpBWndInfo->hParent,pt)
If s_Capture=CT_TATE Then '高さ変更モード時
'上側のウインドウのサイズを計算
x=pt.x
y=pt.y
cx=rc.right-rc.left
cy=MAKEPOINTS(lParam).y+s_Gap
If(cy<MINWIDTH) cy=MINWIDTH
'下側のウインドウの大きさを計算
hWnd2=lpBWndInfo->hDown
GetWindowRect(hWnd2,&rc2)
cx2=cx
cy2=rc2.bottom-rc.top-cy '２つのウインドウの高さを足したものから、
If cy2<MINWIDTH Then '1つ目のウインドウの高さを引く
cy2=MINWIDTH;
cy=rc2.bottom-rc.top-cy2;
If(cy<MINWIDTH) cy=MINWIDTH Then
End If
x2=x
y2=y+cy
Else '幅変更モード時
'左側のウインドウのサイズを計算
x=pt.x
y=pt.y
cx=MAKEPOINTS(lParam).x+s_Gap
cy=rc.bottom-rc.top
If(cx<MINWIDTH) cx=MINWIDTH Then
'右側のウインドウのサイズを計算
hWnd2=lpBWndInfo->hRight
GetWindowRect(hWnd2,rc2)
cx2=rc2.right-rc.left-cx '２つのウインドウの幅を足したものから、
cy2=cy '1つ目のウインドウの幅を引く
If cx2<MINWIDTH Then
cx2=MINWIDTH
cx=rc2.right-rc.left-cx2
If(cx<MINWIDTH) cx=MINWIDTH
End If
x2=x+cx
y2=y
End If
'ちらつき防止のために、ウインドウの更新を一時ストップ
LockWindowUpdate(lpBWndInfo->hParent)
SetWindowPos(hWnd,NULL,x,y,cx,cy,SWP_NOZORDER)
SetWindowPos(hWnd2,NULL,x2,y2,cx2,cy2,SWP_NOZORDER)
'更新再開
LockWindowUpdate(NULL)
'再開しただけでは書き直されないので、再描画
UpdateWindow(lpBWndInfo->hParent)
End If
break
End Select
Return (DefWindowProc(hWnd, wMessage, wParam, lParam))
End Function
/**************************************************************
メインプログラム
/**************************************************************/
Sub CenterWindow(hWnd As HWND)
Dim hWndOwner As HWND
Dim rc As RECT,rc2 As RECT
Dim x As Long,y As Long
If hWndOwner=GetParent(hWnd)=NULL Then
SystemParametersInfo(SPI_GETWORKAREA,0,rc,0)
Else
GetClientRect(hWndOwner,rc)
End If
GetWindowRect(hWnd, &rc2)
x = ((rc.right-rc.left) - (rc2.right-rc2.left)) / 2 +rc.left
y = ((rc.bottom-rc.top) - (rc2.bottom-rc2.top)) / 2 +rc.top
SetWindowPos(hWnd,
HWND_TOP,
x, y,
0, 0,
SWP_NOSIZE)
End Sub
Function ChildProc(hWnd As HWND,wMessage As DWord,wParam As WPARAM,lParam As LPARAM) As Long
Dim hdc As HDC
Dim ps As PAINTSTRUCT
Select Case wMessage
Case WM_CREATE
Return 0
Case WM_DESTROY
Return 0
Case WM_SIZE
Return 0
Case WM_PAINT
hdc=BeginPaint(hWnd,ps)
EndPaint(hWnd,ps)
Return 0
End Select
Return DefWindowProc(hWnd, wMessage, wParam, lParam)
End Function
Function CreateChild(hParent As HWND,rc As *RECT) As HWND
Dim hWnd As HWND
hWnd=CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
szChildClassName,
szChildAppName,
WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN,
rc->left,
rc->top,
rc->right-rc->left,
rc->bottom-rc->top,
hParent,
NULL,
Instance,
NULL)
If hWnd=NULL Then Return NULL
SetChildToBase(hParent,hWnd)
Return hWnd
End Function
Function InitWindow() As HWND
Dim wndclass As WNDCLASS
Dim hWnd As HWND
Dim rc As RECT
Dim xMaxAppWindow As Long
Dim yMaxAppWindow As Long
wndclass.style = CS_HREDRAW or CS_VREDRAW
wndclass.lpfnWndProc = (WNDPROC) WndProc
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = Instance
#ifdef IDI_ICON1
wndclass.hIcon = LoadIcon(Instance, MAKEINTRESOURCE(IDI_ICON1))
#else
wndclass.hIcon = NULL
#endif
wndclass.hCursor = LoadCursor (NULL, IDC_ARROW)
wndclass.hbrBackground = (HBRUSH)(COLOR_APPWORKSPACE+1)
wndclass.lpszMenuName = NULL
wndclass.lpszClassName = szClassName
If RegisterClass(wndclass) Then Return NULL
wndclass.style = CS_HREDRAW or CS_VREDRAW
wndclass.lpfnWndProc = (WNDPROC) ChildProc
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = Instance
wndclass.hIcon = NULL
wndclass.hCursor = LoadCursor (NULL, IDC_ARROW)
wndclass.hbrBackground = (HBRUSH)(COLOR_WINDOW+1)
wndclass.lpszMenuName = NULL
wndclass.lpszClassName = szChildClassName
If RegisterClass(wndclass) Then Return NULL
SystemParametersInfo(SPI_GETWORKAREA,0,rc,0)
xMaxAppWindow=(rc.right-rc.left)/2
yMaxAppWindow=(rc.bottom-rc.top)/2
/* Create the app. window */
hWnd=CreateWindowEx(0,
szClassName,
szAppName,
WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN,
CW_USEDEFAULT,
0,
xMaxAppWindow,
yMaxAppWindow,
NULL,
NULL,
Instance,
NULL)
Return hWnd
End Function
Function WinMain(hInstance As HINSTANCE,hPrevInstance As HINSTANCE,lpszCmd As LPSTR,nCmdShow As Long) As Long
Dim msg As MSG
Dim hWnd As HWND
Instance=hInstance
If InitSplitWindow()=FALSE Then Return FALSE
If hWnd=InitWindow()=NULL Then Return FALSE
ShowWindow(hWnd,nCmdShow)
/* Enter message loop */
While GetMessage(msg,NULL,0,0)
TranslateMessage (msg)
DispatchMessage (msg)
Wend
Return msg.wParam
End Function