vbAccelerator - Contents of code file: frmFixedGroups.frm
VERSION 5.00
Object = "{3D811CB0-6F63-4CA8-BD1E-7858AC6C9A00}#5.6#0"; "vbalSGrid.ocx"
Begin VB.Form frmFixedGroups
Caption = "vbAccelerator SGrid Fixed Groups Sample"
ClientHeight = 4395
ClientLeft = 4275
ClientTop = 3825
ClientWidth = 9000
Icon = "frmFixedGroups.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4395
ScaleWidth = 9000
Begin vbAcceleratorSGrid.vbalGrid grdFixedGroups
Height = 3975
Left = 120
TabIndex = 0
Top = 120
Width = 8715
_ExtentX = 15372
_ExtentY = 7011
BackgroundPictureHeight= 0
BackgroundPictureWidth= 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderStyle = 2
DisableIcons = -1 'True
End
Begin VB.Menu mnuFileTOP
Caption = "&File"
Begin VB.Menu mnuFile
Caption = "&New..."
Index = 0
Shortcut = ^N
End
Begin VB.Menu mnuFile
Caption = "&Open..."
Index = 1
Shortcut = ^O
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 2
End
Begin VB.Menu mnuFile
Caption = "&Save"
Index = 3
Shortcut = ^S
End
Begin VB.Menu mnuFile
Caption = "&Save As..."
Index = 4
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 5
End
Begin VB.Menu mnuFile
Caption = "E&xit"
Index = 6
End
End
Begin VB.Menu mnuEditTOP
Caption = "&Edit"
Begin VB.Menu mnuEdit
Caption = "&Add New..."
Index = 0
Shortcut = ^A
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 1
End
Begin VB.Menu mnuEdit
Caption = "&Resolve..."
Index = 2
Shortcut = ^R
End
Begin VB.Menu mnuEdit
Caption = "&Unresolve..."
Index = 3
Shortcut = ^U
End
Begin VB.Menu mnuEdit
Caption = "&Identify Resolution..."
Index = 4
Shortcut = ^I
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 5
End
Begin VB.Menu mnuEdit
Caption = "&Change Type..."
Index = 6
Shortcut = ^T
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 7
End
Begin VB.Menu mnuEdit
Caption = "&Delete..."
Index = 8
Shortcut = ^D
End
End
Begin VB.Menu mnuHelpTOP
Caption = "&Help"
Begin VB.Menu mnuHelp
Caption = "&vbAccelerator.com..."
Index = 0
Shortcut = {F1}
End
Begin VB.Menu mnuHelp
Caption = "-"
Index = 1
End
Begin VB.Menu mnuHelp
Caption = "&About..."
Index = 2
End
End
End
Attribute VB_Name = "frmFixedGroups"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As
Long) As Long
Private Const SW_SHOWNORMAL = 1
Private m_cDoc As cBugList
Private Sub AddNewBug()
Dim lSelCol As Long
Dim lSelRow As Long
Dim fNew As New frmAddNew
lSelCol = grdFixedGroups.SelectedCol
lSelRow = grdFixedGroups.SelectedRow
Select Case grdFixedGroups.RowGroupingLevel(lSelRow)
Case 0
' a bug is selected
fNew.BugType = grdFixedGroups.CellText(lSelRow, 2)
Case 1, 2
' bug + status is selected
fNew.BugType = grdFixedGroups.CellText(lSelRow, 2)
fNew.BugStatus = grdFixedGroups.CellText(lSelRow, 6)
End Select
fNew.Show vbModal, Me
If Not (fNew.Cancelled) Then
m_cDoc.AddNewBug fNew.BugType, fNew.BugStatus, fNew.Headline, fNew.Author
End If
End Sub
Private Sub Form_Load()
Dim sDemoFile As String
sDemoFile = App.Path
If (right(sDemoFile, 1) <> "\") Then
sDemoFile = sDemoFile & "\"
End If
sDemoFile = sDemoFile & "/home/VB/Code/Controls/S_Grid_2/ListView_Style_Grouping/12138.xml"
Set m_cDoc = New cBugList
m_cDoc.Initialise grdFixedGroups
m_cDoc.File = sDemoFile
End Sub
Private Sub Form_Resize()
On Error Resume Next
grdFixedGroups.Move grdFixedGroups.left, grdFixedGroups.top, _
Me.ScaleWidth - grdFixedGroups.left * 2, _
Me.ScaleHeight - grdFixedGroups.top - grdFixedGroups.left
End Sub
Private Sub grdFixedGroups_MouseUp(Button As Integer, Shift As Integer, x As
Single, y As Single)
Dim lSelCol As Long
Dim lSelRow As Long
If (Button = vbRightButton) Then
lSelCol = grdFixedGroups.SelectedCol
lSelRow = grdFixedGroups.SelectedRow
If (lSelCol > 0) And (lSelRow > 0) Then
Me.PopupMenu mnuEditTOP, , x + grdFixedGroups.left +
Screen.TwipsPerPixelX, y + grdFixedGroups.top + Screen.TwipsPerPixelY
End If
End If
End Sub
Private Sub grdFixedGroups_RowGroupingStateChange(ByVal lRow As Long, ByVal
eNewState As vbAcceleratorSGrid.ECGGroupRowState, bCancel As Boolean)
If (eNewState = ecgCollapsed) Then
bCancel = True
End If
End Sub
Private Sub grdFixedGroups_SelectionChange(ByVal lRow As Long, ByVal lCol As
Long)
Dim lSelCol As Long
Dim lSelRow As Long
Dim bStateChange As Boolean
lSelCol = grdFixedGroups.SelectedCol
lSelRow = grdFixedGroups.SelectedRow
If (lSelCol > 0) And (lSelRow > 0) Then
bStateChange = Not (grdFixedGroups.RowIsGroup(lSelRow))
Else
bStateChange = False
mnuEdit(1).Enabled = False
End If
mnuEdit(2).Enabled = bStateChange
mnuEdit(3).Enabled = bStateChange
mnuEdit(4).Enabled = bStateChange
mnuEdit(6).Enabled = bStateChange
mnuEdit(8).Enabled = bStateChange
End Sub
Private Sub mnuEdit_Click(Index As Integer)
Select Case Index
Case 0
' Add new
AddNewBug
Case Else
MsgBox "Not implemented in this demonstration.", vbInformation
End Select
End Sub
Private Sub mnuFile_Click(Index As Integer)
Select Case Index
Case 7
Unload Me
Case Else
MsgBox "Not implemented in this demonstration", vbInformation
End Select
End Sub
Private Sub mnuHelp_Click(Index As Integer)
Select Case Index
Case 0
ShellExecute Me.hWnd, "open", "/index.html", "", "",
SW_SHOWNORMAL
Case 2
frmAbout.Show vbModal, Me
End Select
End Sub
|
|