frmqueryresult.frm

通用书店管理系统

        .Editable = flexEDKbdMouse
        .ExtendLastCol = True
        
        .FixedRows = 1
        .Cols = 1
        .ColKey(0) = 0
        
        .Clear
        
        Dim i%
        .Cols = UBound(arrHeader) + 2
        For i = 0 To UBound(arrHeader)
            fg.Cell(flexcpText, 0, i + 1) = arrHeader(i)
            fg.ColKey(i + 1) = i + 1
            fg.ColWidth(i + 1) = Me.TextWidth("好") * Len(arrHeader(i)) + 100
        Next i
        lngColKey = fg.Cols - 1
        .FixedAlignment(-1) = flexAlignCenterCenter
        
        '进行列头合并处理
        Dim strTempHeaderMerge$
        strTempHeaderMerge = strHeaderMerge
        Call MergeHeader(strTempHeaderMerge)
        
        .LoadArray (arrInputArray)
        
    End With
    
    Set dlg.frmQR = Me
        
    Call setStatusBar
    
    Call PreExcute      '进行代码预处理
    
    
End Sub

Private Sub Data_Aggregate_Click()
    If fg.Rows <= 1 Or fg.Cols <= 1 Then
        MsgBox "无计算数据！"
        Exit Sub
    End If
        
    Dim r1&, c1&, r2&, c2&
    Call fg.GetSelection(r1, c1, r2, c2)
    If r1 = r2 And c1 = c2 Then
        MsgBox "请选种需计算数据的区域！", vbInformation, "提示"
        Exit Sub
    End If
    
    dlg.ShowSetup ("表格运算")
End Sub

Private Sub Data_CustomGroup_Click()
    
    dlg.ShowSetup ("自定义分组")
End Sub

Private Sub Data_SingleGroup_Click()
    '单列分组
    If fg.Cols <= 1 Then Exit Sub
    With fg
        .MergeCells = flexMergeNever
        .MergeCol(-1) = False
        
        .MergeCells = flexMergeRestrictRows
        .ColPosition(.ColSel) = 1
        .MergeCol(1) = True
    End With
End Sub

Private Sub Data_SortAscending_Click()
    '从小到大排序
    If fg.Cols <= 1 Then Exit Sub
    
    fg.ColSort(fg.ColSel) = flexSortGenericAscending
    fg.Sort = flexSortUseColSort
End Sub

Private Sub Data_SortDescending_Click()
    '从大到小排序
    If fg.Cols <= 1 Then Exit Sub
    
    fg.ColSort(fg.ColSel) = flexSortGenericDescending
    fg.Sort = flexSortUseColSort
End Sub

Private Sub Data_Subtotal_Click()
    '汇总
    
    dlg.ShowSetup ("汇总")
    
End Sub

Private Sub Edit_Copy_Click()
    '拷贝
    Dim r1&, c1&, r2&, c2&
    
    Dim i&, j&
    Dim strTemp
    
    Call fg.GetSelection(r1, c1, r2, c2)
    For i = r1 To r2
        For j = c1 To c2
            strTemp = strTemp & fg.Cell(flexcpTextDisplay, i, j) & Chr(9)
        Next j
        strTemp = strTemp & Chr(13) & Chr(10)
    Next i
    VB.Clipboard.Clear
    VB.Clipboard.SetText strTemp
    
End Sub

Private Sub Edit_Cut_Click()
    '剪切
    
End Sub

Private Sub Edit_DeleteCol_Click()
    '删除列
    
    If fg.Cols <= 1 Then Exit Sub
    
    Dim r&, c&, r1&, c1&, r2&, c2&
    fg.GetSelection r1, c1, r2, c2
    
    For c = c2 To c1 Step -1
        fg.ColPosition(c) = fg.Cols - 1
        fg.Cols = fg.Cols - 1
    Next
    
End Sub

Private Sub Edit_DeleteRow_Click()
    '删除行
    If fg.Rows <= 1 Then Exit Sub
    
    Dim r&, c&, r1&, c1&, r2&, c2&
    fg.GetSelection r1, c1, r2, c2
    
    For r = r2 To r1 Step -1
        fg.RemoveItem r
    Next
    
    Call setStatusBar
    
End Sub

Private Sub Edit_Find_Click()
    '查找
    dlg.ShowSetup ("查找")
    
End Sub

Private Sub Edit_HideColumn_Click()
    '隐藏列
    Dim r&, c&, r1&, c1&, r2&, c2&
    fg.GetSelection r1, c1, r2, c2
    
    For c = c1 To c2
        fg.ColHidden(c) = True
    Next
End Sub

Private Sub Edit_HideRow_Click()
    '隐藏行
    Dim r&, c&, r1&, c1&, r2&, c2&
    fg.GetSelection r1, c1, r2, c2
    
    For r = r1 To r2
        fg.RowHidden(r) = True
    Next
End Sub

Private Sub Edit_Locate_Click()
    '定位
    dlg.ShowSetup ("定位")
End Sub

