单据设置.frm

新世纪ERP系统管理源代码

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()                              '窗 体 装 入
    
    
    '报表主标题及报表编码
    ReportTitle = "销 售 订 单"
    XtReportCode = "c_jzpzcl"
    Load Dyymctbl
    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_DPReadBillInfo(BillCode, Me, Var_Bill())
    
    '以下为文本框处理程序
    TextGroupCode = Var_Bill(2)
    
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    '======================
    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 = Pict.Width / 2 - Lab_Title.Width / 2
    Toolbar1.Width = Pict.Width
    '======================
    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: Exit Sub
    Else
        WglrGrid.Visible = True: aDo_re.Close
    End If
    '======================
    
    '调入网格并记录一些网格信息
    
    GridCode = Var_Bill(3)         '网格属性编码
    Call BzWgcsh(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
    
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 CzxsGrid_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 Bcwggs(WglrGrid, GridCode, GridStr())
    Case "hfmrgs"                                     '恢复默认格式
        Call Hfmrgs(WglrGrid, GridCode, GridStr())
    Case "szxsxm"                                     '设置显示项目
        'Call Szxsxm(WglrGrid, GridCode)
        Xtcdcs = GridCode
        XT_BgxsxmszFrm.Show 1                '调整网格显示项目
        Command1_Click
        ' Call Cxxswg(SzgsGrid, Wggsdm)        '重新定义网格显示
    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)
    
    Textindex = Index
    Text_W.Left = LrText(Index).Left + LrText(Index).Width
    Text_W.Top = LrText(Index).Top + LrText(Index).Height / 2 - Text_W.Height / 2
    Text_W.Visible = True
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
    Case "Save"
        If Trim(Command1.Tag) = "" Then Exit Sub
        Bill_Save
    Case "SD"
        If Trim(Command1.Tag) = "" Then Exit Sub
        SD_Text
    Case "sx"
        If Trim(Command1.Tag) = "" Then Exit Sub
        Command1_Click
    Case "Item"
        If Trim(Command1.Tag) = "" Then Exit Sub
        XT_TItem.Show 1
    Case "type"
        If Trim(Command1.Tag) = "" Then Exit Sub
        '  If WglrGrid.Visible = False Then Exit Sub
        XT_BillPrintType.Tag = Command1.Tag
        XT_BillPrintType.Show 1
    Case "HD"
        If Trim(Command1.Tag) = "" Then Exit Sub
        HD_Text
    Case "Exit"
        Unload Me
    End Select
    
End Sub

Private Sub Text_W_LostFocus()
    Text_W.Visible = False
End Sub

'调整文本框的宽度
Private Sub Text_W_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = True
    Move_X = X
    label_XY.Top = LrText(Textindex).Top + 200
    label_XY.Left = LrText(Textindex).Left + LrText(Textindex).Width / 2
    Caption_XY.Caption = "TextBox宽度=" & LrText(Textindex).Width
    label_XY.Visible = True
    
End Sub

'调整文本框的宽度
Private Sub Text_W_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If TF = True Then
        If (LrText(Textindex).Width - (Move_X - X) > 0) And (LrText(Textindex).Width - (Move_X - X) < (Pict.Width - LrText(Textindex).Left - 100)) Then
            label_XY.Top = LrText(Textindex).Top + 200
            label_XY.Left = LrText(Textindex).Left + LrText(Textindex).Width / 2
            
            '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            LrText(Textindex).Width = LrText(Textindex).Width - (Move_X - X)
            Text_W.Left = LrText(Textindex).Width + LrText(Textindex).Left
            Caption_XY.Caption = "TextBox宽度=" & LrText(Textindex).Width - (Move_X - X)
        End If
    End If
    
End Sub

'调整文本框的宽度
Private Sub Text_W_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = False
    label_XY.Visible = False
    
End Sub

Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)