Monster Media 1994 #1/monster.zip/monster/PROG_BAS/PWBROW.ZIP/PRINT.FRM

Text File | 1994-01-27 | 10KB | 313 lines

VERSION 2.00
Begin Form frmPrint
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Print Version Information"
   ClientHeight    =   2190
   ClientLeft      =   3600
   ClientTop       =   2115
   ClientWidth     =   6330
   Height          =   2655
   Icon            =   PRINT.FRX:0000
   Left            =   3510
   LinkTopic       =   "Form2"
   ScaleHeight     =   2190
   ScaleWidth      =   6330
   Top             =   1740
   Width           =   6510
   Begin CommonDialog cdFont
      Left            =   3840
      Top             =   1800
   End
   Begin CommandButton cbFont
      Caption         =   "Select &Font ..."
      Height          =   375
      Left            =   2280
      TabIndex        =   5
      Top             =   1680
      Width           =   1455
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Print What"
      Height          =   1095
      Left            =   120
      TabIndex        =   4
      Top             =   960
      Width           =   1935
      Begin OptionButton obDirectory
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Entire Directory"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   720
         Width           =   1695
      End
      Begin OptionButton obSelected
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Selected Files"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   360
         Value           =   -1  'True
         Width           =   1575
      End
   End
   Begin CommandButton cbCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4440
      TabIndex        =   3
      Top             =   1680
      Width           =   735
   End
   Begin CommandButton cbOK
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   5400
      TabIndex        =   2
      Top             =   1680
      Width           =   735
   End
   Begin TextBox tbTitle
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Top             =   240
      Width           =   4935
   End
   Begin Label lblDir
      BackStyle       =   0  'Transparent
      Height          =   255
      Left            =   1080
      TabIndex        =   9
      Top             =   720
      Width           =   5175
   End
   Begin Label Label3
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Directory:"
      Height          =   255
      Left            =   0
      TabIndex        =   8
      Top             =   720
      Width           =   975
   End
   Begin Label Label2
      BackStyle       =   0  'Transparent
      Caption         =   "Current Font:"
      Height          =   255
      Left            =   2280
      TabIndex        =   7
      Top             =   1080
      Width           =   1335
   End
   Begin Label lblFont
      BackStyle       =   0  'Transparent
      Height          =   255
      Left            =   2280
      TabIndex        =   6
      Top             =   1320
      Width           =   3855
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Report &Title:"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
End
Dim IDs(16) As String
Dim IDLen(16) As Integer
Dim MaxLen As Integer
Dim LineHeight As Integer

Sub cbCancel_Click ()
    Unload frmPrint
End Sub

Sub cbFont_Click ()
    Const CF_EFFECTS = &H200
    Const CF_PRINTERFONTS = &H2
    Const CF_FORCEFONTEXIST = &H10000

    cdFont.FontName = Printer.FontName
    cdFont.Flags = CF_EFFECTS Or CF_PRINTERFONTS Or CF_FORCEFONTEXIST
    cdFont.Action = 4 ' get font
    lblFont.Caption = cdFont.FontName
    Printer.FontName = cdFont.FontName
    MaxLen = 0 ' invalidate width information
End Sub

Sub cbOK_Click ()
    Dim FullName As String

    frmPrint.MousePointer = 11 ' hourglass
    If MaxLen = 0 Then InitID

    If obSelected.Value = True Then ' Selected files Only
        For i = 0 To frmBrowse!filBrowse.ListCount - 1
            If frmBrowse!filBrowse.Selected(i) Then
                FullName = frmBrowse!filBrowse.Path + "\" + frmBrowse!filBrowse.List(i)
                PrintOne (FullName)
            End If
        Next
    Else    ' print all files in directory
        For i = 0 To frmBrowse!filBrowse.ListCount - 1
            FullName = frmBrowse!filBrowse.Path + "\" + frmBrowse!filBrowse.List(i)
            PrintOne (FullName)
        Next
    End If

    Printer.EndDoc

    frmPrint.MousePointer = 0 ' normal
    Unload frmPrint
End Sub

Sub Form_Load ()
    frmPrint.Top = PrintTop
    frmPrint.Left = PrintLeft
    lblFont.Caption = Printer.FontName
    lblDir.Caption = frmBrowse!lblCurDir.Caption
    tbTitle.Text = "Version information for directory " + lblDir.Caption
    If frmBrowse!filBrowse.ListIndex < 0 Then ' no files selected
        obSelected.Enabled = False ' disable "Selected Files"
        obDirectory.Value = True ' Force "Entire Directory"
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    If frmPrint.WindowState <> 1 Then
        ' window not minimized
        PrintTop = frmPrint.Top
        PrintLeft = frmPrint.Left
    End If
