fc2ブログ

Notesプログレスバー

前回少し書いたプログレスバーについて。

プログレスバー

昔、ユーザーから「実行してから煙草何本吸ったかわからない」などよく苦情がきましたが(今は全館禁煙)、実際計測すると1本ぐらいでした。ただ待たされる方は、「パソコンが固まったのでは?」「いったいどのくらい進んでいるのかわからない」ではイライラするのは当然。そこでプログレスバー。
先日、しげ氏の「Lotus Notes/Domino備忘録」に載っていたが、私も何年か前にたまたま海外フォーラムで見つけて感動した覚えがあります。Lmbcsを追加すれば日本語表示可は知らなかったので本当にありがたい。やはりニーズあると思うので NEMGetFileやNEMPutFileのようにDominoObjectにして欲しいと思いますが。

ビューにアクションボタンを用意して、下記のサンプルを実行(文書数少ないと一瞬で終わってしまうので)。
Declare Function NEMGetFile Lib "nnotesws.dll" Alias "NEMGetFile" (wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String) As Integer
Declare Function NEMProgressBegin Lib "nnotesws.dll" (Byval wFlags As Integer) As Long
Declare Sub NEMProgressEnd Lib "nnotesws.dll" (Byval hwnd As Long)
Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" (Byval hwnd As Long, Byval dwPos As Long)
Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" (Byval hwnd As Long, Byval dwMax As Long)
Declare Sub NEMProgressSetText Lib "nnotesws.dll" (Byval hwnd As Long, Byval pcszLine1 As Lmbcs String, Byval pcszLine2 As Lmbcs String)

Const NPB_TWOLINE% = 1
Const NPB_ONELINE% = 2

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim View As NotesView
  Dim Collection As NotesViewEntryCollection
  Dim Entry As NotesViewEntry
  Dim hwnd As Long
  Dim StartTime As Single
  Dim i As Long

  Set View = UIWorkspace.CurrentView.View
  Set Collection = View.AllEntries
  StartTime = Timer()
  hwnd = NEMProgressBegin(NPB_TWOLINE)
  NEMProgressSetBarRange hwnd, Collection.Count
  NEMProgressSetText hwnd, "準備中", "しばらくお待ちください。"
  Set Entry = Collection.GetFirstEntry
  While Not Entry Is Nothing
    i = i + 1
    NEMProgressSetBarPos hwnd, i
    NEMProgressSetText hwnd, "読み込み中", Format$(i, "#,##0") & "/" & Format$(Collection.Count, "#,##0") & "文書 " & Format$(Timer - StartTime, "0.00") & "秒経過"
    Set Entry = Collection.GetNextEntry(Entry)
  Wend
  NEMProgressEnd hwnd
End Sub

NEMProgressBeginの引数をNPB_ONELINEにすると下記のプログレスバーになる。
その際、NEMProgressSetTextの引数の数は変わらず、3番目の引数(pcszLine2)が無視される。よって表示したいメッセージは2番目の引数(pcszLine1)に寄せる必要がある。
プログレスバー

ただしBreakキー(Ctrl + Pause)を押された場合、画面のプロテクトがかかったままになってしまいます。是非どなたか教えて頂きたい。この回避方法がわからず、クラス化で逃げました。とは言え、最終的にはクラス化したと思いますが。そのサンプルはこちら。
Declare Function NEMGetFile Lib "nnotesws.dll" Alias "NEMGetFile" (wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String) As Integer
Declare Function NEMProgressBegin Lib "nnotesws.dll" (Byval wFlags As Integer) As Long
Declare Sub NEMProgressEnd Lib "nnotesws.dll" (Byval hwnd As Long)
Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" (Byval hwnd As Long, Byval dwPos As Long)
Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" (Byval hwnd As Long, Byval dwMax As Long)
Declare Sub NEMProgressSetText Lib "nnotesws.dll" (Byval hwnd As Long, Byval pcszLine1 As Lmbcs String, Byval pcszLine2 As Lmbcs String)

Const NPB_TWOLINE% = 1
Const NPB_ONELINE% = 2

Class NotesProgress
  Private hwnd As Long
  Private StartTime As Single
  Private Range As Long
  Private i As Long

  Sub New(Count As Long)
    StartTime = Timer()
    Range = Count
    hwnd = NEMProgressBegin(NPB_TWOLINE)
    NEMProgressSetBarRange hwnd, Range
    NEMProgressSetText hwnd, "準備中", "しばらくお待ちください。"
  End Sub

  Sub Update
    i = i + 1
    NEMProgressSetBarPos hwnd, i
    NEMProgressSetText hwnd, "読み込み中", Format$(i, "#,##0") & "/" & Format$(Range, "#,##0") & "文書 " & Format$(Timer - StartTime, "0.00") & "秒経過"
  End Sub

  Sub Delete
    NEMProgressEnd hwnd
  End Sub
End Class

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim View As NotesView
  Dim Collection As NotesViewEntryCollection
  Dim Entry As NotesViewEntry
  Dim Progress As Variant

  Set View = UIWorkspace.CurrentView.View
  Set Collection = View.AllEntries
  Set Progress = New NotesProgress(Collection.Count)
  Set Entry = Collection.GetFirstEntry
  While Not Entry Is Nothing
    Progress.Update
    Set Entry = Collection.GetNextEntry(Entry)
  Wend
