Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

#include "Fileio.ch"
#include "ot4xb.ch"

PROCEDURE Main(cFile)
LOCAL nPos
LOCAL nHandle

   IF FILE(cFile)
      nHandle := FOpen(cFile, FO_READWRITE+FO_DENYWRITE)
      IF FError() <> 0
         ? "Fehler beim Öffnen der Datei:", FError()
      ELSE
?         nPos := FSeek( nHandle, 0 , FS_END )
          FSeek( nHandle, 0 , FS_SET )

?         nPos := ( ULongLong2Double( STR( FSeek( nHandle, 0 , FS_END ) ) ) )
          FSeek( nHandle, 0 , FS_SET )
          FClose( nHandle )
      ENDIF
WAIT

   ELSE
      ALERT("need big file")
   ENDIF

RETURN

Code: Alles auswählen

#include "fivewin.ch"
#include "xbrowse.ch"
#include "hbcompat.ch"

//----------------------------------------------------------------------------//

function XmlView( cXml )

   local oXmlDoc, oTree

   if ValType( cXml ) != 'C'
      cXml        := nil
   endif

   if Empty( cXml ) .and. ;
      Empty( cXml := cGetFile( "XML File(*.xml)|*.xml|", "Select GuestRooms XML file",,CurDir() ) )
      return nil
   endif

   BrowseXML( cXml )

return nil


static function BrowseXML( cXml )

   local oWnd, oFont, oBrw, oHash
   local oTree

   msgRun( "Reading " + cFileNoPath( cXml ), "PLEASE WAIT", { || oTree := XmlTree( cXml ) } )

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-16
   DEFINE WINDOW oWnd TITLE cXml
   oWnd:SetFont( oFont )

   @ 0,0 XBROWSE oBrw OF oWnd SIZE 700,0 PIXEL ;
      DATASOURCE oTree COLSIZES 300 NOBORDER CELL LINES

   ADD TO oBrw DATA oBrw:oTreeItem:Cargo:Depth() PICTURE "99" HEADER "Dp"
   ADD TO oBrw DATA If( Empty( oBrw:oTreeItem:Cargo:aAttributes ), nil, .t. ) HEADER "Atr"
   ADD TO oBrw DATA oBrw:oTreeItem:Cargo:cData HEADER "DATA" SIZE 200

   WITH OBJECT oBrw
      :nHeadStrAligns   := AL_CENTER
      :nStretchCol      := :Data:nCreationOrder
      :nHeadStrAligns   := AL_CENTER
/*
      :bRClicked  := { || msginfo( obrw:otreeitem:cargo:path() ), ;
                          xbrowse( obrw:otreeitem:cargo, obrw:otreeitem:cargo:path() ) }
*/
      :bPopUp     := { || RClickMenu( oBrw:oTreeItem:Cargo ) }
      :aCols[ 1 ]:bLDClickData   := { || oBrw:oTree:Expand( oBrw:oTreeItem:nLevel + ;
               If( oBrw:oTreeItem:lOpened, 0, 1 ) ), oBrw:Refresh() }
      :Atr:SetCheck()
      WITH OBJECT :Data
         :cDataType     := 'M'
         :bLDClickData  := { |r,c,f,o| o:RunBtnAction }
      END
      :bChange    := { || oHash:aArrayData := oBrw:oTreeItem:Cargo:aAttributes, oHash:Refresh( .t. ) }
      //
      :CreateFromCode()
   END

   oWnd:oLeft   := oBrw

   @ 0,0 XBROWSE oHash OF oWnd DATASOURCE HB_Hash() NOBORDER CELL LINES

   WITH OBJECT oHash
      :nHeadStrAligns   := AL_CENTER
      :nWidths          := 300
      :nStretchCol      := 2
      //
      :CreateFromCode()
   END
   oWnd:oClient    := oHash

   ACTIVATE WINDOW oWnd MAXIMIZED
   RELEASE FONT oFont

return nil

static function XmlTree( cXml )

   local oXmlDoc  := TXmlDocument():New( cXml )
   local oRoot    := oXmlDoc:oRoot
   local cPrompt  := If( Empty( oRoot:cName ), cFileNoPath( cXml ), oRoot:cName )
   local oTree

   TREE oTree
      TREEITEM cPrompt CARGO oRoot
      if oRoot:oChild == nil
         oRoot:cData := "BLANK XML FILE"
      else
         SubTree( oRoot:oChild )
      endif
   ENDTREE

   oTree:Expand()

return oTree

static function SubTree( oNode )

   TREE
   do while oNode != nil
      TREEITEM oNode:cName CARGO oNode
      if oNode:oChild != nil
         SubTree( oNode:oChild )
      endif
      oNode    := oNode:oNext
   enddo
   ENDTREE

return nil

static function RClickMenu( oNode )

   local oPop

   MENU oPop POPUP 2007
      MENUITEM "Path" ACTION msginfo( oNode:path() )
      MENUITEM "Browse" ACTION XBrowse( oNode, oNode:path() )
      MENUITEM "PrgGen" ACTION PrgGen( oNode )
   ENDMENU

return oPop

static function PrgGen( oNode )

   local cText    := ""

   if ValType( oNode:aAttributes ) == 'H'
      HEVAL( oNode:aAttributes, { |cKey,uVal| ( ;
         cText += PadR( "   hRow:" + cKey, 24 ) + ' := :GetAttribute( "' + cKey + '" )' + CRLF ) } )
   endif
   if ! Empty( oNode:cData )
      cText += PadR( "   hRow:" + oNode:cName, 24 ) + ' := :cData' + CRLF
   endif

   if Empty( cText )
      ? "No prg"
   else
      cText    := "WITH OBJECT oNode" + CRLF + cText + "END" + CRLF
      MEMOEDIT( cText )
   endif

return nil