No.3ベストアンサー
- 回答日時:
一応サンプルを作りました。
やってみて面白かったけど、やはりオリジナルを作ったほうがかなり楽だということを実感しました。
注意:
ここの掲示板は文字がずれるので、図形が壊れます。以下の文章をメモ帳などのテキストエディタにコピって読んでください。
・・・さて本題・・・
※メッセージボックスの構造
┏━━━━━━━━━━━━━━━━┓
┣━━━━━━━━━━━━━━━━┫
┃ ┃
┃ ┏━┓ ┏━━━━━━━━┓ ┃
┃ ┃I┃ ┃MSG_AREA┃ ┃
┃ ┗━┛ ┗━━━━━━━━┛ ┃
┃ ┃
┃ ┏━━┓ ┏━━┓ ┃
┃ ┃B1┃ ┃B2┃ ┃
┃ ┗━━┛ ┗━━┛ ┃
┗━━━━━━━━━━━━━━━━┛
[I]・・・アイコン(クラス名:Static)
[MSG_AREA]・・・メッセージ表示領域(クラス名:Static)
[B1/B2]・・・ボタン(クラス名:Button)
という構造になっています
メッセージボックスは指定のスタイルによりアイコンの有無・ボタンの数が変化します。
また、メッセージ文字数により、メッセージの表示領域が変更され、ダイアログのサイズも算出されます。
しかもこの大きさの計算は、ダイアログオブジェクトが創生される前に行われるため、フォントを指定したあと、独自で再配置をしなければなりません。この計算ロジックは非常にややこしいものです。
※VBのMsgBox関数(またはAPIMassegeBox関数)内部で行われていると思われる手順(フックしてSpyで調べました)
1.MSGの文字数/ボタンの数/アイコンの有無により、ダイアログの大きさの算出・各オブジェクトの配置位置の算出
2.ダイアログ本体を創生
3.ボタンをダイアログ内部に創生(複数のボタンが存在するとき、左側のボタンから創生)
4.アイコンがあるならアイコンを創生
5.メッセージを創生
6.ボタンにフォーカスをセット
7.画面に表示する(サンプルではここで操作しています)
という順序のようです。
サンプルは、画面に表示する直前にフォントを指定しています。上記で述べたとおり、各オブジェクトはすでにできあがってしまっているので、再配置が必要になります。(サンプル内のsetResize関数を作りこんでください)
以下を標準モジュールに貼り付けて、Sub Mainから実行するようにしてください。
[myMsgBox関数]がオリジナルMsgBoxを呼ぶための関数です。
Option Explicit
Public Const WH_CBT = 5
'太文字([400/700]にしているけど、フォントによって違うかも?)
Public Enum MY_BOLD
MYB_FLASE = 400
MYB_TRUE = 700
End Enum
'斜体
Public Enum MY_ITALIC
MYI_FLASE = 0
MYI_TRUE = 1
End Enum
'下線
Public Enum MY_UNDERLINE
MYU_FLASE = 0
MYU_TRUE = 1
End Enum
'取消し線
Public Enum MY_STRINKEOUT
MYS_FLASE = 0
MYS_TRUE = 1
End Enum
Public Const HCBT_ACTIVATE = 5 ' ウィンドウがこれからアクティブになる通知メッセージ
Public Const WM_SETFONT = &H30 'フォントを指定
Public Const WM_GETFONT = &H31 'テキストボックス、ラベル等が現在使っているフォントのハンドル
Public Const LF_FACESIZE = &H20
Public Const POINT_PER_INCH = 72
Public Const LOGPIXELSY = 90 '縦方向の1論理インチあたりのピクセル数
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = (-1)
Public Const HWND_NOTOPMOST = (-2)
Public Const SWP_NOSIZE = &H1&
Public Const SWP_NOMOVE = &H2&
Public Const SWP_NOZORDER = &H4&
Public Const SWP_NOREDRAW = &H8&
Public Const SWP_NOACTIVATE = &H10&
Public Const SWP_FRAMECHANGED = &H20&
Public Const SWP_SHOWWINDOW = &H40&
Public Const SWP_HIDEWINDOW = &H80&
Public Const SWP_NOCOPYBITS = &H100&
Public Const SWP_NOOWNERZORDER = &H200&
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Type LOGFONT
lfHeight As Long 'キャラクタの高さ
lfWidth As Long 'キャラクタの幅(0 で標準的プロポーション)
lfEscapement As Long '相対的出力角度(単位:1/10度)
lfOrientation As Long '回転角度(単位:1/10度)
lfWeight As Long 'キャラクタの線幅(FW_BOLD, FW_NORMAL)
lfItalic As Byte 'イタリックの時 Chr$(1)、通常 Chr$(0)
lfUnderline As Byte 'アンダーライン付きの時 1
lfStrikeOut As Byte '横線付きの時 1
lfCharSet As Byte 'キャラクタセットの指定
lfOutPrecision As Byte '常に OUT_DEFAULT_PRECIS = 0
lfClipPrecision As Byte ' 同上
lfQuality As Byte 'DEFAULT_QUALITY, DRAFT_QUALITY, PROOF_QUALITY
lfPitchAndFamily As Byte 'DEFAULT_PITCH,FIXED_PITCH, VAIABLE_PITCH
lfFaceName As String * LF_FACESIZE 'タイプフェース名
End Type
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Any) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private mHookProcWnd As Long 'フックプロセスハンドル
Private mFontHandle As Long '作成したフォントハンドル
Public Sub Main()
Call myMsgBox("鈴木 宗○", vbOKCancel Or vbQuestion)
End Sub
'メッセージボックスの初期設定
Public Function myMsgBox( _
inPrompt As String _
, Optional inButtons As VbMsgBoxStyle = vbOKOnly _
, Optional inTitle As String = "vs 辻本 清○" _
, Optional inHelpFile _
, Optional inContext _
) As VbMsgBoxResult
'フック
mHookProcWnd = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, App.hInstance, App.ThreadID)
'メッセージボックスを呼ぶ
myMsgBox = MsgBox(inPrompt, inButtons, inTitle, inHelpFile, inContext)
'メッセージボックスで作成されたフォントを削除する
Call delFont
End Function
'フック関数
Private Function MsgBoxHookProc _
(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Static staFlg As Boolean 'ワーキングフラグ
'システムがウィンドウをアクティブ化しようとしている
If nCode = HCBT_ACTIVATE Then
If staFlg Then
Exit Function
End If
staFlg = True
'フォントを設定する
Call setFont(wParam, 30, MYB_TRUE, MYI_TRUE, MYU_TRUE, MYS_TRUE)
'オブジェクトのリサイズ
Call setResize(wParam)
Call UnhookWindowsHookEx(mHookProcWnd)
staFlg = False
End If
' フック関数の継続を中止
MsgBoxHookProc = False
End Function
Private Sub setFont( _
inOwnerWnd As Long, _
Optional ByVal inFontSize As Single = -1, _
Optional ByVal inBold As MY_BOLD = MYB_FLASE, _
Optional ByVal inItalic As MY_ITALIC = MYI_FLASE, _
Optional ByVal inUnderLine As MY_UNDERLINE = MYU_FLASE, _
Optional ByVal inStrikeOut As MY_STRINKEOUT = MYS_FLASE _
)
Dim udtLOGFONT As LOGFONT
Dim lngDC As Long
Dim lngWk As Long
Dim lngMsgWnd As Long 'メッセージボックスのメッセージ部分のハンドル
'すでに作成済みのフォントを削除
Call delFont
'メッセージボックスの中の、メッセージ部分のハンドルを得る
lngMsgWnd = getWndMsg(inOwnerWnd)
'デバイスコンテキストを得る
lngDC = GetDC(lngMsgWnd)
'現在のフォントのハンドルを取得
lngWk = SendMessage(lngMsgWnd, WM_GETFONT, 0, 0&) And &HFFFF&
' フォント属性を取得
Call GetObject(lngWk, Len(udtLOGFONT), udtLOGFONT)
'新しい設定を行う
With udtLOGFONT
'フォントサイズ/太字/斜体/下線/取消し線
If inFontSize > 0 Then
.lfHeight = inFontSize * (GetDeviceCaps(GetDC(inOwnerWnd), LOGPIXELSY) / POINT_PER_INCH) * (udtLOGFONT.lfHeight / Abs(udtLOGFONT.lfHeight))
End If
.lfWeight = inBold
.lfItalic = inItalic
.lfUnderline = inUnderLine
.lfStrikeOut = inStrikeOut
End With
'論理フォントの作成
mFontHandle = CreateFontIndirect(udtLOGFONT)
'DCへの関連付け
Call SelectObject(lngDC, mFontHandle)
'フォントを指定
Call SendMessage(ByVal lngMsgWnd, ByVal WM_SETFONT, ByVal mFontHandle, 0&)
End Sub
'フォントオブジェクトの削除
Private Sub delFont()
If mFontHandle <> 0& Then
Call DeleteObject(mFontHandle)
mFontHandle = 0
End If
End Sub
'メッセージボックスの中の、メッセージ部分のハンドルを得る
Private Function getWndMsg(inWnd As Long) As Long
Dim lngWnd1 As Long
Dim lngWnd2 As Long
'メッセージボックスには「Static」クラスを持つオブジェクトが1個か2個ある
'1個の時は メッセージ
'2個の時は 最初のStaticはアイコン/次にメッセージ
lngWnd1 = FindWindowEx(inWnd, 0&, "Static" & vbNullChar, vbNullString)
lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Static" & vbNullChar, vbNullString)
'2個目が存在していたら2個目、そうじゃなけりゃ1個目のハンドルを返す
getWndMsg = IIf(lngWnd2 <> 0&, lngWnd2, lngWnd1)
End Function
'オブジェクトのリサイズ
'(ここは作りこまないといけない。計算ロジック大変そう・・・・)
Private Function setResize(inWnd As Long)
Dim lngWidth As Long
Dim lngHeight As Long
Dim lngWnd1 As Long
Dim lngWnd2 As Long
'本当はここで再配置ロジックを行う(ボタン/アイコン/メッセージ)の各ハンドルを得て、サイズを変更
'ここに載っているのは、あくまでサンプルです
'ボタン数が2個限定ですのでお間違いないように!!!!!!!!!!!!!!
'画面サイズを取得
lngWidth = (Screen.Width \ Screen.TwipsPerPixelX)
lngHeight = (Screen.Height \ Screen.TwipsPerPixelY)
'メッセージボックスを座標(0,0)へ表示/メッセージボックスを画面サイズに表示
Call SetWindowPos(inWnd, 0, 0, 0, lngWidth, lngHeight, _
SWP_NOZORDER Or SWP_NOACTIVATE)
'メッセージ
Call SetWindowPos(getWndMsg(inWnd), 0, 0, 0, lngWidth \ 2, lngHeight \ 2, _
SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOMOVE)
'ボタン1(大きさそのまま/配置変更)
lngWnd1 = FindWindowEx(inWnd, 0&, "Button" & vbNullChar, vbNullString)
Call SetWindowPos(lngWnd1, 0, 0, lngHeight - 50, 0, 0, _
SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOSIZE)
'ボタン2(大きさ変更/配置変更)
lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Button" & vbNullChar, vbNullString)
Call SetWindowPos(lngWnd2, 0, lngWidth - 400, lngHeight - 500, 300, 300, _
SWP_NOZORDER Or SWP_NOACTIVATE)
End Function
No.2
- 回答日時:
出来ないことはないですよ。
MSGBOXのフックと、ダイアログのサイズ変更と同じ要領でサイズの変更もできます。ただし、すごく面倒です。
taisuke555氏の言われ通り、MsgBoxの機能だけでは実現できません。オリジナルのMSGBOXのフォームを使用した方が、かな~り楽だと思います。
No.1
- 回答日時:
API関数はよく分かりませんが、msgboxでは出来ないと思います。
どうしてもフォントのサイズを変えてメッセージを表示したければ、
自分で作ってしまったらどうでしょう?
msgboxとそっくり同じ物はちょっと面倒ですが、フォントサイズを変えて、表示するだけでしたら、
Formとラベルとボタンだけですので、そんなに難しくはないと思います。
作る方を選択し、作り方が分からないようでしたらまた、質問してください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/04/21 13:46
- JavaScript フォームが空欄の時にフォームの外をクリックすると、エラーが出るコードを調べています。 1 2023/06/25 11:51
- Outlook(アウトルック) outlookの返信メールで、メッセージ/フォント機能が働かない。 1 2022/04/07 13:03
- その他(インターネット接続・インフラ) Webサイトのフォント・級数変更について 1 2022/10/18 18:08
- Google Drive Googleドライブの警告メッセージを消す方法 4 2022/09/21 06:04
- CAD・DTP vectorworks、winとmacでデータを共有する場合 1 2023/02/20 16:41
- 政治 私の発明した「二階建て漢字」は使えるでしょうか? 3 2023/02/08 16:40
- X(旧Twitter) Twitterの警告について 1 2022/09/07 18:28
- LINE LINEの着信通知音が時々鳴らない、通知メッセージも来ない原因がよく分かりません。 2 2022/04/01 23:37
- デジタルカメラ 画像のJPGファイルの「大きさ」と「サイズ」の意味の違いをお教えください。 8 2022/09/18 14:50
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
メッセージボックスに表示する文字を大きくしたい
Excel(エクセル)
-
MsgBoxについて
Visual Basic(VBA)
-
VBSの「MsgBox」について
Visual Basic(VBA)
-
-
4
MSGBOXのフォント大きさ変更
Visual Basic(VBA)
-
5
メッセージボックスを大きくする方法
Visual Basic(VBA)
-
6
ダイアログにプレビュー表示
Visual Basic(VBA)
-
7
メッセージボックスの背景色
Visual Basic(VBA)
-
8
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
9
VBAでエクセルシートを更新(リフレッシュ)する方法を教えて下さい。
Excel(エクセル)
-
10
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
11
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
12
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
13
Msgboxで使用するフォントの指定は可能?
Visual Basic(VBA)
-
14
メッセージボックスのOKボタンをVBAでクリックさせたい
Visual Basic(VBA)
-
15
エクセルVBA テキストボックスに3桁ごとにコンマ
Visual Basic(VBA)
-
16
MessageBoxで表示される文字列の色を変えたい
C言語・C++・C#
-
17
メッセージボックスで1025文字以上を扱う
Visual Basic(VBA)
-
18
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
-
19
UserForm
Visual Basic(VBA)
-
20
ユーザーフォーム上にアイコンの表示
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
コンボボックス内の文字サイズ変更
-
VBAのフォント変更(エクセルか...
-
フォントの大きさ
-
VB.NET2005 TextBox 高さ(Heig...
-
[VC]リストビューで等幅フォント
-
コンボボックスの一部のアイテ...
-
エディットボックスのフォント...
-
文字色 エクリプス
-
リソースエディタでスタティッ...
-
ドロップダウンリストのフォン...
-
プロポーショナルフォントの文...
-
Smart Art挿入時のフォントサイ...
-
フォントごとの文字列の幅の取得
-
チェックボックスの箱のサイズ...
-
VBA TEXTBOXテキストボックスの...
-
Eclipseで修正したファイル名の...
-
エディットの文字サイズ変更
-
PCによって変わってしまう画面...
-
C# のフォームデザイン&レイア...
-
ワードで自作フォントが変更で...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
フォントの大きさ
-
コンボボックス内の文字サイズ変更
-
VBAのフォント変更(エクセルか...
-
チェックボックスの箱のサイズ...
-
VB.NET2005 TextBox 高さ(Heig...
-
リソースエディタでスタティッ...
-
コンボボックスの一部のアイテ...
-
ドロップダウンリストのフォン...
-
エディットボックスのフォント...
-
文字色 エクリプス
-
プロポーショナルフォントの文...
-
Eclipseで修正したファイル名の...
-
ワードでコントロールツールボ...
-
EDITBOXに関して
-
VBA TEXTBOXテキストボックスの...
-
エディットの文字サイズ変更
-
Msgboxで使用するフォントの指...
-
カレンダーコントロールとサイ...
-
ActiveReport中のフォントサイ...
-
WPFのフォントカラー変更につい...
おすすめ情報