PureBasic Forums - English

Code: Select all

Global Program$ = "Word - Vertical Table Text "

If CreateMutex_(0,1,Program$) = 0 Or GetLastError_() <> 0 
  MessageRequester(" WARNING ! " + Program$," The " +Program$ + " program is already running !",0|#MB_ICONWARNING)
  End 
EndIf

;{ Window Enumeration ******************************************************************************
Enumeration 
  #Window0
EndEnumeration
;}
;{ Gadget Enumeration ******************************************************************************
Enumeration 
  #WordDoc
EndEnumeration
;}
Declare WordDoc()


;{ Font Setup **************************************************************************************
LoadFont(0,"Arial",10)
LoadFont(1,"Arial",10,#PB_Font_Bold)
;}
;{ Setup Main screen *******************************************************************************
DTW = 600
DTH = 400
;}
;{ ComatePlus Includes *****************************************************************************
IncludePath "C:\Program Files\PureBasic\" 
XIncludeFile "COMatePlus.pbi"
;}

; Window Setup ************************************************************************************* 
hWnd = OpenWindow(#Window0, 0, 0,DTW,DTH,Program$,#PB_Window_BorderLess|#WS_BORDER|#PB_Window_ScreenCentered|#PB_Window_Invisible)
SetClassLongPtr_(WindowID(#Window0), #GCL_STYLE, $00020000) 
HideWindow(#Window0,#False)

ButtonGadget(#WordDoc, 20,20,150,25,"Create Word Document")

; Main Program Loop ********************************************************************************
Repeat
  Event = WaitWindowEvent()
  
  
  
  If Event = #PB_Event_Gadget  ;{ Gadgets =========================================================

    Select EventGadget()
      Case #WordDoc  
        WordDoc()
        
    EndSelect

  EndIf
  ;}
       
Until Event = #PB_Event_CloseWindow

End
; Procedures ***************************************************************************************
Procedure WordDoc()
  Protected.COMateObject oWord, oFile, oRange, oWTable0, oPara0, range
  Protected.F TopMargin, LefttMargin, RightMargin, BottomMargin
  
  WordDoc$ = "C:\Temp\Test.doc" 
  
  Number$ = " Sample No." 
  ID$ = " Sample ID " 
  Test1$ = " Blood " 
  Test2$ =  " Tissue " 
    
oWord = COMate_CreateObject("Word.Application") 
If oWord
  If oWord\SetProperty("Visible = #True") = #S_OK
    oFile = oWord\GetObjectProperty("Documents\Open('"+WordDoc$+"')") 
    oFile\SetProperty("PageSetup\Orientation=1")
    TopMargin = oWord\GetIntegerProperty("CentimetersToPoints(2)") ; set top margin height
    oFile\SetProperty("PageSetup\TopMargin=" + StrF(TopMargin))
    LeftMargin = oWord\GetIntegerProperty("CentimetersToPoints(2)") ; set left margin height
    oFile\SetProperty("PageSetup\LeftMargin=" + StrF(LeftMargin))
    RightMargin = oWord\GetIntegerProperty("CentimetersToPoints(1)") ; set right margin height
    oFile\SetProperty("PageSetup\RightMargin=" + StrF(RightMargin))
    BottomMargin = oWord\GetIntegerProperty("CentimetersToPoints(2)") ; set top margin height
    oFile\SetProperty("PageSetup\BottomMargin=" + StrF(BottomMargin))
    If oFile
      oRange = oFile\GetObjectProperty("Bookmarks('\endofdoc')\Range")
      If oRange
        oWTable0 = oFile\GetObjectProperty("Tables\Add(" + Str(oRange) + " as COMateObject, 4,4)") ; rows and columns
        If oWTable0
          oWTable0\SetProperty("Range\ParagraphFormat\SpaceBefore = 12") ; Adjusts space in cells 
          oWTable0\SetProperty("Range\ParagraphFormat\SpaceAfter = 3")  
          oWTable0\SetProperty("Columns(1)\Width = '2.5'")               ; Adjusts width of cells in CM  
          oWTable0\SetProperty("Columns(2)\Width = '2.5'")              
          oWTable0\SetProperty("Columns(3)\Width = '1.5'")
          oWTable0\SetProperty("Columns(4)\Width = '1.5'")
          oWTable0\SetProperty("Rows(4)\Height = '4.5'")
          oWTable0\SetProperty("Cell(1,1)\Range\Font\Name = 'Arial'")  
          oWTable0\SetProperty("Cell(1,1)\Range\Font\Size = 12")       
          oWTable0\SetProperty("Cell(1,1)\Range\Text = '"+Number$+"'")
          oWTable0\SetProperty("Cell(1,2)\Range\Font\Bold = #True")
          oWTable0\SetProperty("Cell(1,2)\Range\Font\Name = 'Arial'")  
          oWTable0\SetProperty("Cell(1,2)\Range\Font\Size = 12")       
          oWTable0\SetProperty("Cell(1,2)\Range\Text = '"+ID$+"'")
          oWTable0\SetProperty("Cell(1,3)\Range\Font\Bold = #True")
          oWTable0\SetProperty("Cell(1,3)\Range\Font\Name = 'Arial'")  
          oWTable0\SetProperty("Cell(1,3)\Range\Font\Size = 12")       
          oWTable0\SetProperty("Cell(1,3)\Range\Text = '"+Test1$+"'")
          oWTable0\SetProperty("Cell(1,4)\Range\Font\Bold = #True")
          oWTable0\SetProperty("Cell(1,4)\Range\Font\Name = 'Arial'")  
          oWTable0\SetProperty("Cell(1,4)\Range\Font\Size = 12")       
          oWTable0\SetProperty("Cell(1,4)\Range\Text = '"+Test2$+"'")
          oWTable0\SetProperty("Range\Rows(1)\Cells\VerticalAlignment = '3'")
          oWTable0\SetProperty("Rows(1)\Shading\Texture = '100'")      
                    
          oWTable0\SetProperty("Cell(1,3)\Range\Orientation = '"+Str(5)+"'")
          
          ;oWTable0\SetProperty("Cell(1,3)\Select")
          ;oWTable0\SetProperty("Cell(1,3)\Selection\Orientation = '"+Str(5)+"'")
          
          ;range = oWTable0\GetObjectProperty("Rows(1)\Cells(3)")
          ;  range\invoke("Select")
          ;  range\invoke("Range\Orientation = '"+Str(5)+"'")
                    
          ;oWtable0\Invoke("Cell(1,3)\Select")
          ;oWTable0\Invoke("Range\Orientation = '"+Str(5)+"'")
          
        EndIf 
      EndIf
      oRange\Release() 
    EndIf  
    oFile\Release()
  EndIf
  oWord\Release()
EndIf
 
EndProcedure