Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/ddepm/ddepm.frm

Visual Basic Form | 1995-05-07 | 12.2 KB | 353 lines

VERSION 2.00
Begin Form frmMain
   BackColor       =   &H00FFFFFF&
   Caption         =   "DDEPM.BAS Test Form"
   ClientHeight    =   5700
   ClientLeft      =   1140
   ClientTop       =   1545
   ClientWidth     =   8685
   Height          =   6105
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   380
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   579
   Top             =   1200
   Width           =   8805
   Begin TextBox txtProgManDDELink
      BackColor       =   &H00FFFF00&
      Height          =   285
      Left            =   0
      TabIndex        =   18
      Text            =   "txtProgManDDELink"
      Top             =   240
      Visible         =   0   'False
      Width           =   2055
   End
   Begin ListBox lstGroups
      Height          =   1395
      Left            =   240
      TabIndex        =   17
      Top             =   390
      Width           =   7845
   End
   Begin Frame fmeOtherFunctions
      Caption         =   "Other Functions"
      Height          =   3225
      Left            =   5580
      TabIndex        =   0
      Top             =   1890
      Width           =   2505
      Begin CommandButton btnddepmGetGroups
         Caption         =   "ddepmGetGroups"
         Height          =   465
         Left            =   150
         TabIndex        =   16
         Top             =   1500
         Width           =   2205
      End
      Begin CommandButton btnddepmGroupInfo
         Caption         =   "ddepmGroupInfo"
         Height          =   465
         Left            =   150
         TabIndex        =   1
         Top             =   960
         Width           =   2205
      End
      Begin CommandButton btnddepmExitProgMan
         Caption         =   "ddepmExitProgMan"
         Height          =   465
         Left            =   150
         TabIndex        =   2
         Top             =   420
         Width           =   2205
      End
      Begin Label lblNote
         Caption         =   "First do GetGroups then select a groupname in the list and do GroupInfo."
         ForeColor       =   &H00FF0000&
         Height          =   735
         Left            =   180
         TabIndex        =   19
         Top             =   2100
         Width           =   2205
      End
   End
   Begin Frame fmeGroupFunctions
      Caption         =   "Group Functions"
      Height          =   3225
      Left            =   2910
      TabIndex        =   10
      Top             =   1890
      Width           =   2505
      Begin CommandButton btnddepmShowGroup
         Caption         =   "ddepmShowGroup"
         Enabled         =   0   'False
         Height          =   465
         Left            =   150
         TabIndex        =   15
         Top             =   2580
         Width           =   2205
      End
      Begin CommandButton btnddepmSelectGroup
         Caption         =   "ddepmSelectGroup"
         Height          =   465
         Left            =   150
         TabIndex        =   14
         Top             =   2040
         Width           =   2205
      End
      Begin CommandButton btnddepmReloadGroup
         Caption         =   "ddepmReloadGroup"
         Height          =   465
         Left            =   150
         TabIndex        =   13
         Top             =   1500
         Width           =   2205
      End
      Begin CommandButton btnddepmDeleteGroup
         Caption         =   "ddepmDeleteGroup"
         Height          =   465
         Left            =   150
         TabIndex        =   12
         Top             =   960
         Width           =   2205
      End
      Begin CommandButton btnddepmCreateGroup
         Caption         =   "ddepmCreateGroup"
         Height          =   465
         Left            =   150
         TabIndex        =   11
         Top             =   420
         Width           =   2205
      End
   End
   Begin Frame fmeItemFunctions
      Caption         =   "Item Functions"
      Height          =   3225
      Left            =   240
      TabIndex        =   4
      Top             =   1890
      Width           =   2505
      Begin CommandButton btnddepmReplaceItem
         Caption         =   "ddepmReplaceItem"
         Height          =   465
         Left            =   150
         TabIndex        =   9
         Top             =   2580
         Width           =   2205
      End
      Begin CommandButton btnddepmDeleteItem
         Caption         =   "ddepmDeleteItem"
         Height          =   465
         Left            =   150
         TabIndex        =   8
         Top             =   2040
         Width           =   2205
      End
      Begin CommandButton btnddepmAddItemExtT
         Caption         =   "ddepmAddItemExtT"
         Enabled         =   0   'False
         Height          =   465
         Left            =   150
         TabIndex        =   7
         Top             =   1500
         Width           =   2205
      End
      Begin CommandButton btnddepmAddItemExt
         Caption         =   "ddepmAddItemExt"
         Height          =   465
         Left            =   150
         TabIndex        =   6
         Top             =   960
         Width           =   2205
      End
      Begin CommandButton btnddepmAddItem
         Caption         =   "ddepmAddItem"
         Height          =   465
         Left            =   150
         TabIndex        =   5
         Top             =   420
         Width           =   2205
      End
   End
   Begin Label lblProgManDDELink
      Alignment       =   2  'Center
      BackColor       =   &H00FFFF00&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblProgManDDELink"
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Visible         =   0   'False
      Width           =   8685
   End
