module1.bas

软测量软件包（BP+MATLAB）

Attribute VB_Name = "Module1"
'Option Explicit
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Const SRCCOPY = &HCC0020

Public rst As ADODB.Recordset
Public rsu, rs1, rs2, rs7 As ADODB.Recordset
Public rs3 As ADODB.Recordset
Public strcon As String
Public strsql, CheckString, checkstring1, judgeChange, mystr1 As String
Public aa(), bb(), cc(), dat(), dat1() As Variant
Public sFilename, anaName, sColumn, intnewname As String, oldtabname As String
'Dim WithEvents adors As Recordset

Public st As String
Public cnndb As ADODB.Connection
Public rs, rr As ADODB.Recordset
Public uuu As ADODB.Recordset
Dim aaa As ADODB.Command
Public cnn1, cnn2 As ADODB.Connection
Public number, flag, flag6, flag7, flag8, xsgs As Integer
Public flag3 As Integer, flag5 As Integer
Public zd, t, nn As Integer
Public dc1, FN, fn1, dc2, strOut, strTable, sPecol, specol2, zdname As String

'DefInt I-N
Dim a(), A0(), X0(), S0(), B0(), f(), g(), b(), dYJ(), YJ()
Public Type hu
   e As Double
   f As Double
   g As Double
   h As Double
   i As Double
   j As Double
   k As Double
   l As Double
'  double m;
'double n;


End Type

Sub OutputText()
 'Dim rr As New ADODB.Recordset
' Form1.Adodc2.Refresh
 
 If rr.RecordCount > 0 Then
  Open strOut For Output As #1
'Set rr = New ADODB.Recordset
'rr.CursorLocation = adUseClient
  
  ' rr.Open "Select top  " + Form1.Text2.Text + " *  from " + intnewname + " order by Date_time asc", cnn1, adOpenDynamic, adLockOptimistic
    'Form1.Adodc2.Recordset.MoveFirst
    
    rr.MoveFirst
   ' For i = 1 To Form1.Adodc2.Recordset.RecordCount
    ' Print #1, Form1.Adodc2.Recordset.Fields(0).Value & "," ' 不 换 行
     For i = 1 To rr.RecordCount
     ' For j = 1 To Form1.Ado.Recordset.Fields.Count - 1
     For j = 1 To rr.Fields.Count - 1
      'If j < Form1.Adodc2.Recordset.Fields.Count - 1 Then
      If j < rr.Fields.Count - 1 Then
      'If Form1.Adodc2.Recordset.Fields(j).Value < 1 Then
         'Form1.Adodc2.Recordset.Fields(j).Value = "0" + Form1.Adodc2.Recordset.Fields(j).Value
        ' End If
         
  
      ' Print #1, Format(Form1.Adodc2.Recordset.Fields(j).Value, "##0.0##"); " ";
      Print #1, Format(rr.Fields(j).Value, "##0.0##"); " ";
      Else
       'Print #1, Format(Form1.Adodc2.Recordset.Fields(j).Value, "##0.0##")
       Print #1, Format(rr.Fields(j).Value, "##0.0##")
     End If
     
      Next j
      ' Print #1, Format(Form1.Adodc2.Recordset.Fields(Form1.Adodc2.Recordset.Fields.Count - 1).Value, "###.###")
     ' Form1.Adodc2.Recordset.MoveNext
     rr.MoveNext
          Next i
       Close #1
       Else
       Exit Sub
       End If
       
  
End Sub


Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim hDc5 As Long, i As Long

Set pic = LoadPicture(FileName) '讀取圖形檔

hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在該memoryDC上放上bitmap圖

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Call StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
Call DeleteDC(hDc5)
End Sub
Public Sub DrawPicture(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim i As Long

Set pic = LoadPicture(FileName) '讀取圖形檔

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Dst.ScaleMode = 3
Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight

End Sub