单据设置.frm

新世纪ERP系统管理源代码

    '调整列宽
    If HjGrid.Visible Then
        With HjGrid
            .ColWidth(Col) = WglrGrid.ColWidth(Col)
        End With
    End If
    
End Sub

Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)
    '如果结束列小于用户定义网格开始列，则结束列=用户定义网格开始列
    '因为开始列以前的列都是隐藏列，由于要把当前开始移动列移动到隐藏列上
    '所以控件自动把隐藏列变为显示列，这样在刷新数据时，会把隐藏列上的数据
    '显示出来，并且，由于开始列以前的隐藏列在XT_Grid中，不对应逻辑值，所以在保存
    '网格格式时会出错
    If Col > Position Then
        If Position < GridInf(1) Then Position = GridInf(1)
    Else
        If Col < GridInf(1) Then Col = GridInf(1)
    End If
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
    
End Sub

Private Sub WglrGrid_Scroll()
    
    '限制用户在录入过程中滚动鼠标
    With WglrGrid
        HjGrid.LeftCol = .LeftCol
    End With
    
End Sub

'调整单据的高度
Private Sub Pict_H_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Move_X = X
End Sub

'调整单据的高度
Private Sub Pict_H_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If (Pict.Width > (Move_X - X)) And (Pict.Width - (Move_X - X) < (Me.Width - Pict.Left - 100)) Then
        Pict.Width = Pict.Width - (Move_X - X)
        Pict_H.Left = Pict.Width - Pict_H.Width
        Pict_W.Width = Pict.Width
        Lab_Title.Left = Pict.Width / 2 - Lab_Title.Width / 2
        Toolbar1.Width = Pict.Width
    End If
End Sub
    
'调整单据的宽度
Private Sub Pict_W_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Move_Y = Y
End Sub

'调整单据的宽度
Private Sub Pict_W_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If (Pict.Height > (Move_Y - Y)) And ((Pict.Height - (Move_Y - Y) + Pict.Top) < (Me.Height - 500)) Then
        Pict.Height = Pict.Height - (Move_Y - Y)
        Pict_W.Top = Pict.Height - Pict_W.Height
        Pict_H.Height = Pict.Height
    End If
    
End Sub

'调整文本宽的位置
Private Sub TsLabel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = True
    Move_Y = Y: Move_X = X
    label_XY.Top = TsLabel(Index).Top + 200
    label_XY.Left = TsLabel(Index).Left + 200
    Caption_XY.Caption = "X=" & TsLabel(Index).Left & ",Y=" & LrText(Index).Top
    label_XY.Visible = True
    
End Sub

'调整文本宽的位置
Private Sub TsLabel_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If TF = True Then
        If (TsLabel(Index).Top - (Move_Y - Y) >= Toolbar1.Height) And ((TsLabel(Index).Top - (Move_Y - Y)) < (Pict.Height - TsLabel(Index).Height) - 175) Then
            TsLabel(Index).Top = TsLabel(Index).Top - (Move_Y - Y)
            label_XY.Top = label_XY.Top - (Move_Y - Y)
            LrText(Index).Top = TsLabel(Index).Top - 30
        End If
        '------------------------
        If (TsLabel(Index).Left - (Move_X - X) >= 0) And (TsLabel(Index).Left - (Move_X - X) < (Pict.Width - LrText(Index).Width - TsLabel(Index).Width - 75)) Then
            TsLabel(Index).Left = TsLabel(Index).Left - (Move_X - X)
            label_XY.Left = label_XY.Left - (Move_X - X)
            LrText(Index).Left = TsLabel(Index).Left + TsLabel(Index).Width + 20
        End If
        If Textindex = Index Then
            Text_W.Left = LrText(Index).Left + LrText(Index).Width
            Text_W.Top = LrText(Index).Top + LrText(Index).Height / 2 - Text_W.Height / 2
        End If
        Caption_XY.Caption = "X=" & TsLabel(Index).Left & ",Y=" & LrText(Index).Top
    End If
    
End Sub

'调整文本宽的位置
Private Sub TsLabel_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = False
    label_XY.Visible = False
    
End Sub

'调整网格位置
Private Sub Grid_XY_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = True
    Move_Y = Y
    Move_X = X
    label_XY.Top = Grid_XY.Top + 200
    label_XY.Left = Grid_XY.Left + 200
    Caption_XY.Caption = "X=" & Grid_XY.Left & ",Y=" & Grid_XY.Top
    label_XY.Visible = True
    
End Sub