End Sub

Sub InitID ()
    Dim i As Integer
    Static BeenHere As Integer

    If Not BeenHere Then
        IDs(0) = "Name: "
        IDs(1) = "Last Modified: "
        IDs(2) = "Size: "
        IDs(3) = "Description: "
        IDs(4) = "File Version: "
        IDs(5) = "Company Name: "
        IDs(6) = "Language: "
        IDs(7) = "Original Name: "
        IDs(8) = "Internal Name: "
        IDs(9) = "Comments: "
        IDs(10) = "Copyright: "
        IDs(11) = "Trademarks: "
        IDs(12) = "Product Name: "
        IDs(13) = "Product Version: "
        IDs(14) = "Special Build: "
        IDs(15) = "Private Build: "
        BeenHere = True
    End If

    For i = 0 To 15
        IDLen(i) = Printer.TextWidth(IDs(i))
        If IDLen(i) > MaxLen Then MaxLen = IDLen(i)
    Next
    LineHeight = Printer.TextHeight("X")
End Sub

Sub PrintOne (FullName As String)
    Dim VerInfoPresent As Integer
    Dim VI As VerInfo
    Dim PageNo As String
    Dim TotHeight As Integer
    Static CurDateTime As String

    If CurDateTime <= " " Then
        CurDateTime = Format(Now, "dddd, mmmm d, yyyy \a\t h:mm AM/PM")
    End If
    VerInfoPresent = GetFileVersion(FullName, VI)
    If VerInfoPresent Then ' compute height of into to be printed
        TotHeight = 17 * LineHeight
    Else
        TotHeight = 4 * LineHeight
    End If
    If (Printer.CurrentY + TotHeight + 1) > Printer.ScaleHeight Then Printer.NewPage

    If Printer.CurrentY = 0 Then ' top of page
        Printer.Print ' leave some top margin
        Printer.Print CurDateTime;
        PageNo = "Page:" + Str$(Printer.Page)
        Printer.CurrentX = Printer.ScaleWidth - Printer.TextWidth(PageNo)
        Printer.Print PageNo
        Printer.Print tbTitle
    End If

    Printer.CurrentY = Printer.CurrentY + (LineHeight / 2)
    Printer.Line (Printer.CurrentX, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
    Printer.CurrentY = Printer.CurrentY + (LineHeight / 2)

    Printer.CurrentX = MaxLen - IDLen(0)
    Printer.Print IDs(0);
    Printer.FontBold = True
    Printer.Print FullName
    Printer.FontBold = False

    Printer.CurrentX = MaxLen - IDLen(1)
    Printer.Print IDs(1); Format$(FileDateTime(FullName), "dddd, mmmm d, yyyy \a\t h:mm AM/PM")

    Printer.CurrentX = MaxLen - IDLen(2)
    Printer.Print IDs(2); Format$(FileLen(FullName), "###,###,###,##0 \b\y\t\e\s")

    If Not VerInfoPresent Then Exit Sub ' no Version info available

    Printer.CurrentX = MaxLen - IDLen(3)
    Printer.Print IDs(3); VI.FileDescription

    Printer.CurrentX = MaxLen - IDLen(4)
    Printer.Print IDs(4); VI.FileVersion

    Printer.CurrentX = MaxLen - IDLen(5)
    Printer.Print IDs(5); VI.CompanyName

    Printer.CurrentX = MaxLen - IDLen(6)
    Printer.Print IDs(6); VI.Language

    Printer.CurrentX = MaxLen - IDLen(7)
    Printer.Print IDs(7); VI.OriginalFileName

    Printer.CurrentX = MaxLen - IDLen(8)
    Printer.Print IDs(8); VI.InternalName

    Printer.CurrentX = MaxLen - IDLen(9)
    Printer.Print IDs(9); VI.Comments

    Printer.CurrentX = MaxLen - IDLen(10)
    Printer.Print IDs(10); VI.LegalCopyright

    Printer.CurrentX = MaxLen - IDLen(11)
    Printer.Print IDs(11); VI.LegalTrademarks

    Printer.CurrentX = MaxLen - IDLen(12)
    Printer.Print IDs(12); VI.ProductName

    Printer.CurrentX = MaxLen - IDLen(13)
    Printer.Print IDs(13); VI.ProductVersion

    Printer.CurrentX = MaxLen - IDLen(14)
    Printer.Print IDs(14); VI.SpecialBuild

    Printer.CurrentX = MaxLen - IDLen(15)
    Printer.Print IDs(15); VI.PrivateBuild
End Sub