ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 20:41

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2009年6月07日(日) 20:49 
オフライン

登録日時: 2009年3月29日(日) 15:45
記事: 106
ABで作成したウインドウは、何も指定しなければ、左端で起動のたびにうろちょろします。
ふと、『メッセージボックスのように中央寄せ出来ないかな・・・?』と思い、コードを書いてみました。

何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;

[hide]
コード:
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)
[/hide]

あとは、足したり引いたりして、好きな場所に移動できます。
何か、変な場所がありましたら、指摘してあげてください。

もしも、重複がありましたら、申し訳ございません。

_________________
↓個人的ソフト置き場
http://www.software.jpn.org/
↓萌えゲー製作とかしていたい
http://www.holygate.jpn.org/


通報する
ページトップ
投稿記事Posted: 2011年2月07日(月) 14:36 
オフライン

登録日時: 2006年2月05日(日) 17:10
記事: 189
住所: 東京都
> 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;

大変重宝しています。
WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1366*768)で実行すると画面中央に表示されて見栄えがよくなりました。

2013年9月3日修正


最後に編集したユーザー たかせ on 2013年9月03日(火) 13:38 [ 編集 2 回目 ]

通報する
ページトップ
投稿記事Posted: 2011年2月27日(日) 17:20 
オフライン

登録日時: 2009年3月29日(日) 15:45
記事: 106
引用:
> > 何もひねっていませんし、かなり単純なので、余り使い道がないと思いますが・・・(^^;
>
> 大変重宝しています。
> WIN-XPデスクトップ(画素数1024*768)で作成した1024*740のノーマルウインドウのプログラムに上記のソースコードを追加してWIN-7ノート(画素数1368*768)で実行すると画面中央に表示されて見栄えがよくなりました。
おお!
お役に立ててよかったです。
ちなみに私は、こんな感じで関数にして使っています。

[hide]
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
[/hide]

かっこつけてFunctionで定義してますが、正直Subでよかったです(^^;

後、ウインドウを既存のウインドウの中央に持って行くのもこれを応用して使ってます。

[hide]
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
[/hide]

良かったらどうぞ~

_________________
↓個人的ソフト置き場
http://www.software.jpn.org/
↓萌えゲー製作とかしていたい
http://www.holygate.jpn.org/


通報する
ページトップ
投稿記事Posted: 2011年2月27日(日) 22:31 
オフライン

登録日時: 2006年2月05日(日) 17:10
記事: 189
住所: 東京都
投稿なさった関数を
SetWindowCenter(hMainWnd,0,-28)で指定したら、
画面の中央に表示することをWindows7のPCで確認しました。

これでフルHD(画素数1920×1080)でも十分いけますね?
本当にどうもありがとうございました。


通報する
ページトップ
投稿記事Posted: 2011年2月28日(月) 15:49 
上記プログラミングは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


通報する
ページトップ
   
投稿記事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


通報する
ページトップ
   
投稿記事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


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke