单据打印设置.frm

新世纪ERP系统管理源代码

Dim Ssql As String
    
Private Sub Combo1_Change()
    
End Sub

Private Sub ComboName_Click()
    If ComboName.ListIndex < 0 Then Exit Sub
    Dim aDo_Printtype As New Recordset
    PrintType.Clear
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from xt_BillDesign where  Billname='" & Trim(ComboName.Text) & "'")
    Ssql = "select * from Xt_BillGridPrint where colindex='000' and grid_code='" & Trim(aDo_re!Grid_code) & "'"
    Set aDo_Printtype = Cw_DataEnvi.DataConnect.Execute(Ssql)
    If aDo_Printtype.RecordCount > 0 Then
        Do While Not aDo_Printtype.EOF
            PrintType.AddItem aDo_Printtype!printgridcode
            aDo_Printtype.MoveNext
            PrintType.ListIndex = 0
        Loop
    Else
        aDo_Printtype.Close
        Ssql = "select * from Xt_BillTextPrint where PrintTextCode='default' and text_group_code='" & Trim(aDo_re!text_group_code) & "'"
        Set aDo_Printtype = Cw_DataEnvi.DataConnect.Execute(Ssql)
        If aDo_Printtype.RecordCount > 0 Then
            PrintType.AddItem "default"
            PrintType.ListIndex = 0
        End If
    End If
End Sub



Public Sub Command1_Click()
    If Trim(PrintType.Text) = "" Then Exit Sub
    '调入单据信息
    Dim aDo_Name As New Recordset
    Set aDo_Name = Cw_DataEnvi.DataConnect.Execute("select * from xt_BillDesign where billname='" & ComboName.Text & "'")
    If aDo_Name.RecordCount > 0 Then
        BillList aDo_Name!BillCode
        Command1.Tag = Trim(aDo_Name!text_group_code)
        PrintType.Tag = PrintType.Text
        XtReportCode = Trim(aDo_Name!Print_code)
    End If
    
    aDo_Name.Close
    If Dyymctbl Is Nothing Then: Else: Unload Dyymctbl
    Load Dyymctbl
    Text_W.Visible = False
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)      '控 制 焦 点 转 移
    
    Dim jdzygs As Integer
    jdzygs = 7                                       '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
    Select Case KeyAscii
    Case vbKeyReturn
        If Kjjdzy(jdzygs) Then
            KeyAscii = 0
        End If
    Case 39           '屏蔽字符"'"
        KeyAscii = 0
    End Select
    
End Sub

Private Sub Form_Load()                              '窗 体 装 入
    
    Fun_FillUserSystem Imgcbo_SysName, Xtczybm
End Sub
    
Sub BillList(BillCode As String)  '初始化单据
    
    On Error Resume Next
    
    Dim B As Integer
    For B = 1 To Max_Text_Index
        Unload LrText(B)
        Unload TsLabel(B)
    Next B
    WglrGrid.Visible = True: LrText(0).Visible = True
    TsLabel(0).Visible = True: Lab_Title.Visible = True
    
    Call Sub_PrintReadBillInfo(BillCode, Me, Var_Bill())
    
    '以下为文本框处理程序
    TextGroupCode = Var_Bill(2)
    
    Call PrintDrwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    XtReportCode = Var_Bill(4)
    Load Dyymctbl
    '<<<<<<<<<<<<<<<<<<<<<<<<<<
    Pict_W.Top = Pict.Height - Pict_W.Height
    Pict_H.Left = Pict.Width - Pict_H.Width
    Pict_W.Width = Pict.Width
    Pict_H.Height = Pict.Height
    Lab_Title.Left = WglrGrid.Width / 2 - Lab_Title.Width / 2 + WglrGrid.Left
    '======================
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from xt_grid where grid_code='" & Trim(Var_Bill(3)) & "'")
    If aDo_re.RecordCount < 1 Then
        WglrGrid.Visible = False: Grid_XY.Visible = False: Grid_H.Visible = False: Grid_W.Visible = False
aDo_re.Close: GridCode = "":  Lab_Title.Left = Pict.Width / 2 - Lab_Title.Width / 2: Exit Sub
    Else
        WglrGrid.Visible = True: aDo_re.Close
    End If
    '======================
    '调入网格并记录一些网格信息
    GridCode = Var_Bill(3)         '网格属性编码
    Call PrintBzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
    
    For jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
        WglrGrid.RowHeight(jsqte) = Sjhgd
    Next jsqte
    Sub_AdjustGrid
    '初始化合计网格
    Call Cshhjwg
    
    '单据变动置为False
    Bln_BillChange = False
    
    '<<<<<<<<<<<<<<<<<<<<<<<<<<
    Grid_W.Left = WglrGrid.Width + WglrGrid.Left
    Grid_W.Top = WglrGrid.Top + WglrGrid.Height / 2 - 50
    Grid_H.Top = WglrGrid.Height + WglrGrid.Top
    Grid_H.Left = WglrGrid.Left + WglrGrid.Width / 2 - 50
    Grid_XY.Top = WglrGrid.Top
    Grid_XY.Left = WglrGrid.Left - Grid_XY.Width
    
    Grid_W.Visible = True
    Grid_H.Visible = True
    Grid_XY.Visible = True
    
    ' Toolbar1.Width = Pict.Width
    
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    
    '卸载打印页面窗体
    Unload Dyymctbl
    
    '判断单据是否发生变化,并返回相应标识
    If Bln_BillChange Then
        Xtfhcs = "1"
    Else
        Xtfhcs = "0"
    End If
    
