VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX" Begin VB.Form Frequency Caption = "Frequency Distribution" ClientHeight = 6375 ClientLeft = 6120 ClientTop = 4020 ClientWidth = 5415 Icon = "Frequency.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6375 ScaleWidth = 5415 Begin VB.CommandButton Help Caption = "&Help" Height = 375 Left = 3360 TabIndex = 15 Top = 120 Width = 1935 End Begin VB.CommandButton Ntuple Caption = "Save Table to &Ntuple File" Height = 375 Left = 240 TabIndex = 14 Top = 5880 Width = 2175 End Begin VB.TextBox colNumber Height = 285 Left = 1560 TabIndex = 12 Text = "50" Top = 4200 Width = 855 End Begin VB.CommandButton Command1 Caption = "S&QL Criteria" Height = 375 Left = 240 TabIndex = 11 Top = 5280 Width = 2175 End Begin VB.TextBox Text2 Height = 285 Left = 3720 TabIndex = 6 Text = "max." Top = 4680 Width = 1575 End Begin VB.TextBox Text1 Height = 285 Left = 3720 TabIndex = 5 Text = "min." Top = 4200 Width = 1575 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 2760 Top = 120 _ExtentX = 847 _ExtentY = 847 _Version = 327681 End Begin VB.CommandButton File Caption = "&Select Database File" Height = 375 Left = 120 TabIndex = 4 Top = 120 Width = 2415 End Begin VB.CommandButton Exit Caption = "E&xit" Height = 375 Left = 3480 TabIndex = 3 Top = 5880 Width = 1815 End Begin VB.CommandButton Show Caption = "Sh&ow it!" Height = 375 Left = 3480 TabIndex = 2 Top = 5280 Width = 1815 End Begin VB.ListBox field_list Height = 2985 Left = 2640 TabIndex = 1 Top = 960 Width = 2655 End Begin VB.ListBox table_list Height = 2985 Left = 0 TabIndex = 0 Top = 960 Width = 2415 End Begin VB.Label Label4 Caption = "# of Columns:" Height = 255 Left = 120 TabIndex = 13 Top = 4200 Width = 1095 End Begin VB.Label Label3 Caption = "Field List:" Height = 255 Left = 2880 TabIndex = 10 Top = 600 Width = 2055 End Begin VB.Label TableList Caption = "Table List:" Height = 255 Left = 120 TabIndex = 9 Top = 600 Width = 1815 End Begin VB.Label Label2 Caption = "Max. value:" Height = 255 Left = 2760 TabIndex = 8 Top = 4560 Width = 975 End Begin VB.Label Label1 Caption = "Min. value:" Height = 255 Left = 2760 TabIndex = 7 Top = 4200 Width = 975 End End Attribute VB_Name = "Frequency" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public dbMydb As Database ' Database object in DAO Public recMyRec As Recordset ' represent the recordset in the chosen field Public sMyField As String ' store the name the chosen field Public sWhere As String ' Where string in SQL Private Sub Command1_Click() ' show the SQL window frmSQL.Show vbModal End Sub Private Sub Exit_Click() ' end the program End End Sub Private Sub field_list_Click() ' choose a field sMyField = field_list.Text End Sub Private Sub File_Click() ' open a database file Dim sFile As String CommonDialog1.filename = "" With CommonDialog1 .Filter = "Access Files (*.mdb)|*.mdb" .ShowOpen If Len(.filename) = 0 Then Exit Sub End If sFile = .filename End With Dim nCount As Integer Dim sTemp As String Set dbMydb = OpenDatabase(sFile) nCount = 0 table_list.Clear While nCount < dbMydb.TableDefs.Count sTemp = dbMydb.TableDefs(nCount).Name If Not sTemp Like "MSys*" Then table_list.AddItem dbMydb.TableDefs(nCount).Name End If nCount = nCount + 1 Wend ' For nCount = 0 To dbMydb.TableDefs.Count - 1 ' Debug.Print table_list.List(nCount) ' Next End Sub Private Sub Form_Load() ' do initialization Set recMyRec = Nothing End Sub Private Sub Form_Resize() ' keep the size of the form If WindowState = 1 Or WindowState = 2 Then Exit Sub Frequency.Height = 6780 Frequency.Width = 5535 End Sub Private Sub Help_Click() ' show help window frmHelp.Show vbModal End Sub Private Sub Ntuple_Click() ' save table data to an Ntuple file Dim nRecCount As Integer ' number of records Dim i, j, k As Integer Dim sFile As String ' .dat file to export data Dim sfiletitle As String Dim sMacroFile As String ' .kumac file Dim smacrofiletitle As String If table_list.Text Like "" Then MsgBox "In order to export an Ntuple file, you have to choose a table first." Exit Sub End If CommonDialog1.filename = "" With CommonDialog1 .DialogTitle = "Save File to:" .Filter = "Ntuple data Files (*.dat)|*.dat" .ShowOpen If Len(.filename) = 0 Then Exit Sub End If sFile = .filename sfiletitle = .FileTitle End With nRecCount = recMyRec.RecordCount If nRecCount = 0 Then MsgBox "The table is empty, so I cannot generate the Ntuple data file." Exit Sub End If i = MsgBox("The old data in the file you have specified will be lost, do you want to continue?", vbOKCancel) If i = vbCancel Then Exit Sub End If ' open the file to put data. Open sFile For Output As #1 recMyRec.MoveFirst For i = 0 To nRecCount - 1 k = 0 For j = 0 To recMyRec.Fields.Count - 1 If recMyRec.Fields(j).Type = dbBigInt Or _ recMyRec.Fields(j).Type = dbBinary Or _ recMyRec.Fields(j).Type = dbCurrency Or _ recMyRec.Fields(j).Type = dbDecimal Or _ recMyRec.Fields(j).Type = dbDouble Or _ recMyRec.Fields(j).Type = dbFloat Or _ recMyRec.Fields(j).Type = dbInteger Or _ recMyRec.Fields(j).Type = dbLong Or _ recMyRec.Fields(j).Type = dbNumeric Or _ recMyRec.Fields(j).Type = dbSingle Then If IsNull(recMyRec.Fields(j)) Then Print #1, "0"; " "; Else: Print #1, recMyRec.Fields(j); " "; End If k = k + 1 End If Next Print #1, recMyRec.MoveNext Next Close #1 ' ' generate MACRO code for PAW ' sMacroFile = Left(sFile, Len(sFile) - 4) + ".kumac" smacrofiletitle = Left(sfiletitle, Len(sfiletitle) - 4) + ".kumac" Open sMacroFile For Append As #1 Print #1, "MACRO " & UCase(Left(smacrofiletitle, Len(smacrofiletitle) - 6)) Print #1, "mess PAW MACRO file generated by FREQUENCY program." Print #1, "mess generation time: " & Now() Print #1, "ntuple/create 10 'Muon Production' "; k; "' '"; nRecCount * k * 4; " _" For j = 0 To recMyRec.Fields.Count - 1 If recMyRec.Fields(j).Type = dbBigInt Or _ recMyRec.Fields(j).Type = dbBinary Or _ recMyRec.Fields(j).Type = dbCurrency Or _ recMyRec.Fields(j).Type = dbDecimal Or _ recMyRec.Fields(j).Type = dbDouble Or _ recMyRec.Fields(j).Type = dbFloat Or _ recMyRec.Fields(j).Type = dbInteger Or _ recMyRec.Fields(j).Type = dbLong Or _ recMyRec.Fields(j).Type = dbNumeric Or _ recMyRec.Fields(j).Type = dbSingle Then Print #1, recMyRec.Fields(j).Name; " "; Next Print #1, Print #1, "ntuple/read 10 " & sfiletitle Print #1, "mess One Ntuple created, with the ID: 10" Print #1, "mess add your own code for plotting histograms below..." Close #1 ' ' explains the work done ' Done.Text1.Text = "The program has done the following things for you:" Done.Text1.Text = Done.Text1.Text + Chr(13) & Chr(10) & Chr(13) & Chr(10) Done.Text1.Text = Done.Text1.Text + "It first wrote all the numeric data fields " & _ "in the table into the .dat file you specified:" + Chr(13) + Chr(10) Done.Text1.Text = Done.Text1.Text + sFile + Chr(13) + Chr(10) + Chr(13) + Chr(10) Done.Text1.Text = Done.Text1.Text + "Then it generated a .kumac file ( MACRO file " & _ "for PAW) with the name of:" + Chr(13) + Chr(10) Done.Text1.Text = Done.Text1.Text + sMacroFile + Chr(13) + Chr(10) + Chr(13) + Chr(10) Done.Text1.Text = Done.Text1.Text + "This MACRO file can read the data from the .dat file, " & _ "and create a ntuple containg the data read." + Chr(13) + Chr(10) + Chr(13) + Chr(10) Done.Text1.Text = Done.Text1.Text + "What you should do in the rest is to put proper " & _ "commands at the end of the MACRO file to plot histograms, to do some cuts, or other " & _ "manipulation of data for your needs, using the PAW commands." Done.Show vbModal End Sub Private Sub Show_Click() ' generate a new plot window If sMyField Like "" Then MsgBox "You must select a field in order to draw the histogram." Exit Sub End If If recMyRec.Fields.Count = 0 Then MsgBox "Histogram not available: the table is empty!" Exit Sub End If If recMyRec.Fields(sMyField).Type = dbBigInt Or _ recMyRec.Fields(sMyField).Type = dbBinary Or _ recMyRec.Fields(sMyField).Type = dbCurrency Or _ recMyRec.Fields(sMyField).Type = dbDecimal Or _ recMyRec.Fields(sMyField).Type = dbDouble Or _ recMyRec.Fields(sMyField).Type = dbFloat Or _ recMyRec.Fields(sMyField).Type = dbInteger Or _ recMyRec.Fields(sMyField).Type = dbLong Or _ recMyRec.Fields(sMyField).Type = dbNumeric Or _ recMyRec.Fields(sMyField).Type = dbSingle Then Else MsgBox "This field does not have a valid data type to be plotted." Exit Sub End If Dim Plot As New FrmPlot ' create a new plot window Dim sSQL As String ' SQL statement for opening the recordsets. Dim i As Integer Plot.min_defined = False Plot.max_defined = False If (Not Text1.Text Like "") And (Not Text1.Text Like "min.") Then Plot.dblMin = CDbl(Text1.Text) Plot.min_defined = True End If If (Not Text2.Text Like "") And (Not Text2.Text Like "max.") Then Plot.dblMax = CDbl(Text2.Text) Plot.max_defined = True End If If Plot.min_defined And plot_max_defined And Plot.dblMin > Plot.dblMax Then MsgBox "Invalid Max/Min value." Exit Sub End If sSQL = "SELECT " & field_list.Text & _ " FROM " & table_list.Text If Not sWhere Like "" Then sSQL = sSQL & " WHERE " & sWhere On Error GoTo ErrHandler: Set Plot.recMy = dbMydb.OpenRecordset(sSQL) If (Plot.recMy.RecordCount = 0) Then MsgBox "No records satistying the criteria you specified." Exit Sub End If Plot.GRANULARITY = CInt(colNumber.Text) ' define the granularity of the histogram Plot.Show ' 'clean the glocal data ' sWhere = "" Text1.Text = "min." Text2.Text = "max." colNumber.Text = "50" Exit Sub ErrHandler: MsgBox "Error opening the recordset. Please check if the SQL statement is valid." End Sub Private Sub table_list_Click() ' show available fields Dim nCount As Integer nCount = 0 Set recMyRec = dbMydb.OpenRecordset(table_list.Text) field_list.Clear While nCount < recMyRec.Fields.Count field_list.AddItem recMyRec.Fields(nCount).Name nCount = nCount + 1 Wend End Sub Private Sub Text1_Click() ' prepare for min. value input Text1.Text = "" End Sub Private Sub Text2_Click() ' prepare for max. value input Text2.Text = "" End Sub