frmywysetup.frm

经典delphi,Delphi下深入Windows核心编程.原书光盘代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmYWYSetup 
   Caption         =   "业务员设置信息列表"
   ClientHeight    =   6765
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   8505
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6765
   ScaleWidth      =   8505
   WindowState     =   2  'Maximized
   Begin VB.Frame Frame2 
      Caption         =   "记录操作"
      Height          =   972
      Left            =   360
      TabIndex        =   1
      Top             =   3960
      Width           =   7920
      Begin VB.CommandButton Command3 
         Caption         =   "toexcel"
         Height          =   375
         Left            =   6120
         TabIndex        =   8
         Top             =   360
         Width           =   975
      End
      Begin VB.CommandButton Command2 
         Caption         =   "toword"
         Height          =   375
         Left            =   4920
         TabIndex        =   7
         Top             =   360
         Width           =   975
      End
      Begin VB.CommandButton command1 
         Caption         =   "打印"
         Height          =   375
         Left            =   3720
         TabIndex        =   6
         Top             =   360
         Width           =   975
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除"
         Height          =   375
         Left            =   2640
         TabIndex        =   4
         Top             =   360
         Width           =   855
      End
      Begin VB.CommandButton cmdModify 
         Caption         =   "修改"
         Height          =   375
         Left            =   1560
         TabIndex        =   3
         Top             =   360
         Width           =   855
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msgList 
      Height          =   3132
      Left            =   240
      TabIndex        =   5
      Top             =   600
      Width           =   7452
      _ExtentX        =   13150
      _ExtentY        =   5530
      _Version        =   393216
      Cols            =   4
      FixedCols       =   3
      AllowUserResizing=   1
   End
   Begin VB.Label lblTitle 
      Caption         =   "业  务  员  设  置  信  息  列  表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   252
      Left            =   1680
      TabIndex        =   0
      Top             =   120
      Width           =   4572
   End
End
Attribute VB_Name = "frmYWYSetup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public txtSQL As String
Dim mrc As ADODB.Recordset
Dim gridrow As Integer
Dim gridcol As Integer
Dim msword







Private Sub cmdAdd_Click()
    gintYWYSmode = 1
    frmYWYSetup1.Show 1
    
End Sub

