作成者 |
メッセージ |
|
|
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで
それが嫌な人は
コード:
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 * sy = 0 Then
SetWindowCenter=0
Exit Function
End If
'中央に持っていく計算
x=(sx-Basho.right+Basho.left)/2+dx
y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then
x=0
Else If x>sx-Basho.right+Basho.left Then
x=sx-Basho.right+Basho.left
End If
If y<0 Then
y=0
Else If y>sy-Basho.bottom+Basho.top Then
y=sy-Basho.bottom+Basho.top
End If
'中央に持っていく
SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE)
End Function
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで それが嫌な人は [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 * sy = 0 Then SetWindowCenter=0 Exit Function End If
'中央に持っていく計算 x=(sx-Basho.right+Basho.left)/2+dx y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then x=0 Else If x>sx-Basho.right+Basho.left Then x=sx-Basho.right+Basho.left End If
If y<0 Then y=0 Else If y>sy-Basho.bottom+Basho.top Then y=sy-Basho.bottom+Basho.top End If
'中央に持っていく SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE) End Function [/code]
|
|
|
投稿記事 |
Posted: 2011年2月28日(月) 15:51 |
|
|
|
|
|
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで
それが嫌な人は
コード:
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 * sy = 0 Then
SetWindowCenter=0
Exit Function
End If
'中央に持っていく計算
x=(sx-Basho.right+Basho.left)/2+dx
y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then
x=0
Else If x>sx-Basho.right+Basho.left Then
x=sx-Basho.right+Basho.left
End If
If y<0 Then
y=0
Else If y>sy-Basho.bottom+Basho.top Then
y=sy-Basho.bottom+Basho.top
End If
'中央に持っていく
SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE)
End Function
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで それが嫌な人は [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 * sy = 0 Then SetWindowCenter=0 Exit Function End If
'中央に持っていく計算 x=(sx-Basho.right+Basho.left)/2+dx y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then x=0 Else If x>sx-Basho.right+Basho.left Then x=sx-Basho.right+Basho.left End If
If y<0 Then y=0 Else If y>sy-Basho.bottom+Basho.top Then y=sy-Basho.bottom+Basho.top End If
'中央に持っていく SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE) End Function [/code]
|
|
|
投稿記事 |
Posted: 2011年2月28日(月) 15:50 |
|
|
|
|
|
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで
それが嫌な人は
コード:
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 * sy = 0 Then
SetWindowCenter=0
Exit Function
End If
'中央に持っていく計算
x=(sx-Basho.right+Basho.left)/2+dx
y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then
x=0
Else If x>sx-Basho.right+Basho.left Then
x=sx-Basho.right+Basho.left
End If
If y<0 Then
y=0
Else If y>sy-Basho.bottom+Basho.top Then
y=sy-Basho.bottom+Basho.top
End If
'中央に持っていく
SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE)
End Function
上記プログラミングはdx,dyによって右と下はウインドウがはみ出るのことがあるで それが嫌な人は [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 * sy = 0 Then SetWindowCenter=0 Exit Function End If
'中央に持っていく計算 x=(sx-Basho.right+Basho.left)/2+dx y=(sy-Basho.bottom+Basho.top)/2+dy
If x<0 Then x=0 Else If x>sx-Basho.right+Basho.left Then x=sx-Basho.right+Basho.left End If
If y<0 Then y=0 Else If y>sy-Basho.bottom+Basho.top Then y=sy-Basho.bottom+Basho.top End If
'中央に持っていく SetWindowCenter=SetWindowPos(hWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE) End Function [/code]
|
|
|
投稿記事 |
Posted: 2011年2月28日(月) 15:49 |
|
|
|
|
|
投稿なさった関数を
SetWindowCenter(hMainWnd,0,-28)で指定したら、
画面の中央に表示することをWindows7のPCで確認しました。
これでフルHD(画素数1920×1080)でも十分いけますね?
本当にどうもありがとうございました。
投稿なさった関数を SetWindowCenter(hMainWnd,0,-28)で指定したら、 画面の中央に表示することをWindows7のPCで確認しました。
これでフルHD(画素数1920×1080)でも十分いけますね? 本当にどうもありがとうございました。
|
|
|
投稿記事 |
Posted: 2011年2月27日(日) 22:31 |
|
|
|
|
|
引用: > > 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
>
> 大変重宝しています。
> 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]
良かったらどうぞ~
|
|
|
投稿記事 |
Posted: 2011年2月27日(日) 17:20 |
|
|
|
|
|
> 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
大変重宝しています。
WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1366*768)で実行すると画面中央に表示されて見栄えがよくなりました。
2013年9月3日修正
> 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
大変重宝しています。 WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1366*768)で実行すると画面中央に表示されて見栄えがよくなりました。
[b]2013年9月3日修正[/b]
|
|
|
投稿記事 |
Posted: 2011年2月07日(月) 14:36 |
|
|
|
|
|
ABで作成したウインドウは、何も指定しなければ、左端で起動のたびにうろちょろします。
ふと、『メッセージボックスのように中央寄せ出来ないかな・・・?』と思い、コードを書いてみました。
何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
Dim sx As Long 'スクリーンx座標
Dim sy As Long 'スクリーンy座標
Dim mp As RECT '自分のウインドウの場所
Dim x As Long
Dim y As Long
sx=GetSystemMetrics(SM_CXSCREEN)/2
sy=GetSystemMetrics(SM_CYSCREEN)/2
GetWindowRect(hMainWnd,mp)
x=mp.left+( sx-( (mp.left+mp.right)/2 ) )
y=mp.top+( sy-( (mp.top+mp.bottom)/2 ) )
SetWindowPos(hMainWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE or SWP_SHOWWINDOW)
あとは、足したり引いたりして、好きな場所に移動できます。
何か、変な場所がありましたら、指摘してあげてください。
もしも、重複がありましたら、申し訳ございません。
ABで作成したウインドウは、何も指定しなければ、左端で起動のたびにうろちょろします。 ふと、『メッセージボックスのように中央寄せ出来ないかな・・・?』と思い、コードを書いてみました。
何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
[hide][code] Dim sx As Long 'スクリーンx座標 Dim sy As Long 'スクリーンy座標 Dim mp As RECT '自分のウインドウの場所 Dim x As Long Dim y As Long
sx=GetSystemMetrics(SM_CXSCREEN)/2 sy=GetSystemMetrics(SM_CYSCREEN)/2
GetWindowRect(hMainWnd,mp)
x=mp.left+( sx-( (mp.left+mp.right)/2 ) ) y=mp.top+( sy-( (mp.top+mp.bottom)/2 ) )
SetWindowPos(hMainWnd,HWND_TOP,x,y,0,0,SWP_NOSIZE or SWP_SHOWWINDOW)[/code][/hide]
あとは、足したり引いたりして、好きな場所に移動できます。 何か、変な場所がありましたら、指摘してあげてください。
もしも、重複がありましたら、申し訳ございません。
|
|
|
投稿記事 |
Posted: 2009年6月07日(日) 20:49 |
|
|
|
|