【QBASIC互換!?】FreeBasic【GPL】 2 [無断転載禁止]©2ch.net (430ﾚｽ)
【QBASIC互換!?】FreeBasic【GPL】 2 [無断転載禁止]©2ch.net http://mevius.5ch.net/test/read.cgi/tech/1482549747/
上
下
前次
1-
新
通常表示
512ﾊﾞｲﾄ分割
ﾚｽ栞
抽出解除
必死ﾁｪｯｶｰ(本家)
(べ)
ﾚｽ栞
あぼーん
129: デフォルトの名無しさん [] 2017/04/15(土) 11:39:21.57 ID:e+ro1QoX >>122 のあとのマンゴー関係で書けなかった内容。 画面中にある表示枠情報。 Dim CmWndpl As WINDOWPLACEMENT CmWndpl.length = sizeof(CmWndpl): 'MS指示、参照前に定義のこと MSReturnCode = GetWindowPlacement(hWnd, @CmWndpl) で取得、 MSReturnCode = SetWindowPlacement(hWnd, @CmWndpl) で復元。 '使用TVの物理サイズの取得 Dim R As RECT Dim as HWND hWnd hWnd = GetDesktopWindow() MSReturnCode = GetWindowRect(hWnd, @R): 'スクリーン座標の取得 'タスクバーの位置と大きさを返す Dim TaskBerInfo As _AppBarData '(大域) Dim MSReturnCodeUintPtr as UINT_PTR ZeroMemory(@TaskBerInfo, sizeof(TaskBerInfo)) : '(MS指定) 「TaskBerInfo」領域内を0で塗りつぶす TaskBerInfo.cbSize = sizeof(TaskBerInfo): '(MS指定) 初期化、領域の大きさを定義 'declare function SHAppBarMessage(byval dwMessage as DWORD, byval pData as PAPPBARDATA) as UINT_PTR MSReturnCodeUintPtr = SHAppBarMessage(ABM_GETTASKBARPOS, @TaskBerInfo) リターンコードが「UINT_PTR」という使用頻度の低い型を使っていることに注意。 http://mevius.5ch.net/test/read.cgi/tech/1482549747/129
130: デフォルトの名無しさん [] 2017/04/15(土) 11:46:28.47 ID:e+ro1QoX 'システム枠の幅と高さの取得 'declare function GetSystemMetrics(byval nIndex as long) as long Select Case ActionType Case SM_CXSCREEN, SM_CYSCREEN '0, 1 'プライマリモニタの画面全体の幅と高さを取得します。 WideLong = GetSystemMetrics(SM_CXSCREEN) HightLong = GetSystemMetrics(SM_CYSCREEN) Case SM_CXVSCROLL, SM_CYHSCROLL '2, 3 垂直スクロールバーの幅、または垂直スクロールバーの矢印の高さをピクセル単位で取得します。 WideLong = GetSystemMetrics(SM_CXVSCROLL) HightLong = GetSystemMetrics(SM_CYHSCROLL) 'const SM_CYCAPTION = 4 ''通常のタイトルバーの高さをピクセル単位で取得します。 Case SM_CXBORDER, SM_CYBORDER '5, 6 立体効果のないウィンドウの境界の幅と高さを取得します。 WideLong = GetSystemMetrics(SM_CXBORDER) HightLong = GetSystemMetrics(SM_CYBORDER) Case SM_CXDLGFRAME, SM_CYDLGFRAME '7,8 'タイトルバーがあり、サイズが変更できないウィンドウの周囲を囲む枠の幅と高さをピクセル単位で取得します。 WideLong = GetSystemMetrics(SM_CXDLGFRAME) HightLong = GetSystemMetrics(SM_CYDLGFRAME) 以下略。「GetSystemMetrics」関係がやたら沢山あって下手に書くとマンゴーに引っかかりそうなので一部分だけ。 Case SM_CXVIRTUALSCREEN, SM_CYVIRTUALSCREEN '78, 79 仮想画面の幅と高さをピクセル単位で取得します。 WideLong = GetSystemMetrics(SM_CXVIRTUALSCREEN) HightLong = GetSystemMetrics(SM_CYVIRTUALSCREEN) と、40組ぐらいある。 'const SM_CXFOCUSBORDER = 83 から 'const SM_CMETRICS = 97 まで、Win系BIファイル('C:\tool\FreeBASIC\inc\win\winbase.bi)には記載があるが、内容が検索では見つけられなかった定数がある。 http://mevius.5ch.net/test/read.cgi/tech/1482549747/130
131: デフォルトの名無しさん [] 2017/04/15(土) 11:51:10.66 ID:e+ro1QoX '表示枠全体, 表示枠使用可能範囲、最大表示可能枠の取得 Dim MainWaku as tagRECT Case 1 'declare function GetWindowRect(byval hWnd as HWND, byval lpRect as LPRECT) as WINBOOL MSReturnCode = GetWindowRect(InhWin, @MainWaku) 'InhWinの左上端と右下端の座標をスクリーン座標で取得します。 Case 2 'declare function GetClientRect(byval hWnd as HWND, byval lpRect as LPRECT) as WINBOOL MSReturnCode = GetClientRect(InhWin, @MainWaku) 'InhWinの表示枠内、ユーサー領域の左上端と右下端の座標をスクリーン座標で取得します。 Case 3 'declare function GetClipCursor(byval lpRect as LPRECT) as WINBOOL MSReturnCode = GetClipCursor(@MainWaku) 'マウスカーソルの移動可能な範囲に相当するスクリーン座標を取得します(最大表示範囲)。 Case 4 'http://liweijing.blogspot.jp/2007/03/blog-post.html 'declare function SystemParametersInfoA(byval uiAction as UINT, byval uiParam as UINT, byval pvParam as PVOID, byval fWinIni as UINT) as WINBOOL MSReturnCode = SystemParametersInfo(SPI_GETWORKAREA, 0, @MainWaku, 0) 'タスクバーの大きさをのぞいた画面の大きさ http://mevius.5ch.net/test/read.cgi/tech/1482549747/131
132: デフォルトの名無しさん [] 2017/04/15(土) 11:54:37.99 ID:e+ro1QoX '表示枠全体, 表示枠使用可能範囲取得 Dim hBtn As HWND Dim MainWaku as tagRECT Dim PointXY as tagPOINT hBtn = GetDlgItem(InhWin, IDnoGRALong): '表示枠内部品のハンドル(枠番号)を取得, hBtn=0でエラー Select Case ActionType Case 1, 11 MSReturnCode = GetWindowRect(hBtn, @MainWaku) 'hBtnの表示枠内部品の、左上端と右下端の座標を表示枠座標で取得します。 Case 2, 12 MSReturnCode = GetClientRect(hBtn, @MainWaku) 'hBtnの表示枠内部品の、左上端(0,0)と右下端の座標を取得します。 http://mevius.5ch.net/test/read.cgi/tech/1482549747/132
133: デフォルトの名無しさん [] 2017/04/15(土) 11:58:30.77 ID:e+ro1QoX 'スクリーン座標 → ユーザー座標に換算 Dim as tagPOINT PointXY1, PointXY2 PointXY1.X = InWaku.Left PointXY1.Y = InWaku.Top IF (ActionType = 1) Then MSReturnCode = ScreenToClient(InhWin, @PointXY1) Else MSReturnCode = ClientToScreen(InhWin, @PointXY1) End If IF (MSReturnCode = 0) Then IError = 1 PointXY2.X = InWaku.Right PointXY2.Y = InWaku.Bottom IF (ActionType = 1) Then MSReturnCode = ScreenToClient(InhWin, @PointXY2) Else MSReturnCode = ClientToScreen(InhWin, @PointXY2) End If IF (MSReturnCode = 0) Then IError = 1 IF (Ierror = 0) Then InWaku.Left = PointXY1.X InWaku.Top = PointXY1.Y InWaku.Right = PointXY2.X InWaku.Bottom = PointXY2.Y Else 'エラー End If てな感じ。 http://mevius.5ch.net/test/read.cgi/tech/1482549747/133
134: デフォルトの名無しさん [] 2017/04/15(土) 12:03:35.44 ID:e+ro1QoX 表示枠や表示部品移動、大きさの変更について、 MSReturnCode = MoveWindow(hBtn, PointXY.X, PointXY.Y, WideLong, HightLong, True): '個別表示物の枠の寸法を定義, 再作画を指示 MSReturnCode = SetWindowPos(InhWin, HWND_TOP, 0, 0, new_width, new_height, SWP_NOMOVE) MSReturnCode = SetWindowPos(hBtn, NULL, 0, 0, new_width, new_height, uFlags) MSReturnCode = GetWindowRect(hBtn, @rw) MSReturnCode = ScreenToClient(InhWin, @PointXY) MSReturnCode = MoveWindow(hBtn, PointXY.X, PointXY.Y, new_width, new_height, True): '個別表示物の枠の寸法を定義, 再作画を指示 MSReturnCode = SetWindowPos(InhWin, HWND_TOP, LeftLong, TopLong, 0, 0, SWP_NOSIZE) が関係しているらしいのだけれども、現在混乱して、作成中止中。 http://mevius.5ch.net/test/read.cgi/tech/1482549747/134
上
下
前次
1-
新
書
関
写
板
覧
索
設
栞
歴
ｽﾚ情報
赤ﾚｽ抽出
画像ﾚｽ抽出
歴の未読ｽﾚ
AAｻﾑﾈｲﾙ
Google検索
Wikipedia
ぬこの手
ぬこTOP
1.487s*