REM  *****  BASIC  *****
REM
REM アルバム作成マクロ
REM
REM LibreOffice Writer 4.2.4.2 で動作確認

OPTION EXPLICIT

Public oDialog as Object
Public oListBox as Object
Public oField1 as Object
Public oField2 as Object
Public oField3 as Object
Public oField4 as Object
 
Sub Main

	' 表示するダイアログを指定
	DialogLibraries.LoadLibrary("Standard")
	oDialog = CreateUnoDialog(DialogLibraries.Standard.MakeAlbumDialog)
	
	oListBox = oDialog.getControl("ListBox1")
	oField1 = oDialog.getControl("Field1")
	oField2 = oDialog.getControl("Field2")
	oField3 = oDialog.getControl("Field3")
	oField4 = oDialog.getControl("Field4")
	
	' ダイアログを表示
	If oDialog.execute() = 1 Then
		' OKボタンが押された
		
		Dim itemSize as Integer
		
		itemSize = oListBox.getItemCount()	' リストボックス項目数を取得
		If itemSize > 0 Then
			Dim oDoc as Object
		  	Dim oTbl as Object
		  	Dim oUndoMng as Object
		  	
			oDoc = ThisComponent
			
			' Undo制御
			oUndoMng = oDoc.getUndoManager()
			
			' undo コンテキストの開始
			oUndoMng.enterUndoContext("Undo Make Album Macro")

			' 表を新規作成
			MakeNewtable(GetTableColSize(), itemSize, GetTableMargin())
			
			oTbl = GetTable
			If IsEmpty(oTbl) Then
				MsgBox "表が見つかりません"
			Else
				' 表内に要素を挿入
				AccessRowColumns(oTbl, GetImageTargetSize())
			End If
			
			' undo コンテキストを終了
			oUndoMng.leaveUndoContext()
		End If
	Else
		' Cancelボタンが押された
		Exit Sub
	End If
	
End Sub

' 表の列数を取得
Function GetTableColSize
	GetTableColSize = CInt(oField1.getText())
End Function

' 画像目標サイズを取得
Function GetImageTargetSize
	GetImageTargetSize = CInt(oField2.getText())
End Function

' 表の左右マージン値を取得
Function GetTableMargin
	GetTableMargin = CInt(oField3.getText())
End Function

' 画像の左右マージン値を取得
Function GetImageMargin
	GetImageMargin = CInt(oField4.getText())
End Function

' ----------------------------------------
' ファイル選択ダイアログを開く

Sub SelectFile
	Dim f as Object
	
	f = createUnoService("com.sun.star.ui.dialogs.FilePicker")
	f.initialize( Array(com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE))
	
	' ファイルの複数選択を可能にする
	f.setMultiSelectionMode(True)
	
	' 表示フィルタを追加
 	f.appendFilter("All Files (*.*)", "*.*")
	f.appendFilter("Image File", "*.bmp;*.jpg;*.gif;*.png")
	f.setCurrentFilter("Image File")	' デフォルトフィルタを指定
	
	If f.execute() = 1 Then
		' 選択された
		Dim sz as Integer
		Dim i as Integer
		Dim sFilePath as String
		
		sz = Ubound(f.selectedFiles())
		
		For i = 0 To sz
			Dim nCnt as Integer
			
			' sFilePath = ConvertFromURL(f.selectedFiles(i)) 
			sFilePath = f.selectedFiles(i)
			
			' リストボックスに追加
			nCnt = oListBox.getItemCount()
			oListBox.addItem(sFilePath, nCnt)
		Next i
	End If
		
End Sub

' ----------------------------------------
' 1セルの幅を大雑把に取得

Sub CalcImageSize
	Dim pw as Long
	Dim cols as Integer
	Dim iw as Long
	
	' ページ横幅を取得
	pw = GetPagePrintWidth()
	
	' 表の左右マージン分を減らす
	pw = pw - (GetTableMargin() * 2)
	
	' 表の列数を取得
	cols = CInt(oField1.getText())

	' 列数で割る
	iw = pw / cols
	
	' 画像の左右マージン分を減らす
	iw = iw - (GetImageMargin() * 2)

	' 画像サイズ指定用 InputBox に代入
	oField2.setText(CStr(iw))
End Sub

' ----------------------------------------
' 最後に挿入した表を取得

