Chip 2001 May/W2KPRK.iso/apps/crystal/disk18/Xvb372._/Xvb372.

Text File | 1999-08-23 | 20KB | 677 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "comdlg32.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "comctl32.ocx"
Begin VB.Form frmMain
   Caption         =   "XtremeDemo"
   ClientHeight    =   6180
   ClientLeft      =   156
   ClientTop       =   708
   ClientWidth     =   8952
   Icon            =   "Main.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6180
   ScaleWidth      =   8952
   Begin VB.PictureBox picNavBar
      Align           =   1  'Align Top
      Height          =   360
      Left            =   0
      ScaleHeight     =   312
      ScaleWidth      =   8904
      TabIndex        =   1
      Top             =   0
      Width           =   8955
      Begin VB.Image imgHome
         Height          =   240
         Left            =   0
         Picture         =   "Main.frx":030A
         Top             =   0
         Width           =   1176
      End
      Begin VB.Image imgWarehouse
         Height          =   240
         Left            =   6240
         Picture         =   "Main.frx":081A
         Top             =   0
         Width           =   1152
      End
      Begin VB.Image imgSales
         Height          =   240
         Left            =   4788
         Picture         =   "Main.frx":0E15
         Top             =   0
         Width           =   1164
      End
      Begin VB.Image imgManagement
         Height          =   240
         Left            =   2940
         Picture         =   "Main.frx":144E
         Top             =   0
         Width           =   1476
      End
      Begin VB.Image imgCompany
         Height          =   240
         Left            =   1476
         Picture         =   "Main.frx":1B92
         Top             =   0
         Width           =   1176
      End
   End
   Begin ComctlLib.StatusBar sbStatusBar
      Align           =   2  'Align Bottom
      Height          =   276
      Left            =   0
      TabIndex        =   0
      Top             =   5904
      Width           =   8952
      _ExtentX        =   15790
      _ExtentY        =   487
      SimpleText      =   ""
      _Version        =   327680
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
         NumPanels       =   3
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            AutoSize        =   1
            Object.Width           =   10266
            Text            =   "Status"
            TextSave        =   "Status"
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Style           =   6
            AutoSize        =   2
            TextSave        =   "8/1/97"
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Style           =   5
            AutoSize        =   2
            TextSave        =   "12:21 PM"
            Object.Tag             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog
      Left            =   285
      Top             =   585
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
   End
   Begin VB.Image imgLauncher
      Height          =   585
      Index           =   0
      Left            =   1140
      MouseIcon       =   "Main.frx":21FF
      Top             =   1485
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileLogin
         Caption         =   "&Login"
      End
      Begin VB.Menu mnuFileClose
         Caption         =   "&Close Preview Window"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuFileBar1
         Caption         =   "-"
      End
      Begin VB.Menu mnuFilePageSetup
         Caption         =   "Page Set&up..."
      End
      Begin VB.Menu mnuFileBar2
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuView
      Caption         =   "&View"
      Begin VB.Menu mnuViewReport
         Caption         =   "&Report"
         Begin VB.Menu mnuViewReportCompany
            Caption         =   "&Company Info"
            Begin VB.Menu mnuViewReportCompanyEmployee
               Caption         =   "&Employee Profile"
            End
            Begin VB.Menu mnuViewReportCompanyMission
               Caption         =   "&Mission"
            End
            Begin VB.Menu mnuViewReportCompanyHistory
               Caption         =   "&Corporate History"
            End
            Begin VB.Menu mnuViewReportCompanyPartners
               Caption         =   "&Founding Partners"
            End
         End
         Begin VB.Menu mnuViewReportManagement
            Caption         =   "&Management Reports"
            Begin VB.Menu mnuViewReportManagementWorldwide
               Caption         =   "&Worldwide Sales"
            End
            Begin VB.Menu mnuViewReportManagementConsolidated
               Caption         =   "&Consolidated Balance Sheet"
            End
            Begin VB.Menu mnuViewReportManagementFinSum
               Caption         =   "Financial &Summary"
            End
            Begin VB.Menu mnuViewReportManagementFinRat
               Caption         =   "Financial &Ratios"
            End
            Begin VB.Menu mnuViewReportManagementIncome
               Caption         =   "&Income Statement"
            End
         End
         Begin VB.Menu mnuViewReportSales
            Caption         =   "&Sales Tools"
            Begin VB.Menu mnuViewReportSalesCustomer
               Caption         =   "&Customer Profile && Order History"
            End
            Begin VB.Menu mnuViewReportSalesSales
               Caption         =   "&Sales by Sales Rep"
            End
            Begin VB.Menu mnuViewReportSalesInventory
               Caption         =   "&Inventory Report"
               Index           =   0
            End
            Begin VB.Menu mnuViewReportSalesOrder
               Caption         =   "&Order Form"
            End
            Begin VB.Menu mnuViewReportSalesProduct
               Caption         =   "&Product Catalog"
            End
         End
         Begin VB.Menu mnuViewReportWarehouse
            Caption         =   "&Warehouse"
            Begin VB.Menu mnuViewReportWarehouseInventory
               Caption         =   "&Inventory Report"
            End
            Begin VB.Menu mnuViewReportWarehouseShipping
               Caption         =   "&Shipping Labels"
            End
            Begin VB.Menu mnuViewReportWarehouseOrder
               Caption         =   "&Order Packing List"
            End
         End
      End
      Begin VB.Menu mnuViewData
         Caption         =   "&Data Form"
         Begin VB.Menu mnuViewDataCustomer
            Caption         =   "&Customer"
         End
         Begin VB.Menu mnuViewDataEmployee
            Caption         =   "&Employee"
         End
         Begin VB.Menu mnuViewDataEmployeeAddresses
            Caption         =   "Employee &Addresses"
         End
         Begin VB.Menu mnuViewDataFinancials
            Caption         =   "&Financials"
         End
         Begin VB.Menu mnuViewDataOrders
            Caption         =   "&Orders"
         End
         Begin VB.Menu mnuViewDataOrdersDetail
            Caption         =   "Orders &Detail"
         End
         Begin VB.Menu mnuViewDataProduct
            Caption         =   "&Product"
         End
         Begin VB.Menu mnuViewDataProductType
            Caption         =   "Product &Type"
         End
         Begin VB.Menu mnuViewDataPurchases
            Caption         =   "P&urchases"
         End
      End
      Begin VB.Menu mnuViewBar1
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewNavigation
         Caption         =   "&Navigation Bar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar
         Caption         =   "&Status Bar"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpContents
         Caption         =   "&Contents"
      End
      Begin VB.Menu mnuHelpSearch
         Caption         =   "&Search For Help On..."
      End
      Begin VB.Menu mnuHelpBar1
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout
         Caption         =   "&About XtremeDemo..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wcmd As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal Y As Long, ByVal w As Long, ByVal h As Long, ByVal repaint As Long) As Long