'调整网格位置
Private Sub Grid_XY_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If TF = True Then
        If (Grid_XY.Top - (Move_Y - Y) >= Toolbar1.Height) And (Grid_XY.Top - (Move_Y - Y) < Pict.Height - 150) Then
            Grid_XY.Top = Grid_XY.Top - (Move_Y - Y)
            label_XY.Top = label_XY.Top - (Move_Y - Y)
            WglrGrid.Top = Grid_XY.Top
        End If
        If (Grid_XY.Left - (Move_X - X) >= 0) And (Grid_XY.Left - (Move_X - X) < Pict.Width - 200) Then
            Grid_XY.Left = Grid_XY.Left - (Move_X - X)
            label_XY.Left = label_XY.Left - (Move_X - X)
            WglrGrid.Left = Grid_XY.Left + Grid_XY.Width
        End If
        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
        Caption_XY.Caption = "X=" & Grid_XY.Left & ",Y=" & Grid_XY.Top
    End If
    
End Sub

'调整网格位置
Private Sub Grid_XY_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = False
    label_XY.Visible = False
    
End Sub

'改变网格的宽度
Private Sub Grid_W_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = True
    Move_X = X
    label_XY.Top = Grid_W.Top + 200
    label_XY.Left = Grid_W.Left - label_XY.Width
    Caption_XY.Caption = "网格宽度=" & WglrGrid.Width
    label_XY.Visible = True
    
End Sub

'改变网格的宽度
Private Sub Grid_W_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If TF = True Then
        If (WglrGrid.Width - (Move_X - X) > 0) And (WglrGrid.Width - (Move_X - X) < (Pict.Width - WglrGrid.Left - 100)) Then
            label_XY.Top = Grid_W.Top + 200
            label_XY.Left = Grid_W.Left - label_XY.Width
            Caption_XY.Caption = "网格宽度=" & WglrGrid.Width - (Move_X - X)
            '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            WglrGrid.Width = WglrGrid.Width - (Move_X - X)
            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
        End If
    End If
    
End Sub

'改变网格的宽度
Private Sub Grid_W_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = False
    label_XY.Visible = False
    
End Sub

'改变网格的高度
Private Sub Grid_H_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = True
    Move_Y = Y
    label_XY.Top = Grid_H.Top + 200
    label_XY.Left = Grid_H.Left + 200
    Caption_XY.Caption = "网格高度=" & WglrGrid.Height
    label_XY.Visible = True
    
End Sub

'改变网格的高度
Private Sub Grid_H_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim gridheight As Integer
    If WglrGrid.FixedRows = 1 Then
        gridheight = WglrGrid.RowHeight(1) * 2 + WglrGrid.RowHeight(0)
    Else
        gridheight = WglrGrid.RowHeight(1) + WglrGrid.RowHeight(0) + WglrGrid.RowHeight(2) * 2
    End If
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    If TF = True Then
        'If WglrGrid.Height > (Move_Y - Y) Then
        If (WglrGrid.Height > Move_Y - Y + gridheight) And ((WglrGrid.Height - (Move_Y - Y) + WglrGrid.Top) < Pict.Height - 130) Then
            label_XY.Top = Grid_H.Top + 200
            label_XY.Left = Grid_H.Left + 200
            Caption_XY.Caption = "网格高度=" & WglrGrid.Height - (Move_Y - Y)
            '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            WglrGrid.Height = WglrGrid.Height - (Move_Y - Y)
            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
        End If
    End If
    
End Sub

'改变网格的高度
Private Sub Grid_H_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    TF = False
    label_XY.Visible = False
    If WglrGrid.Height > (Move_Y - Y) Then
        Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
        WglrGrid.Rows = WglrGrid.FixedRows
        Sub_AdjustGrid
        '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
        With HjGrid
            .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 If
    
End Sub

Private Sub SD_Text() '竖对
    
    Dim i As Integer: Dim Y As Integer
    For Y = 0 To LrText.Count - 1
        If LrText(Y).BackColor = &HF2FAEB Then
            For i = 1 To LrText.Count - 1
                If LrText(i).BackColor = &HF2FAEB Then
                    If LrText(Y).Top > LrText(i).Top Then
                        Y = i
                    End If
                End If
            Next i
            Exit For
        End If
    Next Y
    
    For i = 0 To LrText.Count - 1
        If LrText(i).BackColor = &HF2FAEB Then
            LrText(i).Left = LrText(Y).Left
            TsLabel(i).Left = LrText(i).Left - TsLabel(i).Width - 20
            LrText(i).BackColor = &HFFFFFF
        End If
    Next i
    
End Sub