End Sub

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Sub_AdjustGrid()
    
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For jsqte = .FixedRows To .Rows - 1
                .RowHeight(jsqte) = Sjhgd
            Next jsqte
        Else
            
        End If
    End With
    
End Sub

Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
    
    Dim Lrwglkd As Double
    Dim Hjwgpyl As Integer
    
    With HjGrid
        If Not Sfxshjwg Then
            .Visible = False
            Exit Sub
        Else
            .Visible = True
        End If
        
        '设置网格相关属性
        .Enabled = False
        .Appearance = flexFlat
        .BorderStyle = flexBorderNone
        .ScrollBars = flexScrollBarNone
        .Width = WglrGrid.Width
        .FixedRows = 0
        .Rows = 1
        .Cols = WglrGrid.Cols
        .LeftCol = WglrGrid.LeftCol
        .TextMatrix(0, Qslz) = "合  计"
        For jsqte = 0 To WglrGrid.Cols - 1
            .ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
            .ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
            .ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
            .ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
        Next jsqte
        .ColAlignment(Qslz) = flexAlignCenterTop
        For jsqte = .FixedRows To .Rows - 1
            .RowHeight(jsqte) = .Height / .Rows
        Next jsqte
        
        '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
        .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
        .RowHeight(0) = .Height
        .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
    End With
    
End Sub

Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
    ' Call Cxxswbk
End Sub

'Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
'    FnBln_RefreshArray Col, Position, GridStr(), GridInf()
'End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
    Case "bcgs"                                       '保存表格格式
        Call PrintBcwggs(WglrGrid, GridCode, GridStr())
    Case "hfmrgs"                                     '恢复默认格式
        Call PrintHfmrgs(WglrGrid, GridCode, GridStr())
    Case "szxsxm"                                     '设置显示项目
        Call PrintSzxsxm(WglrGrid, GridCode)
    End Select
    
End Sub

Private Sub Wbkcsh()                          '录入文本框初始化
    Dim Int_TabIndex As Integer    '用来设置文本框TabIndex值
    
    '文本框TabIndex值由0--N
    LrText(0).TabIndex = 0
    Int_TabIndex = 1
    
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
    
    ReDim TextValiJudgeLock(Max_Text_Index)
    For jsqte = 0 To Max_Text_Index
        
        '判断此文本框录入索引号是否存在,如存在则对其进行初始化
        If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
            
            '自动装入录入文本框和其解释标签
            If jsqte <> 0 Then
                Load LrText(jsqte)
                Load TsLabel(jsqte)
            End If
            '判断录入文本框是否显示
            If Textboolean(jsqte, 4) Then
                LrText(jsqte).Visible = True
                TsLabel(jsqte).Visible = True
            Else
                LrText(jsqte).Visible = False
                TsLabel(jsqte).Visible = False
            End If
            
            '设置文本框焦点顺序值
            LrText(jsqte).TabIndex = Int_TabIndex
            '文本框TabIndex值+1
            Int_TabIndex = Int_TabIndex + 1
            
            
            '初始化其内容
            LrText(jsqte).Text = ""
            LrText(jsqte).Tag = ""
            If Textint(jsqte, 5) <> 0 Then
                LrText(jsqte).MaxLength = Textint(jsqte, 5)
            End If
            
            '设置文本框位置及大小,并设置相应标签内容及其位置
            LrText(jsqte).Move Textint(jsqte, 13), Textint(jsqte, 12), Textint(jsqte, 11) ' Textint(Jsqte, 10)
            TsLabel(jsqte).Move Textint(jsqte, 13) - TsLabel(jsqte).Width - 20, Textint(jsqte, 12) + (Textint(jsqte, 10) - TsLabel(jsqte).Height) / 2 - 30
            TsLabel(jsqte).Caption = Trim(Textstr(jsqte, 7)) & ":"
        End If
        
        '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
        TextValiJudgeLock(jsqte) = True
    Next jsqte
    
End Sub



Private Sub Imgcbo_SysName_Click()
    Dim aDo_Name As New Recordset
    ComboName.Clear
    Set aDo_Name = Cw_DataEnvi.DataConnect.Execute("select * from xt_BillDesign where system_code='" & Mid(Trim(Imgcbo_SysName.SelectedItem.Key), 2) & "'")
    Do While Not aDo_Name.EOF
        ComboName.AddItem aDo_Name!BillName
        aDo_Name.MoveNext
    Loop
    If aDo_Name.RecordCount > 0 Then ComboName.ListIndex = 0
    aDo_Name.Close
End Sub



Private Sub LrText_DblClick(Index As Integer)
    
    If LrText(Index).BackColor = &HFFFFFF Then
        LrText(Index).BackColor = &HF2FAEB
    Else
        LrText(Index).BackColor = &HFFFFFF
    End If
    
End Sub

Private Sub LrText_GotFocus(Index As Integer)