Option Explicit
DefInt A-Z
Dim mlblDDELink As label
Sub btnddepmAddItem_Click ()
    Dim i%
    '-- 08/05/93
    '-- OK
    Call ddepmAddItem(mlblDDELink, "Clock.EXE", "Item1")
    '-- 08/05/93
    '-- OK
    'For i% = 1 To 30
    '    Call ddepmAddItem(mlblDDELink, "Clock.EXE", "Item" & i%)
    'Next i%
    '-- 08/08/93
    '-- If CmdLine is Null("") then the method won't execute.
    '-- If CmdLine contains even 1 letter then it will execute.
    'Call ddepmAddItem(mlblDDELink, "r", "")
End Sub
Sub btnddepmAddItemExt_Click ()
    Dim i%
    Dim CmdLine$, ItemName$
    Dim IconPath$, DefDir$, HotKey%
    Dim IconIndex%, xPos%, yPos%, RunMinimized%
    '-- 08/08/93
    '-- OK
    CmdLine$ = "Clock.exe"
    'For i% = 1 To 5
        ItemName$ = "Item" & i%
        xPos% = xPos% + 32
        yPos% = yPos% + 32
        HotKey% = HOTKEY_MOD_CTRL + Asc("X")
        DefDir$ = "C:\WinApps"
        RunMinimized% = True
        Call ddepmAddItemExt(mlblDDELink, CmdLine$, ItemName$, IconPath$, IconIndex%, xPos%, yPos%, DefDir$, HotKey%, RunMinimized%)
    'Next i%
End Sub
Sub btnddepmCreateGroup_Click ()
    Dim GroupName$, GroupPath$
    '-- 08/08/93
    '-- OK
    GroupName$ = "ddepmCreateGroup Test"
    GroupPath$ = "ddepm"
    Call ddepmCreateGroup(mlblDDELink, GroupName$, GroupPath$)
    '-- 08/08/93
    '-- OK
    'GroupName$ = "ddepmCreateGroup Test"
    'GroupPath$ = ""
    'Call ddepmCreateGroup(mlblDDELink, GroupName$, GroupPath$)
    '-- 08/08/93
    '-- OK *BUT* the ddepmDelete function *cannot* delete groups
    '   that have a Null("") name or names that contain only spaces.
    'GroupName$ = ""
    'GroupPath$ = "ddepm"
    'Call ddepmCreateGroup(mlblDDELink, GroupName$, GroupPath$)
    '-- 08/08/93
    '-- If Both the GroupName and GroupPath are Null("") then
    '   no error is generated but no group is created.
    'GroupName$ = ""
    'GroupPath$ = ""
    'Call ddepmCreateGroup(mlblDDELink, GroupName$, GroupPath$)
End Sub
Sub btnddepmDeleteGroup_Click ()
    Dim GroupName$
    '-- 08/08/93
    '-- OK
    GroupName$ = "ddepmCreateGroup Test"
    Call ddepmDeleteGroup(mlblDDELink, GroupName$)
    '-- 08/08/93
    '-- This fails if GroupName is Null("") or contains
    '   only spaces(even if it matches the group name of
    '   nothing but spaces). So if you accidentally create
    '   a group with a Null name you can't delete it via
    '   DDE.
    'GroupName$ = ""
    'Call ddepmDeleteGroup(mlblDDELink, GroupName$)
