よく見かけるVBサンプル集 MENU　40～49

'ユーザー定義型の例
TYPE strSavDatSheet
   strName As String
   strDATA As String
END TYPE
Public strSavDat(5) As strSavDatSheet
'
' ファイルの保存/書込み処理
' ■引数
' ReadType      : 書込むか？(TRUE=書込む、FALUE=読込む)
' □戻値
' TRUEなら成功。FALSEなら失敗。
Public Function RWritingOfFile_SavDat(ByVal SavDatFileName As String, _
                                                    ByVal WritingType As Boolean) As Boolean
ON ERROR GOTO ERRCODE
   Dim H As Integer
   H = FreeFile
   If WritingType = False Then
      '*-*-*-*-*-*-*-*-*
      '        読み込む
      '*-*-*-*-*-*-*-*-*
      'ファイルの有無を調査する (必要があれば)
      'IF not FileExists (SavDatFileName)Then exit function
      '存在するなら、読込む
      Open SavDatFileName For Binary Access Read As #H
      Get #H, , strSavDat
   Else
      '*-*-*-*-*-*-*-*-*
      '        書き込む
      '*-*-*-*-*-*-*-*-*
      Open SavDatFileName For Binary Access Write As #H
      Put #H, , strSavDat
   End If
   Close #H
   RWritingOfFile_SavDat = True
ERRCODE:
End Function

初期値のマウスアイコンを取得して描画する

使用API

'[指定ウィンドウに関係付けられたWNDCLASSEX構造体から、
'指定されたデータ (32bit値)を取得]
Public Const GCW_HCURSOR = (-12) '初期値のカーソルハンドル
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

hWnd
ウィンドウのハンドルを指定します。

nIndex
ウィンドウクラスに関するデータのうち、どのデータ (32 ビット値) を取得するのかを指定します。

nIndex定数値は winuser.h 内で宣言されています。
GCL_HICONSM = (-34)	小さいアイコンのハンドル
GCL_HICON = (-14)	アイコンのハンドル
GCL_HCURSOR = (-12)	初期値のカーソルハンドル
GCL_HBRBACKGROUND = (-10)	背景ブラシのハンドル

関数が成功すると、要求したデータ (32 ビット値) が返ります。
関数が失敗すると、0 が返ります。

'[アイコンを描画します]
Private Declare Function DrawIcon Lib "user32" _
(ByVal hDC&, ByVal X&, ByVal y&, ByVal hIcon&) As Long

hDC
デバイスコンテキストのハンドルを指定します。

X
アイコンの左上隅の x 座標を、論理単位で指定します。

Y
アイコンの左上隅の y 座標を、論理単位で指定します。

hIcon
描画するアイコンのハンドルを指定します。
Windows NT: アイコンリソースは、LoadIcon 関数を使ってロード
Windows 95: アイコンリソースは、LoadIcon 関数か LoadImage 関数を使ってロード
しないといけません。

関数が成功すると、0 以外の値が返ります。
関数が失敗すると、0 が返ります。

X パラメータおよび Y パラメータが指定するアイコンの位置は、
デバイスコンテキストのマッピングモードに依存します。

結果 = GetDefaultCursor(マウスアイコン取得元のhwnd , 描画先のhDC)

使用例

X = GetDefaultCursor(Me.hwnd,Me.hDC)

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 初期値のマウスアイコンを取得して描画する
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' ■引数
' lnghwnd      : マウスアイコン取得元のhwnd
' PichDC      : 描画先のhDC
' □戻値
' TRUEなら成功。FALSEなら失敗。
Public Function GetDefaultCursor(ByRef lnghwnd As Long, _
                                                  ByRef PichDC As Long) As Boolean
    Dim ReCursor As Long
    'カーソルハンドル取得
    ReCursor = GetClassLong(lnghwnd, GCW_HCURSOR)
    IF ReCursor <> 0 THEN
        '取得したカーソルを描画する
        ReCursor = DrawIcon(PichDC, 0, 0, ReCursor)
        IF ReCursor <> 0 THEN GetDefaultCursor = TRUE
    End IF
End Function

現在のマウスアイコンを取得して描画する

使用API

'[現在使用しているマウスカーソルのハンドルを取得]
Private Declare Function GetCursor Lib "user32" Alias _
"GetCursor" () As Long

関数が成功すると、現在のマウスカーソルのハンドルが返ります。
マウスカーソルが存在しないときは、NULL が返ります。

'[アイコンを描画します]
Private Declare Function DrawIcon Lib "user32" _
(ByVal hDC&, ByVal X&, ByVal y&, ByVal hIcon&) As Long

hDC
デバイスコンテキストのハンドルを指定します。

X
アイコンの左上隅の x 座標を、論理単位で指定します。

Y
アイコンの左上隅の y 座標を、論理単位で指定します。

関数が成功すると、0 以外の値が返ります。
関数が失敗すると、0 が返ります。

X パラメータおよび Y パラメータが指定するアイコンの位置は、
デバイスコンテキストのマッピングモードに依存します。

結果 = GetPresentCursor(描画先のhDC)

使用例

X = GetPresentCursor(Me.hDC)

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 現在のマウスアイコンを取得して描画する
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' ■引数
' PichDC      : 描画先のhDC
' □戻値
' TRUEなら成功。FALSEなら失敗。
Public Function GetPresentCursor(ByRef PichDC As Long) As Boolean
    Dim ReCursor As Long
    'カーソルハンドル取得
    ReCursor = GetCursor()
    IF ReCursor <> 0 THEN
        '取得したカーソルを描画する
        ReCursor = DrawIcon(PichDC, 0, 0, ReCursor)
        IF ReCursor <> 0 THEN GetPresentCursor = TRUE
    End IF
End Function

画面の中央にフォームを再配置する

使用API

なし

ウィンドウを画面の中央に表示する1つの例です。

結果 = SetFormCenter Screen(フォームを指定)

使用例

X = SetFormCenter Screen(form1)

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 画面の中央にフォームを再配置する
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' ■引数
' objform      : フォームを指定
' □戻値
' TRUEなら成功。FALSEなら失敗。
Public Sub SetFormCenterScreen(ByRef objform As Object)
On Error GoTo ErrCode
    With objForm
        .Left = Screen.Width \ 2 - .Width \ 2
        .Top = Screen.Height \ 2 - .Height \ 2
    End With
ErrCode:
End Sub

リストボックスの自動スクロール

使用API

'[指定されたウィンドウに関する情報を取得します]
Public Const GWL_STYLE = (-16) 'ウィンドウスタイルを取得
Public Const WS_VSCROLL = &H200000 '垂直スクロールバー
Private Declare Function GetWindowLong Lib "USER32" Alias _
"GetWindowLongA" (ByVal hWnd&, ByVal nIndex&) As Long

関数が成功すると、要求したデータ (32 ビット値) が返ります。
関数が失敗すると、0 が返ります。

call SetListTopIndex (ListBoxを指定)

使用例

call SetListTopIndex (list1)

Ｑ.どこで使いますか？

' 追加したときに、CALLします。
Dim i As Integer
For i = 0 To 100
List1.AddItem i
Call SetListTopIndex(List1)
Next i

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' リストボックスの自動スクロール
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' ■引数
' objLst      : ListBoxを指定
Public Sub SetListTopIndex(ByRef objLst As ListBox)
    Dim LstBoxStyle As Long
    '
    ' ListBoxにスクロールバーの有無をチェックし、
    ' ある場合には、TopIndexにNewIndexをセットする。
    '
    LstBoxStyle = GetWindowLong(objLst.hWnd, GWL_STYLE)
    If LstBoxStyle And WS_VSCROLL Then
        objLst.TopIndex = objLst.NewIndex
    End If
End Sub

TOP