-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFileIOFunctions.bas
2499 lines (2069 loc) · 119 KB
/
FileIOFunctions.bas
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
Attribute VB_Name = "FileIOFunctions"
Option Explicit
Private Const LANG_FILE_ERROR_STATEMENT_ID_OFFSET = 20000
Private Const LANG_FILE_CAUTION_STATEMENT_ID_OFFSET = 22000
Private Const CAP_FLOW_FILE_VERSIONTWO = 2
Private Function BackupFile(strFilePath As String) As String
' Creates a backup of the file given by strFilePath by copying the file
' to a new file, wherein the file's extension has been replaced with .Bak
' Returns the path of the backup file if success; otherwise, returns ""
Dim strBackupPath As String
On Error GoTo BackupFileErrorHandler
If gBlnWriteFilesOnDrive Then
If FileExists(strFilePath) Then
strBackupPath = FileExtensionForce(strFilePath, "bak", True)
FileCopy strFilePath, strBackupPath
BackupFile = strFilePath
Else
BackupFile = ""
End If
Else
BackupFile = ""
End If
Exit Function
BackupFileErrorHandler:
Debug.Assert False
BackupFile = ""
End Function
Public Function BuildPath(strParentDirectory As String, strFileName As String) As String
Dim fso As New FileSystemObject
BuildPath = fso.BuildPath(strParentDirectory, strFileName)
Set fso = Nothing
End Function
Private Function CheckBoxToIntegerString(chkThisCheckBox As CheckBox) As String
CheckBoxToIntegerString = Trim(Str(Val(chkThisCheckBox.value)))
End Function
Public Function ConstructFileDialogFilterMask(strFileTypeDescription As String, strFileExtension As String) As String
' Returns a properly formatted mask string for the Open or Save common dialog
' For example: "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
Dim strMask As String, strAllFiles As String
strAllFiles = LookupMessage(1500)
strMask = strFileTypeDescription & " (*." & strFileExtension & ")|*." & strFileExtension & "|" & strAllFiles & " (*.*)|*.*"
ConstructFileDialogFilterMask = strMask
End Function
Public Function IsComment(ByVal strTestString As String) As Boolean
' Returns True if strTestString starts with ; or '
strTestString = Trim(strTestString)
If Left(strTestString, 1) = COMMENT_CHAR Or Left(strTestString, 1) = "'" Then
IsComment = True
Else
IsComment = False
End If
End Function
Public Sub LoadAbbreviations(blnResetToDefaultAbbreviations As Boolean)
' blnResetToDefaultAbbreviations = False will load abbreviations from disk
' blnResetToDefaultAbbreviations = True will reset abbreviations to default and update the file on disk
Dim intIndex As Integer, intAbbrevFound As Integer
Dim blnFileNotFound As Boolean, blnRecreateFile As Boolean
Dim strWork As String
Dim strFilePath As String, strBackupFilePath As String
Dim InFileNum As Integer
Dim lngErrorID As Long, lngAbbreviationID As Long
Dim intInvalidAbbreviationCount As Integer
Dim strSymbol As String, strFormula As String, strOneLetterSymbol As String, strComment As String
Dim blnIsAminoAcid As Boolean, blnInvalidSymbolOrFormula As Boolean
Dim sngCharge As Single
On Error GoTo LoadAbbreviationsErrorHandler
If Not gBlnAccessFilesOnDrive Then
If blnResetToDefaultAbbreviations Then
' Load the abbreviations from memory
objMwtWin.ResetAbbreviations
End If
Exit Sub
End If
' Load Abbreviations
AddToIntro LookupLanguageCaption(3800, "Loading Abbreviations") & " ...", False, False
strFilePath = BuildPath(gCurrentPath, ABBREVIATIONS_FILENAME)
blnFileNotFound = Not FileExists(strFilePath)
If blnFileNotFound Or blnResetToDefaultAbbreviations Then
' Set the default abbreviations
objMwtWin.ResetAbbreviations
If gBlnWriteFilesOnDrive Then
' Re-create the abbreviations file
SaveAbbreviations True, False, strBackupFilePath
If Len(strBackupFilePath) > 0 Then
AddToIntro LookupMessage(110) & " " & LookupMessage(115) & ": " & strBackupFilePath
Else
AddToIntro LookupMessage(110)
End If
End If
Else
' Load from disk
InFileNum = FreeFile()
Open strFilePath For Input As #InFileNum
' Read the first line and make sure it's a valid version (5.0 or greater)
Line Input #InFileNum, strWork
intIndex = InStr(strWork, "(v")
If intIndex = 0 Then
' Missing version number, so re-create file
blnRecreateFile = True
Else
If Val(Mid(strWork, intIndex + 2)) < 5 Then
' Version is before 5.0, re-create file
blnRecreateFile = True
End If
End If
If blnRecreateFile Then
Close InFileNum
' Set the default abbreviations
objMwtWin.ResetAbbreviations
SaveAbbreviations
Else
objMwtWin.RemoveAllAbbreviations
Do
Line Input #InFileNum, strWork
strWork = Trim(strWork)
If strWork <> "" And Not IsComment(strWork) Then
Select Case intAbbrevFound
Case 0
If Left(strWork, 13) = "[AMINO ACIDS]" Then intAbbrevFound = 1
Case 1
If Left(strWork, 15) = "[ABBREVIATIONS]" Then
intAbbrevFound = 2
Else
LoadAbbreviationsParse strWork, True
End If
Case Else
Debug.Assert intAbbrevFound = 2
LoadAbbreviationsParse strWork, False
End Select
End If
Loop Until EOF(InFileNum)
Select Case intAbbrevFound
Case 0
' Amino Acids not found
AddToIntro LookupMessage(120)
Case 1
' Abbreviations not found
AddToIntro LookupMessage(130)
AddToIntro LookupMessage(135)
Case Else
' Everything is fine
End Select
Close InFileNum
End If
End If
' Validate all of the abbreviations
intInvalidAbbreviationCount = objMwtWin.ValidateAllAbbreviations()
If intInvalidAbbreviationCount > 0 Then
For lngAbbreviationID = 1 To objMwtWin.GetAbbreviationCount
lngErrorID = objMwtWin.GetAbbreviation(lngAbbreviationID, strSymbol, strFormula, sngCharge, blnIsAminoAcid, strOneLetterSymbol, strComment, blnInvalidSymbolOrFormula)
If blnInvalidSymbolOrFormula Then
AddToIntro LookupMessage(160) & ": " & strSymbol & " " & strFormula
End If
Next lngAbbreviationID
End If
Exit Sub
LoadAbbreviationsErrorHandler:
Close InFileNum
AddToIntro LookupMessage(150) & " (" & strFilePath & "): " & Err.Description
' Set the default abbreviations
objMwtWin.ResetAbbreviations
End Sub
Private Sub LoadAbbreviationsParse(strWork As String, blnAminoAcidAbbreviation As Boolean)
Const MAX_PARSE_VALS = 4
Dim strParsedVals(MAX_PARSE_VALS) As String, strRemaining As String
Dim strComment As String
Dim intParseCount As Integer
Dim intParsedValIndex As Integer
Dim strAbbrevSymbol As String, strThisAbbrevData As String
Dim strFormula As String, strOneLetterSymbol As String
Dim sngCharge As Single
Dim lngErrorID As Long
strWork = FormatForLocale(strWork)
' Look for a comment at the end of strWork and store in strComment
strComment = StripComment(strWork)
intParseCount = ParseString(strWork, strParsedVals(), MAX_PARSE_VALS, " ", strRemaining, True, True)
For intParsedValIndex = 1 To MAX_PARSE_VALS
strParsedVals(intParsedValIndex) = Trim(strParsedVals(intParsedValIndex))
Next intParsedValIndex
' Make sure strParsedVals(2) contains useful information (i.e. doesn't start with ' or ; and isn't blank)
If intParseCount > 0 And Len(strParsedVals(2)) > 0 Then
strAbbrevSymbol = strParsedVals(1)
If Len(strAbbrevSymbol) > 6 Then
strAbbrevSymbol = Left(strAbbrevSymbol, 6)
AddToIntro LookupMessage(190) & ": " & strWork
End If
For intParsedValIndex = 1 To 3
' strParsedVals(2) contains the formula
' strParsedVals(3) contains the charge
' strParsedVals(4) contains the 1 letter abbreviation (for amino acids only, and not all have one)
strThisAbbrevData = strParsedVals(intParsedValIndex + 1)
If Not IsComment(strThisAbbrevData) Then
Select Case intParsedValIndex
Case 1
' Formula
strFormula = strThisAbbrevData
Case 2
' Charge
sngCharge = CSngSafe(strThisAbbrevData)
Case 3
' One letter abbreviation
If blnAminoAcidAbbreviation Then
' Single letter abbreviation for amino acids
' Limit to just 1 letter
strOneLetterSymbol = UCase(Left(strThisAbbrevData, 1))
End If
End Select
End If
Next intParsedValIndex
' Note: Passing False to blnValidateFormula so that all abbreviations are added
' We later call .ValidateAllAbbreviations to validate them
lngErrorID = objMwtWin.SetAbbreviation(strAbbrevSymbol, strFormula, sngCharge, blnAminoAcidAbbreviation, strOneLetterSymbol, strComment, False)
If lngErrorID <> 0 Then
' Ignore the error for now; we'll validate all of the abbreviations later
' Reset objMwtWin.ErrorID
objMwtWin.ClearError
End If
Else
AddToIntro LookupMessage(200) & ": " & strWork
End If
End Sub
Public Sub LoadCapillaryFlowInfo()
' Loads Capillary Flow values from an Info file
Dim strInfoFilePath As String, strMessage As String
Dim blnMatched As Boolean
Dim strLineIn As String, intEqualLoc As Integer
Dim strSettingInFile As String, strIDStringInFile As String
Dim InFileNum As Integer
Dim intCapillaryFlowFileFormatVersion As Integer
' 1550 = Capillary Flow Info Files, 1555 = .cap
strInfoFilePath = SelectFile(frmCapillaryCalcs.hwnd, "Select File", gLastFileOpenSaveFolder, False, "", ConstructFileDialogFilterMask(LookupMessage(1550), LookupMessage(1555)), 1, True)
If Len(strInfoFilePath) = 0 Then
' No file selected (or other error)
Exit Sub
End If
On Error GoTo LoadCapillaryFlowInfoErrorHandler
' Open the file for input
InFileNum = FreeFile()
Open strInfoFilePath For Input As #InFileNum
Do While Not EOF(InFileNum)
Line Input #InFileNum, strLineIn
If Len(strLineIn) > 0 Then
If Not IsComment(strLineIn) Then
intEqualLoc = InStr(strLineIn, "=")
If intEqualLoc > 0 Then
strIDStringInFile = UCase(Left(strLineIn, intEqualLoc - 1))
strSettingInFile = Mid(strLineIn, intEqualLoc + 1)
If UCase(Left(strLineIn, 13)) = "CAPILLARYFLOW" Then
blnMatched = ParseCapillaryFlowSetting(strIDStringInFile, strSettingInFile, intCapillaryFlowFileFormatVersion)
Else
blnMatched = False
End If
If Not blnMatched Then
' Not matched, error
' Stop in IDE but ignore when compiled
Debug.Assert False
End If
End If
End If
End If
Loop
Close InFileNum
Exit Sub
LoadCapillaryFlowInfoErrorHandler:
Close InFileNum
strMessage = LookupMessage(330) & ": " & strInfoFilePath
strMessage = strMessage & vbCrLf & Err.Description
MsgBox strMessage, vbOKOnly + vbExclamation, LookupMessage(350)
End Sub
Public Sub LoadDefaultOptions(blnResetToDefaults As Boolean, Optional blnShowDebugPrompts As Boolean = False)
' blnResetToDefaults = False will load defaults from disk
' blnResetToDefaults = True will reset defaults to default
Dim intIndex As Integer, intCharLoc As Integer
Dim strWork As String, strMessage As String, strWorkVal As String, intWorkVal As Integer
Dim blnFileNotFound As Boolean
Dim strNewFontName As String
Dim intNewFontSize As Integer
Dim intSeparatorLoc As Integer, intSavedMaxAllowableIndex As Integer
Dim strFilePath As String
Dim InFileNum As Integer
Dim eResponse As VbMsgBoxResult
On Error GoTo LoadDefaultOptionsErrorHandler
If Not gBlnAccessFilesOnDrive Then
' Load the options from memory
SetDefaultOptions
SetAllTooltips
Exit Sub
End If
strFilePath = BuildPath(gCurrentPath, INI_FILENAME)
blnFileNotFound = Not FileExists(strFilePath)
If blnFileNotFound Or blnResetToDefaults Then
' Set the default options
SetDefaultOptions
SetAllTooltips
If gBlnWriteFilesOnDrive Then
If blnShowDebugPrompts Then MsgBox "LoadDefaultOptions: Re-creating the options file (" & strFilePath & ")"
SaveDefaultOptions
End If
Else
' Load from disk
InFileNum = FreeFile()
If blnShowDebugPrompts Then MsgBox "LoadDefaultOptions: Reading options file (" & strFilePath & ")"
Open strFilePath For Input As #InFileNum
Do
Line Input #InFileNum, strWork
strWork = Trim(strWork)
If strWork <> "" And Not IsComment(strWork) Then
intCharLoc = InStr(strWork, "=")
If intCharLoc > 0 Then
strWorkVal = Mid(strWork, intCharLoc + 1)
intWorkVal = CIntSafe(strWorkVal)
Select Case UCase(Left(strWork, intCharLoc - 1))
Case "VIEW":
If intWorkVal = vmdSingleView Then
frmMain.SetViewMode vmdSingleView
Else
frmMain.SetViewMode vmdMultiView
End If
Case "CONVERT"
If intWorkVal >= 0 And intWorkVal <= 2 Then
frmProgramPreferences.optConvertType(intWorkVal).value = True
End If
Case "ABBREV":
If intWorkVal >= 0 And intWorkVal <= 2 Then
frmProgramPreferences.optAbbrevType(intWorkVal).value = True
End If
Case "STDDEV":
If intWorkVal >= 0 And intWorkVal <= 3 Then
frmProgramPreferences.optStdDevType(intWorkVal).value = True
End If
Case "CAUTION": SetCheckBoxValue frmProgramPreferences.chkShowCaution, intWorkVal
Case "ADVANCE": SetCheckBoxValue frmProgramPreferences.chkAdvanceOnCalculate, intWorkVal
Case "CHARGE": SetCheckBoxValue frmProgramPreferences.chkComputeCharge, intWorkVal
Case "QUICKSWITCH": SetCheckBoxValue frmProgramPreferences.chkShowQuickSwitch, intWorkVal
Case "FONT":
' Also get fontsize before reformatting the objects
strNewFontName = strWorkVal
Case "FONTSIZE":
If intWorkVal >= 7 And intWorkVal <= 64 Then
intNewFontSize = intWorkVal
Else
intNewFontSize = 10
End If
Case "EXITCONFIRM":
If intWorkVal >= 0 And intWorkVal <= 3 Then
frmProgramPreferences.optExitConfirmation(intWorkVal).value = True
End If
Case "FINDERWEIGHTMODEWARN":
If intWorkVal >= -1 And intWorkVal <= 1 Then
With frmProgramPreferences
Select Case intWorkVal
Case 1
.chkAlwaysSwitchToIsotopic.value = vbChecked
' This also checks never show
Case -1
.chkAlwaysSwitchToIsotopic.value = vbUnchecked
.chkNeverShowFormulaFinderWarning.value = vbChecked
Case Else
.chkAlwaysSwitchToIsotopic.value = vbUnchecked
.chkNeverShowFormulaFinderWarning.value = vbUnchecked
End Select
End With
End If
Case "TOOLTIPS"
SetCheckBoxValue frmProgramPreferences.chkShowToolTips, intWorkVal
Case "HIDEINACTIVEFORMS"
SetCheckBoxValue frmProgramPreferences.chkHideInactiveForms, intWorkVal
Case "STARTUPMODULE"
With frmProgramPreferences.cboStartupModule
If intWorkVal < .ListCount Then
.ListIndex = intWorkVal
End If
End With
Case "AUTOSAVEVALUES":
SetCheckBoxValue frmProgramPreferences.chkAutosaveValues, intWorkVal
Case "BRACKETSASPARENTHESES"
SetCheckBoxValue frmProgramPreferences.chkBracketsAsParentheses, intWorkVal
Case "AUTOCOPYCURRENTMWT"
SetCheckBoxValue frmProgramPreferences.chkAutoCopyCurrentMWT, intWorkVal
Case "MAXIMUMFORMULASTOSHOW"
' Note that the cboMaximumFormulasToShow combo box is initialized to the allowable
' values for the current resolution when frmProgramPreferences is loaded
' Parse the two values stored on this line
intSeparatorLoc = InStr(strWorkVal, "::")
If intSeparatorLoc > 0 Then
' intWorkVal holds the user's desired max formula index
intWorkVal = CIntSafe(Left(strWorkVal, intSeparatorLoc - 1))
intSavedMaxAllowableIndex = CIntSafe(Mid(strWorkVal, intSeparatorLoc + 2))
With frmProgramPreferences
If intSavedMaxAllowableIndex = CIntSafeDbl(.cboMaximumFormulasToShow.List(.cboMaximumFormulasToShow.ListCount - 1)) - 1 Then
' Only use the saved desired max formula index if the screen resolution
' has not changed since the program was last exited
' This is done so that the user will realize that more formulas can be displayed at higher resolutions
For intIndex = 0 To .cboMaximumFormulasToShow.ListCount - 1
If .cboMaximumFormulasToShow.List(intIndex) = Trim(Str(intWorkVal)) + 1 Then
.cboMaximumFormulasToShow.ListIndex = intIndex
If frmMain.GetTopFormulaIndex <= intWorkVal Then
gMaxFormulaIndex = intWorkVal
End If
Exit For
End If
Next intIndex
End If
End With
End If
Case "FINDERBOUNDEDSEARCH"
If intWorkVal = 0 Or intWorkVal = 1 Then
frmFinderOptions.cboSearchType.ListIndex = intWorkVal
End If
Case "LANGUAGE"
gCurrentLanguage = strWorkVal
Case "LANGUAGEFILE"
gCurrentLanguageFileName = strWorkVal
Case "LASTOPENSAVEFOLDER"
gLastFileOpenSaveFolder = strWorkVal
Case Else
' Not matched, error
' Stop in IDE but ignore when compiled
Debug.Assert False
End Select
Else
' Not matched, error
' Stop in IDE but ignore when compiled
Debug.Assert False
End If
End If
Loop Until EOF(InFileNum)
Close InFileNum
If blnShowDebugPrompts Then MsgBox "LoadDefaultOptions: Set Fonts"
' Tasks that need to be done now that the options have been loaded
SetFonts strNewFontName, intNewFontSize
If blnShowDebugPrompts Then
eResponse = MsgBox("Show detailed debugging information when setting ToolTips?", vbQuestion + vbYesNo + vbDefaultButton2)
SetAllTooltips (eResponse = vbYes)
Else
SetAllTooltips
End If
End If
Exit Sub
LoadDefaultOptionsErrorHandler:
Close InFileNum
strMessage = LookupMessage(400) & " (" & strFilePath & "): " & Err.Description
strMessage = strMessage & vbCrLf & LookupMessage(410) & vbCrLf & LookupMessage(345)
MsgBox strMessage, vbOKOnly + vbExclamation, LookupMessage(350)
End Sub
Public Sub LoadElements(intNewElementMode As Integer, Optional blnShowFrmIntro As Boolean = True)
' intNewElementMode = 0 will load elements from disk
' intNewElementMode = 1 will reset elements to default (average weights)
' intNewElementMode = 2 will change elements to isotopic weights
' intNewElementMode = 3 will change the elements to their integer weights
' If loading elements from memory, re-creates the element file
' Otherwise, loads from disk and updates the values in objMwtWin
Const MAX_PARSE_COUNT = 4
Dim intParseCount As Integer, intParsedValIndex As Integer
Dim strParsedVals(MAX_PARSE_COUNT) As String ' 0-based array
Dim intCharLoc As Integer
Dim blnElementsHeaderFound As Boolean, blnFileNotFound As Boolean, blnRecreateFile As Boolean
Dim InFileNum As Integer
Dim eNewElementWeightType As emElementModeConstants
Dim strLineIn As String, strRemaining As String
Dim strSymbol As String
Dim lngElementID As Long, lngErrorID As Long
Dim dblMass As Double, dblUncertainty As Double, sngCharge As Single, intIsotopeCount As Integer
Dim dblNewMass As Double, dblNewUncertainty As Double, sngNewCharge As Single
Dim strFilePath As String, strBackupFilePath As String
On Error GoTo LoadElementsErrorHandler
If Not gBlnAccessFilesOnDrive Then
' Load the element weights from memory
SwitchWeightModeInteger intNewElementMode
Exit Sub
End If
' Load Elements
If blnShowFrmIntro Then frmIntro.Show vbModeless
frmIntro.lblLoadStatus.Caption = LookupLanguageCaption(3810, "Loading Elements") & " ..."
strFilePath = BuildPath(gCurrentPath, ELEMENTS_FILENAME)
blnFileNotFound = Not FileExists(strFilePath)
If blnFileNotFound Or intNewElementMode >= 1 Then
If blnFileNotFound Then
AddToIntro LookupMessage(270) & " (" & strFilePath & ")"
End If
SwitchWeightModeInteger intNewElementMode
If gBlnWriteFilesOnDrive Then
SaveElements strBackupFilePath
If Len(strBackupFilePath) > 0 Then
AddToIntro LookupMessage(210) & " " & LookupMessage(115) & ": " & strBackupFilePath
Else
AddToIntro LookupMessage(210)
End If
End If
Else
' Load from disk
InFileNum = FreeFile()
Open strFilePath For Input As #InFileNum
' Read the first line and make sure it's a valid version (5.0 or greater)
Line Input #InFileNum, strLineIn
intCharLoc = InStr(strLineIn, "(v")
If intCharLoc = 0 Then
' Missing version number, so re-create file
blnRecreateFile = True
Else
If Val(Mid(strLineIn, intCharLoc + 2)) < 5 Then
' Version is before 5.0, re-create file
blnRecreateFile = True
End If
End If
If blnRecreateFile Then
Close InFileNum
SwitchWeightModeInteger intNewElementMode
SaveElements
Else
blnElementsHeaderFound = False
Do
Line Input #InFileNum, strLineIn
strLineIn = Trim(strLineIn)
strRemaining = ""
If strLineIn <> "" And Not IsComment(strLineIn) Then
If Not blnElementsHeaderFound Then
If Left(strLineIn, 19) = "[ELEMENTWEIGHTTYPE]" Then
eNewElementWeightType = CIntSafe(Trim(Mid(strLineIn, 20)))
If eNewElementWeightType < 1 Or eNewElementWeightType > 3 Then
eNewElementWeightType = 1
End If
SwitchWeightMode eNewElementWeightType
gElementWeightTypeInFile = eNewElementWeightType
End If
If Left(strLineIn, 13) = "[ELEMENTS]" Then
blnElementsHeaderFound = True
If eNewElementWeightType = 0 Then
' No gElementWeightType statement present, assume type 1
eNewElementWeightType = 1
SwitchWeightMode eNewElementWeightType
gElementWeightTypeInFile = eNewElementWeightType
End If
End If
Else
strLineIn = FormatForLocale(strLineIn)
' Note: by using a delimeter of " ;'" and setting MatchWholeDelimeter to false, then strLineIn will be split based on a space, semicolon, or apostrophe
intParseCount = ParseString(strLineIn, strParsedVals(), MAX_PARSE_COUNT, " ;'", strRemaining, False, True, False)
If intParseCount >= 3 Then
For intParsedValIndex = 0 To MAX_PARSE_COUNT - 1
strParsedVals(intParsedValIndex) = Trim(strParsedVals(intParsedValIndex))
Next intParsedValIndex
If IsNumeric(strParsedVals(1)) Then
strSymbol = strParsedVals(0)
dblNewMass = CDblSafe(strParsedVals(1))
If IsNumeric(strParsedVals(3)) Then
dblNewUncertainty = CDblSafe(strParsedVals(2))
Else
dblNewUncertainty = 0
End If
If IsNumeric(strParsedVals(3)) Then
sngNewCharge = CSngSafe(strParsedVals(3))
Else
sngNewCharge = 0
End If
If dblNewMass >= 0 And dblNewUncertainty >= 0 Then
' Make sure strSymbol is valid, and grab the current values for the element
lngElementID = objMwtWin.GetElementID(strSymbol)
If lngElementID > 0 Then
' Get the current element values
lngErrorID = objMwtWin.GetElement(lngElementID, strSymbol, dblMass, dblUncertainty, sngCharge, intIsotopeCount)
Debug.Assert lngErrorID = 0
' See if new mass is more than 20% different than old mass
If dblNewMass > 1.2 * dblMass Or _
dblNewMass < 0.8 * dblMass Then
AddToIntro LookupMessage(220, ": " & strSymbol & ", " & CStr(dblNewMass))
End If
' See if uncertainty is more than 10 times different than old uncertainty
If gElementWeightTypeInFile = emAverageMass And _
(dblNewUncertainty > 10 * dblUncertainty Or _
dblNewUncertainty < 0.1 * dblUncertainty) Then
AddToIntro LookupMessage(230, ": " & strSymbol & ", " & CStr(dblNewUncertainty))
End If
lngErrorID = objMwtWin.SetElement(strSymbol, dblNewMass, dblNewUncertainty, sngNewCharge, False)
If lngErrorID <> 0 Then
AddToIntro LookupMessage(lngErrorID) & ": " & strLineIn
End If
Else
AddToIntro LookupMessage(250) & ": " & strLineIn
End If
Else
AddToIntro LookupMessage(200) & ": " & strLineIn
End If
Else
AddToIntro LookupMessage(200) & ": " & strLineIn
End If
Else
AddToIntro LookupMessage(200) & ": " & strLineIn
End If
End If
End If
Loop Until EOF(InFileNum)
If Not blnElementsHeaderFound Then
' Elements not found
AddToIntro LookupMessage(260)
AddToIntro LookupMessage(265)
End If
Close InFileNum
End If
End If
LoadElementsExit:
' Recompute the abbreviation masses
objMwtWin.RecomputeAbbreviationMasses
' Make sure QuickSwitch Element Mode value is correct
frmMain.ShowHideQuickSwitch frmProgramPreferences.chkShowQuickSwitch.value
Exit Sub
LoadElementsErrorHandler:
Close InFileNum
AddToIntro LookupMessage(280) & " (" & strFilePath & ")"
AddToIntro Err.Description
AddToIntro LookupMessage(265)
Resume LoadElementsExit
End Sub
Public Function LoadLanguageSettings(strLangFilename As String, strNewLanguage As String) As Boolean
Dim strFilePath As String
Dim blnSuccess As Boolean
Dim strSearchForFile As String, strMessage As String
' See if the language file exists
strFilePath = BuildPath(gCurrentPath, strLangFilename)
strSearchForFile = Dir(strFilePath)
If Len(strSearchForFile) > 0 Then
' Load the new language file into form frmStrings
blnSuccess = LoadLanguageFile(strFilePath, frmStrings.grdLanguageStrings, frmStrings.grdLanguageStringsCrossRef, True)
If blnSuccess Then
' Reset menu captions to numeric values
ResetMenuCaptions False
' Load the captions into controls on all forms
LoadLanguageCaptions
' Load the captions into the dynamic text fields on the Formula Finder form
frmFinder.LoadDynamicTextCaptions
' Add shortcut keys to menus
AppendShortcutKeysToMenuCaptions
' Save new language in gCurrentLanguage
gCurrentLanguage = strNewLanguage
gCurrentLanguageFileName = strLangFilename
' Save new value for gMWAbbreviation
gMWAbbreviation = LookupLanguageCaption(4040, "MW")
If Len(gMWAbbreviation) <> 2 Then
gMWAbbreviation = "MW"
End If
blnSuccess = True
Else
' Problem loading settings
strMessage = LookupMessage(440) & " (" & strFilePath & ")"
strMessage = strMessage & vbCrLf & LookupMessage(450)
MsgBox strMessage, vbOKOnly + vbExclamation, LookupMessage(350)
blnSuccess = False
End If
Else
strMessage = LookupMessage(460) & " (" & strFilePath & ")"
strMessage = strMessage & vbCrLf & LookupMessage(450)
MsgBox strMessage, vbOKOnly + vbExclamation, LookupMessage(350)
blnSuccess = False
End If
LoadLanguageSettings = blnSuccess
End Function
Private Sub LoadGridColumnTitles(grdThisFlexGrid As MSFlexGrid)
Dim intIndex As Integer
On Error GoTo LoadGridColumnTitlesErrorHandler
' Need to update Column titles in various MSFlexGrids in program
With grdThisFlexGrid
Select Case LCase(.Name)
Case "grdamino"
.TextMatrix(0, 0) = "AbbrevID (Hidden)"
.TextMatrix(0, 1) = LookupLanguageCaption(9180, .TextMatrix(0, 0))
.TextMatrix(0, 2) = LookupLanguageCaption(9160, .TextMatrix(0, 1))
.TextMatrix(0, 3) = LookupLanguageCaption(9150, .TextMatrix(0, 2))
.TextMatrix(0, 4) = LookupLanguageCaption(9190, .TextMatrix(0, 3))
.TextMatrix(0, 5) = LookupLanguageCaption(9195, "Comment")
Case "grdnormal"
.TextMatrix(0, 0) = "AbbrevID (Hidden)"
.TextMatrix(0, 1) = LookupLanguageCaption(9170, .TextMatrix(0, 0))
.TextMatrix(0, 2) = LookupLanguageCaption(9160, .TextMatrix(0, 1))
.TextMatrix(0, 3) = LookupLanguageCaption(9150, .TextMatrix(0, 2))
.TextMatrix(0, 4) = LookupLanguageCaption(9195, "Comment")
Case "grdelem"
.TextMatrix(0, 0) = LookupLanguageCaption(9350, .TextMatrix(0, 0))
.TextMatrix(0, 1) = LookupLanguageCaption(9360, .TextMatrix(0, 1))
.TextMatrix(0, 2) = LookupLanguageCaption(9370, .TextMatrix(0, 2))
.TextMatrix(0, 3) = LookupLanguageCaption(9150, .TextMatrix(0, 3))
Case "grdmodsymbols"
.TextMatrix(0, 0) = "ModSymbolID (Hidden)"
.TextMatrix(0, 1) = LookupLanguageCaption(15610, "Symbol")
.TextMatrix(0, 2) = LookupLanguageCaption(15620, "Mass")
.TextMatrix(0, 3) = LookupLanguageCaption(15640, "Comment")
Case "grdionlist"
.TextMatrix(0, 0) = LookupLanguageCaption(12550, "Mass")
.TextMatrix(0, 1) = LookupLanguageCaption(12560, "Intensity")
.TextMatrix(0, 2) = LookupLanguageCaption(12570, "Symbol")
Case "grdfragmasses"
.TextMatrix(0, 0) = LookupLanguageCaption(12500, "#")
.TextMatrix(0, 1) = LookupLanguageCaption(12510, "Immon.")
' We can only update the Seq column if the initial language is English
For intIndex = 0 To .Cols - 1
If .TextMatrix(0, intIndex) = "Seq." Then
.TextMatrix(0, intIndex) = LookupLanguageCaption(12520, "Seq.")
Exit For
End If
Next intIndex
.TextMatrix(0, .Cols - 1) = .TextMatrix(0, 0)
Case "grdpc", "grdlanguagestrings", "grdmenuinfo", "grdlanguagestringscrossref"
' No column titles in grdPC or grdLanguageStrings or grdMenuInfo or grdLanguageStringsCrossRef
Case Else
' Unknown Grid: do not set any titles
' Add cases above for the other grids so this assertion is note reached
Debug.Assert False
End Select
End With
Exit Sub
LoadGridColumnTitlesErrorHandler:
Debug.Assert False
GeneralErrorHandler "MwtWinProcedures|LoadGridColumnTitles", Err.Number, Err.Description
End Sub
Private Sub LoadLanguageCaptions(Optional boolSingleFormOnly As Boolean = False, Optional frmThisSingleForm As VB.Form)
Dim frmThisForm As VB.Form
If boolSingleFormOnly Then
LoadLanguageCaptionsIntoForm frmThisSingleForm
frmThisSingleForm.Refresh
Else
' Load new captions into all forms
For Each frmThisForm In Forms
LoadLanguageCaptionsIntoForm frmThisForm
frmThisForm.Refresh
Next
LoadLanguageCaptionsIntoAppWideDynamicLabels
frmEditElem.PositionFormControls
frmEditAbbrev.PositionFormControls
End If
If frmMain.mnuShowTips.Checked = True Then
' Load all ToolTips
SetAllTooltips
End If
Dim strMinutesElapsedRemaining As String, strClickToPause As String
Dim strPreparingToPause As String, strPaused As String
Dim strResuming As String, strPressEscapeToAbort As String
' Update language captions for frmProgress and objMwtWin.frmProgress
strMinutesElapsedRemaining = LookupLanguageCaption(14740, "min. elapsed/remaining")
strClickToPause = LookupLanguageCaption(14710, "Click to Pause")
strPreparingToPause = LookupLanguageCaption(14715, "Preparing to Pause")
strPaused = LookupLanguageCaption(14720, "Paused")
strResuming = LookupLanguageCaption(14725, "Resuming")
strPressEscapeToAbort = LookupLanguageCaption(14730, "(Press Escape to Abort)")
frmProgress.SetStandardCaptionText strMinutesElapsedRemaining, strPreparingToPause, strResuming, strClickToPause, strPaused, strPressEscapeToAbort
objMwtWin.SetStandardProgressCaptionText strMinutesElapsedRemaining, strPreparingToPause, strResuming, strClickToPause, strPaused, strPressEscapeToAbort
End Sub
Private Sub LoadLanguageCaptionsIntoAppWideDynamicLabels()
Dim intIndex As Integer
' Need to update Formula 1, Formula 2, etc. in frmMain since they are
' added dynamically and do not have a LanguageID# in their .Tag
With frmMain
For intIndex = 0 To frmMain.GetTopFormulaIndex
.lblFormula(intIndex).Caption = ConstructFormulaLabel(intIndex)
Next intIndex
End With
End Sub
Private Sub LoadLanguageCaptionsIntoForm(frmThisForm As VB.Form)
Dim ctlThisControl As Control, strControlType As String
Dim boolComboBox As Boolean
' Load the caption for the form
frmThisForm.Caption = LookupLanguageCaption(frmThisForm.Tag, frmThisForm.Caption)
' Load captions for each control on form (if appropriate)
' Note that ToolTips are loaded separately using SetAllTooltips
' Attempting to set ToolTips using this Sub results in very high processor usage
For Each ctlThisControl In frmThisForm.Controls
boolComboBox = False
With ctlThisControl
strControlType = TypeName(ctlThisControl)
Select Case strControlType
Case "Label"
.Caption = LookupLanguageCaption(.Tag, .Caption)
Case "Menu"
.Caption = LookupLanguageCaption(.Caption, .Caption, True, .Name)
Case "TabStrip"
' Not implemented: use .Tag to set .Caption and .ToolTipText to set .ToolTipText
Case "Toolbar"
' Not implemented: use .ToolTipText to set .ToolTipText
Case "ListView"
' Not implemented: use .Tag to set .Text
Case "CommonDialog"
' Not used
Case "StatusBar"
' MsgBox "status bar fontsize=" & ctl.Font.Size
Case "SplitFrame"
Case "ScrollPanel"
Case "PictureBox"
Case "ProgressBar"
Case "TextBox"
Case "Timer"
Case "Shape"
Case "ComboBox"
boolComboBox = True
Case "Image"
Case "ListBox"
Case "Line"
Case "MSFlexGrid"
LoadGridColumnTitles ctlThisControl
Case "RichTextBox"
' I use the .Tag property of RichTextBox controls to store useful values
' Do not attempt to set the caption
Case Else
' Regular control (and Frames)
.Caption = LookupLanguageCaption(.Tag, .Caption)
End Select
End With
If boolComboBox Then
' Do not Re-populate if control is cboSortResults (.Tag = 10850)
' The control's list items are added dynamically depending on the checkboxes on the form
If ctlThisControl.Tag <> "10850" Then
PopulateComboBox ctlThisControl, True
End If
End If
Next
End Sub
Private Function LoadLanguageFile(strLangFilePath As String, grdThisLanguageGrid As MSFlexGrid, grdThisLanguageGridCrossRef As MSFlexGrid, blnForeignLanguage As Boolean) As Boolean
' This sub assumes file strLangFilePath exists
' Check for this before calling
Dim strWork As String, intEqualPos As Integer, lngKeyValue As Long
Dim strNewSymbolCombo As String, strCaption As String
Dim blnCautionFound As Boolean, intCrossRefTrack As Integer
Dim lngError As Long
Dim InFileNum As Integer
Const CROSS_REF_TRACK_STEP = 1000
On Error GoTo LoadLanguageFileErrorHandler
If Not FileExists(strLangFilePath) Then
' File not found
AddToIntro LookupMessage(460) & " (" & strLangFilePath & ")"
AddToIntro LookupMessage(305)