End Sub
Sub btnddepmDeleteItem_Click ()
    Dim i%
    Dim ItemToDelete$
    '-- 08/05/93
    '-- OK
    ItemToDelete$ = InputBox("Item to delete")
    Call ddepmDeleteItem(mlblDDELink, ItemToDelete$, "")
    '-- 08/05/93
    '-- OK
    'For i% = 1 To 30
    '    Call ddepmDeleteItem(mlblDDELink, "Item" & i%, "")
    'Next i%
    '-- 08/08/93
    '-- If CmdLine is Null("") then the method won't execute.
    '-- If the Item specified doesn't exist then the method
    '   won't execute.
    '-- If CmdLine Matches and ItemName does not, the
    '   command will execute but will flag an error that
    '   it was unable to execute. Hmmm.
    'Call ddepmDeleteItem(mlblDDELink, "", "")
End Sub
Sub btnddepmExitProgMan_Click ()
    Call ddepmExitProgMan(mlblDDELink, False)
End Sub
Sub btnddepmGetGroups_Click ()
    Dim i%
    Dim GetGroups%
    ReDim arrGroups$(0)
    GetGroups% = ddepmGetGroups(mlblDDELink, arrGroups$())
    lstGroups.Clear
    For i% = 0 To UBound(arrGroups$)
        lstGroups.AddItem arrGroups$(i%)
    Next i%
End Sub
Sub btnddepmGroupInfo_Click ()
    Dim GroupInfo%
    Dim i%
    Dim GroupName$
    ReDim tarrGroupItems(0) As T_ProgManGroupItem
    GroupName$ = lstGroups.Text
    GroupInfo% = ddepmGroupInfo(frmMain!txtProgManDDELink, GroupName$, tarrGroupItems())
    '-- The initial group info (retreived in the first line) ideally
    '   wouldn't be in an element of the array of items because its
    '   contents don't match the elements in the Type. Oh well, it's
    '   just a test.<g>
    Cls
    Print "GROUP: "; tarrGroupItems(0).Name & "     FILE: " & tarrGroupItems(0).CmdLine
    lstGroups.Clear
    For i% = 1 To UBound(tarrGroupItems)
        lstGroups.AddItem "Name: " & tarrGroupItems(i%).Name & "  CmdLine: " & tarrGroupItems(i%).CmdLine
        lstGroups.AddItem "DefDir: " & tarrGroupItems(i%).DefaultDir & "  Icon Path: " & tarrGroupItems(i%).IconPath
        lstGroups.AddItem "X:" & tarrGroupItems(i%).xPos & "  Y:" & tarrGroupItems(i%).yPos & "  Hot-Key:" & tarrGroupItems(i%).HotKey
        lstGroups.AddItem "Icon:" & tarrGroupItems(i%).IconIndex & "  Minimize:" & tarrGroupItems(i%).RunMinimized
        lstGroups.AddItem "************************************************"
    Next i%
End Sub
Sub btnddepmReloadGroup_Click ()
    Dim GroupName$
    '-- 08/08/93
    '-- OK if Groupname exists generates Error(won't execute
    '   method) if not.
    GroupName$ = "ddepmCreateGroup Test"
    Call ddepmReloadGroup(mlblDDELink, GroupName$)
    '-- 08/08/93
    '-- Doesn't generate an error but it does seem to think
    '   about it for a second before returning.
    'GroupName$ = ""
    'Call ddepmReloadGroup(mlblDDELink, GroupName$)
End Sub
Sub btnddepmReplaceItem_Click ()
    Dim OldItem$, NewCmdLine$, NewItemName$
    '-- 08/08/93
    '-- OK
    OldItem$ = "Item1"
    NewCmdLine$ = "NotePad.EXE"
    NewItemName$ = "Notepad"
    Call ddepmReplaceItem(mlblDDELink, OldItem$, NewCmdLine$, NewItemName$)
End Sub
Sub btnddepmSelectGroup_Click ()
    Dim GroupName$
    '-- 08/09/93
    '-- Works only if the Group is minimized. If the
    '   Group is in a normal window state but not
    '   active then it doesn't work.
    GroupName$ = "ddepmCreateGroup Test"
    Call ddepmSelectGroup(mlblDDELink, GroupName$)
End Sub
Sub filGroupFiles_Click ()
End Sub
Sub Form_Load ()
    Set mlblDDELink = frmMain!lblProgManDDELink
End Sub