Public gsDatabase As String
Public gsConnect As String
Public gsRecordsource As String

Public XtremeDemo As New clsXtremeDemo

Private m_colReportNames As New Collection

Private Function SetNavTab(ctlNew As Control) As Boolean
  Static ctlOld As Control
  SetNavTab = True
  If Not ctlOld Is Nothing Then
    If ctlOld = ctlNew Then
      SetNavTab = False
    Else
      ctlNew.Picture = LoadPicture(App.Path & "\images\dn_" & Mid$(ctlNew.Name, 4) & ".gif")
      ctlOld.Picture = LoadPicture(App.Path & "\images\up_" & Mid$(ctlOld.Name, 4) & ".gif")
      HideLaunchers
      Me.Picture = LoadPicture(App.Path & "\images\bg_" & Mid$(ctlNew.Name, 4) & ".gif")
    End If
  Else
    ctlNew.Picture = LoadPicture(App.Path & "\images\dn_" & Mid$(ctlNew.Name, 4) & ".gif")
    HideLaunchers
    Me.Picture = LoadPicture(App.Path & "\images\bg_" & Mid$(ctlNew.Name, 4) & ".gif")
  End If
  Set ctlOld = ctlNew
End Function

Private Sub ResetLaunchers()
  Dim intLauncherIndex As Integer
  For intLauncherIndex = 1 To imgLauncher.UBound
    Unload imgLauncher(intLauncherIndex)
    m_colReportNames.Remove 1
  Next intLauncherIndex
End Sub

Private Sub HideLaunchers()
  Dim intLauncherIndex As Integer
  For intLauncherIndex = 1 To imgLauncher.UBound
    imgLauncher(intLauncherIndex).Visible = False
  Next intLauncherIndex
End Sub

Private Sub ShowLaunchers()
  Dim intLauncherIndex As Integer
  For intLauncherIndex = 1 To imgLauncher.UBound
    imgLauncher(intLauncherIndex).Visible = True
  Next intLauncherIndex
End Sub

