frmset.frm

ktv场所的包房开房、迎宾、预定管理系统。

         Top             =   2295
         Width           =   4170
         _ExtentX        =   7355
         _ExtentY        =   2249
         View            =   3
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         FullRowSelect   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
   End
   Begin VB.CommandButton cmdConfirm 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   285
      Left            =   3735
      TabIndex        =   44
      Top             =   5310
      Width           =   1000
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   285
      Left            =   4860
      TabIndex        =   43
      Top             =   5310
      Width           =   1000
   End
   Begin VB.Frame fraTemplate 
      BorderStyle     =   0  'None
      Height          =   4500
      Left            =   405
      TabIndex        =   31
      Top             =   450
      Width           =   5200
      Begin VB.Frame Frame1 
         Height          =   4500
         Left            =   0
         TabIndex        =   33
         Top             =   0
         Width           =   5200
         Begin MSComDlg.CommonDialog dlg 
            Left            =   1305
            Top             =   2205
            _ExtentX        =   847
            _ExtentY        =   847
            _Version        =   393216
         End
         Begin VB.CommandButton cmdTemSaveAs 
            Caption         =   "另存为..."
            Height          =   330
            Left            =   405
            TabIndex        =   16
            Top             =   720
            Width           =   2175
         End
         Begin VB.CommandButton cmdTemLoad 
            Caption         =   "装载..."
            Height          =   330
            Left            =   405
            TabIndex        =   15
            Top             =   315
            Width           =   2175
         End
         Begin VB.Label Label8 
            AutoSize        =   -1  'True
            Caption         =   "当前模板位置："
            Height          =   180
            Left            =   450
            TabIndex        =   35
            Top             =   1350
            Width           =   1260
         End
         Begin VB.Label labtemplatefile 
            AutoSize        =   -1  'True
            Height          =   180
            Left            =   900
            TabIndex        =   34
            Top             =   1710
            Width           =   90
         End
      End
   End
   Begin MSComctlLib.TabStrip tabBK 
      Height          =   5145
      Left            =   135
      TabIndex        =   17
      Top             =   45
      Width           =   5730
      _ExtentX        =   10107
      _ExtentY        =   9075
      ShowTips        =   0   'False
      TabMinWidth     =   1058
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   5
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "页面设置"
            Key             =   "page"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "标签集合"
            Key             =   "collection"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "列头设置"
            Key             =   "colheader"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "表体设置"
            Key             =   "content"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab5 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "模板"
            Key             =   "template"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public WithEvents rpt       As report
Attribute rpt.VB_VarHelpID = -1

Private WithEvents HColheader   As cScrollBar
Attribute HColheader.VB_VarHelpID = -1
Private m_HColheader            As cScrollBar
Private WithEvents HContent     As cScrollBar
Attribute HContent.VB_VarHelpID = -1
Private m_HContent              As cScrollBar

Private bConfirm            As Boolean      '*是否确认了设置

Private bakFile             As String       '*暂时存放原先配置的文件
Private fn                  As Integer      '*文件号

Private cpColHeader         As Integer      '*当前分页（列头）
Private cpContent           As Integer      '*当前分页（正文）


Private preTab              As String       '*上一个TAB（为写入页面信息和分页用）

Private bDirty              As Boolean      '*是否修改了页面信息

Private bCode               As Boolean      '*是否是代码修改MergeCol属性

Private Sub chkMerge_Click()
'*设置合并列
    If bCode Then
        Exit Sub
    End If
    If lvContent.SelectedItem Is Nothing Then
        Exit Sub
    End If
    
    rpt.Content.SetMergeCol lvContent.SelectedItem.Index, IIf(chkMerge.Value = 1, True, False)
    LoadContent
End Sub


Private Sub cmbCollection_Click()
'*当改变标签集合对象时，重新装载相关的集合到控件进行显示
    Select Case cmbCollection.ListIndex
        Case 0      '*表头
            LoadCollection rpt.Header, Landscape
        Case 1      '*表尾
            LoadCollection rpt.Footer, Landscape
        Case 2      '*页头
            LoadCollection rpt.Title, Landscape
        Case 3      '*页尾
            LoadCollection rpt.Tail, Landscape
        Case 4      '*页左
            LoadCollection rpt.LeftSection, Portrait
        Case 5      '*页右
            LoadCollection rpt.RightSection, Portrait
    End Select
End Sub