Private Sub cmdDelete_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    
    If msgList.Rows > 1 Then
        If MsgBox("真的要删除业务员编号为" & Trim(msgList.TextMatrix(msgList.row, 1)) & "的记录吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = msgList.row
            
            txtSQL = "select * from inh full join outh on inh.ywman = outh.ywman full join xsdh on inh.ywman = xsdh.ywman full join dh on inh.ywman = dh.ywman full join mate on mate.ywdm = inh.ywman full join plang on plang.pl_man = inh.ywman full join zc on inh.ywman = zc.ywman where "
            txtSQL = txtSQL & "inh.ywman = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or outh.ywman = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or xsdh.ywman = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or dh.ywman = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or mate.ywdm = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or plang.pl_man = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            txtSQL = txtSQL & "or zc.ywman = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            If Not mrc.EOF Then
                MsgBox "数据库中存在与" & Trim(msgList.TextMatrix(intCount, 2)) & "相关的信息，不能删除！", vbOKOnly, "警告"
                Exit Sub
            Else
            
                txtSQL = "delete from dm_ywy where dm ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
                Set mrc = ExecuteSQL(txtSQL, MsgText)
            End If
            
            Unload frmYWYSetup
            frmYWYSetup.txtSQL = "select * from dm_ywy"
            frmYWYSetup.Show
        End If
    End If
End Sub

Private Sub cmdModify_Click()
Dim intCount As Integer
    
    If frmYWYSetup.msgList.Rows > 1 Then
        gintYWYSmode = 2
        intCount = msgList.row
        If intCount > 0 Then
           frmYWYSetup1.txtSQL = "select * from dm_ywy where mc ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
           frmYWYSetup1.Show 1
        Else
            MsgBox "警告", vbOKOnly + vbExclamation, "请首先选择需要修改的纪录！"
        End If
    End If

End Sub

Private Sub Command1_Click()
'frmYWYSetup.PrintForm
    Dim fnt As Single
    Dim pp As Integer
    Dim ss As String
    Dim foot As String
    Dim kan As Integer
    Dim i As Integer
    Dim dd As String
    Dim j As Integer

    pp = 0 '设置开始页码0
    Dim stry, strx, strx1, stry1, linw, page1, p, n, st, o As Integer
    Static a(8) As Integer '定义打印的列数
    ss = "业务员设置信息表" '定义表头
    kan = 0
    For i = 0 To 8
    a(i) = 1500 '定义每列宽
    kan = kan + a(i) '计算表格总宽度
    Next
  
    page1 = 50 '定义每页行数
    strx = 200
    strx1 = 200 '定义X方向起始位置
    stry = 1400
    stry1 = 1400 '定义Y方向起始位置
    linw = 240 '定义行宽
    fnt = 8 '定义字体大小
    Printer.FontName = "宋体" '定义字体
 
    dd = prnt1(4000, 700, 18, ss) '打印标题
    
   Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
    For j = 0 To gridrow - 1 'gridrow为所要打印的行数
       msgList.row = j
       strx = strx1
       Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
    
       p = p + 1
       For i = 0 To gridcol - 1
        'strx = 0
       msgList.col = i
       
       ' ss = msgList.TextMatrix(j, i)
       dd = prnt1(strx - 0, stry - 0, fnt, msgList.Text)
     
 
       strx = strx + a(i)
       Next
  
       If p > page1 Then 'next page
          p = 0
          strx = strx1
    'line last line
         Printer.Line (strx - 50, stry + linw)-(strx + kan - 10, stry + linw)
         stry = stry1
    'line col
         For n = 0 To gridcol - 1
          Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
          strx = strx + a(n)
         Next
         Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
         pp = pp + 1
         foot = "第 " + CStr(pp) + "页"
         dd = prnt1(strx - 30 - 1000, stry + (page1 + 2) * linw + 100, 10, foot) '打印页角码
  
         Printer.NewPage 'next page
         dd = prnt1(4000, 700, 18, ss) '打印标题
         strx = strx1
         stry = stry1
         Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30) ' print first row
       Else
         stry = stry + linw
       End If
    Next
    st = stry
    If p < page1 Then   '在最后页剩余划空行
    For o = p To page1 + 1
    strx = strx1
    Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
    stry = stry + linw
    Next
    End If
    stry = stry1
    strx = strx1
    stry = stry1 'line col
    For n = 0 To gridcol
    Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
    strx = strx + a(n)
    Next
    Printer.Line (strx - 30, stry - 30)-(strx - 30, stry + (page1 + 2) * linw)
    pp = pp + 1
    foot = "第 " + CStr(pp) + "页"
    stry = stry1
    strx = strx1
    stry = stry1 'line col
    dd = prnt1(strx + 5000, stry + (page1 + 2) * linw + 100, 10, foot) '打印页角码
  
    Printer.EndDoc '打印结束

End Sub

Private Sub Command2_Click()


Screen.MousePointer = 11
    Set msword = CreateObject("word.basic")
  
    Dim AppID, ReturnValue
    AppID = Shell("C:\Program Files\Microsoft Office\Office\WINWORD.EXE", 1)
    ' Run Microsoft Word.
  
'    msword.AppActivate "Microsoft Word"
'   msword.AppActivate "Microsoft Word", 1
    full
    Screen.MousePointer = 0

End Sub

Private Sub Command3_Click()
Dim i As Integer
    Dim j As Integer
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
  
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    'Set xlBook = xlApp.Workbooks.Add
    'On Error Resume Next
    Set xlBook = xlApp.Workbooks.Add 'Open("d:\text2.xls")
    Set xlSheet = xlBook.Worksheets(1)
    xlSheet.Cells(6, 1) = "i"
    For i = 0 To gridrow - 1
    msgList.row = i
    For j = 0 To 6
    msgList.col = j
  
    If IsNull(msgList.Text) = False Then
    xlSheet.Cells(i + 5, j + 1) = msgList.Text
    End If
    Next j
    Next i
    Exit Sub