Function GetTable
	Dim oDoc as Object
	Dim oTbls as Object
	
	oDoc = ThisComponent
	oTbls = oDoc.TextTables
	If oTbls.hasElements = False Then
		' 表が無い
		GetTable = Empty
	Else
		' 1つ目の表オブジェクトを取得する場合
		' oTbl = oTbls.getByIndex(0)
		
		' 最後に挿入した表を取得する場合
		GetTable = oTbls.getByIndex(oTbls.getCount() -1)
	End If
End Function

' ----------------------------------------
' 表を新規作成
'
Sub MakeNewTable(iCols as Integer, iCellMax as Integer, margin as Integer)
	Dim oDoc as Object
	Dim iRows as Integer
  	Dim oTbl as Object
  	Dim oCurs as Object
	
	' 文書を新規作成する場合
	' Dim Dummy()
	' oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	
	' 現在開いてる文書を対象にする場合
	oDoc = ThisComponent

	' 行数を算出	
	iRows = iCellMax / iCols
	If iCellMax - (iRows * iCols) > 0 Then iRows = iRows + 1
	iRows = iRows * 2

	' 表オブジェクトを作成
	oTbl = oDoc.createInstance("com.sun.star.text.TextTable")
	oTbl.setName("AlbumTable")
	oTbl.initialize(iRows, iCols)

	' サイズを指定
	oTbl.HoriOrient = 0 ' com.sun.star.text.HoriOrientation.NONE
	oTbl.LeftMargin = margin
	oTbl.RightMargin = margin
	
	' 文書の最終位置に表オブジェクトを挿入
	oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTbl, False)
	
	' 枠線を設定
	' SetTableBorder(oTbl)
End Sub

' ----------------------------------------
' 表の枠線設定を変更する
'
Sub SetTableBorder(oTbl)
	Dim border as Object
	
	border = oTbl.TableBorder
	border.TopLine.OuterLineWidth = 0
	border.BottomLine.OuterLineWidth = 0
	oTbl.TableBorder = border
End Sub

' ----------------------------------------
' 行と列にアクセスする
'
Sub AccessRowColumns(oTbl as Object, iw as Long)
	Dim ridx as Integer
	Dim cidx as Integer
	Dim rcnt as Integer
	Dim ccnt as Integer

	Dim i as Integer
	i = 0

	rcnt = oTbl.getRows.getCount()		' 行数
	ccnt = oTbl.getColumns.getCount()	' 列数

	For ridx = 1 to rcnt
		For cidx = 1 to ccnt
		
			Dim cellname as String
			Dim cell as Object
			
			cellname = Chr(64 + cidx) & ridx	' "A1" "B2" 等のセル名を生成
			cell = oTbl.getCellByName(cellname)	' セルにアクセス
			
			If ridx mod 2 = 0 Then
				' 作者名等記入欄
				
				' セル内を縦方向で上揃えにする
				cell.VertOrient = com.sun.star.text.VertOrientation.TOP
			Else
				' 画像欄
				
				If i < oListBox.getItemCount() Then
					
					' 画像ファイル名をリストボックス内から取得
					Dim sUrl as String
					oListBox.selectItemPos(i, True)
					sUrl = oListBox.getSelectedItem()
		
					' セル内容を変更する例。行:列を挿入
					' cell.string = CStr(ridx) & " : " & CStr(cidx)
					
					' 画像を挿入
					InsertTextGraphic(oTbl, cidx - 1, ridx - 1, sUrl, iw)
					
					i = i + 1
				End If
				
				' セル内を縦方向でセンタリング
				cell.VertOrient = com.sun.star.text.VertOrientation.CENTER
			End If
			
			' セル内を横方向でセンタリング
			cell.createTextCursor().paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
		Next
	Next
End Sub

' ----------------------------------------
' 画像を挿入

Sub InsertTextGraphic(oTbl, col, row, sUrl, iTargetSize)
	Dim oDoc as Object
	Dim dispather as Object
	Dim oText as Object
	Dim oViewCursor as Object
	Dim aSize
	Dim aArgs(0) As New com.sun.star.beans.PropertyValue
	Dim oGp as Object
	Dim oImage as Object
	Dim oTxtGrp as Object
	
	oDoc = ThisComponent
	oViewCursor = oDoc.getCurrentController().getViewCursor()
	
	oGp = CreateUnoService("com.sun.star.graphic.GraphicProvider")
	
	aArgs(0).Name = "URL"
	aArgs(0).Value = sUrl
	oImage = oGp.queryGraphic(aArgs)
	oTxtGrp = oDoc.createInstance("com.sun.star.text.TextGraphicObject")
	oTxtGrp.Graphic = oImage
	aSize = oImage.Size
	' Print aSize.Width & " x " & aSize.Height

	Dim fScale as Double
	If aSize.Width > aSize.Height Then
		fScale = CDbl(iTargetSize) / aSize.Width
	Else
		fScale = CDbl(iTargetSize) / aSize.Height
	End If
	aSize.Width = CLng(aSize.Width * fScale)
	aSize.Height = CLng(aSize.Height * fScale)
	
	With oTxtGrp
		.setSize(aSize)
	 	.VertOrient = com.sun.star.text.VertOrientation.CENTER
	    .HoriOrient = com.sun.star.text.HoriOrientation.CENTER
	    ' .VertOrientRelation = com.sun.star.text.RelOrientation.PAGE_PRINT_AREA
	    ' .HoriOrientRelation = com.sun.star.text.RelOrientation.PAGE_PRINT_AREA
	    ' .Surround = com.sun.star.text.WrapTextMode.THROUGHT
	    
		' 画像を文字として挿入
		.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
	End With
	
	Dim oCell as Object
	oCell = oTbl.getCellByPosition(col, row) ' 列、行で指定
   	' oDoc.getCurrentController().select(oCell)
   	
	oCell.getText.insertTextContent(oCell, oTxtGrp, True)
End Sub

' 画像挿入のテスト
Sub InsertTextGraphicTest
	Dim oTbl as Object
	Dim sUrl as String
	Dim fScale as Single
	sUrl = "file:///C:/home/Pictures/pub_pictures/pcd01.jpg"
	fScale = 2540.0 / 3
	oTbl = GetTable
	InsertTextGraphic(oTbl, 0, 0, sUrl, fScale)
End Sub

' ----------------------------------------
' 表内のカーソル位置を取得、その1

Sub GetPosInTable
	Dim oDoc as Object
	Dim oTbl as Object
	Dim oVCur as Object
	Dim oCurCell as Object
	Dim oDisp as String
	
	oDoc = ThisComponent
	oVCur = oDoc.getCurrentController().getViewCursor()
	If IsEmpty(oVCur.TextTable) Then
		Print "The cursor is NOT in a table"
	Else
		oTbl = oVCur.TextTable
		oDisp = "The cursor is in cell " & oVCur.Cell.CellName
		Msgbox(oDisp, 0, "Curor Position in Table")
	End If
End Sub

Function InTable
	Dim oDoc as Object
	Dim oVCur as Object
	
	oDoc = ThisComponent
	oVCur = oDoc.getCurrentController().getViewCursor()
	If IsEmpty(oVCur.TextTable) Then
		CheckPosInTable = Empty
	Else
		CheckPosInTable = oVCur.Cell
	End If
End Function

' ----------------------------------------
' 表内に画像を文字として挿入してみる例

Sub InsertGraphicToTbl
	Dim oDoc as Object
	Dim oTbl as Object
	Dim oImage as Object
	Dim oCell as Object
	Dim sUrl as String
	
	sUrl = "file:///C:/home/Pictures/pub_pictures/pcd02.jpg"
	oDoc = ThisComponent
	oTbl = GetTable
	oImage = oDoc.createInstance("com.sun.star.text.GraphicObject")
	oImage.GraphicURL = sUrl
	oImage.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
	oImage.Width = 3000
	oImage.Height = 3000
	
	oCell = oTbl.getCellByPosition(0,0)
	oCell.getText.insertTextContent( oCell, oImage, False )
End Sub

' ----------------------------------------
' 画像をリンク形式で挿入する例

Sub InsertTextGraphicLink(sUrl as String, enableChara as Boolean)
	Dim oDoc as Object
	Dim oViewCursor as Object
	Dim oImage as Object
	Dim aSize As New com.sun.star.awt.Size
	
	oDoc = ThisComponent
	oViewCursor = oDoc.getCurrentController().getViewCursor()
	aSize.Width = 2000
	aSize.Height = 2000
	oImage = oDoc.createInstance("com.sun.star.text.TextGraphicObject")
	oImage.GraphicURL = sUrl
	oImage.Size = aSize
	
	If enableChara Then
		' 画像を文字として挿入
		oImage.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
	End If
	
	' 表内には挿入できない
	oDoc.Text.insertTextContent(oViewCursor, oImage, False)
End Sub

Sub InsertTextGraphicLinkTest
	InsertTextGraphicLink("file:///C:/home/Pictures/pub_pictures/pcd03.jpg", True)
