home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pminfo / pmmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  7.1 KB  |  215 lines
  1. VERSION 2.00
  2. Begin Form PMMainForm 
  3.    BackColor       =   &H8000000F&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   3195
  7.    ClientLeft      =   2430
  8.    ClientTop       =   3060
  9.    ClientWidth     =   5910
  10.    Height          =   3600
  11.    Icon            =   PMMAIN.FRX:0000
  12.    Left            =   2370
  13.    LinkMode        =   1  'Source
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   3195
  17.    ScaleWidth      =   5910
  18.    Top             =   2715
  19.    Width           =   6030
  20.    Begin CommandButton PrintButton 
  21.       Caption         =   "Save To Word"
  22.       Enabled         =   0   'False
  23.       FontBold        =   0   'False
  24.       FontItalic      =   0   'False
  25.       FontName        =   "MS Sans Serif"
  26.       FontSize        =   8.25
  27.       FontStrikethru  =   0   'False
  28.       FontUnderline   =   0   'False
  29.       Height          =   375
  30.       Left            =   2160
  31.       TabIndex        =   4
  32.       Top             =   2760
  33.       Width           =   1575
  34.    End
  35.    Begin CommandButton PMInfoButton 
  36.       Caption         =   "Get Progman Info"
  37.       FontBold        =   0   'False
  38.       FontItalic      =   0   'False
  39.       FontName        =   "MS Sans Serif"
  40.       FontSize        =   8.25
  41.       FontStrikethru  =   0   'False
  42.       FontUnderline   =   0   'False
  43.       Height          =   375
  44.       Left            =   120
  45.       TabIndex        =   1
  46.       Top             =   2760
  47.       Width           =   1575
  48.    End
  49.    Begin CommandButton QuitButton 
  50.       Caption         =   "Quit"
  51.       FontBold        =   0   'False
  52.       FontItalic      =   0   'False
  53.       FontName        =   "MS Sans Serif"
  54.       FontSize        =   8.25
  55.       FontStrikethru  =   0   'False
  56.       FontUnderline   =   0   'False
  57.       Height          =   375
  58.       Left            =   4200
  59.       TabIndex        =   3
  60.       Top             =   2760
  61.       Width           =   1575
  62.    End
  63.    Begin TextBox DDEText 
  64.       Height          =   285
  65.       Left            =   120
  66.       TabIndex        =   0
  67.       Top             =   3000
  68.       Visible         =   0   'False
  69.       Width           =   1455
  70.    End
  71.    Begin PictureBox Ctl3D1 
  72.       Height          =   480
  73.       Left            =   0
  74.       ScaleHeight     =   450
  75.       ScaleWidth      =   1170
  76.       TabIndex        =   5
  77.       Top             =   2280
  78.       Width           =   1200
  79.    End
  80.    Begin Outline PMOutline 
  81.       Height          =   2535
  82.       Left            =   120
  83.       PictureClosed   =   PMMAIN.FRX:0302
  84.       PictureLeaf     =   PMMAIN.FRX:045C
  85.       PictureMinus    =   PMMAIN.FRX:05B6
  86.       PictureOpen     =   PMMAIN.FRX:0710
  87.       PicturePlus     =   PMMAIN.FRX:086A
  88.       TabIndex        =   2
  89.       Top             =   120
  90.       Width           =   5655
  91.    End
  92. Sub Form_Load ()
  93. CenterForm PMMainForm
  94. PMMainForm.Caption = ProgTitle
  95. End Sub
  96. Sub PMInfoButton_Click ()
  97. Dim Looper As Integer
  98. On Error GoTo PMInfoError
  99. Screen.MousePointer = 11
  100. 'turn off the print button (in case this isn't the first time we're running this
  101. PrintButton.Enabled = False
  102. 'set up our DDE topics with progman so we can get the info we want
  103. DDEText.LinkTopic = "ProgMan|ProgMan"
  104. DDEText.LinkItem = "PROGMAN"
  105. DDEText.LinkMode = COLD_LINK
  106. 'get the text from program manager of all the groups
  107. DDEText.LinkRequest
  108. 'parse out the group names into an array
  109. If Not FillGroupList() Then
  110.   'if couldn't get group name list then quit
  111.   MsgBox "Unable to get list of groups.", 16, ProgTitle
  112.   Screen.MousePointer = 0
  113.   Exit Sub
  114. End If
  115. 'clear out the text so we can get the individual information for each group
  116. DDEText.Text = ""
  117. 'dimension the group information array
  118. ReDim GroupInfoList(0)
  119. 'go through each group and read in all the information
  120. For Looper = 1 To UBound(GroupList)
  121.   'set the linkitem equal to the name of the group for which we want information
  122.   DDEText.LinkItem = GroupList(Looper).Name
  123.   'turn the conversation on to suck in the information
  124.   DDEText.LinkMode = COLD_LINK
  125.   'request the info
  126.   DDEText.LinkRequest
  127.   'plug the group information into our array
  128.   If Not FillGroupInfoList(Looper) Then
  129.     MsgBox "Unable to get individual group information.", 16, ProgTitle
  130.     Screen.MousePointer = 0
  131.     Exit Sub
  132.   End If
  133. Next Looper
  134. 'compile the information into our master list
  135. If Not FillMasterList() Then
  136.   MsgBox "Unable to compile ProgMan information.", 16, ProgTitle
  137.   Screen.MousePointer = 0
  138.   Exit Sub
  139. End If
  140. 'clear the outline control
  141. PMOutline.Clear
  142. 'fill the outline with the ProgMan data
  143. FillPMOutline
  144. 'enable the print button
  145. PrintButton.Enabled = True
  146. PMInfoResume:
  147. Screen.MousePointer = 0
  148. Exit Sub
  149. PMInfoError:
  150. MsgBox "Error #" + Trim$(Str$(Err)) + " - " + Error + " - has occurred."
  151. Resume PMInfoResume
  152. End Sub
  153. Sub PrintButton_Click ()
  154. Dim Looper As Integer
  155. Dim CurLevel As Integer
  156. Dim LastLevel As Integer
  157. Dim Msg As String
  158. On Error GoTo PrintError
  159. Msg = "This will take a few moments; the screen won't be updated until "
  160. Msg = Msg + "all the information has been put into Word.  Do you want "
  161. Msg = Msg + "to continue?"
  162. 'let the user know that they're going to have to wait
  163. If MsgBox(Msg, YES_NO_QUESTION, ProgTitle) = NO Then Exit Sub
  164. 'open up Word
  165. Set OhMyWord = CreateObject("word.basic")
  166. 'maximize the window if necessary
  167. If Not OhMyWord.AppMaximize() Then OhMyWord.AppMaximize
  168. 'open a new document
  169. OhMyWord.FileNew
  170. 'set the header information
  171. OhMyWord.ViewHeader        'move to the header
  172. OhMyWord.Bold              'turn on bold
  173. OhMyWord.Insert ProgTitle  'insert my program name
  174. OhMyWord.Insert Chr$(9)    'tab over once
  175. OhMyWord.Insert Chr$(9)    'tab over again
  176. OhMyWord.Insert Format$(Date, "mmmm d, yyyy")  'insert the date
  177. OhMyWord.Bold              'turns bold back off
  178. OhMyWord.ViewHeader        'move back to the document
  179. 'switch to outline view
  180. OhMyWord.ViewOutline
  181. 'initialize level variable
  182. LastLevel = 1
  183. For Looper = 1 To UBound(MasterList)
  184.   'add the text to the document
  185.   OhMyWord.Insert MasterList(Looper).Name
  186.   'figure out indentation
  187.   CurLevel = MasterList(Looper).Level
  188.   If CurLevel = LastLevel Then          'we're at the same level; don't need to do anything
  189.   ElseIf CurLevel > LastLevel Then      'we've gone down a level
  190.     OhMyWord.OutlineDemote              'move the outline down a level
  191.   ElseIf LastLevel - CurLevel = 1 Then  'we've gone up one level
  192.     OhMyWord.OutlinePromote
  193.   Else                                  'we've gone up two levels
  194.     OhMyWord.OutlinePromote
  195.     OhMyWord.OutlinePromote
  196.   End If
  197.   'go to the next line
  198.   OhMyWord.InsertPara
  199.   'set the level indicator
  200.   LastLevel = CurLevel
  201. Next Looper
  202. 'save the document
  203. OhMyWord.FileSaveAs DOC_NAME
  204. 'move to the start of the document
  205. OhMyWord.StartOfDocument
  206. PMMainForm.WindowState = WINDOW_MINIMIZED
  207. PrintResume:
  208. Exit Sub
  209. PrintError:
  210. MsgBox "Error #" + Trim$(Str$(Err)) + " - " + Error + " - has occurred."
  211. Resume PrintResume
  212. End Sub
  213. Sub QuitButton_Click ()
  214. End Sub
  215.