home *** CD-ROM | disk | FTP | other *** search
/ Chip Hitware 7 B / CHIP_HITWARE_7B.iso / Edukacja / WorldView / worldview.exe / %MAINDIR% / Source / Main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-02-21  |  18.0 KB  |  512 lines

  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "WorldView"
  5.    ClientHeight    =   5430
  6.    ClientLeft      =   60
  7.    ClientTop       =   600
  8.    ClientWidth     =   9780
  9.    HelpContextID   =   10
  10.    Icon            =   "Main.frx":0000
  11.    KeyPreview      =   -1  'True
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   5430
  14.    ScaleWidth      =   9780
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.PictureBox picPicture 
  17.       BorderStyle     =   0  'None
  18.       Height          =   1335
  19.       Left            =   3960
  20.       ScaleHeight     =   1335
  21.       ScaleWidth      =   1935
  22.       TabIndex        =   4
  23.       TabStop         =   0   'False
  24.       Top             =   2520
  25.       Visible         =   0   'False
  26.       Width           =   1935
  27.       Begin VB.Image imgPicture 
  28.          BorderStyle     =   1  'Fixed Single
  29.          Height          =   855
  30.          Left            =   120
  31.          Stretch         =   -1  'True
  32.          Top             =   120
  33.          Width           =   1215
  34.       End
  35.    End
  36.    Begin ComctlLib.ProgressBar ProgressBar1 
  37.       Align           =   2  'Align Bottom
  38.       Height          =   255
  39.       Left            =   0
  40.       TabIndex        =   3
  41.       Top             =   5175
  42.       Width           =   9780
  43.       _ExtentX        =   17251
  44.       _ExtentY        =   450
  45.       _Version        =   327682
  46.       Appearance      =   1
  47.    End
  48.    Begin ComctlLib.ListView lvwInfo 
  49.       Height          =   1095
  50.       Left            =   3360
  51.       TabIndex        =   2
  52.       Top             =   720
  53.       Width           =   1815
  54.       _ExtentX        =   3201
  55.       _ExtentY        =   1931
  56.       View            =   3
  57.       LabelEdit       =   1
  58.       LabelWrap       =   -1  'True
  59.       HideSelection   =   0   'False
  60.       _Version        =   327682
  61.       Icons           =   "ImageList1"
  62.       SmallIcons      =   "ImageList1"
  63.       ForeColor       =   -2147483640
  64.       BackColor       =   -2147483643
  65.       BorderStyle     =   1
  66.       Appearance      =   1
  67.       NumItems        =   2
  68.       BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
  69.          Key             =   ""
  70.          Object.Tag             =   ""
  71.          Text            =   "Field"
  72.          Object.Width           =   2540
  73.       EndProperty
  74.       BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
  75.          SubItemIndex    =   1
  76.          Key             =   ""
  77.          Object.Tag             =   ""
  78.          Text            =   "Value"
  79.          Object.Width           =   2540
  80.       EndProperty
  81.    End
  82.    Begin ComctlLib.TreeView tvwCountry 
  83.       Height          =   4935
  84.       Left            =   0
  85.       TabIndex        =   0
  86.       Top             =   0
  87.       Width           =   3135
  88.       _ExtentX        =   5530
  89.       _ExtentY        =   8705
  90.       _Version        =   327682
  91.       HideSelection   =   0   'False
  92.       Indentation     =   529
  93.       LabelEdit       =   1
  94.       Style           =   7
  95.       ImageList       =   "ImageList1"
  96.       Appearance      =   1
  97.    End
  98.    Begin ComctlLib.TabStrip TabStrip1 
  99.       Height          =   2535
  100.       Left            =   4920
  101.       TabIndex        =   1
  102.       Top             =   0
  103.       Width           =   4815
  104.       _ExtentX        =   8493
  105.       _ExtentY        =   4471
  106.       MultiRow        =   -1  'True
  107.       _Version        =   327682
  108.       BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7} 
  109.          NumTabs         =   3
  110.          BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7} 
  111.             Caption         =   "Tab 1"
  112.             Key             =   ""
  113.             Object.Tag             =   ""
  114.             ImageVarType    =   2
  115.          EndProperty
  116.          BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7} 
  117.             Caption         =   "Tab 2"
  118.             Key             =   ""
  119.             Object.Tag             =   ""
  120.             ImageVarType    =   2
  121.          EndProperty
  122.          BeginProperty Tab3 {0713F341-850A-101B-AFC0-4210102A8DA7} 
  123.             Caption         =   "Tab 3"
  124.             Key             =   ""
  125.             Object.Tag             =   ""
  126.             ImageVarType    =   2
  127.          EndProperty
  128.       EndProperty
  129.    End
  130.    Begin ComctlLib.ImageList ImageList1 
  131.       Left            =   3000
  132.       Top             =   4680
  133.       _ExtentX        =   1005
  134.       _ExtentY        =   1005
  135.       BackColor       =   -2147483643
  136.       ImageWidth      =   14
  137.       ImageHeight     =   14
  138.       MaskColor       =   12632256
  139.       _Version        =   327682
  140.       BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
  141.          NumListImages   =   4
  142.          BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  143.             Picture         =   "Main.frx":0442
  144.             Key             =   "world"
  145.          EndProperty
  146.          BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  147.             Picture         =   "Main.frx":075C
  148.             Key             =   "info"
  149.          EndProperty
  150.          BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  151.             Picture         =   "Main.frx":0A76
  152.             Key             =   "right"
  153.          EndProperty
  154.          BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
  155.             Picture         =   "Main.frx":0D90
  156.             Key             =   "down"
  157.          EndProperty
  158.       EndProperty
  159.    End
  160.    Begin VB.Menu mnuFile 
  161.       Caption         =   "&File"
  162.       Begin VB.Menu mnuFileProperties 
  163.          Caption         =   "P&roperties"
  164.       End
  165.       Begin VB.Menu mnuSep1 
  166.          Caption         =   "-"
  167.       End
  168.       Begin VB.Menu mnuFileExit 
  169.          Caption         =   "E&xit"
  170.       End
  171.    End
  172.    Begin VB.Menu mnuHelp 
  173.       Caption         =   "&Help"
  174.       Begin VB.Menu mnuHelpCredits 
  175.          Caption         =   "&Credits"
  176.       End
  177.       Begin VB.Menu mnuSep2 
  178.          Caption         =   "-"
  179.       End
  180.       Begin VB.Menu mnuHelpAbout 
  181.          Caption         =   "&About"
  182.       End
  183.    End
  184. Attribute VB_Name = "frmMain"
  185. Attribute VB_GlobalNameSpace = False
  186. Attribute VB_Creatable = False
  187. Attribute VB_PredeclaredId = True
  188. Attribute VB_Exposed = False
  189. Option Explicit
  190. Dim objTabs As New clsItemCol
  191. Private Sub LoadCountries()
  192. On Error GoTo ErrHandler
  193. 'Dim db As ADODB.Connection
  194. 'Dim rs As ADODB.Recordset
  195. Dim db As Database
  196. Dim rs As Recordset
  197. Dim sName As String
  198. Dim NewNode As Node
  199.   'db.ConnectionString = GetConnectString & AppPath & "worldview.mdb"
  200.   'db.Open
  201.   'Set rs = New ADODB.Recordset
  202.   'Set rs = db.Execute("select Id, CountryNameShort, CountryNameLong from tbl_Country order by CountryNameShort")
  203.   Set db = OpenDatabase(GetDatabaseName)
  204.   Set rs = db.OpenRecordset("select Id, CountryNameShort, CountryNameLong from tbl_Country order by CountryNameShort")
  205.   tvwCountry.Nodes.Clear
  206.   While Not rs.EOF
  207.     sName = rs!CountryNameShort & ""
  208.     If StrComp(sName, "none", vbTextCompare) = 0 Then
  209.       sName = rs!CountryNameLong & ""
  210.     End If
  211.     If sName <> "" Then
  212.       Set NewNode = tvwCountry.Nodes.Add(, , , sName, "world")
  213.       NewNode.Tag = rs!Id
  214.     End If
  215.     rs.MoveNext
  216.   Wend
  217.   'Close Everything
  218.   rs.Close
  219.   db.Close
  220. EndSub:
  221.   Exit Sub
  222. ErrHandler:
  223.   Call SetErr(Err, Err.Description, Me.Name & ".LoadCountries")
  224.   GoTo EndSub
  225.   Resume
  226. End Sub
  227. Private Sub LoadCountry(ByVal CountryId As Long)
  228. On Error GoTo ErrHandler
  229. 'Dim db As New ADODB.Connection
  230. 'Dim rs As ADODB.Recordset
  231. Dim db As Database
  232. Dim rs As Recordset
  233. Dim i As Integer
  234. Dim j As Integer
  235. Dim sFieldName As String
  236. Dim NewItem As ListItem
  237. Dim lCount As Long
  238.   Screen.MousePointer = vbHourglass
  239.   'Set db = New ADODB.Connection
  240.   'db.ConnectionString = GetConnectString & AppPath & "worldview.mdb"
  241.   'db.Open
  242.   'Set rs = New ADODB.Recordset
  243.   'Set rs = db.Execute("select * from tbl_Country where Id = " & CountryId)
  244.   Set db = OpenDatabase(GetDatabaseName)
  245.   Set rs = db.OpenRecordset("select * from tbl_Country where Id = " & CountryId)
  246.   'Load the information if not EOF
  247.   lvwInfo.ListItems.Clear
  248.   If Not rs.EOF Then
  249.     'The last tab is the MAP
  250.     If Me.TabStrip1.SelectedItem.Index = Me.TabStrip1.Tabs.Count Then
  251.       If FileExists(AppPath & rs!picname) Then
  252.         Set imgPicture.Picture = LoadPicture(AppPath & rs!picname)
  253.       Else
  254.         Set imgPicture.Picture = LoadPicture("")
  255.       End If
  256.       Me.lvwInfo.Visible = False
  257.       picPicture.Visible = True
  258.     Else
  259.       Set imgPicture.Picture = LoadPicture("")
  260.       Me.lvwInfo.Visible = True
  261.       picPicture.Visible = False
  262.     End If
  263.     lCount = objTabs(Me.TabStrip1.SelectedItem.Index).Fields.Count
  264.     For i = 1 To lCount
  265.       sFieldName = objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i).Name
  266.       Set NewItem = lvwInfo.ListItems.Add(, , sFieldName, , "right")
  267.       
  268.       'If this item has subitems
  269.       'then display them
  270.       'else just display the value of this item
  271.       If objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i).Fields.Count > 0 Then
  272.         NewItem.SmallIcon = "down"
  273.         For j = 1 To objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i).Fields.Count
  274.           sFieldName = objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i).Fields(j).Name
  275.           Set NewItem = lvwInfo.ListItems.Add(, , "      " & sFieldName, , "info")
  276.           'Load the Value
  277.           Call SetItemValue(NewItem, rs(sFieldName).Type, rs(sFieldName) & "", objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i).Fields(j))
  278.         Next j
  279.       Else
  280.         'Load the Value
  281.         Call SetItemValue(NewItem, rs(sFieldName).Type, rs(sFieldName) & "", objTabs(Me.TabStrip1.SelectedItem.Index).Fields(i))
  282.       End If
  283.       
  284.       ProgressBar1.Value = (CLng(i) * 100) \ lCount
  285.       
  286.     Next i
  287.   End If
  288.   ProgressBar1.Value = 0
  289.   'Close Everything
  290.   rs.Close
  291.   db.Close
  292. EndSub:
  293.   Screen.MousePointer = vbDefault
  294.   SetCaption
  295.   Exit Sub
  296. ErrHandler:
  297.   Call SetErr(Err, Err.Description, Me.Name & ".LoadCountry")
  298.   GoTo EndSub
  299.   Resume
  300. End Sub
  301. Private Sub SetCaption()
  302. Dim sText As String
  303.   If (tvwCountry.SelectedItem Is Nothing) Then
  304.     sText = "<None>"
  305.   Else
  306.     sText = "[" & tvwCountry.SelectedItem.Text & "]"
  307.   End If
  308.   Me.Caption = App.CompanyName & " " & App.Title & " - " & sText
  309. End Sub
  310. Private Sub SetItemValue(ByVal NewItem As ListItem, ByVal lFieldType As Long, ByVal sFieldValue As String, ByVal objField As clsFieldEl)
  311. On Error GoTo ErrHandler
  312. Dim sFormat As String
  313.   If Val(sFieldValue) = -1 Then
  314.     sFieldValue = "NA"
  315.   End If
  316.   'Put the precision on it if necessary
  317.   sFormat = String(objField.Precision, "0")
  318.   If Len(sFormat) > 0 Then sFormat = "." & sFormat
  319.   sFormat = "###,###,###,###,##0" & sFormat
  320.   Select Case lFieldType
  321.     Case dbCurrency:
  322.       sFieldValue = "$" & Format(sFieldValue, sFormat)
  323.     'Case adDecimal, adDouble, adInteger, adNumeric, adSingle, adSmallInt, adTinyInt, adUnsigneadigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt:
  324.     Case dbDouble, dbInteger, dbSingle:
  325.       sFieldValue = Format(sFieldValue, sFormat)
  326.   End Select
  327.   NewItem.SubItems(1) = sFieldValue & " " & objField.Trailer
  328. EndSub:
  329.   Exit Sub
  330. ErrHandler:
  331.   Call SetErr(Err, Err.Description, Me.Name & ".SetItemValue")
  332.   GoTo EndSub
  333.   Resume
  334. End Sub
  335. Private Sub LoadTemplate()
  336. On Error GoTo ErrHandler
  337. 'This gets the Sections (tabs) from the template file
  338. Dim fle As Integer
  339. Dim sLineItem As String
  340. Dim sFieldName As String
  341. Dim sTrailer As String
  342. Dim sPrecision As String
  343. Dim lCount As Long
  344. Dim NewTab As clsItemEl
  345. Dim NewFieldCol As clsFieldCol
  346. Dim NewField As clsFieldEl
  347. Dim lIdx As Long
  348.   objTabs.Clear
  349.   fle = FreeFile
  350.   Open AppPath & "template.txt" For Input As fle
  351.   While Not EOF(fle)
  352.     'The line number
  353.     lCount = lCount + 1
  354.     'Now find the next line
  355.     Line Input #fle, sLineItem
  356.     'We are entering a new section, soes not apply to this program
  357.     If Left(sLineItem, 1) = "!" Then
  358.       Set NewTab = objTabs.Add(Trim(Right(sLineItem, Len(sLineItem) - 1)), lCount)
  359.       GoTo LineProcessed
  360.     End If
  361.     'We are entering Sub-Categories, so this header must exists first
  362.     If Left(sLineItem, 1) = "~" Then
  363.       'Set the field to the current fields collection
  364.       Set NewFieldCol = NewTab.Fields.Add(Trim(Right(sLineItem, Len(sLineItem) - 1)), "", 0).Fields
  365.       GoTo LineProcessed
  366.     End If
  367.     If sLineItem = "" Then
  368.       'Set back to the tabs fields
  369.       Set NewFieldCol = NewTab.Fields
  370.       GoTo LineProcessed
  371.     End If
  372.     'Parse the LineItem and get the information out of it
  373.     lIdx = InStr(1, sLineItem, "|")
  374.     If lIdx > 0 Then
  375.       'Get the Group Database fieldname
  376.       sFieldName = Left(sLineItem, lIdx - 1)
  377.       
  378.       'Get the Precision if this is a number
  379.       sLineItem = Right(sLineItem, Len(sLineItem) - Len(sFieldName) - 1)
  380.       lIdx = InStr(1, sLineItem, "|")
  381.       sPrecision = Mid(sLineItem, 1, lIdx - 1)
  382.       
  383.       'Get the Trailer that is the unit this value is in (km, in, etc...)
  384.       sLineItem = Right(sLineItem, Len(sLineItem) - Len(sPrecision) - 1)
  385.       lIdx = InStr(1, sLineItem, "|")
  386.       sTrailer = Mid(sLineItem, 1, lIdx - 1)
  387.       
  388.     End If
  389.     Call NewFieldCol.Add(sFieldName, sTrailer, Val(sPrecision))
  390. LineProcessed:
  391.   Wend
  392. EndSub:
  393.   Close fle
  394.   Set NewTab = Nothing
  395.   Exit Sub
  396. ErrHandler:
  397.   Call SetErr(Err, Err.Description, Me.Name & ".LoadTemplate")
  398.   GoTo EndSub
  399.   Resume
  400. End Sub
  401. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  402.   If KeyCode = vbKeyF5 Then
  403.     LoadCountries
  404.   End If
  405. End Sub
  406. Private Sub Form_Load()
  407. On Error GoTo ErrHandler
  408. Dim i As Integer
  409.   If Not IsDataAware Then End
  410.   Me.Width = Screen.Width * 0.6
  411.   Me.Height = Screen.Height * 0.6
  412.   Call SetCaption
  413.   Call LoadTemplate
  414.   lvwInfo.ColumnHeaders(1).Width = 2500
  415.   lvwInfo.ColumnHeaders(2).Width = 6000
  416.   'Load the TabStrip
  417.   TabStrip1.Tabs.Clear
  418.   For i = 1 To objTabs.Count
  419.     Call TabStrip1.Tabs.Add(, , objTabs(i).FieldName)
  420.   Next i
  421. EndSub:
  422.   LoadCountries
  423.   Exit Sub
  424. ErrHandler:
  425.   Call SetErr(Err, Err.Description, Me.Name & ".Form_Load")
  426.   GoTo EndSub
  427.   Resume
  428. End Sub
  429. Private Function IsDataAware() As Boolean
  430. '  If GetConnectString = "" Then
  431. '    IsDataAware = False
  432. '    Call MsgBox("This application requires Microsoft's DCOM and ADO. They must be installed in this order as well." & vbCrLf & "These components can be download from our website at http://www.gravitybox.com", vbInformation, "Application Terminated")
  433. '  Else
  434. '    IsDataAware = True
  435. '  End If
  436.     IsDataAware = True
  437. End Function
  438. Private Sub Form_Resize()
  439. On Error Resume Next
  440.   tvwCountry.Move 0, 0, tvwCountry.Width, Me.ScaleHeight - ProgressBar1.Height
  441.   TabStrip1.Move tvwCountry.Width, 0, Me.ScaleWidth - tvwCountry.Width, Me.ScaleHeight - ProgressBar1.Height
  442.   lvwInfo.Move TabStrip1.Left + 120, (TabStrip1.Height - TabStrip1.ClientHeight), TabStrip1.Width - 240, Me.ScaleHeight - (TabStrip1.Height - TabStrip1.ClientHeight) - ProgressBar1.Height - 120
  443.   picPicture.Move lvwInfo.Left, lvwInfo.Top, lvwInfo.Width, lvwInfo.Height
  444. End Sub
  445. Private Sub imgPicture_DblClick()
  446.   If imgPicture.Picture <> 0 Then
  447.     Load frmFullPic
  448.     Set frmFullPic.Image1.Picture = imgPicture.Picture
  449.     frmFullPic.Caption = Me.tvwCountry.SelectedItem.Text
  450.     frmFullPic.Width = frmFullPic.Image1.Width + (frmFullPic.Width - frmFullPic.ScaleWidth)
  451.     frmFullPic.Height = frmFullPic.Image1.Height + (frmFullPic.Height - frmFullPic.ScaleHeight)
  452.     frmFullPic.Show vbModal
  453.   End If
  454. End Sub
  455. Private Sub lvwInfo_DblClick()
  456.   If Not (lvwInfo.SelectedItem Is Nothing) Then
  457.     Load frmSupp
  458.     frmSupp.Caption = lvwInfo.SelectedItem.Text
  459.     frmSupp.Text1.Text = lvwInfo.SelectedItem.SubItems(1)
  460.     frmSupp.Show vbModal
  461.   End If
  462. End Sub
  463. Private Sub lvwInfo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  464. Dim NewItem As ListItem
  465.   Set NewItem = lvwInfo.HitTest(X, Y)
  466.   If (NewItem Is Nothing) Then
  467.     lvwInfo.ToolTipText = ""
  468.   Else
  469.     lvwInfo.ToolTipText = NewItem.SubItems(1)
  470.     Set lvwInfo.SelectedItem = NewItem
  471.   End If
  472. End Sub
  473. Private Sub mnuFileExit_Click()
  474.   Unload Me
  475. End Sub
  476. Private Sub mnuFileProperties_Click()
  477.   Call MsgBox("Country Count: " & Me.tvwCountry.Nodes.Count, vbInformation)
  478. End Sub
  479. Private Sub mnuHelpAbout_Click()
  480.   Set gAboutIcon = Me.Icon
  481.   frmAbout.Show vbModal
  482.   Set gAboutIcon = Nothing
  483. End Sub
  484. Private Sub mnuHelpCredits_Click()
  485. Dim sMsg As String
  486.   sMsg = "The information contained in this program was taken off the CIA World FactBook Site. This site can be found at the following internet address:" & vbCrLf & vbCrLf & _
  487.          "http://www.odci.gov/cia/publications/factbook/" & vbCrLf & vbCrLf & _
  488.          "All information contained within is property of the CIA and all accuracy is a direct result of CIA compilation of this information. GravityBox Software has only built this application to better display the given information. Neither this program nor its information content is for sale."
  489.   Call MsgBox(sMsg, vbInformation)
  490. End Sub
  491. Private Sub picPicture_Resize()
  492. On Error Resume Next
  493.   imgPicture.Move 0, 0, picPicture.Width, picPicture.Height
  494. End Sub
  495. Private Sub TabStrip1_Click()
  496.   If Not (tvwCountry.SelectedItem Is Nothing) Then
  497.     Call LoadCountry(tvwCountry.SelectedItem.Tag)
  498.   End If
  499. End Sub
  500. Private Sub tvwCountry_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  501. Dim NewNode As Node
  502.   Set NewNode = tvwCountry.HitTest(X, Y)
  503.   If (NewNode Is Nothing) Then
  504.     tvwCountry.ToolTipText = ""
  505.   Else
  506.     tvwCountry.ToolTipText = NewNode.Text
  507.   End If
  508. End Sub
  509. Private Sub tvwCountry_NodeClick(ByVal Node As ComctlLib.Node)
  510.   Call LoadCountry(Node.Tag)
  511. End Sub
  512.