End Sub

ここからクラスの話で、インスタンス化(New)→ 解放(Delete)。
New はよく使いますが、Deleteは「Set NEMProgress = Nothing」など解放時に呼び出されます。明示的に呼び出す場合は「Delete NEMProgress」。サンプルでは明示的に解放していないが、Delete内にPrint文を入れるとスクリプト終了時に実行(=オブジェクト解放)されているのがわかります。

私はよくやってしまいますが、プログレスバーが記述されたプログラムをデバッグするとNotesクライアントを強制終了するしかなくなるので注意を!
スポンサーサイト



テーマ : プログラミング
ジャンル : コンピュータ

NotesUIWorkspace の SaveFileDialog

エクスポートやインポートを自前で用意しなければならない場面が多々あります。ユーザビリティを考慮しなければ簡単に作れますが、少しだけこだわりたい。

例えばエクスポートのファイル名を指定する場面で NotesUIWorkspace の SaveFileDialog を使うところで一工夫。
・ ダイアログを開いた時点のフォルダを、デスクトップやマイドキュメントにする。
・ 今開かれているファイルを選択した場合は、その時点でエラーメッセージを表示する。

プログラムは下記の通り。アクションボタンにコピペして確認を是非!
ファイルオープン時にエラー番号 101 の場合は、ファイルが既に開かれているためメッセージを表示。WShell.SpecialFoldersを使ってデスクトップのパスを取得しています。
* マイドキュメントの場合は、WShell.SpecialFolders("MyDocuments")
Sub Click(Source As Button)
  On Error Goto ErrorHandler

  Dim UIWorkspace As New NotesUIWorkspace
  Dim Session As New NotesSession
  Dim Database As NotesDatabase
  Dim WShell As Variant
  Dim FileName As Variant
  Dim FileNum As Integer

  Set Database = Session.CurrentDatabase
  Set WShell = CreateObject("WScript.Shell")

NormalHandler :

  FileName = UIWorkspace.SaveFileDialog(False, "名前を付けて保存", "テキスト ファイル (*.csv)|*.csv", WShell.SpecialFolders("Desktop"), "temp.csv")
  If Isempty(FileName) Then
    Exit Sub
  Elseif Strconv(Right(FileName(0), 4), 2) <> ".csv" Then
    FileName(0) = FileName(0) & ".csv"
  End If
  FileNum = Freefile
  Open FileName(0) For Output As #FileNum
  Msgbox FileName(0), 0, Database.Title
  Close #FileNum
  Exit Sub

ErrorHandler :

  If Err = 101 Then
    If Msgbox("現在、そのファイルは使用されています。新しいファイル名で保存しますか?", 4 + 32, Database.Title) = 6 Then
      Resume NormalHandler
    End If
  Else
    Msgbox "エラーが発生しました。", 0 + 16, Database.Title
  End If
  Exit Sub
End Sub

下記のプログラムは、処理内容は同じだが On Error ステートメントでエラー番号に従った処理へ振り分ける場合。
Sub Click(Source As Button)
  On Error Goto ErrorHandler
  On Error 101 Goto DialogHandler

  Dim UIWorkspace   As New NotesUIWorkspace
  Dim Session As New NotesSession
  Dim Database As NotesDatabase
  Dim WShell As Variant
  Dim FileName As Variant
  Dim FileNum As Integer

  Set Database = Session.CurrentDatabase
  Set WShell = CreateObject("WScript.Shell")

NormalHandler :

  FileName = UIWorkspace.SaveFileDialog(False, "名前を付けて保存", "テキスト ファイル (*.csv)|*.csv", WShell.SpecialFolders("Desktop"), "temp.csv")
  If Isempty(FileName) Then
    Exit Sub
  Elseif Strconv(Right(FileName(0), 4), 2) <> ".csv" Then
    FileName(0) = FileName(0) & ".csv"
  End If
  FileNum = Freefile
  Open FileName(0) For Output As #FileNum
  Msgbox FileName(0), 0, Database.Title
  Close #FileNum
  Exit Sub

DialogHandler :

  If Msgbox("現在、そのファイルは使用されています。新しいファイル名で保存しますか?", 4 + 32, Database.Title) = 6 Then
    Resume NormalHandler
  End If
  Exit Sub

ErrorHandler :

  Msgbox "エラーが発生しました。", 0 + 16, Database.Title
  Exit Sub
End Sub

この例ではエクスポートのため、書き出し終了(ファイルクローズ後)したところでExcel起動まで記述すれば更にユーザビリティ高いと思います。折角 WScript.Shell を宣言していることだし。
If Msgbox("CSV ファイルを開きますか?", 4 + 32, Database.Title) = 6 Then
  Call WShell.Run("Excel """ & FileName(0) & """")
End If

他には文書数が多い場合にプログレスバーが欲しい。プログレスバーはNotesAPI を使用すれば可能。ニーズは高いと思うので、是非デザイナーのヘルプに載せて欲しいと思うのですが。

テーマ : プログラミング
ジャンル : コンピュータ

プロフィール

ピヨパパ

Author:ピヨパパ
静岡市のエンドユーザーSE。
最近はDominoの開発ばかりでうんざり。
是非気軽にコメントして下さい。

FC2カウンター
最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる