by 水波形 » 2011年2月27日(日) 17:20
> > 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
>
> 大変重宝しています。
> WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1368*768)で実行すると画面中央に表示されて見栄えがよくなりました。
おお!
お役に立ててよかったです。
ちなみに私は、こんな感じで関数にして使っています。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]
hWnd→中央に持っていく対象のウインドウ
dx→中央からのズレ(x軸。中央に持っていく場合、この引数は0)
dy→中央からのズレ(y軸。中央に持っていく場合、この引数は0)
コード: 全て選択
Function SetWindowCenter(hWnd As HWND,dx As Long,dy As Long) As Long
Dim x As Long,y As Long 'ウインドウの位置
Dim sx As Long,sy As Long 'スクリーン座標
Dim Basho As RECT 'ウインドウのrc
'ウインドウの位置を取得
GetWindowRect(hWnd,Basho)
'スクリーンの大きさ取得
sx=GetSystemMetrics(SM_CXSCREEN)
sy=GetSystemMetrics(SM_CYSCREEN)
If sx=0 or sy=0 Then
SetWindowCenter=0
Exit Function
End If
'中央に持っていく計算
x=(sx/2) - ( ((Basho.left+Basho.right)/2)-Basho.left )
y=(sy/2) - ( ((Basho.top+Basho.bottom)/2)-Basho.top )
x=x+dx
y=y+dy
If x<0 Then
x=0
Else If x>sx Then
x=sx - (Basho.right-Basho.left)
End If
If y<0 Then
y=0
Else If y>sy Then
y=sy - (Basho.bottom-Basho.top)
End If
'中央に持っていく
If SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE)=0 Then
SetWindowCenter=0
Exit Function
End If
SetWindowCenter=1
End Function
かっこつけてFunctionで定義してますが、正直Subでよかったです(^^;
後、ウインドウを既存のウインドウの中央に持って行くのもこれを応用して使ってます。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]
hOWnd→ここで指定したウインドウの中央に持って行きます。
hWnd→ここで指定したウインドウをhOWndの中央に持っていきます。
コード: 全て選択
Sub SetWindowCenterIn(hOWnd As HWND,hWnd As HWND,sx As Long,sy As Long)
Dim Basho As RECT
Dim my As RECT
Dim x As Long,y As Long
GetWindowRect(hOWnd,Basho)
GetWindowRect(hWnd,my)
x=( (Basho.left+Basho.right)/2 ) - ( ((my.left+my.right)/2)-my.left )
y=( (Basho.top+Basho.bottom)/2 ) - ( ((my.top+my.bottom)/2)-my.top )
x=x+sx
y=y+sy
SetWindowPos(hWnd,NULL,x,y,0,0,SWP_NOSIZE)
End Sub
良かったらどうぞ~
[quote]> > 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
>
> 大変重宝しています。
> WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1368*768)で実行すると画面中央に表示されて見栄えがよくなりました。[/quote]
おお!
お役に立ててよかったです。
ちなみに私は、こんな感じで関数にして使っています。
[hide]
hWnd→中央に持っていく対象のウインドウ
dx→中央からのズレ(x軸。中央に持っていく場合、この引数は0)
dy→中央からのズレ(y軸。中央に持っていく場合、この引数は0)
[code]
Function SetWindowCenter(hWnd As HWND,dx As Long,dy As Long) As Long
Dim x As Long,y As Long 'ウインドウの位置
Dim sx As Long,sy As Long 'スクリーン座標
Dim Basho As RECT 'ウインドウのrc
'ウインドウの位置を取得
GetWindowRect(hWnd,Basho)
'スクリーンの大きさ取得
sx=GetSystemMetrics(SM_CXSCREEN)
sy=GetSystemMetrics(SM_CYSCREEN)
If sx=0 or sy=0 Then
SetWindowCenter=0
Exit Function
End If
'中央に持っていく計算
x=(sx/2) - ( ((Basho.left+Basho.right)/2)-Basho.left )
y=(sy/2) - ( ((Basho.top+Basho.bottom)/2)-Basho.top )
x=x+dx
y=y+dy
If x<0 Then
x=0
Else If x>sx Then
x=sx - (Basho.right-Basho.left)
End If
If y<0 Then
y=0
Else If y>sy Then
y=sy - (Basho.bottom-Basho.top)
End If
'中央に持っていく
If SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE)=0 Then
SetWindowCenter=0
Exit Function
End If
SetWindowCenter=1
End Function[/code][/hide]
かっこつけてFunctionで定義してますが、正直Subでよかったです(^^;
後、ウインドウを既存のウインドウの中央に持って行くのもこれを応用して使ってます。
[hide]
hOWnd→ここで指定したウインドウの中央に持って行きます。
hWnd→ここで指定したウインドウをhOWndの中央に持っていきます。
[code]Sub SetWindowCenterIn(hOWnd As HWND,hWnd As HWND,sx As Long,sy As Long)
Dim Basho As RECT
Dim my As RECT
Dim x As Long,y As Long
GetWindowRect(hOWnd,Basho)
GetWindowRect(hWnd,my)
x=( (Basho.left+Basho.right)/2 ) - ( ((my.left+my.right)/2)-my.left )
y=( (Basho.top+Basho.bottom)/2 ) - ( ((my.top+my.bottom)/2)-my.top )
x=x+sx
y=y+sy
SetWindowPos(hWnd,NULL,x,y,0,0,SWP_NOSIZE)
End Sub[/code][/hide]
良かったらどうぞ~