frmpro.frm

用于三次采油技术的经济评价

End Sub



Private Sub ins_line_Click()
'  MSFlexGrid1.Text = Text1.Text
  Beep
4 msg$ = "注意：输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间！" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "请输入增加行数："
  wgxx$ = InputBox$(msg$, "信息输入")
  If wgxx$ = "" Then Exit Sub
  AddLine = Int(Val(Trim$(wgxx$)))
  If AddLine < 1 Or AddLine > insline_max Then
   Beep
   msg$ = "输入信息错误。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间。"
   Title$ = "警告"
   xchoose = MsgBox(msg$, 48, Title$)
   GoTo 4
  End If
  
  For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row + AddLine Step -1
   For k = 1 To MSFlexGrid1.Cols - 1
    MSFlexGrid1.TextMatrix(i, k) = MSFlexGrid1.TextMatrix(i - AddLine, k)
   Next k
  Next i
  For i = MSFlexGrid1.row To MSFlexGrid1.row + AddLine - 1
   For k = 1 To MSFlexGrid1.Cols - 1
    MSFlexGrid1.TextMatrix(i, k) = ""
   Next k
  Next i
    
  Call blank_MSFlexGridshow
  
  MSFlexGrid1.RowSel = MSFlexGrid1.row
End Sub

Private Sub MSFlexGrid1_DblClick()
   MSFlexGrid1_keypress 13
End Sub

Private Sub MSFlexGrid1_LeaveCell()
 If bb = 2 And MSFlexGrid1.Text <> Text1.Text Then
   
    MSFlexGrid1.Text = Text1.Text
   ' Call draw_line
   End If
End Sub

Private Sub showtextbox()
    Dim testx, testy As Long
   ' frmpro.Show 1
    Text1.Visible = 0
    Text1.Height = MSFlexGrid1.CellHeight
    Text1.Width = MSFlexGrid1.CellWidth
    
    testx = MSFlexGrid1.Left + MSFlexGrid1.CellLeft
    testy = MSFlexGrid1.Top + MSFlexGrid1.CellTop

    Text1.Left = testx: Text1.Top = testy

    Text1.ZOrder    'make sure it's on top!
    Text1.Visible = -1  'show it
 Text1.SetFocus  'make it active
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'MSFlexGrid1.Rows = sat_max
  If Button = 2 Then
   If Text1.Text <> MSFlexGrid1.Text Then MSFlexGrid1.Text = Text1.Text
   If MSFlexGrid1.row > MSFlexGrid1.RowSel Then
    del1$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1))
   Else
    del1$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1))
   End If
   If MSFlexGrid1.col > MSFlexGrid1.ColSel Then
    col1$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1))
   Else
    col1$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1))
   End If
  
   jbz = 0
   If Val(del2$) + 1 <= MSFlexGrid1.Rows - 1 Then
    For i = Val(del2$) + 1 To MSFlexGrid1.Rows - 1
     For j = 1 To MSFlexGrid1.Cols - 1
      If MSFlexGrid1.TextMatrix(i, j) <> "" Then jbz = 1: GoTo 2
     Next j
    Next i
   End If
2  If jbz = 0 Then del_line.Enabled = 0 Else del_line.Enabled = -1
  
   seli = 0
   
   For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row Step -1
    For j = 1 To MSFlexGrid1.Cols - 1
     If MSFlexGrid1.TextMatrix(i, j) <> "" Then seli = i: GoTo 3
    Next j
   Next i
3  If seli <> 0 Then insline_max = MSFlexGrid1.Rows - 1 - seli Else insline_max = 0
   If insline_max > 0 Then ins_line.Enabled = -1 Else ins_line.Enabled = 0
  
   PopupMenu operate
  End If
End Sub

Private Sub MSFlexGrid1_Scroll()
  If MSFlexGrid1.col < MSFlexGrid1.LeftCol Or MSFlexGrid1.row < MSFlexGrid1.TopRow Then Text1.Visible = 0: Exit Sub
  If MSFlexGrid1.col <> MSFlexGrid1.Cols - 1 And MSFlexGrid1.row <> MSFlexGrid1.Rows - 1 Then
   If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col + 1)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row + 1)) Then Text1.Visible = 0: Exit Sub
  Else
   If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row)) Then Text1.Visible = 0: Exit Sub
  End If
  If (MSFlexGrid1.CellLeft + MSFlexGrid1.CellWidth) > MSFlexGrid1.Width Then Text1.Visible = 0:   Exit Sub
  If (MSFlexGrid1.CellTop + MSFlexGrid1.CellHeight + Text1.Height) > MSFlexGrid1.Height Then Text1.Visible = 0:   Exit Sub
  Call showtextbox
End Sub





Private Sub SSCommand1_Click() '调用数据
kr_frt$(1) = "#0.000": kr_frt$(2) = "#0.0000": kr_frt$(3) = "#0.0000"
  kr_frt$(4) = "#0.0000": kr_frt$(5) = "#0.0000": kr_frt$(6) = "#0.0000"
  kr_frt$(7) = "#0": kr_frt$(8) = "#0"
 'SSCommand2.Caption = "Save File"
Dim b(1 To 10)
Dim A(1 To 100, 1 To 10)
On Error GoTo myerrr
CommonDialog1.filename = ""
'CommonDialog1.Flags = 600

CommonDialog1.InitDir = workpath
CommonDialog1.Filter = "Excel文件|*.xls|数据库文件|*.mdb"

CommonDialog1.ShowOpen
filename1 = CommonDialog1.filename

Dim oleExcel As Object
 Set oleExcel = CreateObject("Excel.Application")
  oleExcel.Visible = False
Dim Count As Integer
 On Error GoTo myerrr
If Right$(filename1, 3) = "XLS" Or Right$(filename1, 3) = "xls" Then

    
 oleExcel.Workbooks.Open filename:=filename1
i = 1
Do
i = i + 1
A(i, 1) = oleExcel.Worksheets("数据输入表").Range("A1").Cells(i, 1): A(i, 2) = oleExcel.Worksheets("数据输入表").Range("b1").Cells(i, 1)
A(i, 3) = oleExcel.Worksheets("数据输入表").Range("c1").Cells(i, 1)
  A(i, 4) = oleExcel.Worksheets("数据输入表").Range("d1").Cells(i, 1)

 A(i, 5) = oleExcel.Worksheets("数据输入表").Range("e1").Cells(i, 1)
  A(i, 6) = oleExcel.Worksheets("数据输入表").Range("f1").Cells(i, 1)
   A(i, 7) = oleExcel.Worksheets("数据输入表").Range("g1").Cells(i, 1)
   A(i, 8) = oleExcel.Worksheets("数据输入表").Range("h1").Cells(i, 1)
Loop While A(i, 1) <> 0
 Count = i - 2
 
 VarPingJiaQi = Count
   TxtNianXian.Text = Str(Count)
   
 

    For i = 1 To Count
     For k = 1 To 7
        'MsgBox Data1.Recordset.Fields(k).
        TempS = A(i + 1, k + 1)
        
        VarShengCheng(i, k + 1) = Val(TempS)
     Next k
    
  Next i
 
  For i = 1 To Count
      VarShengCheng(i, 1) = i
  Next i
' oleExcel.DisplayAlerts = False
 'AppExcel.Application.Quit
oleExcel.Quit
Set oleExcel = Nothing


 Else
  
  Count = 0        '表中的记录数
  ' MsgBox OpeningDatabase
  
  ''******************修改纪录***********************
  Set Data1 = New ADODB.Connection
  Data1.CursorLocation = adUseClient
  Data1.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & filename1
  Set adozjyyyhg = New ADODB.Recordset
  adozjyyyhg.Open "select * from 数据输入表", Data1, adOpenStatic, adLockOptimistic
   
   'Data1.Refresh
   With adozjyyyhg
  ' .OpenRecordset
      If (.EOF = True) And (.BOF = True) Then
         'MsgBox "数据库无记录"
         Exit Sub
      
      Else
        .MoveFirst
         Do While .EOF = False
           Count = Count + 1
           .MoveNext
         Loop
       'MsgBox "数据库共有" & Count & "条记录"
     End If
     
   End With
   VarPingJiaQi = Count
    TxtNianXian.Text = Str(Count)
    
   'Data1.Refresh
   adozjyyyhg.MoveFirst
   
   For i = 1 To Count
     For k = 1 To 7
        'MsgBox Data1.Recordset.Fields(k).
        TempS = adozjyyyhg.Fields(k).Value
        VarShengCheng(i, k + 1) = Val(TempS)
     Next k
    adozjyyyhg.MoveNext
  Next i
  adozjyyyhg.Close
  For i = 1 To Count
      VarShengCheng(i, 1) = i
  Next i
  
  End If
  mTotalRows& = Str(Count)
  MSFlexGrid1.Rows = mTotalRows& + 1
  
  For m = 1 To mTotalRows&
    MSFlexGrid1.RowHeight(m) = 400 '设定高度
   MSFlexGrid1.ColAlignment(0) = 4
   For n = 1 To MSFlexGrid1.Cols - 1
    MSFlexGrid1.ColAlignment(n) = 4
          MSFlexGrid1.TextMatrix(m, n) = Format$(VarShengCheng(m, n + 1), kr_frt$(n))
          If MSFlexGrid1.TextMatrix(m, n) > 1000000000 Then
             MSFlexGrid1.TextMatrix(m, n) = Format$(0.1, "0.000")
             End If
        Text1.Text = MSFlexGrid1.Text
    Next n
     MSFlexGrid1.TextMatrix(m, 0) = m
    Next m
 
  Exit Sub
myerrr:
MousePointer = 0
   Me.Enabled = -1
       Me.MousePointer = 1





End Sub

Private Sub SSCommand2_Click() 'save file
MSFlexGrid1.Text = Text1.Text
'Text1.Visible = False
If newis = 1 Then
 On Error GoTo errhandler
    CommonDialog1.CancelError = True
    
     workpath = App.Path
    CommonDialog1.InitDir = workpath
1    CommonDialog1.Filter = "海上项目数据文件 (*.mdo)|*.mdo"
       CommonDialog1.DefaultExt = "*.mdo"
     'OpeningDatabase = filename$
    CommonDialog1.filename = workpath + "\" + filename$
     CommonDialog1.ShowSave
    
    CommonDialog1.FilterIndex = 2
    If Dir(CommonDialog1.filename) <> "" Then
    Beep
    msg$ = "警告：" + CommonDialog1.filename + "已经存在。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "要替换吗？"
    xchoose = MsgBox(msg$, 49, "警告")
    If xchoose = 2 Then GoTo 1
    filename$ = Trim$(CommonDialog1.FileTitle)
   End If
    
    
    OpeningDatabase = CommonDialog1.filename
    
   newis = 2
   formmain.Toolbar1.Buttons.Item(4).Enabled = True

    Set FileSystemObject = CreateObject("scripting.FileSystemObject")
    FileSystemObject.copyfile App.Path + "\" + "template\sdsdf-误删.vbw", OpeningDatabase
    'FileSystemObject.copyfile App.Path + "\" + "template\huaname.dat", workpath + "\" + "huaname1.dat"
    'Zwfilepathdat = workpath + "\" + filename$ + ".dat"
        'ZwfileQiTaPathdat = workpath + "\" + filename$ + "QiTa.dat"



End If
ShengChengGrideAdd
'SSCommand2.Caption = "OK"
formmain.mploy.Enabled = True
formmain.meco.Enabled = True
formmain.minvest.Enabled = True
formmain.Toolbar1.Buttons.Item(7).Enabled = 1
formmain.Toolbar1.Buttons.Item(8).Enabled = 1
formmain.Toolbar1.Buttons.Item(9).Enabled = 1
'filename$ = Trim$(CommonDialog1.FileTitle)
formmain.Caption = "经济评价系统 [版本1.0]" & "--" & filename$

errhandler:
   
   MousePointer = 0
   Me.Enabled = -1
  
   
End Sub
Public Sub ShengChengGrideAdd()      '将网格中的数据添加到数据库中的"数据输入表"
 
  Dim Count
  Count = Val(TxtNianXian.Text)
  VarPingJiaQi = Count
  
  On Error GoTo myerrr
  Set Data1 = New ADODB.Connection
  Data1.CursorLocation = adUseClient
  Data1.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & OpeningDatabase
  Set adozjyyyhg = New ADODB.Recordset
  
  adozjyyyhg.Open "select * from 数据输入表", Data1, adOpenStatic, adLockOptimistic
  With adozjyyyhg
    'MsgBox "eof=" & .EOF & "BOF=" & .BOF
    If Not ((.EOF = True) And (.BOF = True)) Then
      .MoveLast
    End If
    Do While .BOF = False
       .Delete
       .MovePrevious
    Loop
    If (.BOF = False) Then
      .MoveFirst
      .Delete
    End If
   
      For i = 1 To Count
        .AddNew                            ' 将网格中的数据添加到数据库中的"数据输入表"
        For k = 0 To 7
          If MSFlexGrid1.TextArray(i * 8 + k) = "" Then
           Str1 = "0.000"
            
          Else
             Str1 = MSFlexGrid1.TextArray(i * 8 + k)
         End If
          
          .Fields(k).Value = Str1
         ' VarShengCheng(I, k + 1) = Val(Str1)
        Next k
        
        .Update
        
      Next i