-
Notifications
You must be signed in to change notification settings - Fork 0
/
frmPeakfq.vb
3198 lines (2981 loc) · 151 KB
/
frmPeakfq.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Imports atcUtility
Imports atcControls
Imports MapWinUtility
Imports MapWinUtility.Strings
Imports System.Drawing.SystemColors
Imports ZedGraph
Friend Class frmPeakfq
Inherits System.Windows.Forms.Form
Friend DefaultMajorGridColor As Color = Color.FromArgb(255, 225, 225, 225)
Friend DefaultMinorGridColor As Color = Color.FromArgb(255, 245, 245, 245)
Dim DefaultSpecFile As String
Const tmpSpecName As String = "PKFQWPSF.TMP"
'Friend ThreshColors(255) As System.Drawing.Color '= {Color.CornflowerBlue, Color.DarkSeaGreen, Color.DeepPink, Color.DarkGoldenrod, Color.LightSlateGray, Color.Violet}
Friend ThreshColors() As System.Drawing.Color = {Color.Yellow, Color.Magenta, Color.Lime, Color.Cyan, Color.Coral, Color.DarkSeaGreen, Color.DeepPink, Color.DarkOrange, Color.SlateBlue}
Dim CurGraphName As String
Dim CurStationIndex As Integer = -1
Dim CurThreshRow As Integer = 0
Dim CurIntervalRow As Integer = 0
Dim GBCrit As Double = 0 'keeps track of current Grubbs-Beck Low Outlier (PILF) Threshold
Dim pLastClickedRow As Integer
Private Class GraphListItem
Public Label As String
Public Index As Integer
Public Overrides Function ToString() As String
Return Label
End Function
Public Sub New(ByVal aLabel As String, ByVal aIndex As Integer)
Label = aLabel
Index = aIndex
End Sub
End Class
Private Sub chkAddOut_CheckStateChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles chkAddOut.CheckStateChanged
Dim Index As Short = chkAddOut.GetIndex(eventSender)
If Index = 1 Then 'text file additional output
If chkAddOut(1).CheckState = CheckState.Checked Then
If Len(PfqPrj.AddOutFileName) = 0 Then 'set default
lblOutFile(1).Text = IO.Path.ChangeExtension(PfqPrj.OutFile, ".bcd")
End If
lblOutFile(1).Visible = True
cmdOpenOut(1).Visible = True
optAddFormat(0).Visible = True
optAddFormat(1).Visible = True
Else 'smaller frame is fine
lblOutFile(1).Visible = False
cmdOpenOut(1).Visible = False
optAddFormat(0).Visible = False
optAddFormat(1).Visible = False
End If
End If
End Sub
Private Sub cmdExit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdExit.Click
Call frmPeakfq_FormClosed(Me, New System.Windows.Forms.FormClosedEventArgs(CloseReason.None))
End Sub
Private Sub cmdGraph_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdGraph.Click
For i As Integer = 0 To lstGraphs.Items.Count - 1
If lstGraphs.GetSelected(i) Then
GenFrequencyGraph(i)
End If
Next i
End Sub
Private Sub PopulateGrid()
Dim ipos, j, i, ilen, Ind As Integer
Dim lRow As Integer = 1
Dim vSta As pfqStation = Nothing
Dim lName As String
With grdSpecs 'At this point, there should already be one instantiated with header rows
.Enabled = True
.BackColor = SystemColors.Control
End With
With grdSpecs.Source
.ColorCells = True
For Each vSta In PfqPrj.Stations
lRow += 1
.CellValue(lRow, 0) = vSta.id
.CellEditable(lRow, 0) = False
.Alignment(lRow, 0) = atcAlignment.HAlignRight
.CellColor(lRow, 0) = SystemColors.ControlDark
.CellEditable(lRow, 0) = False
'add stations to pull-down list on Threshold tab
lName = vSta.id
i = 0
While cboStation.Items.Contains(lName)
i += 1
lName = vSta.id & "-" & i
End While
cboStation.Items.Add(lName)
.CellValue(lRow, 1) = vSta.AnalysisOption
.CellEditable(lRow, 1) = True
.CellValue(lRow, 2) = vSta.BegYear
.CellEditable(lRow, 2) = True
.Alignment(lRow, 2) = atcAlignment.HAlignRight
.CellValue(lRow, 3) = vSta.EndYear
.CellEditable(lRow, 3) = True
.Alignment(lRow, 3) = atcAlignment.HAlignRight
.CellValue(lRow, 4) = vSta.EndYear - vSta.BegYear + 1
.CellEditable(lRow, 4) = False
.CellColor(lRow, 4) = SystemColors.ControlDark
.Alignment(lRow, 4) = atcAlignment.HAlignRight
If vSta.HistoricPeriod Then
.CellValue(lRow, 5) = "Yes"
Else
.CellValue(lRow, 5) = "No"
End If
.CellEditable(lRow, 5) = True
If vSta.SkewOpt = 0 Then
.CellValue(lRow, 6) = "Station"
ElseIf vSta.SkewOpt = 1 Then
.CellValue(lRow, 6) = "Weighted"
ElseIf vSta.SkewOpt = 2 Then
.CellValue(lRow, 6) = "Regional"
End If
.CellEditable(lRow, 6) = True
If vSta.UseSkewMap Then
.CellValue(lRow, 7) = "Yes"
Else
.CellValue(lRow, 7) = "No"
End If
.CellEditable(lRow, 7) = True
If Math.Abs(vSta.GenSkew) < 10 Then .CellValue(lRow, 8) = vSta.GenSkew
.CellEditable(lRow, 8) = True
.Alignment(lRow, 8) = atcAlignment.HAlignRight
If vSta.SESkew > 0 Then .CellValue(lRow, 9) = vSta.SESkew
.CellEditable(lRow, 9) = True
.Alignment(lRow, 9) = atcAlignment.HAlignRight
.CellValue(lRow, 10) = DecimalAlign((vSta.SESkew ^ 2).ToString, , 4)
.CellColor(lRow, 10) = SystemColors.ControlDark
.CellEditable(lRow, 10) = False
.CellValue(lRow, 11) = vSta.LowHistPeak
.CellColor(lRow, 11) = SystemColors.ControlDark
.CellEditable(lRow, 11) = False
.Alignment(lRow, 11) = atcAlignment.HAlignRight
.CellValue(lRow, 12) = vSta.LowOutlier
.CellEditable(lRow, 12) = True
.Alignment(lRow, 12) = atcAlignment.HAlignRight
.CellValue(lRow, 13) = vSta.LOTestType
.CellEditable(lRow, 13) = True
.CellValue(lRow, 14) = vSta.HighSysPeak
.CellColor(lRow, 14) = SystemColors.ControlDark
.CellEditable(lRow, 14) = False
.Alignment(lRow, 14) = atcAlignment.HAlignRight
.CellValue(lRow, 15) = vSta.HighOutlier
.Alignment(lRow, 15) = atcAlignment.HAlignRight
.CellValue(lRow, 16) = vSta.GageBaseDischarge
.Alignment(lRow, 16) = atcAlignment.HAlignRight
If vSta.AnalysisOption = "EMA" Then
'don't allow editing of hi-outlier field
.CellEditable(lRow, 15) = False
.CellColor(lRow, 15) = SystemColors.ControlDark
.CellEditable(lRow, 16) = False
.CellColor(lRow, 16) = SystemColors.ControlDark
Else
.CellEditable(lRow, 15) = True
.CellColor(lRow, 15) = Color.White
.CellEditable(lRow, 16) = True
.CellColor(lRow, 16) = Color.White
End If
If vSta.UrbanRegPeaks Then
.CellValue(lRow, 17) = "Yes"
Else
.CellValue(lRow, 17) = "No"
End If
.CellEditable(lRow, 17) = True
.CellValue(lRow, 18) = vSta.Lat
.CellEditable(lRow, 18) = True
.Alignment(lRow, 18) = atcAlignment.HAlignRight
.CellValue(lRow, 19) = vSta.Lng
.CellEditable(lRow, 19) = True
.Alignment(lRow, 19) = atcAlignment.HAlignRight
'setting of skew terms may be influenced by Lat/Lng, so make call here
SetSkewFields(grdSpecs, lRow, 6)
.CellValue(lRow, 20) = vSta.PlotName
.CellEditable(lRow, 20) = True
ilen = Len(vSta.PlotName)
For j = .Rows - 2 To .FixedRows Step -1 'look for duplicate plot names and adjust as needed
If vSta.PlotName = Nothing Then
ElseIf VB.Left(.CellValue(j, 19), ilen) = vSta.PlotName Then 'duplicate found
ipos = InStr(.CellValue(j, 19), "-")
If ipos > 0 Then 'not first duplicate, increase index number
Dim larr() As String = .CellValue(lRow, 19).Split("-")
Dim lastInd As Integer = Integer.Parse(larr(larr.Length - 1))
Ind = lastInd
'Ind = CInt(Mid(.CellValue(j, 17), ipos + 1))
.CellValue(lRow, 19) = vSta.PlotName & "-" & CStr(Ind + 1)
Else 'first duplicate
.CellValue(lRow, 19) = vSta.PlotName & "-1"
End If
End If
Next j
Next vSta
End With
'post population settings
With grdSpecs
.AllowHorizontalScrolling = True
.Visible = True
.SizeAllColumnsToContents()
.Refresh()
End With
End Sub
Private Sub ProcessGrid()
Dim i As Integer
Dim curSta As pfqStation
With grdSpecs.Source
For i = .FixedRows To .Rows - 1
curSta = PfqPrj.Stations.Item(i - .FixedRows) ' New pfqStation
curSta.id = .CellValue(i, 0)
curSta.AnalysisOption = .CellValue(i, 1)
If IsNumeric(.CellValue(i, 2)) Then curSta.BegYear = CInt(.CellValue(i, 2))
If IsNumeric(.CellValue(i, 3)) Then curSta.EndYear = CInt(.CellValue(i, 3))
If .CellValue(i, 5) = "Yes" Then
curSta.HistoricPeriod = True
Else
curSta.HistoricPeriod = False
End If
If .CellValue(i, 6) = "Station" Then
curSta.SkewOpt = 0
ElseIf .CellValue(i, 6) = "Weighted" Then
curSta.SkewOpt = 1
ElseIf .CellValue(i, 6) = "Regional" Then
curSta.SkewOpt = 2
End If
If .CellValue(i, 7) = "Yes" Then
curSta.UseSkewMap = True
Else
curSta.UseSkewMap = False
End If
If IsNumeric(.CellValue(i, 8)) Then curSta.GenSkew = CSng(.CellValue(i, 8))
If IsNumeric(.CellValue(i, 9)) Then curSta.SESkew = CSng(.CellValue(i, 9))
If IsNumeric(.CellValue(i, 12)) Then curSta.LowOutlier = CSng(.CellValue(i, 12))
curSta.LOTestType = .CellValue(i, 13)
If IsNumeric(.CellValue(i, 15)) Then curSta.HighOutlier = CSng(.CellValue(i, 15))
If IsNumeric(.CellValue(i, 16)) Then curSta.GageBaseDischarge = CSng(.CellValue(i, 16))
If .CellValue(i, 17) = "Yes" Then
curSta.UrbanRegPeaks = True
Else
curSta.UrbanRegPeaks = False
End If
If IsNumeric(.CellValue(i, 18)) Then curSta.Lat = CSng(.CellValue(i, 18))
If IsNumeric(.CellValue(i, 19)) Then curSta.Lng = CSng(.CellValue(i, 19))
curSta.PlotName = .CellValue(i, 20)
'PfqPrj.Stations.Add(curSta)
Next
End With
End Sub
Private Sub PopulateOutput()
lblOutFile(0).Text = PfqPrj.OutFile
If PfqPrj.DataType = 0 Then 'ASCII input, can't output to WDM
chkAddOut(0).Enabled = False
chkAddOut(0).CheckState = CheckState.Unchecked
Else
chkAddOut(0).Enabled = True
If PfqPrj.AdditionalOutput Mod 2 = 1 Then
chkAddOut(0).CheckState = CheckState.Checked
End If
End If
If PfqPrj.AdditionalOutput >= 2 Then
chkAddOut(1).CheckState = CheckState.Checked
lblOutFile(1).Text = PfqPrj.AddOutFileName
lblOutFile(1).Visible = True
cmdOpenOut(1).Visible = True
optAddFormat(0).Visible = True
optAddFormat(1).Visible = True
If PfqPrj.AdditionalOutput < 4 Then 'watstore format
optAddFormat(0).Checked = True
Else 'tab-separated format
optAddFormat(1).Checked = True
End If
'fraAddOut.Height = VB6.TwipsToPixelsY(1575)
Else
chkAddOut(1).CheckState = CheckState.Unchecked
lblOutFile(1).Text = "(none)"
lblOutFile(1).Visible = False
cmdOpenOut(1).Visible = False
optAddFormat(0).Visible = False
optAddFormat(1).Visible = False
'fraAddOut.Height = VB6.TwipsToPixelsY(735)
End If
If PfqPrj.ExportFileName.Length > 0 Then
chkExport.CheckState = CheckState.Checked
lblExportFile.Text = PfqPrj.ExportFileName
lblExportFile.Visible = True
cmdOpenExport.Visible = True
Else
chkExport.CheckState = CheckState.Unchecked
lblExportFile.Text = "(none)"
lblExportFile.Visible = False
cmdOpenExport.Visible = False
End If
If PfqPrj.EmpiricalFileName.Length > 0 Then
chkEmpirical.CheckState = CheckState.Checked
lblEmpirical.Text = PfqPrj.EmpiricalFileName
lblEmpirical.Visible = True
cmdOpenEmpirical.Visible = True
Else
chkEmpirical.CheckState = CheckState.Unchecked
lblEmpirical.Text = "(none)"
lblEmpirical.Visible = False
cmdOpenEmpirical.Visible = False
End If
If PfqPrj.ExtendedOutput Then
chkExtendedOutput.CheckState = CheckState.Checked
Else
chkExtendedOutput.CheckState = CheckState.Unchecked
End If
If PfqPrj.Graphic Then
If UCase(PfqPrj.GraphFormat) = "EMF" Then
cboGraphFormat.SelectedIndex = 1
ElseIf UCase(PfqPrj.GraphFormat) = "PNG" Then
cboGraphFormat.SelectedIndex = 2
ElseIf UCase(PfqPrj.GraphFormat) = "GIF" Then
cboGraphFormat.SelectedIndex = 3
ElseIf UCase(PfqPrj.GraphFormat) = "JPEG" Then
cboGraphFormat.SelectedIndex = 4
ElseIf UCase(PfqPrj.GraphFormat) = "TIFF" Then
cboGraphFormat.SelectedIndex = 5
Else 'use BMP
cboGraphFormat.SelectedIndex = 6
End If
cboDataGraphFormat.SelectedIndex = cboGraphFormat.SelectedIndex
Else
cboGraphFormat.SelectedIndex = 1
End If
If PfqPrj.PrintPlotPos Then
chkPlotPos.CheckState = CheckState.Checked
Else
chkPlotPos.CheckState = CheckState.Unchecked
End If
txtCI.Text = PfqPrj.ConfidenceInterval
txtPlotPos.Text = PfqPrj.PlotPos
End Sub
Private Sub ProcessOutput()
Dim i As Short
Dim lOutDir As String
PfqPrj.OutFile = lblOutFile(0).Text
lOutDir = PathNameOnly((PfqPrj.OutFile))
If Len(lOutDir) > 0 And lOutDir <> PfqPrj.InputDir Then PfqPrj.OutputDir = lOutDir
lblOutFileView(0).Text = PfqPrj.OutFile
If chkAddOut(0).CheckState = CheckState.Checked Then
PfqPrj.AdditionalOutput = 1
Else
PfqPrj.AdditionalOutput = 0
End If
If chkAddOut(1).CheckState = CheckState.Checked Then
If optAddFormat(0).Checked = True Then 'watstore format
PfqPrj.AdditionalOutput = PfqPrj.AdditionalOutput + 2
Else 'tab-separated format
PfqPrj.AdditionalOutput = PfqPrj.AdditionalOutput + 4
End If
PfqPrj.AddOutFileName = lblOutFile(1).Text
lblOutFileView(1).Text = PfqPrj.AddOutFileName
Else
PfqPrj.AddOutFileName = ""
lblOutFileView(1).Text = "(none)"
End If
If chkExport.CheckState = CheckState.Checked Then
PfqPrj.ExportFileName = lblExportFile.Text
lblExportFileView.Text = PfqPrj.ExportFileName
Else
PfqPrj.ExportFileName = ""
lblExportFileView.Text = "(none)"
End If
If chkEmpirical.CheckState = CheckState.Checked Then
PfqPrj.EmpiricalFileName = lblEmpirical.Text
lblEmpiricalFileView.Text = PfqPrj.EmpiricalFileName
Else
PfqPrj.EmpiricalFileName = ""
lblEmpiricalFileView.Text = "(none)"
End If
If chkExtendedOutput.CheckState = CheckState.Checked Then
PfqPrj.ExtendedOutput = True
Else
PfqPrj.ExtendedOutput = False
End If
If cboGraphFormat.SelectedIndex = 0 Then 'no graphics
PfqPrj.Graphic = False
Else 'get graphic format
PfqPrj.Graphic = True
PfqPrj.GraphFormat = StrRetRem(cboGraphFormat.Text)
End If
If chkPlotPos.CheckState = CheckState.Checked Then
PfqPrj.PrintPlotPos = True
Else
PfqPrj.PrintPlotPos = False
End If
'UPGRADE_WARNING: Couldn't resolve default property of object txtCL.Value. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
PfqPrj.ConfidenceInterval = txtCI.Text
'UPGRADE_WARNING: Couldn't resolve default property of object txtPlotPos.Value. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
PfqPrj.PlotPos = txtPlotPos.Text
End Sub
Private Sub cmdOpenOut_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdOpenOut.Click
Dim Index As Short = cmdOpenOut.GetIndex(eventSender)
On Error GoTo FileCancel
If Index = 0 Then
cdlOpenOpen.Title = "Main PeakFQ Output File"
cdlOpenSave.Title = "Main PeakFQ Output File"
'UPGRADE_WARNING: Filter has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
cdlOpenOpen.Filter = "PeakFQ Output (*.prt)|*.prt|All Files (*.*)|*.*"
cdlOpenSave.Filter = "PeakFQ Output (*.prt)|*.prt|All Files (*.*)|*.*"
cdlOpenOpen.FileName = PfqPrj.OutFile
cdlOpenSave.FileName = PfqPrj.OutFile
Else 'additional output file
cdlOpenOpen.Title = "Additional PeakFQ Output File"
cdlOpenSave.Title = "Additional PeakFQ Output File"
If optAddFormat(0).Checked = True Then
'UPGRADE_WARNING: Filter has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
cdlOpenOpen.Filter = "Watstore Output (*.bcd)|*.bcd|All Files (*.*)|*.*"
cdlOpenSave.Filter = "Watstore Output (*.bcd)|*.bcd|All Files (*.*)|*.*"
If Len(PfqPrj.AddOutFileName) = 0 Then 'provide default file name
PfqPrj.AddOutFileName = IO.Path.ChangeExtension(PfqPrj.DataFileName, ".bcd")
End If
Else
'UPGRADE_WARNING: Filter has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
cdlOpenOpen.Filter = "Tab-delimited Output (*.tab)|*.tab|All Files (*.*)|*.*"
cdlOpenSave.Filter = "Tab-delimited Output (*.tab)|*.tab|All Files (*.*)|*.*"
If Len(PfqPrj.AddOutFileName) = 0 Then 'provide default file name
PfqPrj.AddOutFileName = IO.Path.ChangeExtension(PfqPrj.DataFileName, ".tab")
End If
End If
cdlOpenOpen.FileName = PfqPrj.AddOutFileName
cdlOpenSave.FileName = PfqPrj.AddOutFileName
End If
cdlOpenSave.ShowDialog()
cdlOpenOpen.FileName = cdlOpenSave.FileName
If FileExists(cdlOpenOpen.FileName) Then 'make sure it's OK to overwrite
If MsgBox("File exists. Do you want to overwrite it?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then GoTo FileCancel
End If
lblOutFile(Index).Text = cdlOpenOpen.FileName
FileCancel:
End Sub
Private Sub cmdOutFileView_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdOutFileView.Click
Dim Index As Short = cmdOutFileView.GetIndex(eventSender)
If Len(lblOutFileView(Index).Text) > 0 And lblOutFileView(Index).Text <> "(none)" Then
'Shell(Chr(34) & FileViewer() & Chr(34) & " " & lblOutFileView(Index).Text, AppWinStyle.NormalFocus)
System.Diagnostics.Process.Start("notepad.exe", lblOutFileView(Index).Text)
Else
MsgBox("No " & fraOutFileRes(Index).Text & " is available for viewing.", MsgBoxStyle.Information, "PeakFQ")
End If
End Sub
Private Sub cmdRun_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdRun.Click
Dim i As Integer
Dim s As String
Dim lStnInd As Integer
Dim lBackToSpecs As Boolean = False
For i = 0 To PfqPrj.Stations.Count - 1
If PfqPrj.Stations(i).UseSkewMap Then
If MsgBox("The Bulletin 17B map skew is selected for one or more stations. " &
"Note that improved methods for estimating regional skew have been " &
"developed and this option is included in PeakFQ only to allow " &
"reproduction of a previous Bulletin 17B analysis." & vbCrLf & vbCrLf &
"Click OK to continue." & vbCrLf &
"Click Cancel to return to Station Specifications.", MsgBoxStyle.OkCancel,
"PeakFQ Run Issue") = MsgBoxResult.Cancel Then
lBackToSpecs = True
End If
End If
Next
If lBackToSpecs Then
Me.sstPfq.SelectedIndex = 0
Else
If Len(PfqPrj.SpecFileName) > 0 Then
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
lstGraphs.Items.Clear()
ProcessGrid()
If CurStationIndex >= 0 Then
'thresholds already populated on Input/View tab, retrieve values from there
ProcessThresholds()
Else 'for case of thresholds not yet populated, check date range of perception thresholds
Dim lThrColl As Generic.List(Of pfqStation.ThresholdType) = Nothing
For i = 0 To PfqPrj.Stations.Count - 1
lThrColl = New Generic.List(Of pfqStation.ThresholdType)
For j As Integer = 0 To PfqPrj.Stations(i).Thresholds.Count - 1
Dim lThresh As New pfqStation.ThresholdType
lThresh = PfqPrj.Stations(i).Thresholds(j)
If lThresh.SYear < PfqPrj.Stations(i).BegYear Then lThresh.SYear = PfqPrj.Stations(i).BegYear
If lThresh.EYear > PfqPrj.Stations(i).EndYear Then lThresh.EYear = PfqPrj.Stations(i).EndYear
lThrColl.Add(lThresh)
Next
PfqPrj.Stations(i).Thresholds = lThrColl
Next
End If
If cboDataGraphFormat.SelectedIndex > 0 Then
'save all data input graphs in specified format
lStnInd = CurStationIndex
For CurStationIndex = 0 To PfqPrj.Stations.Count - 1
If PfqPrj.Stations(CurStationIndex).AnalysisOption.ToUpper <> "SKIP" Then
UpdateInputGraph(vbTrue)
End If
Next
CurStationIndex = lStnInd
End If
ProcessOutput()
s = PfqPrj.SaveAsString
If s.Length > 0 Then
SaveFileString((PfqPrj.SpecFileName), s)
Application.DoEvents()
PfqPrj.RunBatchModel()
Application.DoEvents()
SetGraphNames()
cmdGraph.Enabled = True
sstPfq.TabPages.Item(3).Enabled = True
sstPfq.SelectedIndex = 3
'For CurStationIndex = 0 To PfqPrj.Stations.Count - 1
' If PfqPrj.Stations(CurStationIndex).AnalysisOption.ToUpper <> "SKIP" Then
' GenEMARepresentationGraph()
' End If
'Next
'CurStationIndex = lStnInd
End If
Me.Cursor = System.Windows.Forms.Cursors.Default
Else
MsgBox("PeakFQ Specfication or Data File must be opened before viewing results.", MsgBoxStyle.Information, "PeakFQ Results")
End If
End If
End Sub
Private Sub cmdSave_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdSave.Click
SaveSpecFile()
End Sub
Private Sub frmPeakfq_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Dim i As Integer
Logger.StartToFile("PeakFQ.log", , False)
lblInstruct.Text = "Use File menu to Open PeakFQ data or PKFQWin spec file." & vbLf & "Update Station, Threshold and Output specifications as desired." & vbLf & "Click Run PeakFQ button to generate results."
With grdSpecs
.Source = New atcControls.atcGridSource
End With
With grdSpecs.Source
.FixedRows = 2
.Rows = 1
.Columns = 19
.CellValue(1, 0) = "Station ID"
.CellValue(0, 1) = "Analysis"
.CellValue(1, 1) = "Option"
.CellValue(0, 2) = "Beginning"
.CellValue(1, 2) = "Year"
.CellValue(0, 3) = "Ending"
.CellValue(1, 3) = "Year"
.CellValue(0, 4) = "Record"
.CellValue(1, 4) = "Length"
.CellValue(0, 5) = "Inc Hist"
.CellValue(1, 5) = "Peaks"
.CellValue(0, 6) = "Skew"
.CellValue(1, 6) = "Option"
.CellValue(0, 7) = "Use B17B"
.CellValue(1, 7) = "Map Skew"
.CellValue(0, 8) = "Regional"
.CellValue(1, 8) = "Skew"
.CellValue(0, 9) = "Reg Skew"
.CellValue(1, 9) = "Std Error"
.CellValue(0, 10) = "Mean"
.CellValue(1, 10) = "Sqr Err"
.CellValue(0, 11) = "Low Hist"
.CellValue(1, 11) = "Peak"
.CellValue(0, 12) = "PILF (LO)"
.CellValue(1, 12) = "Threshold"
.CellValue(0, 13) = "PILF (LO)"
.CellValue(1, 13) = "Test"
.CellValue(0, 14) = "High Sys"
.CellValue(1, 14) = "Peak"
.CellValue(0, 15) = "Hi-Outlier"
.CellValue(1, 15) = "Threshold"
.CellValue(0, 16) = "Gage Base"
.CellValue(1, 16) = "Discharge"
.CellValue(0, 17) = "Urban/Reg"
.CellValue(1, 17) = "Peaks"
.CellValue(1, 18) = "Latitude"
.CellValue(1, 19) = "Longitude"
.CellValue(0, 20) = "Plot"
.CellValue(1, 20) = "Name"
End With
grdSpecs.SizeAllColumnsToContents()
grdThresh.Source = New atcControls.atcGridSource
With grdThresh.Source
.FixedRows = 1
.CellValue(0, 0) = "Start Year"
.CellValue(0, 1) = "End Year"
.CellValue(0, 2) = "Lower Bound"
.CellValue(0, 3) = "Upper Bound"
.CellValue(0, 4) = "Comment (Required)"
.ColorCells = True
For i = 0 To .Columns - 1
grdThresh.SizeColumnToString(i, .CellValue(0, i))
Next
End With
grdInterval.Source = New atcControls.atcGridSource
With grdInterval.Source
.FixedRows = 1
.CellValue(0, 0) = "Year"
.CellValue(0, 1) = "Peak"
.CellValue(0, 2) = "Remark Codes"
.CellValue(0, 3) = "Lower Bound"
.CellValue(0, 4) = "Upper Bound"
.CellValue(0, 5) = "Comment (Required)"
.ColorCells = True
For i = 0 To .Columns - 1
grdInterval.SizeColumnToString(i, .CellValue(0, i))
Next
grdInterval.SizeColumnToString(1, .CellValue(0, 1) & .CellValue(0, 1))
End With
InitGraph(zgcThresh, "Input")
'Dim lRed As Integer
'Dim lGreen As Integer
'Dim lBlue As Integer
'Dim lOffset As Integer
'For i = 0 To 255
' lOffset = 10 * i
' lRed = (20 * lOffset + 20) Mod 255
' If lRed < 150 Then lRed += 100
' lGreen = (130 * lOffset + 130) Mod 255
' If lGreen < 150 Then lGreen += 100
' lBlue = (240 * lOffset + 200) Mod 255
' If lBlue < 150 Then lBlue += 100
' ThreshColors(i) = Color.FromArgb(255, lRed, lGreen, lBlue)
'Next
sstPfq.SelectedIndex = 0
sstPfq.TabPages.Item(0).Enabled = False
sstPfq.TabPages.Item(1).Enabled = False
sstPfq.TabPages.Item(2).Enabled = False
sstPfq.TabPages.Item(3).Enabled = False
cmdRun.Enabled = False
cmdSave.Enabled = False
End Sub
Private Sub frmPeakfq_FormClosed(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Logger.Flush()
End
End Sub
Private Sub lstGraphs_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles lstGraphs.DoubleClick
cmdGraph_Click(cmdGraph, New System.EventArgs())
End Sub
Public Sub mnuAbout_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuAbout.Click
'MsgBox("Version " & My.Application.Info.Version.Major & "." & My.Application.Info.Version.Minor & "." & My.Application.Info.Version.Revision, MsgBoxStyle.Information, "PKFQWin")
frmAbout.Show()
End Sub
Public Sub mnuExit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuExit.Click
Call frmPeakfq_FormClosed(Me, New System.Windows.Forms.FormClosedEventArgs(CloseReason.None))
End Sub
Public Sub mnuFeedback_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuFeedback.Click
'*********************
'New feedback routine STARTS
'*********************
Dim lName As String = ""
Dim lEmail As String = ""
Dim lMessage As String = ""
Dim lFeedbackForm As New frmFeedback
lFeedbackForm.Text = "PeakFQ Feedback"
'TODO: format as an html document?
Dim lFeedback As String = lFeedbackForm.GetSystemInfo()
Dim lSectionFooter As String = "___________________________" & vbCrLf
'lFeedback &= "Project: " & g_Project.FileName & vbCrLf
'lFeedback &= "Config: " & g_Project.ConfigFileName & vbCrLf
lFeedback &= lSectionFooter
lName = System.Reflection.Assembly.GetExecutingAssembly.FullName
If lFeedbackForm.ShowFeedback(lName, lEmail, lMessage, lFeedback, False, False, False, PathNameOnly(System.Reflection.Assembly.GetExecutingAssembly.Location)) Then
Dim lFeedbackCollection As New System.Collections.Specialized.NameValueCollection
lFeedbackCollection.Add("name", Trim(lName))
lFeedbackCollection.Add("email", Trim(lEmail))
lFeedbackCollection.Add("message", Trim(lMessage))
lFeedbackCollection.Add("sysinfo", lFeedback)
Try
Dim lClient As New System.Net.WebClient
lClient.Proxy.Credentials = System.Net.CredentialCache.DefaultCredentials
lClient.UploadValues("http://hspf.com/cgi-bin/feedback-PeakFQ.cgi", "POST", lFeedbackCollection)
Logger.Msg("Feedback successfully sent", "Send Feedback")
Catch e As Exception
Logger.Msg("Feedback could not be sent", "Send Feedback")
End Try
End If
'*********************
'New feedback routine ENDS
'*********************
End Sub
Public Sub mnuHelpMain_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuHelpMain.Click
'temporarily not referencing on-line help as it is very outdated, prh 3/2014
frmAbout.Show()
'Dim lHelpFilename As String
'lHelpFilename = FindFile("", "C:\Doc\Peakfq\Out\peakfq.chm")
'If FileExists(lHelpFilename) Then
' ShowHelp(lHelpFilename)
' ShowHelp("")
'Else
' Logger.Dbg("Help File Not Found")
'End If
End Sub
Public Sub mnuOpen_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuOpen.Click
Dim FName As String
Dim s As String
On Error GoTo FileCancel
cdlOpenOpen.Title = "Open PeakFQ File"
cdlOpenSave.Title = "Open PeakFQ File"
cdlOpenOpen.Filter = "PeakFQ Watstore Data (*.pkf,*.inp,*.txt)|*.pkf;*.inp;*.txt|PeakFQ Watstore Data (*.*)|*.*|PeakFQ WDM Data (*.wdm)|*.wdm|PKFQWin Spec (*.psf)|*.psf"
cdlOpenSave.Filter = "PeakFQ Watstore Data (*.pkf,*.inp,*.txt)|*.pkf;*.inp;*.txt|PeakFQ Watstore Data (*.*)|*.*|PeakFQ WDM Data (*.wdm)|*.wdm|PKFQWin Spec (*.psf)|*.psf"
If cdlOpenOpen.ShowDialog = Windows.Forms.DialogResult.OK Then
cdlOpenSave.FileName = cdlOpenOpen.FileName
FName = cdlOpenOpen.FileName
If FName.Length < 240 Then 'acceptable file name length
PfqPrj.Stations.Clear()
PfqPrj = New pfqProject
PfqPrj.InputDir = PathNameOnly(FName)
PfqPrj.OutputDir = PathNameOnly(FName) 'default output directory to same as input
grdSpecs.Source.Rows = grdSpecs.Source.FixedRows
cboStation.Items.Clear()
CurStationIndex = -1
'set to current directory
ChDriveDir(PfqPrj.InputDir)
sstPfq.SelectedIndex = 0
sstPfq.TabPages.Item(3).Enabled = False
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
Application.DoEvents()
If cdlOpenOpen.FilterIndex <= 3 Then 'open data file
PfqPrj.DataFileName = FName
PfqPrj.BuildNewSpecFile() 'build basic spec file (I/O files)
PfqPrj.RunBatchModel() 'run model to generate verbose spec file
PfqPrj.ReadSpecFile() 'read verbose spec file
DefPfqPrj = PfqPrj.Copy
Else 'open spec file
s = WholeFileString(FName)
'build default project from initial version of spec file
SaveFileString(PathNameOnly(FName) & "\" & tmpSpecName, s)
PfqPrj.SpecFileName = PathNameOnly(FName) & "\" & tmpSpecName 'make working verbose copy
If FileExists(PfqPrj.DataFileName) AndAlso PfqPrj.Stations.Count > 0 Then
' DefPfqPrj = PfqPrj.SaveDefaults(s)
DefPfqPrj.DataFileName = PfqPrj.DataFileName
DefPfqPrj.BuildNewSpecFile() 'build basic spec file (I/O files)
DefPfqPrj.RunBatchModel() 'run model to generate verbose spec file
DefPfqPrj.ReadSpecFile() 'read verbose spec file
If FileExists(PfqPrj.DataFileName.Substring(0, PfqPrj.DataFileName.Length - 3) & "PRT") Then
IO.File.Delete(PfqPrj.DataFileName.Substring(0, PfqPrj.DataFileName.Length - 3) & "PRT")
End If
End If
End If
Me.Cursor = System.Windows.Forms.Cursors.Default
If FileExists(PfqPrj.DataFileName) Then
If PfqPrj.Stations.Count > 0 Then
'read peak data for each station from output file
PfqPrj.ReadPeaks()
If FileExists(PfqPrj.OutFile) Then
'delete output file generated from reading data
Kill(PfqPrj.OutFile)
End If
' txtData.Text = PfqPrj.DataFileName
lblData.Text = "PeakFQ Data File: " & PfqPrj.DataFileName
If cdlOpenOpen.FilterIndex = 4 Then 'opened spec file, put name on main form
' txtSpec.Text = fname
lblSpec.Text = "PKFQWin Spec File: " & FName
End If
If PfqPrj.EMA Then
cboAnalysisOption.SelectedItem = "EMA"
Else
cboAnalysisOption.SelectedItem = "B17B"
End If
cboLOTest.SelectedItem = "Multiple Grubbs-Beck"
EnableGrid()
PopulateGrid()
PopulateOutput()
sstPfq.TabPages.Item(0).Enabled = True
sstPfq.TabPages.Item(1).Enabled = True
sstPfq.TabPages.Item(2).Enabled = True
cmdRun.Enabled = True
cmdSave.Enabled = True
mnuSaveSpecs.Enabled = True
' PfqPrj.SpecFileName = tmpSpecName 'use temporary name for active spec file
Else
MessageBox.Show("Problem processing peak station data." & vbCrLf &
"Check file and path names of selected files", "File-Open Problem")
End If
End If
Else
MessageBox.Show("File name exceeds maximum allowable length (113 characters)." & vbCrLf &
"Check file and path names of selected files", "File-Open Problem")
End If
End If
FileCancel:
End Sub
Private Sub EnableGrid()
Dim i As Short
For i = 1 To 20
If i <> 4 AndAlso i <> 10 AndAlso i <> 11 AndAlso i <> 14 Then
'grdSpecs.set_ColEditable(i, True)
With grdSpecs.Source
For lrow As Integer = .FixedRows To .Rows - 1
If lrow + 1 > .FixedRows Then
.CellEditable(lrow, i) = True
End If
Next
End With
End If
Next i
End Sub
Public Sub mnuSaveSpecs_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuSaveSpecs.Click
SaveSpecFile()
End Sub
Private Sub SaveSpecFile()
Dim s As String
On Error GoTo FileCancel
cdlOpenOpen.Title = "PKFQWin Specification File"
cdlOpenSave.Title = "PKFQWin Specification File"
'UPGRADE_WARNING: Filter has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
cdlOpenOpen.Filter = "PKFQWin Spec File (*.psf)|*.psf|All Files (*.*)|*.*"
cdlOpenSave.Filter = "PKFQWin Spec File (*.psf)|*.psf|All Files (*.*)|*.*"
If VB.Right(PfqPrj.SpecFileName, 12) = tmpSpecName Then 'no spec file yet
cdlOpenOpen.FileName = IO.Path.ChangeExtension(PfqPrj.DataFileName, ".psf")
cdlOpenSave.FileName = IO.Path.ChangeExtension(PfqPrj.DataFileName, ".psf")
Else 'use existing spec file as default
cdlOpenOpen.FileName = DefaultSpecFile
cdlOpenSave.FileName = DefaultSpecFile
End If
cdlOpenSave.ShowDialog()
cdlOpenOpen.FileName = cdlOpenSave.FileName
ProcessGrid()
If CurStationIndex >= 0 Then ProcessThresholds()
ProcessOutput()
s = PfqPrj.SaveAsString(DefPfqPrj)
If s.Length > 0 Then
SaveFileString((cdlOpenOpen.FileName), s) 'save spec file under selected name
lblSpec.Text = cdlOpenOpen.FileName
End If
FileCancel:
End Sub
Private Sub sstPfq_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles sstPfq.SelectedIndexChanged
Static PreviousTab As Short = sstPfq.SelectedIndex()
'frmPeakfq_Resize(Me, New System.EventArgs())
PreviousTab = sstPfq.SelectedIndex()
sstPfq.SelectedTab.Focus()
If sstPfq.SelectedIndex = 1 Then
cmdCodeLookup.Visible = True
Else
cmdCodeLookup.Visible = False
End If
End Sub
Private Sub SetGraphNames()
Dim j, i, k As Integer
Dim ipos, ilen, Ind As Integer
Dim newName, oldName, GraphName As String
On Error Resume Next
lstGraphs.Items.Clear()
With grdSpecs.Source
For i = 1 To .Rows - .FixedRows
If .CellValue(i + 1, 1) <> "Skip" Then
j = j + 1
'oldName = "PKFQ-" & j & ".BMP"
newName = .CellValue(i + 1, 20)
If i > 1 Then 'look for repeating station IDs
ilen = Len(newName)
For k = i - 1 To 1 Step -1
GraphName = VB6.GetItemString(lstGraphs, k)
If VB.Left(GraphName, ilen) = newName Then
'same station ID, add index number
If Len(GraphName) > ilen Then 'add one to this index
ipos = InStrRev(GraphName, "-")
Ind = CInt(VB.Right(GraphName, ipos - 1))
newName = newName & CStr(Ind + 1)
Else 'just add "-1"
newName = newName & "-1"
End If
End If
Next k
End If
lstGraphs.Items.Add(New GraphListItem(newName, i))
'If PfqPrj.Graphic Then 'save graph to file
'always call generate graphic so analysis info is retrieved
'for generating EMA representation plot
'(graphic won't be saved if no format has been selected)
GenFrequencyGraph(lstGraphs.Items.Count - 1, True)
GenEMARepresentationGraph(lstGraphs.Items.Count - 1)
'End If
End If
Next i
End With
CurGraphName = IO.Path.ChangeExtension(VB6.GetItemString(lstGraphs, 0), ".BMP")
End Sub
Private Sub RenameGraph(ByRef oldName As String, ByVal newName As String)
'rename PeakFQ graphic files
'always BMPs; other graphic files too if BMP is not the graphic format
On Error Resume Next
Kill(newName)
Rename(oldName, newName)
If PfqPrj.GraphFormat <> "BMP" Then 'rename other graphic files too
newName = FilenameNoExt(newName) & "." & PfqPrj.GraphFormat
Kill(newName)
Rename(FilenameNoExt(oldName) & "." & PfqPrj.GraphFormat, newName)
End If
End Sub
Private Sub grdSpecs_CellEdited(ByVal aGrid As atcControls.atcGrid, ByVal aRow As Integer, ByVal aColumn As Integer) Handles grdSpecs.CellEdited
Try
Dim lSYear As Integer = 0
Dim lEYear As Integer = 0
With grdSpecs.Source
Dim lStnIndex As Integer = aRow - .FixedRows
Select Case aColumn
Case 1 'check to see if switching to EMA
If .CellValue(aRow, aColumn) = "EMA" Then 'force inclusion of historic peaks
.CellValue(aRow, 5) = "Yes"
'set to Multiple G-B test
.CellValue(aRow, 13) = "Multiple"
'don't allow editing of hi-outlier or gage base fields