MukkuMuku備忘: 2011/02

2011/02/26

access2010 SQL Azure その3

Microsoft Access and SQL Azure Information Center for Developers
んー、こんなものがあったのね。
さっそく試してみた。思いのほかレスポンスがいいなという感想。

SQL Azureとクライアント間はセキュリティ接続だっけか？が必須だからman in the middleはないだろうということと、Azure側でのIPフィルタリングとか施すんだろうな、たぶん。

2011/02/22

PCの消費電力はどんだけだ。鼻毛鯖ってよ。

自宅の引越を機会にワットチェッカーなるものを買ってみた。だって新居が20Aっていうんだもの。30Aの契約に変えましたけど。
買ってから動作テストしかしてなかったいわゆる鼻毛鯖をi7-860に換装しまして、VGAはHD5750を追加/メモリは2Gを4枚/intelなSSDを2枚/日立1TなHDDを1枚てな構成。モニタU2410を2枚を含めて確認。
何もしてないときであれば200W程度だった。エンコードなどさせたときは300W。ゲームなどはしないから鼻毛鯖の電源でもよさそうだったけど、結局650W電源に換装。モニタの明るさはかなり落としてるからモニタ分の消費電力は低く抑えられていると思う。

DDR3-4Gって安くなってるし、今思うとタイプSDをお嫁に出して鼻毛をもう一台買っておくべきだったな。チップセットの一件が落ち着いたらSDを改造しちゃうか。

2011/02/15

access2010 不具合いろいろ

久しぶりにKBを覗いてみた。だらだらと。

2011/02/14

access2010 Kiosk Form

Option Compare Database
Option Explicit

Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SW_SHOW = 5
Public Const SW_HIDE = 0
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_SHOWWINDOW = &H40
Public Const SW_MAXIMIZE = 3

Declare PtrSafe Function SetWindowPos Lib "user32" _
                            (ByVal Hwnd As LongPtr, _
                             ByVal hWndInsertAfter As LongPtr, _
                             ByVal x As Long, _
                             ByVal y As Long, _
                             ByVal cx As Long, _
                             ByVal cy As Long, _
                             ByVal wFlags As Long _
                             ) As Long
 
Declare PtrSafe Function ShowWindow Lib "user32" _
                                (ByVal Hwnd As LongPtr, _
                                 ByVal nCmdShow As Long _
                                ) As Long

Option Compare Database
Option Explicit
'境界線スタイル：なし、スクロールバーとかは非表示にしておく
Private Sub Form_Close()
    ShowWindow Application.hWndAccessApp, SW_SHOW
End Sub

Private Sub Form_Load()
    If Not Me.PopUp Then Exit Sub
    ShowWindow Application.hWndAccessApp, SW_HIDE
    ShowWindow Me.Hwnd, SW_MAXIMIZE
End Sub

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

Private Sub コマンド2_Click()
    DoCmd.OpenForm "フォーム2"
End Sub

Private Sub Form_Load()
    If Not Me.PopUp Then Exit Sub

    SetWindowPos Me.Hwnd, HWND_TOPMOST, 0, 0, _
                 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW
End Sub

これでいいか？なんの考慮もしてない。Alt+Tabなど抑制はしない。これ以降はお好みでどうぞ。なんの考えもなくコード書くもんじゃないと悟った夜。

access2010 IAccessible.accStateプロパティ(oleacc)

accStateプロパティを参照して、リボンが最小化されているか調べる。
また、リボンの最小化を実行する。

Option Compare Database
Option Explicit

Const CHILDID_SELF = 0&
Const OBJID_CLIENT = &HFFFFFFFC
Const ROLE_SYSTEM_PUSHBUTTON = &H2B

Declare PtrSafe Function AccessibleChildren Lib "oleacc" ( _
                                ByVal paccContainer As IAccessible, _
                                ByVal iChildStart As Long, _
                                ByVal cChildren As Long, _
                                ByRef rgvarChildren As Any, _
                                ByRef pcObtained As Long _
                                ) As Long

Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                ByVal hWnd As LongPtr, _
                                ByVal dwId As Long, _
                                riid As Any, _
                                ByRef ppvObject As IAccessible _
                                ) As Long