Private Sub AddLauncher(strReportName As String, Optional strImageFilename As String)
  Dim intLauncherIndex As Integer
  intLauncherIndex = imgLauncher.UBound + 1
  Load imgLauncher(intLauncherIndex)
  With imgLauncher(intLauncherIndex)
    .Left = 0
    If intLauncherIndex = 1 Then
      If picNavBar.Visible Then
        .Top = picNavBar.Height
      Else
        .Top = 0
      End If
    Else
      .Top = imgLauncher(intLauncherIndex - 1).Top + imgLauncher(intLauncherIndex - 1).Height
    End If
    If strImageFilename = Empty Then
      .Picture = LoadPicture(App.Path & "\images\rp_" & strReportName & ".gif")
    Else
      .Picture = LoadPicture(App.Path & "\images\" & strImageFilename)
    End If
    .Visible = True
  End With
  m_colReportNames.Add strReportName
End Sub

Private Sub Form_Load()
  Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 500)
  Me.Top = GetSetting(App.Title, "Settings", "MainTop", 500)
  Me.Width = GetSetting(App.Title, "Settings", "MainWidth", Screen.Width - 500)
  Me.Height = GetSetting(App.Title, "Settings", "MainHeight", Screen.Height - 500)

  frmSplash.Show vbModeless, Me
  frmSplash.Refresh

  Me.Show
  imgHome_Click

  Unload frmSplash

  gsDatabase = Mid(App.Path, 1, (Len(App.Path) - 23)) & "\XTREME.MDB"
  gsConnect = ""
  ChDir (App.Path)
End Sub

Private Sub Form_Resize()
  If Me.Width > Me.Image.Width Then Me.Width = Me.Image.Width
  If Me.Height > Me.Image.Height Then Me.Height = Me.Image.Height
  If IsObject(XtremeDemo.m_crwWindow) Then
    If Me.mnuFileClose.Enabled Then
      MoveWindow XtremeDemo.m_crwWindow.WindowHandle, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 1
    End If
  End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim i As Integer

  'close all sub forms
  For i = Forms.Count - 1 To 1 Step -1
    Unload Forms(i)
  Next
  If Me.WindowState <> vbMinimized Then
     SaveSetting App.Title, "Settings", "MainLeft", Me.Left
     SaveSetting App.Title, "Settings", "MainTop", Me.Top
     SaveSetting App.Title, "Settings", "MainWidth", Me.Width
     SaveSetting App.Title, "Settings", "MainHeight", Me.Height
  End If
End Sub

Private Sub imgCompany_Click()
    If Me.mnuFileClose.Enabled Then
        XtremeDemo.CloseWindow
    End If

  If SetNavTab(imgCompany) Then
    ResetLaunchers
    AddLauncher "empprof"
    ShowLaunchers
  End If
End Sub

Private Sub imgHome_Click()
    If Me.mnuFileClose.Enabled Then
        XtremeDemo.CloseWindow
    End If

  If SetNavTab(imgHome) Then
    ResetLaunchers
  End If
End Sub

Private Sub imgLauncher_Click(Index As Integer)
  XtremeDemo.LaunchReport m_colReportNames(Index)
End Sub

Private Sub imgManagement_Click()
  If Me.mnuFileClose.Enabled Then
    XtremeDemo.CloseWindow
  End If

  If SetNavTab(imgManagement) Then
    ResetLaunchers
    AddLauncher "wwsales"
    AddLauncher "balance"
    AddLauncher "finstate"
    AddLauncher "income"
    ShowLaunchers
  End If
End Sub

Private Sub imgSales_Click()
  If Me.mnuFileClose.Enabled Then
    XtremeDemo.CloseWindow
  End If

  If SetNavTab(imgSales) Then
    ResetLaunchers
    AddLauncher "customer"
    AddLauncher "empsales"
    AddLauncher "invent", "rp_invent_s.gif"
    AddLauncher "statemnt"
    AddLauncher "prodcat"
    ShowLaunchers
  End If
End Sub

Private Sub imgWarehouse_Click()
  If Me.mnuFileClose.Enabled Then
    XtremeDemo.CloseWindow
  End If

  If SetNavTab(imgWarehouse) Then
    ResetLaunchers
    AddLauncher "invent", "rp_invent_w.gif"
    AddLauncher "maillabl"
    AddLauncher "ordpack"
    ShowLaunchers
  End If
End Sub

Private Sub mnuFileClose_Click()
  XtremeDemo.CloseWindow
End Sub

Private Sub mnuViewDataPurchases_Click()
    Dim f As New frmPurchases
    f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataProductType_Click()
  Dim f As New frmProductType
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataProduct_Click()
  Dim f As New frmProduct
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataOrdersDetail_Click()
  Dim f As New frmOrdersDetail
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataOrders_Click()
  Dim f As New frmOrders
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataFinancials_Click()
  Dim f As New frmFinancials
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataEmployeeAddresses_Click()
  Dim f As New frmEmployeeAddresses
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataEmployee_Click()
  Dim f As New frmEmployee
  f.Show vbModeless, Me
