Attribute VB_Name = "mod_ctPackage_Extra"
' Modul for Visual Basic 6
' Copyright (C) 2003,2004 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

'#ctPackage_Extra_FlagA
'   10   GetSizes
'   20   GetTotalUncSize
'  130 = DrawPackageStats (requires 10/20)
' 1000 = SortedFileListAliasIndex
' 3000 = GenFileListDirStruc

Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long

#If (ctPackage_Extra_FlagA And &H130&) = &H130& Then
  Public Sub ctPackage_Extra_DrawPackageStats(ByVal ctPackagePointer As Long, ByVal xPictureBox As PictureBox, ByVal MaxX As Long, ByVal MaxY As Long, Optional ByVal StartX As Long, Optional ByVal StartY As Long)
    Dim Total As Long
    Dim DataX As Long
    Dim TOCTotal As Long
    Dim Wasted As Long
    
    Dim xScale As Single
    Dim zScale As Long
    Dim Pos1 As Long
    Dim Pos2 As Long
    Dim Total2 As Long
    Dim HeaderPos As Long
    Dim ctPIType As ctPackage_InfoType

    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      
      Total = ctPackage_Extra_GetSizes(ctPackagePointer, DataX, TOCTotal, Wasted)
      Total2 = ctPackage_Extra_GetTotalUncSize(ctPackagePointer)
      If Total > Total2 Then
        xScale = (MaxX - 10&) / Total
        Else
        xScale = (MaxX - 4&) / Total2
        End If
      
      zScale = (MaxY \ 2 - 1)
      
      xPictureBox.Cls
      HeaderPos = ctPIType.FileHeader
      Pos2 = HeaderPos * xScale + StartX
      zScale = StartY + zScale
      xPictureBox.Line (StartX, StartY)-(Pos2, zScale), QBColor(2), BF
      Pos1 = Pos2 + 2
      Pos2 = (4& + (HeaderPos + TOCTotal) * xScale) + StartX
      xPictureBox.Line (Pos1, StartY)-(Pos2, zScale), QBColor(3), BF
      Pos1 = Pos2 + 2
      Pos2 = (6& + (HeaderPos + TOCTotal + DataX) * xScale) + StartX
      xPictureBox.Line (Pos1, StartY)-(Pos2, zScale), QBColor(1), BF
      Pos1 = Pos2 + 2
      Pos2 = (8& + (HeaderPos + TOCTotal + DataX + Wasted) * xScale) + StartX
      xPictureBox.Line (Pos1, StartY)-(Pos2, zScale), QBColor(4), BF
      'zScale = zScale - StartY
      xPictureBox.Line (StartX, zScale + 2&)-(StartX + (Total2 * xScale) + 1&, 2 * zScale - StartY + 2&), QBColor(14), BF
      End If
    End Sub
  #End If

#If (ctPackage_Extra_FlagA And &H10&) = &H10& Then
  Public Function ctPackage_Extra_GetSizes(ByVal ctPackagePointer As Long, Optional ByRef Data As Long, Optional ByRef TOCTotal As Long, Optional ByRef Wasted As Long) As Long
    Dim xChar1 As String
    Dim ctPIType As ctPackage_InfoType

    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      ctPackage_Extra_GetSizes = GetFileSize(ctPIType.FileHandle, 0&)
      'Get FileID, HeaderPos + 1&, xChar1
      If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader, 0&, 0&) = -1& Then
        If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, ctPackageConst_HeaderSize, 0&, ByVal 0&) = 0& Then
          Data = LenCharToLong(xChar1, ctPackageConst_HeaderPosDataSize)
          TOCTotal = ctPackageConst_TOCSizeTotal + LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount + 1&) * ctPackageConst_TOCWidth + LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames)
          Wasted = ctPackage_Extra_GetSizes - Data - TOCTotal - ctPIType.FileHeader
          End If
        End If
      Else
      ctPackage_Extra_GetSizes = -1&
      End If
    End Function
  #End If



#If (ctPackage_Extra_FlagA And &H20&) = &H20 Then
  Public Function ctPackage_Extra_GetTotalUncSize(ByVal ctPackagePointer As Long) As Long
    Dim xLong1 As Long
    Dim xChar1 As String
    
    Dim ctPIType As ctPackage_InfoType

    ctPackage_Extra_GetTotalUncSize = -1&
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      'Get FileID, HeaderPos + 1&, xChar1
      If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader, 0&, 0&) = -1& Then
        If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, ctPackageConst_HeaderSize, 0&, ByVal 0&) = 0& Then
          xLong1 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount + 1&)
          xChar1 = String(xLong1 * ctPackageConst_TOCWidth, vbNullChar)
          'Get FileID, HeaderPos + ctPackageConst_HeaderSize + 1&, xChar1
          'If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader + ctPackageConst_HeaderSize, 0&, 0&) = -1& Then
            If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, xLong1 * ctPackageConst_TOCWidth, 0&, ByVal 0&) = 0& Then
              ctPackage_Extra_GetTotalUncSize = 0&
              For xLong1 = 0& To xLong1 - 1&
                ctPackage_Extra_GetTotalUncSize = ctPackage_Extra_GetTotalUncSize + LenCharToLong(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosExtSize)
                Next
              End If
          '  End If
          End If
        End If
      'Else
      'ctPackage_Extra_GetTotalUncSize = -1
      End If
    End Function
  #End If