End Sub

Private Sub Form_Load()
    ShowTitle
    ShowData
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
        If Me.ScaleHeight < 10 * lblTitle.Height Then
            
            Exit Sub
        End If
        If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
            
            Exit Sub
        End If
        '控制控件的位置
                
        lblTitle.Top = lblTitle.Height
        lblTitle.Left = (Me.Width - lblTitle.Width) / 2
        
        msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
        msgList.Width = Me.ScaleWidth - 200
        msgList.Left = Me.ScaleLeft + 100
        msgList.Height = Me.ScaleHeight - msgList.Top - 1500
        
        Frame2.Top = msgList.Top + msgList.Height + 50
        Frame2.Left = Me.ScaleWidth / 2 - 3000
    End If
End Sub



Public Sub FormClose()
    Unload Me
End Sub
Private Sub ShowData()
    
    Dim j As Integer
    Dim i As Integer
    Dim z As Integer
    Dim MsgText As String
z = 0

  
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    gridcol = mrc.Fields.Count
    
        With msgList
        .Rows = 1
        
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 0 To mrc.Fields.Count - 1
                If Not IsNull(Trim(mrc.Fields(i))) Then
                Select Case mrc.Fields(i).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i) & ""
                End Select
                End If
            Next i
            mrc.MoveNext
            z = z + 1
            
        Loop
        
       gridrow = z + 1
              
    End With
    mrc.Close
    
    
End Sub


'显示Grid表头
Private Sub ShowTitle()
    Dim i As Integer
    
    With msgList
        .cols = 9
        .TextMatrix(0, 0) = "业务员编号"
        .TextMatrix(0, 1) = "业务员姓名"
        .TextMatrix(0, 2) = "业务员类别"
        .TextMatrix(0, 3) = "联系电话"
        .TextMatrix(0, 4) = "家庭住址"
        .TextMatrix(0, 5) = "身份证号码"
        .TextMatrix(0, 6) = "类别编号"
        .TextMatrix(0, 7) = "备注信息"
        
        
       
        
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方式
        For i = 0 To 8
            .ColAlignment(i) = 0
        Next i
        
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .ColWidth(0) = 1000
        .ColWidth(1) = 1000
        .ColWidth(2) = 2000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 1000
        .ColWidth(6) = 2000
        .ColWidth(7) = 1000
        .ColWidth(8) = 1000
        
        
        .row = 1
    End With
End Sub




Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '右键弹出
    If Button = 2 And Shift = 0 Then
       
    End If
    
End Sub

Function prnt1(X As Integer, Y As Integer, font As Single, txt As String)
    Printer.CurrentX = X
    Printer.CurrentY = Y
    Printer.FontBold = False
    Printer.FontSize = font
    Printer.Print txt
    
    End Function

Sub full()
    Dim i As Integer, j As Integer, col As Integer, row As Integer, cols As Integer
    Dim cellcontent As String
    Me.Hide
    cols = gridcol '表格的列数
    row = gridrow '打印表的行数
    msword.filenewdefault
    msword.MsgBox "正在建立MS_WORD报表，请稍候.......", "", -1
    msword.leftpara
    msword.ScreenUpdating 0
    msword.tableinserttable , cols, row, , , 16, 167
    msword.startofdocument
    For j = 0 To gridrow - 1 ' 表格的行数
    msgList.row = j
    For i = 1 To cols
    msgList.col = i
    If IsNull(msgList.Text) Then
    cellcontent$ = ""
    Else
    cellcontent$ = msgList.Text
    End If
    msword.Insert cellcontent$
    msword.nextcell
    Next i
    Next j
    msword.tabledeleterow
    msword.startofdocument
    msword.tableselectrow
    msword.tableheadings 1
    msword.centerpara
    'msword.startdocument
    msword.screenrefresh
    msword.ScreenUpdating 1
    msword.MsgBox " 结束", "", -1
    Me.Show
  
    End Sub