End Sub

Private Sub mnuViewDataCustomer_Click()
  Dim f As New frmCustomer
  f.Show vbModeless, Me
End Sub

Private Sub mnuHelpAbout_Click()
  frmAbout.Show vbModal, Me
End Sub

Private Sub mnuViewNavigation_Click()
  If mnuViewNavigation.Checked Then
    picNavBar.Visible = False
    mnuViewNavigation.Checked = False
  Else
    picNavBar.Visible = True
    mnuViewNavigation.Checked = True
  End If
End Sub

Private Sub mnuViewReportCompanyEmployee_Click()
  imgCompany_Click
  Me.Refresh
  imgLauncher_Click (1)
End Sub

Private Sub mnuViewReportCompanyHistory_Click()
  imgCompany_Click
  Me.Refresh
  imgLauncher_Click (3)
End Sub

Private Sub mnuViewReportCompanyMission_Click()
  imgCompany_Click
  Me.Refresh
  imgLauncher_Click (2)
End Sub

Private Sub mnuViewReportCompanyPartners_Click()
  imgCompany_Click
  Me.Refresh
  imgLauncher_Click (4)
End Sub

Private Sub mnuViewReportManagementConsolidated_Click()
  imgManagement_Click
  Me.Refresh
  imgLauncher_Click (2)
End Sub

Private Sub mnuViewReportManagementFinRat_Click()
  imgManagement_Click
  Me.Refresh
  imgLauncher_Click (4)
End Sub

Private Sub mnuViewReportManagementFinSum_Click()
  imgManagement_Click
  Me.Refresh
  imgLauncher_Click (3)
End Sub

Private Sub mnuViewReportManagementIncome_Click()
  imgManagement_Click
  Me.Refresh
  imgLauncher_Click (5)
End Sub

Private Sub mnuViewReportManagementWorldwide_Click()
  imgManagement_Click
  Me.Refresh
  imgLauncher_Click (1)
End Sub

Private Sub mnuViewReportSalesCustomer_Click()
  imgSales_Click
  Me.Refresh
  imgLauncher_Click (1)
End Sub

Private Sub mnuViewReportSalesInventory_Click(Index As Integer)
  imgSales_Click
  Me.Refresh
  imgLauncher_Click (3)
End Sub

Private Sub mnuViewReportSalesOrder_Click()
  imgSales_Click
  Me.Refresh
  imgLauncher_Click (4)
End Sub

Private Sub mnuViewReportSalesProduct_Click()
  imgSales_Click
  Me.Refresh
  imgLauncher_Click (5)
End Sub

Private Sub mnuViewReportSalesSales_Click()
  imgSales_Click
  Me.Refresh
  imgLauncher_Click (2)
End Sub

Private Sub mnuViewReportWarehouseInventory_Click()
  imgWarehouse_Click
  Me.Refresh
  imgLauncher_Click (1)
End Sub

Private Sub mnuViewReportWarehouseOrder_Click()
  imgWarehouse_Click
  Me.Refresh
  imgLauncher_Click (3)
End Sub

Private Sub mnuViewReportWarehouseShipping_Click()
  imgWarehouse_Click
  Me.Refresh
  imgLauncher_Click (2)
End Sub

Private Sub mnuViewStatusBar_Click()
  If mnuViewStatusBar.Checked Then
    sbStatusBar.Visible = False
    mnuViewStatusBar.Checked = False
  Else
    sbStatusBar.Visible = True
    mnuViewStatusBar.Checked = True
  End If
End Sub

Private Sub mnuHelpContents_Click()
  Dim nRet As Integer

  'if there is no helpfile for this project display a message to the user
  'you can set the HelpFile for your application in the
  'Project Properties dialog
  If Len(App.HelpFile) = 0 Then
    MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
  Else
    On Error Resume Next
    nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
    If Err Then
      MsgBox Err.Description
    End If
  End If
End Sub

Private Sub mnuHelpSearch_Click()
  Dim nRet As Integer

  'if there is no helpfile for this project display a message to the user
  'you can set the HelpFile for your application in the
  'Project Properties dialog
  If Len(App.HelpFile) = 0 Then
    MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
  Else
    On Error Resume Next
    nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
    If Err Then
      MsgBox Err.Description
    End If
  End If
End Sub

Private Sub mnuFilePageSetup_Click()
  dlgCommonDialog.ShowPrinter
End Sub

Private Sub mnuFileExit_Click()
  'unload the form
  Unload Me
End Sub