End Sub

' ----------------------------------------
' 画像のサイズを取得
'
' OOoBasic/Generic/Image - ...?
' http://hermione.s41.xrea.com/pukiwiki/index.php?OOoBasic%2FGeneric%2FImage

Function GetImageSize(sUrl)
	Dim oGP as Object
	Dim oSFA as Object
	Dim oImgInput as Object
	Dim oGraphic as Object
	Dim aSizePixel as Object
	Dim aSize(2) as Integer
	
	oGP = CreateUnoService("com.sun.star.graphic.GraphicProvider")
	oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
	oImgInput = oSFA.openFileRead(sUrl)
	
	Dim aImgDesc(0) As New com.sun.star.beans.PropertyValue
	aImgDesc(0).Name = "InputStream"
	aImgDesc(0).Value = oImgInput
	oGraphic = oGP.queryGraphic(aImgDesc)
	aSizePixel = oGraphic.SizePixel

	aSize(0) = aSizePixel.Width
	aSize(1) = aSizePixel.Height
	oImgInput.closeInput()
	GetImageSize = aSize
End Function

Sub GetImageSizeTest
	Dim ret(2) as Integer
	ret = GetImageSize("file://C:/home/Pictures/pub_pictures/pcd09.jpg")
	msgbox "Width x height = " & CStr(ret(0)) & " x " & CStr(ret(1))
End Sub

' ----------------------------------------
' 表の幅を取得してみるテスト
'
' 表を新規作成した場合、巨大な値しか返ってこない…

Sub GetCellSize
	Dim oDoc as Object
	Dim oTbl as Object
	Dim csize as Integer
	Dim w as Integer
	Dim tw as Long
	Dim margin as Long

	margin = 100
	
	oDoc = ThisComponent
	oTbl = GetTable
	
	' print oTbl.TableColumnRelativeSum
	
	If False Then
		' 表の幅を、左マージン・右マージン指定により設定し直す
		oTbl.HoriOrient = com.sun.star.text.HoriOrientation.NONE
		oTbl.LeftMargin = margin
		oTbl.RightMargin = margin
	End If

	' 列数を取得
	csize = oTbl.getColumns.getCount()

	' 表の幅を取得
	tw = oTbl.Width
	' tw = oTbl.RelativeWidth

	Dim oTblColSeps
	oTblColSeps = oTbl.TableColumnSeparators 
	' print "ColumnSeparators (1) = " & oTblColSeps(1).Position

	w = tw / csize - 400
	print "Table Width = " & tw & "  cell w = " & w
	
End Sub

' ----------------------------------------
' ページの印刷可能範囲の横幅を取得

Function GetPagePrintWidth
	Dim oDoc As Object
	Dim oStyleFamilies As Object
	Dim oPageStyles As Object
	Dim oPageStyle As Object
	Dim pagePrintWidth as Long
	
	oDoc = ThisComponent
	oStyleFamilies = oDoc.StyleFamilies
	oPageStyles = oStyleFamilies.getByName("PageStyles")
	oPageStyle = oPageStyles.getByName("Standard")
	
	pagePrintWidth = oPageStyle.Width - oPageStyle.LeftMargin - oPageStyle.RightMargin
	
	' print pagePrintWidth
	
	GetPagePrintWidth = pagePrintWidth
End Function

' ----------------------------------------
' ページスタイルを取得してみるテスト

Sub pagestylescontainer_elements
	Dim oDoc As Object
	Dim oStyleFamilies As Object
	Dim oPageStyles As Object
	Dim oPageStyle As Object
	Dim aStyleNames() As String
	Dim i As Integer
	Dim str as String
	Dim pagePrintWidth as Long
	
	oDoc = ThisComponent
	oStyleFamilies = oDoc.StyleFamilies
	oPageStyles = oStyleFamilies.getByName("PageStyles")
	aStyleNames() = oPageStyles.getElementNames()

	str = ""
	For i = 0 To UBound(aStyleNames())
		str = str & aStyleNames(i) & Chr(10)
	Next i
	MsgBox str
	
	oPageStyle = oPageStyles.getByName("Standard")
	print "page width = " & oPageStyle.Width
	print "page left  margin = " & oPageStyle.LeftMargin
	print "page right margin = " & oPageStyle.RightMargin
	
	pagePrintWidth = oPageStyle.Width - oPageStyle.LeftMargin - oPageStyle.RightMargin
	print "page width = " & oPageStyle.Width & "   print width = " & pagePrintWidth
End Sub