愚者の経験

「また今度」はほとんどこない

月別アーカイブ: 9月 2011

Windows 8 Preview版

ノートパソコンに入れてみようかなぁ。
「Metro UI」とかOfficeの32bitの動作とかARMとか気になることいっぱい。

64bit版は4.83GBのISOファイル…どうやってインストールするんだ?
DVDに焼けないしUSBメモリインストールでいいのか?

追記(2011/09/30):USB起動のインストーラで起動したが、インストールディスクを選んだ時点で警告がでて、先に進めなかった。
インストール用のUSBメモリは「Windows 7 USB DVD ダウンロード ツール」でISOファイルを指定して作成。

コマンドでVHDを作成しても同様。ディスクを選んだ時点で警告が…結局ノートに直接上書きインストールした。

広告

ドラッグで移動、かつサイズ変更可能なコントロール

参考URLhttp://hatenachips.blog34.fc2.com/blog-entry-166.html

ドラッグの移動はなんとかなります。が、サイズ変更が難しい。
コントロールの端に来たらSetCursor関数(API)で矢印を表示。

MouseDown時にSetCursorで変わっていたらサイズ変更、変わってなければドラッグで移動

の順でとりあえず作ってみようか。

イメージコントロールに画像を表示

画像そのものをデータベースに取り込んだ場合、その表示に困りました。 Pictureプロパティかコントロールソースに画像のパスを入れるしかないと思っていたのです。
(連結オブジェクトフレームは重すぎなので対象外です。)

しかしようやくわかりましたのでそれのメモ。PictureDataプロパティなんてあったんですね。

‘登録処理の画像パス取得後
dim ARY() as Byte     ‘画像のバイナリ格納用
Open FilePath For Binary as #1     ‘FreeFileで取得してもいい
Redim ARY(LOF(#1))                   ‘ファイルのサイズ取得し配列の大きさ決定

Get #1, , ARY                                 ‘画像バイナリ取得

‘この取得したバイナリをヴァリアント型に変換するとイメージコントロールの
‘PictureDataプロパティに代入出来、画像が直接表示されます。(Pictureプロパティが空でも)
‘Me.Image0.PictureData = CVar(ARY)
‘データベースのフィールドに格納(データ型はOLEオブジェクト型かメモ型で)
Me.ImageData.Value = CVar(ARY)

‘データベースに格納してある状態から表示するには
‘Me.Image0.PictureData = Me.ImageData

これで画像の表示は解決しそうです。
コントロールソースはバイナリフィールドでも表示できれば完璧だったのに。
追記:この表示方法はAccess2007以降の「カレントデータベース」オプションにある「Pictureプロパティの保存形式」を
「もとの画像形式を保持する」にしないとエラーが出ます。(指定したビットマップは、デバイスに依存しないビットマップ(.DIB)ではありません)

自作?クラス2

 スクロールバーの位置を制御するクラスです。
参考URL:http://www.f3.dion.ne.jp/~element/msaccess/AcTipsSyncSubformsScroll.html

スクロールバーを持っているフォームを指定すると、その位置の取得と設定が行えます。

例)
‘縦スクロールバーの場合

Dim Scroll as c_Scroll
Dim VPos as Long

Set Scroll = New c_Scroll
‘スクロールバーがあるフォーム指定
Scroll.SetTarget=Me.テストサブフォーム.Form
‘スクロールバーの位置を保存
VPos = Scroll.VScrollPos
‘——————————-
‘この間の処理でスクロールバーの位置が変更される

‘スクロールバーの位置を保存した時の状態にする
Scroll.VScrollPos = VPos

というような形で使えると思います。
モジュールを試したい方は以下の内容をテキストに貼って、拡張子「cls」で保存してVBEからインポートしてください。
一応頻繁に使いそうな縦スクロールバーの位置取得の「VScrollPos」を規定のメンバにしてあります。
導入は自己責任でお願いします。

メモ:Windows Vista以降ではスクロールバーのクラス名は「NUIScrollBar」でXPは「ScrollBar」となっているらしいがAccess2010の場合はWindow7 と XP は同じ「NUIScrollBar」だった。

Private Type SCROLLINFO
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type
Private Declare Function GetScrollInfo Lib “USER32” _
    (ByVal Hwnd As Long, _
    ByVal n As Long, _
    lpScrollInfo As SCROLLINFO) _
    As Long
Private Declare Function GetWindow Lib “USER32” _
    (ByVal Hwnd As Long, _
    ByVal wCmd As Long) _
    As Long
Private Declare Function GetWindowLong Lib “USER32” _
    Alias “GetWindowLongA” _
    (ByVal Hwnd As Long, _
    ByVal nIndex As Long) _
    As Long
       
Private Declare Function GetClassName Lib “USER32” _
    Alias “GetClassNameA” _
    (ByVal Hwnd As Long, _
    ByVal lpClassname As String, _
    ByVal nMaxCount As Long) _
    As Long
        
Private Declare Function SendMessage Lib “USER32” _
    Alias “SendMessageA” _
    (ByVal Hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long
        
Private Declare Function PostMessage Lib “USER32” _
    Alias “PostMessageA” _
    (ByVal Hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long
   
Private Const MAX_LEN = 255
Private Const GWL_STYLE = (-16)
‘ スクロールバーの種類
Private Const SBS_HORZ = &H0&
Private Const SBS_VERT = &H1&
Private Const SBS_SIZEBOX = &H8&
‘ スクロール情報の各定数
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)
‘ Get
Private Const SB_CTL = 2
‘ スクロールバー関係のウィンドウメッセージ
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
‘ SendMassageAPI用
Private Const SB_THUMBPOSITION = 4
‘ ウィンドウハンドルの取得
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private ScrollForm As Form
Private VScrInfo As SCROLLINFO
Private HScrInfo As SCROLLINFO
Private VScrHwnd As Long
Private HScrHwnd As Long
Private Sub Class_Initialize()
    VScrHwnd = 0
    HScrHwnd = 0
End Sub
Private Sub Class_Terminate()
    Set ScrollForm = Nothing
End Sub
Public Function ScrollReset() As Boolean
    Me.VScrollPos = 1
    Me.HScrollPos = 1
End Function
Public Function MoveUp(Optional Count As Long = 1) As Boolean
    Me.VScrollPos = Me.VScrollPos – Count
End Function
Public Function MoveDown(Optional Count As Long = 1) As Boolean
    Me.VScrollPos = Me.VScrollPos + Count
End Function
Public Function MoveLeft(Optional Count As Long = 1) As Boolean
    Me.HScrollPos = Me.HScrollPos – Count
End Function
Public Function MoveRight(Optional Count As Long = 1) As Boolean
    Me.HScrollPos = Me.HScrollPos + Count
End Function
Public Property Get PageRecordCount()
    Dim Ret As Long
   
    Ret = Me.VScrollPos
    PageRecordCount = VScrInfo.nPage
   
End Property
Public Function SetTarget(ByVal SetForm As Form) As Boolean
    Set ScrollForm = SetForm
   
    VScrHwnd = VScrollBarHwnd
    HScrHwnd = HScrollBarHwnd
End Function
Public Property Get VScrollPos() As Long
‘垂直スクロールバーボタンの位置を取得
‘規定のメンバ
    Dim Ret As Long
    If ScrollForm Is Nothing Then
        Beep
        MsgBox “フォームを指定してください。”, vbInformation, “フォーム未指定”
        VScrollPos = 0
        Exit Property
    ElseIf VScrHwnd = 0 Then
        VScrHwnd = VScrollBarHwnd
       
        If VScrHwnd = 0 Then
            Beep
            MsgBox “垂直スクロールバーがありません。”, vbInformation, “スクロールバー無し”
            VScrollPos = 0
            Exit Property
        End If
    End If
   
    ‘ SCROLLINFO 構造体を初期化します。
    VScrInfo.fMask = SIF_ALL
    VScrInfo.cbSize = Len(VScrInfo)
    VScrInfo.nPos = 0
    VScrInfo.nTrackPos = 0
           
    Ret = GetScrollInfo(VScrHwnd, SB_CTL, VScrInfo)
    ‘ 戻り値をセットします。
    VScrollPos = VScrInfo.nPos + 1
End Property
Public Property Get HScrollPos() As Long
‘水平スクロールバーボタンの位置を取得
    Dim Ret As Long
    If ScrollForm Is Nothing Then
        Beep
        MsgBox “フォームを指定してください。”, vbInformation, “フォーム未指定”
        HScrollPos = 0
        Exit Property
    ElseIf HScrHwnd = 0 Then
        HScrHwnd = HScrollBarHwnd
       
        If HScrHwnd = 0 Then
            Beep
            MsgBox “水平スクロールバーがありません。”, vbInformation, “スクロールバー無し”
            HScrollPos = 0
            Exit Property
        End If
    End If
   
    ‘ SCROLLINFO 構造体を初期化します。
    HScrInfo.fMask = SIF_ALL
    HScrInfo.cbSize = Len(HScrInfo)
    HScrInfo.nPos = 0
    HScrInfo.nTrackPos = 0
   
    Ret = GetScrollInfo(HScrHwnd, SB_CTL, HScrInfo)
           
    ‘ 戻り値をセットします。
    HScrollPos = HScrInfo.nPos + 1
End Property
Public Property Let VScrollPos(SetPos As Long)
    If ScrollForm Is Nothing Then
        Beep
        MsgBox “フォームを指定してください。”, vbInformation, “フォーム未指定”
        Exit Property
    ElseIf VScrHwnd = 0 Then
        VScrHwnd = VScrollBarHwnd
       
        If VScrHwnd = 0 Then
            Beep
            MsgBox “垂直スクロールバーがありません。”, vbInformation, “スクロールバー無し”
            VScrollPos = 0
            Exit Property
        End If
    End If
    Dim lngret As Long
    Dim LngThumb As Long
    LngThumb = CDWord(SB_THUMBPOSITION, SetPos – 1)
       
    lngret = SendMessage(ScrollForm.Hwnd, WM_VSCROLL, ByVal LngThumb, ByVal VScrHwnd)
           
End Property
Public Property Let HScrollPos(SetPos As Long)
    If ScrollForm Is Nothing Then
        Beep
        MsgBox “フォームを指定してください。”, vbInformation, “フォーム未指定”
        Exit Property
    ElseIf HScrHwnd = 0 Then
        HScrHwnd = HScrollBarHwnd
       
        If HScrHwnd = 0 Then
            Beep
            MsgBox “水平スクロールバーがありません。”, vbInformation, “スクロールバー無し”
            HScrollPos = 0
            Exit Property
        End If
    End If
    Dim lngret As Long
    Dim LngThumb As Long
    LngThumb = CDWord(SB_THUMBPOSITION, SetPos – 1)
       
    lngret = SendMessage(ScrollForm.Hwnd, WM_HSCROLL, ByVal LngThumb, ByVal HScrHwnd)
End Property
Private Function CDWord(LoWord As Long, HiWord As Long) As Long
    CDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function
Private Function VScrollBarHwnd() As Long
   
    Dim Hwnd_VSB As Long
    Dim Hwnd As Long
   
    Hwnd_VSB = GetWindow(ScrollForm.Hwnd, GW_CHILD)
               
    Do
        If ClassName(Hwnd_VSB) = “NUIScrollBar” Then
            If GetWindowLong(Hwnd_VSB, GWL_STYLE) And SBS_VERT Then
                VScrollBarHwnd = Hwnd_VSB
                Exit Function
            End If
        End If
   
        Hwnd_VSB = GetWindow(Hwnd_VSB, GW_HWNDNEXT)
   
    Loop While Hwnd_VSB 0
   
    VScrollBarHwnd = -1
End Function
Private Function HScrollBarHwnd() As Long
    Dim Hwnd_VSB As Long
    Dim lngStyle As Long
   
    Hwnd_VSB = GetWindow(ScrollForm.Hwnd, GW_CHILD)
               
    Do
        If ClassName(Hwnd_VSB) = “NUIScrollBar” Then
            lngStyle = GetWindowLong(Hwnd_VSB, GWL_STYLE)
            If (lngStyle And SBS_SIZEBOX) = False Then
                 If (lngStyle And 1) = SBS_HORZ Then
                    HScrollBarHwnd = Hwnd_VSB
                    Exit Function
                End If
            End If
        End If
   
        Hwnd_VSB = GetWindow(Hwnd_VSB, GW_HWNDNEXT)
   
    Loop While Hwnd_VSB 0
   
    HScrollBarHwnd = -1
End Function
Private Function ClassName(Hwnd As Long)
    Dim strBuffer As String
    Dim lngLen As Long
   
    strBuffer = Space$(MAX_LEN)
    lngLen = GetClassName(Hwnd, strBuffer, MAX_LEN)
    If lngLen > 0 Then ClassName = Left(strBuffer, lngLen)
End Function

スクロールイベント

サブフォームコントロールのスクロール時を取れって言われても….
「あれ?とれんかった?」とかちょっとイラッとしますw

参考URL:http://www.f3.dion.ne.jp/~element/msaccess/AcTipsSyncSubformsScroll.html
↑ここのコードはいつも参考にさせてもらってます。

現在のところAccessでは
1.タイマーなどでスクロールバーの前回値を格納して確認
2.サブクラス化でメッセージ(WM_VSCROLL等)を取る
ぐらいしか方法がないように思います。

上記のサンプルで縦スクロールバーと横スクロールバーのハンドルの取得方法がわかりますので
自分で任意に移動はさせられても、移動したことを検知できないです。

せめてクリック時でも起こってくれればマウスポインタからハンドル特定とかできそうなのに
フォームやセクションの「クリック時」「マウスボタンクリック時」などはスクロールバーをクリックしても
サブフォームの「フォーカス取得時」以外なにも起きないです。
もちろんすでにフォーカスがサブフォーム内にあれば「フォーカス取得時」も起きないので…orz
となるとコントロールごとの「フォーカス喪失時」で。でももっとスマートな方法を知ってる人いたら
ぜひ教えてくださいm(_ _)m