progman.bas

制作安装程序必备此模块包含的SUB及Function能帮你做出专业的安装程序

' This Module contains sub/functions to help you writing
' great installation apps.
'
' The functions in this module enable you to :
'
'       Create Program Manager Groups         (CreateProgmanGroup)
'       Create Program Manager Icons          (CreateProgmanGroup)
'       Delete Program Manager Group          (DeleteProgmanGroup)
'       Restore Program Manager wind.         (Restore Program Manager)
'       Shade Form like in other setup progs. (ShadeForm)
'
' See the subs for parameters and that kind of stuff.
' To use these functions you must have a label called DDELabel
' on your form (used for DDE). With Search and Replace in this
' module you can specify your own label name.
'
' I've tested it with Windows95. It only create menu items in
' the taskbar.

Sub CreateProgManGroup (xForm As Form, GroupName As String, GroupPath As String)
    
    ' Sub/Function Name       : CreateProgManGroup
    ' Purpose                 : Create Program Manager Group
    ' Parameters              : xForm (Form with Label named DDELabel)
    '                           Groupname (Name of Group to create)
    '                           GroupPath (Path were group is to be created)
    ' Created by              : Paul Treffers
    ' Date Created            : 12/05/95
    
    Screen.MousePointer = 11
    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next
    '--------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '--------------------------------
    xForm.DDELabel.LinkTopic = "ProgMan|Progman"
    xForm.DDELabel.LinkMode = 2
    For I% = 1 To 10                                         ' Loop to ensure that there is enough time to
      Z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    xForm.DDELabel.LinkTimeout = 100
    '---------------------
    ' Create program group
    '---------------------
    xForm.DDELabel.LinkExecute "[CreateGroup(" + GroupName$ + Chr$(44) + GroupPath$ + ")]"
    '-----------------
    ' Reset properties
    '-----------------
    xForm.DDELabel.LinkTimeout = 50
    xForm.DDELabel.LinkMode = 0
    
    Screen.MousePointer = 0
End Sub

Sub CreateProgManItem (xForm As Form, CmdLine As String, IconTitle As String)
    
    ' Sub/Function Name       : CreateProgManItem
    ' Purpose                 : Create Program Manager Item in Group
    ' Parameters              : xForm (Form with Label named DDELabel)
    '                           CMDLine (specify here a executable that is to be executed)
    '                           IconTitle (specify here a title for the icon)
    ' Created by              : Paul Treffers
    ' Date Created            : 12/05/95
    
    Dim I%
    Dim Z%
    Screen.MousePointer = 11
    
    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next


    '---------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '---------------------------------
    xForm.DDELabel.LinkTopic = "ProgMan|Progman"
    xForm.DDELabel.LinkMode = 2
    For I% = 1 To 10                                         ' Loop to ensure that there is enough time to
      Z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    xForm.DDELabel.LinkTimeout = 100
    '------------------------------------------------
    ' Create Program Item, one of the icons to launch
    ' an application from Program Manager
    '------------------------------------------------
    xForm.DDELabel.LinkExecute "[AddItem(" + CmdLine + Chr$(44) + IconTitle + Chr$(44) + ",,)]"
    xForm.DDELabel.LinkExecute "[ShowGroup(groupname, 1)]"
    '-----------------
    ' Reset properties
    '-----------------
    xForm.DDELabel.LinkTimeout = 50
    xForm.DDELabel.LinkMode = 0
    Screen.MousePointer = 0
End Sub

Sub DeleteProgManGroup (xForm As Form, GroupName As String)
    
    ' Sub/Function Name       : CreateProgManGroup
    ' Purpose                 : Create Program Manager Group
    ' Parameters              : xForm (Form with Label called DDELabel)
    '                           Groupname (Name of Group to delete)
    ' Created by              : Paul Treffers
    ' Date Created            : 12/05/95
    
    
    Dim I%
    Dim Z%
    Screen.MousePointer = 11
    On Error Resume Next
    xForm.DDELabel.LinkTopic = "ProgMan|Progman"
    xForm.DDELabel.LinkMode = 2
    For I% = 1 To 10                                         ' Loop to ensure that there is enough time to
      Z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    xForm.DDELabel.LinkTimeout = 100
    xForm.DDELabel.LinkExecute "[DeleteGroup(" + GroupName$ + ")]"
    xForm.DDELabel.LinkTimeout = 50
    xForm.DDELabel.LinkMode = 0
    Screen.MousePointer = 0

End Sub

Sub RestoreProgMan ()
    ' Sub/Function Name       : Restore Program
    ' Purpose                 : Restores Program Manager Window
    '                           Call this sub before starting dde with program manager
    ' Created by              : Paul Treffers
    ' Date Created            : 12/05/95
    On Error GoTo RestoreProgManErr
    AppActivate "Program Manager"   ' Activate Program Manager.
    SendKeys "%{ }{Enter}", True      ' Send Restore keystrokes.
RestoreProgManErr:
    Exit Sub
End Sub

Sub ShadeForm (Frm As Form)
    
    ' Sub/Function Name       : ShadeForm
    ' Purpose                 : Created a shaded form like the microsoft setups
    ' Parameters              : Form (Frm)
    ' Created by              : Paul Treffers
    ' Date Created            : 12/05/95
   
    
    Dim I As Integer
    Dim NumberOfRects As Integer
    Dim GradColor As Long
    Dim GradValue As Integer
    Frm.ScaleMode = 3
    Frm.DrawStyle = 6
    Frm.DrawWidth = 2
    Frm.AutoRedraw = True
    NbrOfRects = 64
    For I = 1 To 64
	GradValue = 255 - (I * 4 - 1)
	GradColor = RGB(0, 0, GradValue)
	Frm.Line (0, Frm.ScaleHeight * (I - 1) / 64)-(Frm.ScaleWidth, Frm.ScaleHeight * I / 64), GradColor, BF
    Next I
    Frm.Refresh

End Sub