• 締切済み

(VB6)MDI親FormのPictureプロパティの設定方法

MDIの親フォームのPictureプロパティに、コードで画像を貼りつけて、表示領域に全画面表示させたいのですが、できません。 MDIの親フォームでなければ、PaintPictureを使えるというのは調べましたが、MDIの親フォームではどのようにすればいいのでしょうか。 public Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long Public Const RDW_ALLCHILDREN = &H80 Public Const RDW_ERASE = &H4 Public Const RDW_INVALIDATE = &H1 Public Const RDW_UPDATENOW = &H100Private Sub Command1_Click() Me.Picture = LoadPicture("C:\pic\aa.jpg") Call RedrawWindow(Me.hWnd, ByVal 0&, 0&, RDW_ERASE Or _ RDW_INVALIDATE Or RDW_ALLCHILDREN Or RDW_UPDATENOW) End Sub

みんなの回答

  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.2

拡大または縮小してとなると VB側で用意されたイベントだけでは無理なように思います 普通のFormなら Paintイベントがあるのでここを細工すればいいのですが ・・・ やるとするならば MDIFromをサブクラス化して WndProc(ウィンドウプロシージャ)を自前で定義して WM_PAINTや WM_ERASEBKGRNDなどを捕まえて修理しないといけないのかも # 出来るかどうかは検証していません m(__)m ただ、サブクラス化を行うと VBのIDEでのデバッグが出来なくなる点を考慮すると 面倒になりそうです PictureBoxを貼り付けてしまうと PictureBoxの部分はクライアント領域から除外されてしまうので これも使えませんね 子フォームは このPictureBoxの下へ潜ってしみますし ・・・

goodsun8
質問者

補足

通常の方法では無理みたいですね。 時間も無いので、この処理を諦めます。 ありがとうございました。

  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

このボタンはどのように配置されているものでしょう？ 親のMDIFormにツールバーなどを設置してその上に追加したボタンでしょうか？ それとも 子Formに追加したボタンでしょうか？ 前者ならばお示しのコードで 表示可能だと思いますよ 後者であるなら Me.Pictureや Me.hWndなどの Meを MDIFormを示すように MDIForm1.Picture や MDIForm1.ｈWndに変更しないといけません

goodsun8
質問者

補足