Private Sub HD_Text() '横对
    
    Dim i As Integer: Dim Y As Integer
    For Y = 0 To LrText.Count - 1
        If LrText(Y).BackColor = &HF2FAEB Then
            For i = 1 To LrText.Count - 1
                If LrText(i).BackColor = &HF2FAEB Then
                    If LrText(Y).Top > LrText(i).Top Then
                        Y = i
                    End If
                End If
            Next i
            Exit For
        End If
    Next Y
    
    For i = 0 To LrText.Count - 1
        If LrText(i).BackColor = &HF2FAEB Then
            LrText(i).Top = LrText(Y).Top
            TsLabel(i).Top = LrText(i).Top + 30
            LrText(i).BackColor = &HFFFFFF
        End If
    Next i
    
End Sub


Sub Bill_Save() '保存单据信息
    
    Dim i As Integer, Sql_Str As String
    Dim aDo_Tab As New Recordset
    Dim aDo_Name As New Recordset
    Set aDo_Name = Cw_DataEnvi.DataConnect.Execute("select * from xt_BillDesign where billname='" & ComboName.Text & "'")
    
    For i = 0 To Max_Text_Index
        Sql_Str = "update Xt_text_input set TextTop=" & LrText(i).Top & ",TextLeft=" & LrText(i).Left & ",TextWidth=" & LrText(i).Width _
        & " where  text_group_code='" & Trim(aDo_Name!text_group_code) & "' and text_index=" & i
        Cw_DataEnvi.DataConnect.Execute Sql_Str
    Next i
    Sql_Str = "update  Xt_grid set GridHeight=" & WglrGrid.Height & ",GridWidth=" & WglrGrid.Width _
    & ",GridTop=" & WglrGrid.Top & ",GridLeft=" & WglrGrid.Left _
    & " where Grid_Code='" & Trim(aDo_Name!Grid_code) & "' and ColIndex='000'"
    Cw_DataEnvi.DataConnect.Execute Sql_Str
    
    
    Sql_Str = "update xt_BillDesign set FormHeight=" & Pict.Height + 375 & ",FormWidth=" & Pict.Width _
    & " where billname='" & ComboName.Text & "'"
    Cw_DataEnvi.DataConnect.Execute Sql_Str
    i = 0
    Set aDo_Tab = Cw_DataEnvi.DataConnect.Execute("select * from Xt_text_input where text_group_code='" & Trim(aDo_Name!text_group_code) & "' order by texttop,textleft")
    Do While Not aDo_Tab.EOF
        Cw_DataEnvi.DataConnect.Execute "update Xt_text_input set tabindex= " & i & " where text_index=" & aDo_Tab!text_Index & " and text_group_code='" & Trim(aDo_Name!text_group_code) & "'"
        i = i + 1
        aDo_Tab.MoveNext
    Loop
    
    
    Dim aDo_Printtype As New Recordset
    Sql_Str = "select * from Xt_BillTextPrint where PrintTextCode='default' and text_group_code='" & Trim(aDo_Name!text_group_code) & "'"
    Set aDo_Printtype = Cw_DataEnvi.DataConnect.Execute(Sql_Str)
    If aDo_Printtype.RecordCount > 0 Then Exit Sub
    
    Sql_Str = "insert into Xt_BilltextPrint(text_group_code,text_index,PrintTextCode,PrintTop,PrintLeft,Printwidth) " _
    & " select text_group_code,text_index,PrintTextCode='" & "default" & "', PrintTop=texttop,PrintLeft=textleft,Printwidth=textwidth from Xt_text_input" _
    & " where text_group_code='" & Trim(aDo_Name!text_group_code) & "'"
    Cw_DataEnvi.DataConnect.Execute Sql_Str
    
    If WglrGrid.Visible = True Then
        Sql_Str = "insert into Xt_BillGridPrint(Grid_Code,ColIndex,PrintGridCode,PrintGridHeight,PrintGridWidth,PrintGridTop,PrintGridLeft,PrintDataRows,PrintColWidth,BillTitlePrint)" _
        & " select Grid_Code,ColIndex,PrintGridCode='" & "default" & "',PrintGridHeight=GridHeight,PrintGridWidth=GridWidth,PrintGridTop=GridTop," _
        & "PrintGridLeft=GridLeft,PrintDataRows=3,PrintColWidth=ColWidth,BillTitlePrint='" & Lab_Title.Caption & "' from xt_grid where grid_code='" & Trim(aDo_Name!Grid_code) & "'"
        Cw_DataEnvi.DataConnect.Execute Sql_Str
    End If
    aDo_Tab.Close
    aDo_Name.Close
    
    
    
End Sub