Private Sub Edit_Number_Click()
    '自然序号
    Dim lngNum As Long
    
    If Me.fg.OutlineBar = flexOutlineBarComplete Then
        MsgBox "在树型模式下不允许插入自然序号！"
        Edit_Number.Checked = False
        Exit Sub
    End If
    
    If fg.ColWidth(0) = 0 Then
        If fg.MergeCol(1) Then
            Dim lngNo&
            lngNo = 1
            For lngNum = fg.FixedRows To fg.Rows - 1
                If lngNum = fg.FixedRows Then
                    fg.Cell(flexcpText, lngNum, 0) = lngNum - fg.FixedRows + 1
                Else
                    If fg.Cell(flexcpText, lngNum, 1) = fg.Cell(flexcpText, lngNum - 1, 1) Then
                        fg.Cell(flexcpText, lngNum, 0) = lngNo
                    Else
                        lngNo = lngNo + 1
                        fg.Cell(flexcpText, lngNum, 0) = lngNo
                    End If
                End If
            Next lngNum
        Else
            For lngNum = fg.FixedRows To fg.Rows - 1
                fg.Cell(flexcpText, lngNum, 0) = lngNum - fg.FixedRows + 1
            Next lngNum
        End If
        
        Dim i%
        For i = 0 To fg.FixedRows - 1
            fg.Cell(flexcpText, i, 0) = "序号"
        Next i
        fg.MergeCells = flexMergeRestrictRows
        fg.MergeCol(0) = True
        
        fg.ColWidth(0) = Me.TextWidth("1") * IIf(Len(CStr(lngNum)) < 3, 3, Len(CStr(lngNum))) + 220
        Edit_Number.Checked = True
    Else
        fg.ColWidth(0) = 0
        Edit_Number.Checked = False
    End If
    
End Sub

Private Sub Edit_Replace_Click()
    dlg.ShowSetup ("替换")
End Sub

Private Sub Edit_SelectAll_Click()
    '全选
    Call Me.fg.Select(fg.FixedRows, 1, fg.Rows - 1, fg.Cols - 1)
    
End Sub

Private Sub Edit_ViewHiddenColumn_Click()
    '显示隐藏列
    fg.ColHidden(-1) = False
    
End Sub

Private Sub Edit_ViewHiddenRow_Click()
    '显示隐藏行
    Me.fg.RowHidden(-1) = False
    
End Sub

Private Sub fg_CellButtonClick(ByVal row As Long, ByVal Col As Long)

'    If Row = 0 And Col > 0 Then
'        Call fg.Select(0, fg.ColSel, fg.Rows - 1, fg.ColSel)
'    End If
'
'    If Col = 0 And Row > 0 Then
'        Call fg.Select(fg.RowSel, 0, fg.RowSel, fg.Cols - 1)
'    End If

End Sub

Private Sub File_Close_Click()
    '关闭窗体
    
    Unload Me
End Sub

Private Sub File_Print_Click()
    '打印
    Dim colFixed As Long
    
    '保存固定行列颜色
    colFixed = fg.BackColorFixed
    fg.BackColorFixed = vbWhite
    
    Dim ro As New ResultOutput
    ro.hwnd_FlexGrid = Me.fg.hWnd
    Set ro.PrintInfo = Me.defPrintInfo
    ro.showPrint
    
    '恢复固定行列颜色
    fg.BackColorFixed = colFixed
    
End Sub

Private Sub File_Reset_Click()
    '复位
    
    Call iniControl
    
End Sub

Private Sub File_Save_Click()
    '保存
    
    On Error Resume Next
    
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    Err.Number = 0
    If Trim(strFileName) = "" Then
        cd.CancelError = True
        cd.Filter = "Excel文件 (*.Xls)|*.Xls|Text文件 (*.Txt)|*.Txt"
        cd.ShowSave
        If Err.Number = 0 Then
            If fs.FileExists(cd.FileName) Then
                If MsgBox("该文件已经存在，是否覆盖原文件？", vbYesNo + vbInformation, "警告") = vbYes Then
                    Call fg.SaveGrid(strFileName, flexFileTabText)
                    strFileName = cd.FileName
                End If
            Else
                Call fg.SaveGrid(strFileName, flexFileTabText)
                strFileName = cd.FileName
            End If
        End If
    Else
        Call fg.SaveGrid(strFileName, flexFileTabText)
        strFileName = cd.FileName
    End If
    
End Sub

Private Sub File_SaveAs_Click()
    '另存为
    
    On Error Resume Next
    
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    Err.Number = 0
    
    cd.FileName = strFileName
    cd.CancelError = True
    cd.Filter = "Excel文件 (*.Xls)|*.Xls|Text文件 (*.Txt)|*.Txt"
    cd.ShowSave
    
    If Err.Number = 0 Then
        If fs.FileExists(cd.FileName) Then
            If MsgBox("该文件已经存在，是否覆盖原文件？", vbYesNo + vbInformation, "警告") = vbYes Then
                Call fg.SaveGrid(strFileName, flexFileTabText)
                strFileName = cd.FileName
            End If
        Else
            Call fg.SaveGrid(strFileName, flexFileTabText)
            strFileName = cd.FileName
        End If
    End If
    
    
End Sub

Private Sub Form_Load()
    Call iniControl     '控件初始化
End Sub

Private Sub Form_Resize()
    '动态地改变控件大小
    If Me.ScaleWidth > 400 Then fg.Width = Me.ScaleWidth - 300
    If Me.ScaleHeight > fg.Top + sb.Height + 250 Then
        fg.Height = Me.ScaleHeight - fg.Top - sb.Height - 200
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    '关闭对话框
    Unload dlg
    Set dlg = Nothing
    
End Sub

Private Sub Insert_AppendColumn_Click()
    '追加列
    fg.Cols = fg.Cols + 1
End Sub

Private Sub Insert_AppendRow_Click()
    '追加行