LotusScript で QR コードを作画するこの連載は今回が最終回となります。
DXL がビットマップに対応していないことから、暫定策として GIF ファイルに変換する対応をしました。今回は出来上がった GIF ファイルを文書に貼り付ける部分を作成します。
エージェントの作成と関数の追加
前回作成した CreateQRcode_GIF エージェントをコピペして DrawQRcode を作成します。このエージェントに関数を追加して作業を進めます。
リッチテキストフィールドに QR コードをインラインイメージ（見える状態）で貼り付ける処理には DXL を活用しなければなりません。この連載の本題ではないので詳細は割愛しますが、DXL にご興味がある方は以下の連載をご確認ください（一部関数は連載より流用）。
◇ 文書を DXL に変換
既存文書を DXL で操作できるよう変換処理を行う関数です。
|
Function xGetDOMParser(vnd As NotesDocument) As NotesDOMParser 'Dominoデータ を DXL に変換する準備 Dim dexp As NotesDXLExporter Set dexp = xns.CreateDXLExporter() Call dexp.SetInput(vnd) 'パーサーに変換する DXL をセット Dim dprs As NotesDOMParser Set dprs = xns.CreateDOMParser() Call dprs.SetInput(dexp) 'DXL 変換を実行 Call dexp.Process() Set xGetDOMParser = dprs End Function |
この関数は『DXL Step-by-Step：#3）文書を DXL で取得』で紹介しています。
◇ QR コードの表示
リッチテキスト内に QR コードをインラインイメージで貼り付ける関数です。
引数 vsFld で指定された名前のリッチテキストフィールドにセットするのですが、フィールドをいったん削除しています。フィールド内の既存コンテンツはクリアされますので注意してください。
|
Function xSetDXL_GIF(vdprs As NotesDOMParser, ByVal vsFld As String, ByVal vsFP_GIF As String, viX As Integer, viY As Integer) Dim ddn As NotesDOMDocumentNode Dim den As NotesDOMElementNode Dim denDoc As NotesDOMElementNode Dim denItem As NotesDOMElementNode Dim denRT As NotesDOMElementNode Dim denPar As NotesDOMElementNode Dim denPic As NotesDOMElementNode Dim denGIF As NotesDOMElementNode Dim dtn As NotesDOMTextNode Dim nst As NotesStream Set ddn = vdprs.Document 'document ノード取得 Set denDoc = ddn.DocumentElement '既存フィールドを削除 Call xRemoveItemByName(denDoc, vsFld) 'リッチテキストフィールド作成 Set den = ddn.CreateElementNode("item") Call den.SetAttribute("name", vsFld) Set denItem = denDoc.AppendChild(den) 'リッチテキスト作成 Set den = ddn.CreateElementNode("richtext") Set denRT = denItem.AppendChild(den) '段落定義 id='1' Set den = ddn.CreateElementNode("pardef") Call den.SetAttribute("id", "1") Call denRT.AppendChild(den) '段落の作成 Set den = ddn.CreateElementNode("par") Call den.SetAttribute("def", "1") Set denPar = denRT.AppendChild(den) 'イメージリソースの追加 Set den = ddn.CreateElementNode("picture") Call den.SetAttribute("align", "baseline") Call den.SetAttribute("width", CStr(viX) & "px") Call den.SetAttribute("height", CStr(viY) & "px") Set denPic = denPar.AppendChild(den) '画像の作成 Set den = ddn.CreateElementNode("gif") Set denGIF = denPic.AppendChild(den) 'GIF をストリームで開く Set nst = xns.CreateStream() Call nst.Open(vsFP_GIF, "binary") '画像の中身 Set dtn = ddn.CreateTextNode(StreamToBase64(nst)) Call denGIF.AppendChild(dtn) Call nst.Close() End Function |
この関数については合致する記事はありませんが、インラインイメージの貼り付けについては『DXL Step-by-Step：#41）インラインイメージの貼り付け』で触れています。
また、今回は画像サイズは QR コードのサイズであり、事前にわかっています。そこで、画像ファイルから取得するのではなく、関数の引数で受け取り処理を簡略化しています。
◇ 指定したフィールドの削除
xSetDXL_GIF からコールされているサブ関数で、DXL でフィールドを削除する関数です。
|
Function xRemoveItemByName(vden As NotesDOMElementNode, ByVal vsName As String) Dim dn As NotesDOMNode Dim den As NotesDOMElementNode Dim sName As String Dim s As String sName = LCase(vsName) Set dn = vden.FirstChild Do Until dn.Isnull If dn.NodeType = DOMNODETYPE_ELEMENT_NODE Then If dn.NodeName = "item" Then Set den = dn s = LCase(den.GetAttribute("name")) If sName = s Then Call vden.RemoveChild(den) Exit Function End If End If End If Set dn = dn.NextSibling Loop End Function |
この関数の参考記事は現時点でありません。フィールドである item ノードから名前が一致するものを探し出し削除しています。
◇ 画像のエンコード
こちらも xSetDXL_GIF からコールされているサブ関数です。DXL 内の画像は Base64 でエンコードしておく必要があります。そのエンコード処理を行う関数です。
|
'OpenNTF LotusScript Gold Collection より拝借（StreamToBase64） Function StreamToBase64(streamIn As NotesStream) As String Dim s As String On Error GoTo theOldWay ' ReadEncoded function is not documented. In case it doesn't work have a backup. s = streamIn.ReadEncoded(ENC_BASE64, 76) s = Replace(s, Chr$(13), "") s = Replace(s, Chr$(10), "") StreamToBase64 = s Exit Function theOldWay: Dim session As New NotesSession Dim db As NotesDatabase Dim doc As NotesDocument Dim mime As NotesMIMEEntity Set db = session.CurrentDatabase Set doc = db.CreateDocument Set mime = doc.CreateMIMEEntity("Body") streamIn.Position = 0 Call mime.SetContentFromBytes(streamIn, "image/gif", ENC_NONE) mime.EncodeContent(ENC_BASE64) s = mime.ContentAsText s = Replace(s, Chr$(13), "") s = Replace(s, Chr$(10), "") StreamToBase64 = s End Function |
コメントに記載した通り、 OpenNTF の LotusScript Gold Collection プロジェクトより拝借した関数です。『DXL Step-by-Step：#10）イメージリソースの新規作成』で紹介しています。
◇ 文書の保存
最後の関数は文書を保存する関数です。
|
Function DXL_Import(vdprs As NotesDOMParser, ByVal viOption As Integer, ByVal vbIsDesign As Boolean) As Boolean Dim nst As NotesStream Dim ndb As NotesDatabase Dim dimp As NotesDXLImporter On Error GoTo Err_Proc 'DXL の抽出準備 Set nst = xns.CreateStream() Call vdprs.SetOutput(nst) Call vdprs.Serialize() '保存（インポート） Set ndb = xns.CurrentDatabase Set dimp = xns.CreateDXLImporter() If vbIsDesign = True Then '設計の保存 dimp.DesignImportOption = viOption Else '文書の保存 dimp.DocumentImportOption = viOption End If 'DXL の保存 Call dimp.Import(nst.ReadText(), ndb) DXL_Import = True Exit_Proc: Exit Function Err_Proc: MsgBox Error$, 16, "DXL_Import" DXL_Import = False Resume Exit_Proc End Function |
この関数は『DXL Step-by-Step：#23）サンプルコード（段落と文字の装飾①）』で紹介しています。
メインルーチンの修正
エージェントの Initialize を修正し、今回作成した QR コード表示機能を追加します。
|
Sub Initialize ・・・ Dim iX As Integer '画像の幅 Dim iY As Integer '画像の高さ Dim dprs As NotesDOMParser ・・・ '② GIF ファイルの作成 Call DrawQR_GIF(abQR, "c:\tmp\QR.gif") '③ リッチテキストにインラインで貼り付け Set dprs = xGetDOMParser(nd) iX = UBound(abQR, 1) + 1 '画像の幅 iY = UBound(abQR, 2) + 1 '画像の高さ Call xSetDXL_GIF(dprs, "QRcode", "c:\tmp\QR.gif", iX, iY) Call DXL_Import(dprs, 5, False) '文書を更新 End If End Sub |
ビューの修正と動作検証
エージェントが完成したら、アクションボタンをビューに追加します。
ビューを保存後、動作検証します。正常に実行されると冒頭の画像のように QR コードが表示されます。
まとめ
今回の連載は、LotusScript だけを使って QR コードをビットマップ画像として描画する方法について解説しました。あわせて、ビットマップ画像のフォーマット仕様についても整理し、仕組みを理解しながら作り上げる流れをご紹介しました。
本来であれば、できる限り幅広い環境で動作させるために LotusScript だけで完結させることを目指していましたが、現状の DXL ではビットマップに対応していないため、最終的な GIF 変換には Windows の機能に頼らざるを得ない部分がありました。その結果、完全に LotusScript だけで完結する構成にはできなかった点は少し心残りです。
機会があれば GIF フォーマットのファイルを LotusScript で生成することにも挑戦してみたいと思います。仕様が理解できたらという制約はありますが...
| 前回 | QR コードの作画 |
0 件のコメント:
コメントを投稿