Declare PtrSafe Function IIDFromString Lib "ole32" ( _
                                ByVal lpsz As LongPtr, _
                                lpiid As Any _
                                ) As Long
 
Declare PtrSafe Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As LongPtr, _
                                ByVal hWnd2 As LongPtr, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As LongPtr

'リボンが最小化されているかどうか
Function IsRibbonMinimize() As Boolean
    Dim IID(0 To 3) As Long, acc As IAccessible, targetAcc As IAccessible
    
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), _
                  IID(0)
    AccessibleObjectFromWindow getHwnd, _
                               OBJID_CLIENT, _
                               IID(0), _
                               acc
    Set targetAcc = GetAcc(acc, "リボンの最小化", ROLE_SYSTEM_PUSHBUTTON)
    
    Select Case targetAcc.accState(CHILDID_SELF)
        Case 1048576
            IsRibbonMinimize = False
        Case 1048584
            IsRibbonMinimize = True
    End Select
End Function

'リボンを最小化する
Sub RibbonMinimize()
    Dim IID(0 To 3) As Long, acc As IAccessible, targetAcc As IAccessible
    
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), _
                  IID(0)
    AccessibleObjectFromWindow getHwnd, _
                               OBJID_CLIENT, _
                               IID(0), _
                               acc
    Set targetAcc = GetAcc(acc, "リボンの最小化", ROLE_SYSTEM_PUSHBUTTON)
    
    If targetAcc.accState(CHILDID_SELF) = 1048576 Then
        targetAcc.accDoDefaultAction CHILDID_SELF
    End If
End Sub

Function getHwnd() As LongPtr
    Dim pHwnd As LongPtr
    pHwnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
    pHwnd = FindWindowEx(pHwnd, 0, "MsoCommandBar", "Ribbon")
    pHwnd = FindWindowEx(pHwnd, 0, "MsoWorkPane", "Ribbon")
    pHwnd = FindWindowEx(pHwnd, 0, "NUIPane", "")
    pHwnd = FindWindowEx(pHwnd, 0, "NetUIHWND", "")
    getHwnd = pHwnd
End Function

'**** 引用 http://www.ka-net.org/ ****
Function GetAcc(myAcc As IAccessible, _
                        myAccName As String, _
                        myAccRole As Long _
                        ) As IAccessible
  Dim ReturnAcc As IAccessible
  Dim ChildAcc As IAccessible
  Dim List() As Variant
  Dim Count As Long
  Dim i As Long
    
  If (myAcc.accState(CHILDID_SELF) <> 32769) And _
     (myAcc.accName(CHILDID_SELF) = myAccName) And _
     (myAcc.accRole(CHILDID_SELF) = myAccRole) Then
    Set ReturnAcc = myAcc
  Else
    Count = myAcc.accChildCount
    If Count > 0& Then
      ReDim List(Count - 1&)
      If AccessibleChildren(myAcc, 0&, ByVal Count, List(0), Count) = 0& Then
        For i = LBound(List) To UBound(List)
          If TypeOf List(i) Is IAccessible Then
            Set ChildAcc = List(i)
            Set ReturnAcc = GetAcc(ChildAcc, myAccName, myAccRole)
            If Not ReturnAcc Is Nothing Then Exit For
          End If
        Next
      End If
    End If
  End If
  Set GetAcc = ReturnAcc
End Function

access2010 IAccessible.accLocationメソッド(oleacc)

Option Compare Database
Option Explicit

Const CHILDID_SELF = 0&

Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                ByVal hWnd As LongPtr, _
                                ByVal dwId As Long, _
                                riid As Any, _
                                ByRef ppvObject As IAccessible _
                                ) As Long

Declare PtrSafe Function IIDFromString Lib "ole32" ( _
                                ByVal lpsz As LongPtr, _
                                lpiid As Any _
                                ) As Long

Declare PtrSafe Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As LongPtr, _
                                ByVal hWnd2 As LongPtr, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As LongPtr

Function ODocTabsHwnd() As LongPtr
    Dim pHwnd As LongPtr
    pHwnd = FindWindowEx(Application.hWndAccessApp, _
                         0, _
                         vbNullString, _
                         "ODocTabs")
    pHwnd = FindWindowEx(pHwnd, _
                         0, _
                         "NetUIHWND", _
                         vbNullString)
    ODocTabsHwnd = pHwnd
End Function

Sub DocumentTabsPos()
    Dim IID(0 To 3) As Long, acc As IAccessible
    Dim xLeft As Long, yTop As Long, _
        xWidth As Long, yHeight As Long
    
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), _
                  IID(0)
    AccessibleObjectFromWindow ODocTabsHwnd, _
                               CHILDID_SELF, _
                               IID(0), _
                               acc
    acc.accLocation xLeft, yTop, xWidth, yHeight
    Debug.Print xLeft, yTop, xWidth, yHeight
End Sub

2011/02/11

access2010 “閉じる”をできるだけ検知

閉じるということをできるだけ検知してみようとしている。
基本的にフォームだけなのだけど、PopUpの時もしくはカスケード表示の時のフォーム上のシステムメニュー(っていうでしたっけ、フォームアイコン右クリメニュー)は検知できていない。
以下コードは64bit用。

2011/02/10

access2010 access2007 更新前処理イベント内で閉じるボタンのクリックを判定する方法

YU-TANGさんところの
更新前処理イベント内で閉じるボタンのクリックを判定する方法
をaccess2010でやってみた。
タブ付きドキュメントである場合の件。とりあえず動作することは確認できた。

Option Compare Database
Option Explicit

'*************************
'参照設定
'oleacc.dll
'*************************

Const ROLE_SYSTEM_LIST = &H21
Const ROLE_SYSTEM_PUSHBUTTON = &H2B
Const ROLE_SYSTEM_BUTTONMENU = &H39
Const ROLE_SYSTEM_PROPERTYPAGE = &H26
Const ROLE_SYSTEM_MENUITEM = &HC
Const ROLE_SYSTEM_CLIENT = &HA

Private IsRibbonAction As Boolean

Type POINTAPI
        X As Long
        Y As Long
End Type
 
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
                                Alias "RtlMoveMemory" ( _
                                Destination As Any, _
                                Source As Any, _
                                ByVal Length As LongPtr)
                                 
Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                lpPoint As POINTAPI _
                                ) As Long
#If Win64 Then
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" ( _
                                ByVal llXY As LongLong, _
                                ByRef ppvObject As Any, _
                                ByRef pvarChild As Variant _
                                ) As Long
 
Private Function PointToLongLong(point As POINTAPI) As LongLong
    Dim ll As LongLong, cbLongLong As LongPtr
    cbLongLong = LenB(ll)
    If LenB(point) = cbLongLong Then
        CopyMemory ll, point, cbLongLong
    End If
    PointToLongLong = ll
End Function
#Else
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" ( _
                                ByVal xScreen As Long, _
                                ByVal yScreen As Long, _
                                ByRef ppvObject As Any, _
                                ByRef pvarChild As Variant _
                                ) As Long
#End If
#Else
Private Declare Function GetCursorPos Lib "user32" ( _
                                lpPoint As POINTAPI _
                                ) As Long
 
Private Declare Function AccessibleObjectFromPoint Lib "oleacc" ( _
                                ByVal xScreen As Long, _
                                ByVal yScreen As Long, _
                                ByRef ppvObject As Any, _
                                ByRef pvarChild As Variant _
                                ) As Long
#End If
 
Function IsCloseButtonClicked() As Boolean
    Dim xy As POINTAPI, acc As IAccessible
    Dim Child As Variant, btnName As String, tabCaption As String
    
    If IsRibbonAction Then
        IsCloseButtonClicked = True
        IsRibbonAction = False
        Exit Function
    End If
    
    GetCursorPos xy
 
#If Win64 Then
    AccessibleObjectFromPoint PointToLongLong(xy), acc, Child
#Else
    AccessibleObjectFromPoint xy.X, xy.Y, acc, Child
#End If
 
    If acc Is Nothing Then
        IsCloseButtonClicked = False
        Exit Function
    End If
 
    btnName = acc.accName(Child)
 
    tabCaption = CodeContextObject.Caption
    If tabCaption = "" Then
        tabCaption = CodeContextObject.Name
    End If

    Select Case acc.accRole(Child)
        Case ROLE_SYSTEM_LIST
            MsgBox "タスクバー:すべてのウィンドウを閉じる" & _
                    vbCrLf & btnName
        Case ROLE_SYSTEM_PUSHBUTTON
            If InStr(1, btnName, "を閉じる") > 1 Then
                MsgBox "フォーム閉じるボタン" & _
                        vbCrLf & btnName
            Else
                MsgBox "Application閉じるボタン" & _
                        vbCrLf & btnName
            End If
        Case ROLE_SYSTEM_BUTTONMENU
            MsgBox "システムメニュー:閉じる" & _
                    vbCrLf & btnName
        Case ROLE_SYSTEM_MENUITEM
            MsgBox "フォームアイコンダブルクリック" & _
                    vbCrLf & btnName
        Case ROLE_SYSTEM_PROPERTYPAGE
            '結果的にこうなる
            MsgBox "Applicationアイコンダブルクリック" & _
                    vbCrLf & btnName
        Case Else
            MsgBox "不明 もしくは、Backstageのコマンド" & _
                    vbCrLf & btnName
    End Select
    IsCloseButtonClicked = True
End Function

'RibbonXmlで検知:フォームが開いていること前提
Sub onActionClose(ctr As Object, CancelDefault)
    If Screen.ActiveForm.Dirty Then
        MsgBox "RibbonXmlで管理できるコマンド:" & ctr.ID
        IsRibbonAction = True
    End If
    CancelDefault = False
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <commands>
    <command idMso="WindowClose" onAction="onActionClose" />
    <command idMso="CloseDocument" onAction="onActionClose" />
    <command idMso="FileCloseDatabase" onAction="onActionClose" />
    <command idMso="FileExit" onAction="onActionClose" />
  </commands>
</customUI>

a2007でも動作するけどOfficeメニューから閉じる動作については対応は今のところ放置。同様に、BackStageから閉じる場合も反応できない。この辺はリボンカスタマイズでなんとかなるかな。タスクバーから閉じる場合もダメなんす。 a2010Runtimeだけシステムメニューから閉じるの場合反応なし。a2010（x64）についてはからっきし動作しない。調査してみるけど、これは俺には無理かも。AccessibleObjectFromPoint にXYをどのように渡すかだろうか。

64bitも動作するようになった。座標をLongLongで渡して成功。そして、デレクティブ。
でも、考えないといけないこと、たくさんあるな。どうしようかな。いずれにせよ、とりあえず。

いろいろ継ぎはぎしてみてBackstageとかOfficemenuもRibbonXmlで一応握ってみたと。
んー、やっぱりとりあえずレベル。たまに失敗している気配はしている。検証甘いから、何も考えずに実装するするにはちょっと心もとない。Accessibleを使うっつーところだけがポイントだろうか。

access2010 Undoメソッド/Undoイベント　NavigationControl

Use code to "undo" things in Access
こんな時にUndoですよって話だと思うんだけど、何故、移動コントロール(NavigationControl)もあるのって思う。まぁどうでもいい話だけど。
NavigationControlのメンバーにValueとかもあるんだけど使えるわけもなく、なんだかなぁ。
イベントも各種あるけど使いどころがわからないという。強制終了とか起きちゃうし。

ふと、１つのフォーム上にNavigationControlが複数存在させ、各々が個々に関連するサブフォームをもつナビゲーションフォームをコネタで試してみた。
できた。けど、BrowseTo使った時点でクラッシュした。独立したナビゲーションフォームはフォーム上にひとつしか存在できないことが前提に作られているようだ。無理ですよっていうチラシの裏。

2011/02/03

access2010 レポート/セクションのプロパティ

その1 セクション改ページ/ForceNewPageプロパティ
以前のバージョンと挙動が違うのが１件

ACCESS 2010: Extra report page prints when Group Footer set to After Section

その2 レポート PageHeader/PageFooter/Picture/PictureAlignment/PicturePages/PictureTiling

2011/02/01

access2010 access2007 イメージコントロールのコントロールソースプロパティ

そう言われればそうねって感じだったのだけれども、

メンバにいないのね

ImageControl.Properties("ControlSource") ってことね

登録: 投稿 (Atom)

MukkuMuku備忘