すみません。 上記のコードのSub Command1_Click()は適当につけてしまったので、 Me.Picture = LoadPicture("C:\pic\aa.jpg")の「Me」はMDIの親フォームです。 質問の意図としては、画像のサイズをMDIの親フォームの背景に、MDIの大きさに合わせて、画像の大きさを変えて貼りつけたいという意味です。 画像の大きさそのままなら、上のようなコードで可能なのですが・・・

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 「コンパイルエラー End Subが必要です。」

    Access2016でファイルを作成しているのですが、下記のVBAを実行しようとすると、「コンパイルエラー End Subが必要です。」とエラーメッセージが返ってきてしまいます。 構文の修正が必要であるとお気づきであれば、その箇所を教えていただけないでしょうか。初歩的な質問で恥ずかしい限りですが、何卒よろしくお願い致します。 Option Compare Database Option Explicit Public Declare PtrSafe 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 fuFlags As Long) As Long Public Declare PtrSafe Function GetSystemMenu Lib "user32" _ (ByVal hWnd As Long, ByVal fRever As Long) As Long Public Declare PtrSafe Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, ByVal uItem As Long, ByVal fuFlags As Long) As Long Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const HWND_TOP = &H0 Public Const SC_SIZE = &HF000 Public Const SC_MAXIMIZE = &HF030 Public Const SC_CLOSE = &HF060 Public Const SC_RESTORE = &HF120 Public Const MF_BYCOMMAND = &H0& Public Sub test() Private Sub Form_Open(Cancel As Integer) Dim hWnd As Long hWnd = Application.hWndAccessApp SetWindowPos hWnd, HWND_TOP, 0, 0, 800, 600, SWP_NOMOVE hWnd = GetSystemMenu(hWnd, 0) RemoveMenu hWnd, SC_SIZE, MF_BYCOMMAND End Sub

  • ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード

    Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。 作ったプログラムは以下の通りです。 標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。

  • VB2010でMDI親フォームから子フォームを表示

    VB2010でソフトを作っております。 MDI親フォームから子フォームを表示させたいのですが…。 過去に少しだけVB6を使っていたことがありますが、クラスという概念に苦労しております インスタンスや初期化といったところをうまく扱えばとは思うのですが、よろしくご指導お願いいたします。 1.MDI親フォーム(Form1)のボタンを押し、子フォーム(Form2)を表示させる 2.子フォームが表示されていなかったら表示させる 3.子フォームが表示されていたら何もしない これだけの事ですがずいぶん悩んでおります。 全コードがこれです。 Public Class Form1 Private f2 As New Form2 Private Sub Form1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.IsMdiContainer = True End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim fChild As Form() = Me.MdiChildren For Each f As Form In fChild If f.Text = "Form2" Then Exit Sub End If Next f2 = New Form2 f2.MdiParent = Me f2.Show() f2.Activate() End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click If f2 Is Nothing OrElse f2.IsDisposed Then f2 = New Form2 f2.MdiParent = Me End If f2.Show() f2.Activate() End Sub End Class ボタン１でもボタン２でも、期待する動作はするのですが、 ボタン１ではアクティブになっているフォームの名前を力技で取得している気がして… ボタン２では子フォーム(Form2)をすでに表示している状態でもさらにShowをしているのが気に入らなくて… もっとスマートな方法がありましたら、ご指導お願いします。

  • Excel VBAでIE「ダウンロードの表示」生成

    　Internet Explorer で、「ダウンロードの表示」のDialogウィンドウをショートカット(Ctrl + J )を使って表示させたいのですが、Excel VBA で以下のコードで試したのですが、うまくいきません。どういうコードを書いたらよいのでしょうか？アクセスキーを使った方法では、「ツール」で N 　に該当するのが「ダウンロードの表示」と「Send To Note」の2つあって起動できません。 　よろしくお願いします。 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const VK_CONTROL = &H11 Public Const VK_J = &H4A Public Const navOpenInNewTab = &H800 Sub Test() Dim objIE As Object Dim hWnd_objIE As Long Dim Ret As Long 'IE起動 Set objIE= CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "https://www.google.co.jp/", navOpenInNewTab Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop 'objIEのhWnd取得 hWnd_objIE = objIE.hwnd 'IEの親ウィンドウのhWnd取得する 'hWnd_objIE のウィンドウにPostMessageする Ret = PostMessage(hWnd_objIE, WM_KEYDOWN, VK_CONTROL, 0) Ret = PostMessage(hWnd_objIE, WM_KEYDOWN, VK_J, 0) Sleep 100 Ret = PostMessage(hWnd_objIE, WM_KEYUP, VK_CONTROL, 0) Ret = PostMessage(hWnd_objIE, WM_KEYUP, VK_J, 0) End Sub

  • WindowsAPI（GetWindowLongA）について質問です。

    WindowsAPI（GetWindowLongA）について質問です。 以下コードを実行すると、ウィンドウにスクロールバーが表示されてしまいます。 実行はVBAでAccessのフォームを呼び出しています。 フォーム自体はディスプレイ幅より明らかに小さいフォームサイズです。 SetWindowLongAの引数指定が間違っているのでしょうか？ また、スクロールバーを表示させない方法はありますでしょうか？ アドバイスよろしくお願いいたします。 'Windows属性の取得 Public Declare Function GetClassLongPtr Lib "user32" Alias "GetWindowLongA" ( _ ByVal hWnd As Long, ByVal nIndex As Long) As Long 'Windows属性の変更 Public Declare Function SetWindowLongPt Lib "user32" Alias "SetWindowLongA" ( _ ByVal hWnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Sub MenuBarsReset() Const GWL_STYLE = (-16) Const WS_SYSMENU = &H80000 Dim lngRetVal As Long lngRetVal = GetClassLongPtr(hWndAccessApp, GWL_STYLE) lngRetVal = SetWindowLongPt(hWndAccessApp, GWL_STYLE, lngRetVal - WS_SYSMENU) End Sub

  • こちらでマクロのコードを書いてもらったのですが、

    こちらでエクセルのコードを書いてもらい、そのコードを貼り付けてやってみたのですが、うまくいってるのでしょうか？ 書いてもらったコードが (1)シートタブを右クリックし「コードの挿入」からVBEを開き、 以下のVBAコードを貼り付ける。 Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) 　　UserForm1.Caption = Target.Range.Text 　　UserForm1.PictureSizeMode = fmPictureSizeModeZoom 　　UserForm1.Picture = LoadPicture(Target.ScreenTip) 　　UserForm1.Show End Sub (2)VBEのメニューより「挿入」→「ユーザーフォーム」でフォームを作成し、 フォームを右クリックしてコードの表示を選択。 初期で入力されているコードを全て削除したのちに、以下のコードを貼り付け。 VBEを「×」で閉じる。 Option Explicit 'Windows API宣言 Private Const GWL_STYLE = (-16) Private Const WS_THICKFRAME = &H40000 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long ' フォームをリサイズ可能にするための設定 Public Sub FormSetting() 　　　　Dim result As Long 　　　　Dim hwnd As Long 　　　　Dim Wnd_STYLE As Long 　　　　hwnd = GetActiveWindow() 　　　　Wnd_STYLE = GetWindowLong(hwnd, GWL_STYLE) 　　　　Wnd_STYLE = Wnd_STYLE Or WS_THICKFRAME Or &H30000 　　　　result = SetWindowLong(hwnd, GWL_STYLE, Wnd_STYLE) 　　　　result = DrawMenuBar(hwnd) End Sub Private Sub UserForm_Activate() 　　　　Call FormSetting End Sub (3)任意のセル（例えばA1セル）に任意の文字を入力し、ハイパーリンクを作成します。 セル参照の入力はリンクを挿入したセルのアドレス「A1」とし、 ヒント設定にて表示させたい画像のパスを設定します。 対応しているファイル形式は（bmp・dib・gif・jpg・wmf・emf・ico・cur）になります。 作成したリンクをクリックするとウィンドウで画像が開きます。 リサイズ可能にしているため、大きさは変更できますが、開いた時の初期サイズは (2)で作成したユーザーフォームのサイズになります。 以上になるのですが、上記のを実行して、A1をクリックしたら開きたい画像がフォトビューアーで開き、A1の下あたりに、添付画像のように別のA1と書かれたウィンドウが開きます。 本当はこのA1と書かれた所に開きたい画像が表示されてるはずなのでしょうか？

  • VBA ユーザーフォームの×ボタン制御の不具合

    PowerPoint VBAで複数のユーザーフォームからなるVBAマクロを作成しました。 フォーム内の「次へ」「前へ」ボタンでのみ、マクロの実行制御をしているので、途中で右上の×を押されると、想定外エラーが発生します。 そこで、一番下に貼りつけたようなコードを全てのフォームに挿入することで、右上の×が表示されないようにしました。 あくまでフォームにしかコードは埋め込んでいません。 （標準モジュール、クラスには入ってません） ですが、極稀に、「フォームの右上×」ではなく、「PowerPointの右上×」が非表示になってしまう現象が発生します。 いろいろやるうちに再現はするのですが、厳密な再現手順がよくわかりません。 状況と下記ソースから、どこらへんに原因がありそうかアドバイス頂けないでしょうか？ 全コードは出せない部分が多いのですが、アドバイスにあたり必要なコードがあれば、別途貼らせて頂きます。 Private Const GWL_STYLE = (-16) Private Const WS_SYSMENU = &H80000 ' ウィンドウに関する情報を返す Private Declare Function GetWindowLong Lib "USER32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long ' ウィンドウの属性を変更 Private Declare Function SetWindowLong Lib "USER32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long ' Activeなウィンドウのハンドルを取得 Private Declare Function GetActiveWindow Lib "USER32.dll" () As Long ' メニューバーを再描画 Private Declare Function DrawMenuBar Lib "USER32.dll" (ByVal hWnd As Long) As Long ' フォームアクティブ時処理 Private Sub UserForm_Activate() Dim hWnd As Long Dim Wnd_STYLE As Long hWnd = GetActiveWindow() Wnd_STYLE = GetWindowLong(hWnd, GWL_STYLE) Wnd_STYLE = Wnd_STYLE And (Not WS_SYSMENU) SetWindowLong hWnd, GWL_STYLE, Wnd_STYLE DrawMenuBar hWnd End Sub

  • Excel VBA によるマウス操作

    こんばんは。 まず以下のコードをご覧ください。 Public Declare Sub mouse_event Lib "user32.dll" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _ ByVal dwData As Long, ByVal dwExtraInfo As Long) Public Const MOUSEEVENTF_ABSOLUTE = &H8000& Public Const MOUSEEVENTF_MOVE = &H1 Public Const MOUSEEVENTF_LEFTDOWN = &H2 Public Const MOUSEEVENTF_LEFTUP = &H4 Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 Public Const MOUSEEVENTF_MIDDLEUP = &H40 Public Const MOUSEEVENTF_RIGHTUP = &H10 Public Const MOUSEEVENTF_RIGHTDOWN = &H8 Sub test() Call mouse_event(MOUSEEVENTF_ABSOLUTE, 10, 65500, 0, 0) Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) End Sub ExcelでSub test()を実行し、マウスで画面の左下の「スタート」を左クリックしたのと同じ結果が出ればいいのですが、うまくいきません。 フォームボタンで実行したらしばらくポインターが点滅していました。 クリックはされているようですが、移動ができてないようです。 このAPI関数というものが、このカテゴリーでよいのかも分からない私ですが、どうかご回答よろしくお願いします。

  • Formを動かせるようにしたい

    お世話になります。 OS　XP　PRO　　VB6（SP５）で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。

  • VBを使ってのCD-RWへのバックアップ方法を教えてください。

    こんにちは。よろしくお願いします。 ＶＢ５を使って開発しています。 パソコンの環境はWindowsXP（SP2）、データはAccess2003のMDBデータとスキャナで取り込んだ画像ファイルです。 上記２データをＣＤ－ＲＷにバックアップする処理をフォーム上のコマンドボタンを押して実行したいと考えています。 いろいろなサイトなどを探してみてFilecopyやSHFileOperationといったコピーの方法があると知りどちらも試してみたのですが、うまくいきません。間違っている箇所すらわからない状態です。ＣＤ－ＲＷにバックアップを取ることは不可能なのでしょうか。また正しい方法が別に存在するのでしょうか。ご指摘、アドバイスをお願いいたします。 下は実際に作った処理です。 ----------------------------------------------------- Filecopy "D:\data\*.*","E:\back\*.*" ------------------------------------------------------ Private Declare Function SHFileOperation Lib "shell32" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As String End Type Private Const FO_COPY = &H2 Private Const FO_DELETE = &H3 Private Const FO_MOVE = &H1 Private Const FO_RENAME = &H4 Private Sub Command1_Click() Dim Ret As Long Dim sf As SHFILEOPSTRUCT sf.hwnd = Me.hwnd sf.wFunc = FO_COPY sf.pFrom = "D:\data\*" sf.pTo = "E:\back\" Ret = SHFileOperation(sf) If Ret <> 0 Then MsgBox "失敗しました。" End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する