Private Sub cmbCollectionAlign_Click()
    Select Case cmbCollection.ListIndex
        Case 0      '*表头
            rpt.Header.AlignMode = cmbCollectionAlign.ListIndex
        Case 1      '*表尾
            rpt.Footer.AlignMode = cmbCollectionAlign.ListIndex
        Case 2      '*页头
            rpt.Title.AlignMode = cmbCollectionAlign.ListIndex
        Case 3      '*页尾
            rpt.Tail.AlignMode = cmbCollectionAlign.ListIndex
        Case 4      '*页左
            rpt.LeftSection.AlignMode = cmbCollectionAlign.ListIndex
        Case 5      '*页右
            rpt.RightSection.AlignMode = cmbCollectionAlign.ListIndex
    End Select
End Sub


Private Sub cmbPageAlign_Click()
    rpt.Align = cmbPageAlign.ListIndex
End Sub

Private Sub cmbOrient_Validate(Cancel As Boolean)
    If cmbOrient.tag <> cmbOrient.text Then
        bDirty = True
    End If
    cmbOrient.tag = cmbOrient.text
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdColHeader_Click()
'*设置列头

    Dim fText       As New frmText
    Dim cText       As New clsText
    
    rpt.ColHeader.GetText(1, 1).Clone cText
    cText.drawBorder = False
    Set fText.cText = cText
    
    fText.bEditRowHeight = True
    
    fText.Show vbModal, Me
    
    '*如果设置了列头，全部改写列头单元格
    If fText.bSelect Then
        Dim i               As Integer
        Dim j               As Integer
        Dim tmpStr          As String
        Dim tmpWidth        As Single
        Dim tmpLeft         As Single
        Dim tmpTop          As Single
        Dim mText           As clsText
        
        For i = 1 To rpt.ColHeader.Cols
            For j = 1 To rpt.ColHeader.rows
            
                Set mText = rpt.ColHeader.GetText(i, j)
                
                With mText
                
                    tmpStr = .stringX
                    tmpWidth = .width
                    tmpLeft = .Left
                    tmpTop = .Top
                    
                    cText.drawBorder = True
                    cText.Clone mText
                    
                    .stringX = tmpStr
                    .width = tmpWidth
                    .Left = tmpLeft
                    .Top = tmpTop
                    
                    .height = .rowheight
                End With
                
            Next j
        Next i
        
        rpt.ColHeader.Merge rpt.width - (rpt.LeftMargin + rpt.RightMargin) _
                            - (rpt.LeftSection.GetWidth + rpt.RightSection.GetWidth)
        
        ShowColheader
    
    End If
    
    Set fText = Nothing
    Set cText = Nothing
End Sub

Private Sub cmdColHeaderNxt_Click()
    If cpColHeader < rpt.cutpages Then
        cpColHeader = cpColHeader + 1
        ShowColheader
    End If
End Sub

Private Sub cmdColHeaderPre_Click()
    If cpColHeader > 1 Then
        cpColHeader = cpColHeader - 1
        ShowColheader
    End If
End Sub

Private Sub cmdConfirm_Click()
'*确认设置，读取当前的配置文件
    bConfirm = True

    SavePageInfo

    Unload Me
End Sub

Private Sub cmdContent_Click()
'*设置正文列

    If lvContent.SelectedItem Is Nothing Then
        Exit Sub
    End If
    
Dim col         As Integer      '*列
Dim fText       As New frmText
Dim cText       As New clsText
    
    col = lvContent.SelectedItem.Index
    
    rpt.Content.GetColText(col).Clone cText
    cText.drawBorder = False
    
    Set fText.cText = cText
    
    fText.bEditRowHeight = True
    
    fText.Show vbModal, Me
    
    If fText.bSelect Then
        
        cText.Left = rpt.Content.GetColText(col).Left
        cText.drawBorder = True
        rpt.Content.SetColText col, cText
        
        '*将所有列的行高设为一致
        Dim i           As Integer
        Dim mText       As clsText
        
        For i = 1 To rpt.ColHeader.Cols
            Set mText = New clsText
            Set mText = rpt.Content.GetColText(i)
            mText.rowheight = cText.rowheight
            rpt.Content.SetColText i, mText
            Set mText = Nothing
        Next i
        
        Enabled = False
        'flatProgressBar1.Visible = True
        
        rpt.CalPage
    
        ShowContent
        
        Enabled = True
        'flatProgressBar1.Visible = False
        
        LoadContent
    End If
    
    Set fText = Nothing
    Set cText = Nothing
End Sub

Private Sub cmdContentNxt_Click()
    If cpContent < rpt.cutpages Then
        cpContent = cpContent + 1
        ShowContent
    End If
End Sub

Private Sub cmdContentPre_Click()
    If cpContent > 1 Then
        cpContent = cpContent - 1
        ShowContent
    End If
End Sub

Private Sub cmdCollectionAdd_Click()
'*增加
    Select Case cmbCollection.ListIndex