Attribute VB_Name = "ReRomanize" Option Explicit #Const EvaluateFirstCharacterDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 #Const FindFieldCurrentlyPointedToDebug = 0 ' -1 #Const ReRomanizeAdjustNFIDebug = 0 ' -1 #Const ReRomanizeTextDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 #Const ReRomanizeTextDetailsDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 #Const ReRomanizeTextDetailsBasicsDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 #Const RomanizationAssistanceDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 #Const RomanizeHighlightedTextDebug = 0 ' -1 #Const RomanizeWholeRecordDebug = 0 ' -1 ' 0 '-1 ' 20180926 Bucknum: added Unicode-compliant font constants for RTF formatting Private Const ArialUnicodeMS$ = "Arial Unicode MS" ' Monotype Private Const LucidaSansUnicode$ = "Lucida Sans Unicode" ' Microsoft Private Const NotoSans$ = "Noto Sans" ' Google Private Const NotoSerif$ = "Noto Serif" ' Google Private Const TextFormattedDefaultFont$ = ArialUnicodeMS$ Private Const sAuthorityNonfilingString$ = "130:2 430:2 530:2" Private Const sBibliographicNonfilingString$ = "130:1 240:2 242:2 243:2 245:2 440:2 630:1 730:1 740:1 830:2" Private Const sCommunityInfoNonfilingString$ = "245:2 440:2 630:1 730:1 740:1" Private prvsRightToLeftMarker$, prvsLeftToRightMarker$ Private Const CHARACTERSET_CODES_FOR_880_BasicAsG0$ = "(B" Private Const CHARACTERSET_CODES_FOR_880_HebrewAsG0$ = "(2" Private Const CHARACTERSET_CODES_FOR_880_BasicCyrillicAsG0$ = "(N" Private Const CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ = "(3" Private Const CHARACTERSET_CODES_FOR_880_GreekAsG0$ = "(S" Private Const CHARACTERSET_CODES_FOR_880_CJKAsG0$ = "$1" Private Const CHARACTERSET_CODES_FOR_880_ExtendedCyrillicAsG1$ = ")Q" Private Const CHARACTERSET_CODES_FOR_880_ExtendedArabicAsG1$ = ")4" Private Const CHARACTERSET_CODES_FOR_880_ExtendedLatinAsG1$ = ")!E" ' convert this constant into its ASCII value subtract 48; and multiply this ' remainder by 6 to transform it into an offset into the following hyphen-delimited string ' the first character (0) is the MARC-8'code table' number; same as above, with extensions ' the second character (1) is the code to use for the set in non-880 fields after escape ("?"=illegal in non-880); ' 4rd-5th chars (3-4) are the code to use after escape in 880 field ' ignore other characters--turned out not to be needed ' 1 2 3 4 5 6 7 8 9 : ; ' 012345 012345 012345 012345 012345 012345 012345 012345 012345 012345 012345 Private Const CharSetU2MTranslation$ = "*****-1s s -2g*g *-3b b -4p p -5? (2 -6? (N -7? (3 -8g*(S*-9? $1 -:? (Q -;? (4 " Global Const ROMANIZATIONACTION_DisplayMarcRecord% = 1 Global Const ROMANIZATIONACTION_RomanizeHighlightedText% = 2 Global Const ROMANIZATIONACTION_RomanizeWholeRecord% = 3 Global Const ROMANIZATIONACTION_UCaseWord% = 4 Global Const ROMANIZATIONACTION_LCaseWord% = 5 Global Const ROMANIZATIONACTION_ReplaceText% = 6 Global Const ROMANIZATIONACTION_UCaseEach% = 7 Global Const ROMANIZATIONACTION_Define% = 8 Enum RomanizationAction DefineSubstitution = ROMANIZATIONACTION_Define% DisplayMarcRecord = ROMANIZATIONACTION_DisplayMarcRecord% LowercaseWord = ROMANIZATIONACTION_LCaseWord% ReplaceText = ROMANIZATIONACTION_ReplaceText% RomanizeHighlightedText = ROMANIZATIONACTION_RomanizeHighlightedText% RomanizeWholeRecord = ROMANIZATIONACTION_RomanizeWholeRecord% UppercaseWord = ROMANIZATIONACTION_UCaseWord% UppercaseEachWord = ROMANIZATIONACTION_UCaseEach% End Enum Global Const ROMANIZATIONRESULT_Success% = 0 Global Const ROMANIZATIONRESULT_TextNotHighlighted% = 1 Global Const ROMANIZATIONRESULT_HighlightedTextBecomesNothing% = 2 Global Const ROMANIZATIONRESULT_TextNotFindable% = 3 Global Const ROMANIZATIONRESULT_ActionUnclear% = 4 Global Const ROMANIZATIONRESULT_FieldNotFound% = 5 Global Const ROMANIZATIONRESULT_880WithNoSubfield6% = 6 Global Const ROMANIZATIONRESULT_880NotAllowed% = 7 Global Const ROMANIZATIONRESULT_880AlreadyPresent% = 8 Global Const ROMANIZATIONRESULT_NoCharacterToDefine% = 9 Global Const ROMANIZATIONRESULT_FileOpen% = 10 Global Const ROMANIZATIONDIRECTION_Unknown% = 0 Global Const ROMANIZATIONDIRECTION_Roman2Vernacular% = 1 Global Const ROMANIZATIONDIRECTION_Vernacular2Roman% = 2 Type ROMANIZATIONDETAILTYPE FullString As String Equivalent As String EquivalentUpperCase As String FullStringLengthInCharacters As Integer FullStringLengthInBytes As Integer EquivalentUpperCasePresent As Boolean InitialOnly As Boolean TerminalOnly As Boolean MedialOnly As Boolean End Type Type ROMANIZATIONDETAILARRAY Detail() As ROMANIZATIONDETAILTYPE DetailLast As Long DetailMax As Long End Type Type ROMANIZATIONTABLETYPE Vernacular2Roman As Object Roman2Vernacular As Object Name As String FullFileName As String Vernacular() As ROMANIZATIONDETAILARRAY Roman() As ROMANIZATIONDETAILARRAY VernacularLast As Long VernacularMax As Long RomanLast As Long RomanMax As Long AllowCaseVariation As Boolean AllowDefineButton As Boolean ApostropheCharacters As String ApostropheCharactersPresent As Boolean BySyllables As Boolean DoNotUse880Field As Boolean FontName As String NoRomanization As Boolean ' things that pertain only to romanized-to-vernacular R2VCreateEmpty880s As Boolean R2VFieldsIncluded As String R2VIncludeFormattingCharactersLcPattern As Boolean R2VOtherSubfieldsExcludedByTag As String R2VSubfieldsAlwaysExcluded As String R2VSubfield6Code As String R2VVowelMarker As String ' things that pertain only to vernacular-to-romanized V2RCreateEmptyFields As Boolean V2RFieldsIncluded As String V2ROtherSubfieldsExcludedByTag As String V2RSubfieldsAlwaysExcluded As String V2RUppercaseFirstCharacterInSubfield As String V2RPersonalNameUppercase As Boolean End Type Type RESEQUENCETABLETYPE Tag As String * 3 LinkTag As String * 3 Field As String Field880 As String Sequence As Integer Sequence880 As Integer End Type Public Type ROMANIZATIONSCRIPTTYPE Name As String LoadScript As Boolean FileSize As Long End Type Global gblaReSequenceTable() As RESEQUENCETABLETYPE Global gblaRomanizationScript() As ROMANIZATIONSCRIPTTYPE Global gblaRomanizationTable() As ROMANIZATIONTABLETYPE Global gbliReSequenceTableLast% Global gbliRomanizationScriptLast% Global gbliRomanizationTableLast%, gbliRomanizationTableMax% Global gbliRomanizationTablesBytes# Public Function ReRomanizeText(ByVal sRecordType$, ByVal sTag$, ByVal sText$, ByVal iRomanizationTable%, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalMarcCharacter As Utf8CharClass, Optional ByRef iRomanizationDirection% = -1, Optional ByVal sSubfieldCode$ = "") As String Dim sOut$, sLeft$, sRight$, sWord$ Dim iLength% Dim lPtr As Long, lLength As Long Dim bFound As Boolean On Error GoTo 0 If iRomanizationTable% < 1 Or iRomanizationTable% > gbliRomanizationTableLast% Then sOut$ = sText$ Else If iRomanizationDirection% = -1 Then iRomanizationDirection% = EvaluateFirstCharacter(sText$, iRomanizationTable%, LocalMarcCharacter) End If Select Case iRomanizationDirection% Case ROMANIZATIONDIRECTION_Unknown% sOut$ = sText$ Case ROMANIZATIONDIRECTION_Roman2Vernacular% sOut$ = ReRomanizeTextDetails(sText$, gblaRomanizationTable(iRomanizationTable%).Roman2Vernacular, gblaRomanizationTable(iRomanizationTable%).Roman(), LocalMarcRecordObject, LocalMarcCharacter, True, iRomanizationTable%) Case ROMANIZATIONDIRECTION_Vernacular2Roman% sOut$ = ReRomanizeTextDetails(sText$, gblaRomanizationTable(iRomanizationTable%).Vernacular2Roman, gblaRomanizationTable(iRomanizationTable%).Vernacular(), LocalMarcRecordObject, LocalMarcCharacter, False, iRomanizationTable%) If gblaRomanizationTable(iRomanizationTable%).V2RPersonalNameUppercase Then ' todo: in reality, we should *only* add the comma if the first ' indicator is one or two (regardless of indicator, we should ' uppercase every word in the string) Select Case sRecordType$ Case "A" If InStr("100 400 500", sTag$) > 0 Then ReRomanizeTextPersonalNameHandling: lPtr = InStr(sOut$, LocalMarcRecordObject.MarcDelimiter + "a") If lPtr > 0 Then sLeft$ = Mid(sOut$, 1, lPtr + 1) sOut$ = Mid(sOut$, lPtr + 2) ElseIf Mid(sOut$, 1, 1) = LocalMarcRecordObject.MarcDelimiter Then GoTo ReRomanizeTextNoPNH Else sLeft$ = "" End If lPtr = InStr(sOut$, LocalMarcRecordObject.MarcDelimiter) If lPtr > 0 Then sRight$ = Mid(sOut$, lPtr) sOut$ = Mid(sOut$, 1, lPtr - 1) Else sRight$ = "" End If sOut$ = Trim(sOut$) ' first "word" in the heading remains as such lPtr = InStr(sOut$, " ") If lPtr > 0 Then sLeft$ = sLeft$ + LocalMarcRecordObject.UCaseFirstWord(Mid(sOut$, 1, lPtr - 1) + ",") sOut$ = Trim(Mid(sOut$, lPtr + 1)) Do While Len(sOut$) > 0 GetNextPiece sOut$, sWord$, " " sLeft$ = sLeft$ + " " + LocalMarcRecordObject.UCaseFirstWord(sWord$) Loop End If sOut$ = sLeft$ + sOut$ + sRight$ End If ReRomanizeTextNoPNH: ' NOTE label in left margin Case "B" If InStr("100 400 600 700 800", sTag$) > 0 Then GoTo ReRomanizeTextPersonalNameHandling End If End Select End If If Len(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield) > 0 Then If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$) > 0 Then If InStr(sOut$, LocalMarcRecordObject.MarcDelimiter) > 0 Then ' potentially interesting For lPtr = Len(sOut$) - 2 To 1 Step -1 If Mid(sOut$, lPtr, 1) = LocalMarcRecordObject.MarcDelimiter Then If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$ + "/" + Mid(sOut$, lPtr + 1, 1)) > 0 Then sOut$ = Mid(sOut$, 1, lPtr + 1) + LocalMarcRecordObject.UCaseFirstWord(Mid(sOut$, lPtr + 2)) End If End If Next ' lptr ElseIf Len(sSubfieldCode$) > 0 Then If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$ + "/" + sSubfieldCode$) > 0 Then sOut$ = LocalMarcRecordObject.UCaseFirstWord(sOut$) End If End If End If End If End Select End If ReRomanizeText = LocalMarcRecordObject.RemoveRepeatedCharacters(sOut$, " ") 'DumpRomanizationTables End Function Public Sub LoadOneRomanizationTable(ByVal sFileNameIncludingPath$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass, ByRef sDefaultFieldsIncluded$, Optional ByRef ProgressBarCtrl As Control = Nothing) ' we're going to read the file line-by-line, even though it has the ' general appearance of an INI file, because it may be more than ' 32K (for Chinese) Dim iIn%, iMode%, iElement%, iRc%, iRc2%, iRc3% Dim sRight$, sLeft$, sUpperCase$, sTruncation$, sOriginal$ Dim bLeft As Boolean, bRight As Boolean sTruncation$ = "%" iIn% = FreeFile On Error GoTo LRFT_FileOpenError Open sFileNameIncludingPath$ For Input As #iIn% On Error GoTo 0 ' if we get this far we must have *something* gbliRomanizationTableLast% = gbliRomanizationTableLast% + 1 If gbliRomanizationTableLast% > gbliRomanizationTableMax% Then gbliRomanizationTableMax% = gbliRomanizationTableMax% + 5 ReDim Preserve gblaRomanizationTable(0 To gbliRomanizationTableMax%) End If With gblaRomanizationTable(gbliRomanizationTableLast%) ' save the file name, in case we need to add to it later .FullFileName = sFileNameIncludingPath$ ' by default, include everything 100 through 840 .R2VFieldsIncluded = sDefaultFieldsIncluded$ .V2RFieldsIncluded = sDefaultFieldsIncluded$ ' these subfields are always excluded .R2VSubfieldsAlwaysExcluded = "uvxy0123456789" .V2RSubfieldsAlwaysExcluded = "uvxy0123456789" ' there is no additional tag-based exclusion of subfields .R2VOtherSubfieldsExcludedByTag = "" .V2ROtherSubfieldsExcludedByTag = "" ' 20070703: added IncludeFormattingCharactersLcPattern; default False .R2VIncludeFormattingCharactersLcPattern = False ' set default script identification code .R2VSubfield6Code = "" ' 20100809 Bucknum added: VowelMarker ' set default script vowel marker .R2VVowelMarker = "" Set .Roman2Vernacular = CreateObject("Scripting.Dictionary") Set .Vernacular2Roman = CreateObject("Scripting.Dictionary") .AllowDefineButton = False .FontName = "" Do While Not EOF(iIn%) Line Input #iIn%, sRight$ '20090322 added by Bucknum: 'monitor progress of romanization table load If Not ProgressBarCtrl Is Nothing Then DoEvents 'add 2 to the line input for line-feed characters LoadRomanizationTablesProgress Len(sRight$) + 2, ProgressBarCtrl End If If Len(sRight$) > 0 Then If Mid(sRight$, 1, 1) <> "#" Then If Mid(sRight$, 1, 1) = "[" Then Select Case Trim(UCase(sRight$)) Case "[GENERAL]" iMode% = 1 Case "[ROMANTOSCRIPT]" iMode% = 2 Case "[SCRIPTTOROMAN]" iMode% = 3 Case Else If .NoRomanization Then ' 20070830 added Exit Do End If iMode% = 4 ' we'll ignore all of this! End Select Else Select Case iMode% Case 1 ' general stanza: options and switches GetNextPiece sRight$, sLeft$, "=" Select Case sLeft$ Case "Name" .Name = sRight$ Case "FontName" ' 20180928 added for font customization by language/script ' for Swiss-type, proportionally-spaced, sans-serif fonts .FontName = sRight$ Case "NoRomanization" ' 20070830 added NoRomanization concept .NoRomanization = LocalMarcRecordObject.IsTrue(sRight$) Case "DoNotUse880Field" .DoNotUse880Field = LocalMarcRecordObject.IsTrue(sRight$) Case "AllowCaseVariation" .AllowCaseVariation = LocalMarcRecordObject.IsTrue(sRight$) Case "ApostropheCharacters" 'Debug.Print "RA 2" .ApostropheCharacters = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject) If Len(.ApostropheCharacters) > 0 Then .ApostropheCharactersPresent = True End If Case "AllowDefineButton" .AllowDefineButton = LocalMarcRecordObject.IsTrue(sRight$) Case "BySyllables" .BySyllables = LocalMarcRecordObject.IsTrue(sRight$) Case "Truncation" sTruncation$ = sRight$ End Select Case 2 ' roman to vernacular script (including Wade-Giles to Pinyin) If InStr(sRight$, "=") > 0 Then GetNextPiece sRight$, sLeft$, "=" Select Case sLeft$ Case "FieldsIncluded" .R2VFieldsIncluded = sRight$ GoTo LORT_NextLine Case "IncludeFormattingCharactersLcPattern" ' 20070703: added .R2VIncludeFormattingCharactersLcPattern = True GoTo LORT_NextLine Case "CreateEmpty880s" .R2VCreateEmpty880s = True GoTo LORT_NextLine Case "Subfield6Code" .R2VSubfield6Code = sRight$ GoTo LORT_NextLine Case "SubfieldsAlwaysExcluded" .R2VSubfieldsAlwaysExcluded = sRight$ GoTo LORT_NextLine Case "OtherSubfieldsExcludedByTag" .R2VOtherSubfieldsExcludedByTag = sRight$ GoTo LORT_NextLine Case "VowelMarker" ' 20100809 Bucknum added: .R2VVowelMarker = sRight$ GoTo LORT_NextLine End Select LORT_RTV_ContinueWithDividedLine: ' NOTE label in left margin bLeft = False bRight = False If Mid(sLeft$, 1, 1) = sTruncation$ Then bLeft = True sLeft$ = Mid(sLeft$, 2) End If If Right(sLeft$, 1) = sTruncation$ Then bRight = True sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1) End If 'Debug.Print "RA 3" sRight$ = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject) sLeft$ = RomanizeConvertText(sLeft$, LocalMarcRecordObject, LocalCharacterObject) 'If Mid(sLeft$, 1, 1) = "v" Then ' Debug.Print "After 3: >" + sLeft$ + "< >" + sRight$ + "<" 'End If iRc% = InStr(sRight$, "/") If iRc% > 0 Then sUpperCase$ = Mid(sRight$, 1, iRc% - 1) sRight$ = Mid(sRight$, iRc% + 1) Else sUpperCase$ = "" End If LocalCharacterObject.Utf8Char = sLeft$ ' isolating the first character If .Roman2Vernacular.Exists(LocalCharacterObject.Utf8Char) Then iElement% = .Roman2Vernacular.item(LocalCharacterObject.Utf8Char) Else .RomanLast = .RomanLast + 1 If .RomanLast > .RomanMax Then .RomanMax = .RomanMax + 10 ReDim Preserve .Roman(0 To .RomanMax) End If iElement% = .RomanLast .Roman2Vernacular.Add LocalCharacterObject.Utf8Char, iElement% End If .Roman(iElement%).DetailLast = .Roman(iElement%).DetailLast + 1 If .Roman(iElement%).DetailLast > .Roman(iElement%).DetailMax Then .Roman(iElement%).DetailMax = .Roman(iElement%).DetailMax + 5 ReDim Preserve .Roman(iElement%).Detail(0 To .Roman(iElement%).DetailMax) End If If .AllowCaseVariation Then .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString = LocalMarcRecordObject.SafeLCase(sLeft$) 'Debug.Print "Before and after: >" + sLeft$ + "< >" + .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString + "<" Else .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString = sLeft$ End If .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObject.SafeLen(sLeft$) .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullStringLengthInBytes = Len(sLeft$) .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).Equivalent = sRight$ .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCasePresent = False If Len(sUpperCase$) > 0 Then .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCase = sUpperCase$ .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCasePresent = True End If If bLeft Then If bRight Then .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).MedialOnly = True Else .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).TerminalOnly = True End If ElseIf bRight Then .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).InitialOnly = True End If ElseIf InStr(sRight$, vbTab) > 0 Then GetNextPiece sRight$, sLeft$, vbTab GoTo LORT_RTV_ContinueWithDividedLine End If Case 3 ' vernacular script to roman If InStr(sRight$, "=") > 0 Then GetNextPiece sRight$, sLeft$, "=" Select Case sLeft$ Case "CreateEmptyFields" ' added 20070830 .V2RCreateEmptyFields = True GoTo LORT_NextLine Case "FieldsIncluded" .V2RFieldsIncluded = sRight$ GoTo LORT_NextLine Case "SubfieldsAlwaysExcluded" .V2RSubfieldsAlwaysExcluded = sRight$ GoTo LORT_NextLine Case "OtherSubfieldsExcludedByTag" .V2ROtherSubfieldsExcludedByTag = sRight$ GoTo LORT_NextLine Case "UppercaseFirstCharacterInSubfield" .V2RUppercaseFirstCharacterInSubfield = sRight$ GoTo LORT_NextLine Case "PersonalNameHandling" .V2RPersonalNameUppercase = LocalMarcRecordObject.IsTrue(sRight$) GoTo LORT_NextLine End Select LORT_VTR_ContinueWithDividedLine: bLeft = False bRight = False If Mid(sLeft$, 1, 1) = sTruncation$ Then bLeft = True sLeft$ = Mid(sLeft$, 2) End If If Right(sLeft$, 1) = sTruncation$ Then bRight = True sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1) End If 'Debug.Print "RA 4" sRight$ = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject) sLeft$ = RomanizeConvertText(sLeft$, LocalMarcRecordObject, LocalCharacterObject) iRc% = InStr(sRight$, "/") If iRc% > 0 Then sUpperCase$ = Mid(sRight$, 1, iRc% - 1) sRight$ = Mid(sRight$, iRc% + 1) Else sUpperCase$ = "" End If LocalCharacterObject.Utf8Char = sLeft$ ' isolating the first character If .Vernacular2Roman.Exists(LocalCharacterObject.Utf8Char) Then iElement% = .Vernacular2Roman.item(LocalCharacterObject.Utf8Char) Else .VernacularLast = .VernacularLast + 1 If .VernacularLast > .VernacularMax Then .VernacularMax = .VernacularMax + 10 ReDim Preserve .Vernacular(0 To .VernacularMax) End If iElement% = .VernacularLast .Vernacular2Roman.Add LocalCharacterObject.Utf8Char, iElement% End If .Vernacular(iElement%).DetailLast = .Vernacular(iElement%).DetailLast + 1 If .Vernacular(iElement%).DetailLast > .Vernacular(iElement%).DetailMax Then .Vernacular(iElement%).DetailMax = .Vernacular(iElement%).DetailMax + 5 ReDim Preserve .Vernacular(iElement%).Detail(0 To .Vernacular(iElement%).DetailMax) End If .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullString = sLeft$ .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObject.SafeLen(sLeft$) .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullStringLengthInBytes = Len(sLeft$) .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).Equivalent = sRight$ .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).EquivalentUpperCasePresent = False If bLeft Then If bRight Then .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).MedialOnly = True Else .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).TerminalOnly = True End If ElseIf bRight Then .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).InitialOnly = True End If ' main condition is: contains equals sign? ElseIf InStr(sRight$, vbTab) > 0 Then GetNextPiece sRight$, sLeft$, vbTab GoTo LORT_VTR_ContinueWithDividedLine End If End Select End If End If End If LORT_NextLine: Loop If Len(.Name) = 0 Then .Name = "Unknown script #" + Trim(str(gbliRomanizationTableLast%)) End If End With Close #iIn% LRFT_FileOpenErrorresume: Exit Sub LRFT_FileOpenError: Resume LRFT_FileOpenErrorresume End Sub Public Function RomanizeConvertText(ByVal sIn$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass) As String ' convert "&H notations to the equivalent, leaving other stuff as you find it Dim lPtr As Long Dim sLeader$, sOriginal$ Dim bShow As Boolean ' If InStr(sIn$, "U+") > 0 Then ' bShow = True ' sOriginal$ = sIn$ ' End If sIn$ = LocalMarcRecordObject.ReplaceCharacters(sIn$, "_", " ") sLeader$ = "&H" Do lPtr = InStr(sIn$, sLeader$) Do While lPtr > 0 LocalCharacterObject.UcsHex = Mid(sIn$, lPtr + 2, 4) sIn$ = LocalMarcRecordObject.SafeStuff(sIn$, lPtr, 6, LocalCharacterObject.Utf8Char) lPtr = InStr(sIn$, sLeader$) Loop Select Case sLeader$ Case "&H" sLeader$ = "U+" Case "U+" sLeader$ = "&x" Case "&x" sLeader$ = "&X" Case "&X" sLeader$ = "&h" Case "&h" Exit Do End Select Loop ' If bShow Then ' Debug.Print "RCT >" + sOriginal$ + "< >" + sIn$ + "<" ' End If RomanizeConvertText = sIn$ End Function Public Sub LoadRomanizationTables(ByVal sConfigurationFilePath$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass, Optional ByRef ProgressBarCtrl As Control = Nothing) Dim sMasterFile$, sFile$, sDefaultFieldsIncluded$ Dim iCtr% ' Static bLoaded As Boolean Dim bDebug As Boolean ' 20090322 changed by Bucknum: ' removed bLoaded to allow reloading tables ' If bLoaded Then ' Exit Sub ' End If 'prvsRightToLeftMarker$ , prvsLeftToRightMarker$ 'prvsRightToLeftMarker$ = LocalMarcRecordObject.MarcRightToLeftMarker 'prvsLeftToRightMarker$ = LocalMarcRecordObject.MarcLeftToRightMarker For iCtr% = 100 To 840 sDefaultFieldsIncluded$ = sDefaultFieldsIncluded$ + " " + Trim(str(iCtr%)) Next ' irc% sMasterFile$ = sConfigurationFilePath$ + "RomanizationMaster.cfg" bDebug = LocalMarcRecordObject.IsTrue(ReadIniFile(sMasterFile$, "Files", "Debug", "False", 15)) iCtr% = 1 Do sFile$ = ReadIniFileOrNothing(sMasterFile$, "Files", Trim(str(iCtr%)), 250) If Len(sFile$) = 0 Then If bDebug Then MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sFile$ + "<" End If Exit Do End If If InStr(sFile$, "\") = 0 Then If LenB(Dir$(sConfigurationFilePath$ + sFile$)) > 0 And gblaRomanizationScript(iCtr%).LoadScript Then LoadOneRomanizationTable sConfigurationFilePath$ + sFile$, LocalMarcRecordObject, LocalCharacterObject, sDefaultFieldsIncluded$, ProgressBarCtrl If bDebug Then MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sConfigurationFilePath$ + sFile$ + "< vernacular entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).VernacularLast) + " roman entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).RomanLast) End If End If Else If LenB(Dir$(sFile$)) > 0 And gblaRomanizationScript(iCtr%).LoadScript Then LoadOneRomanizationTable sFile$, LocalMarcRecordObject, LocalCharacterObject, sDefaultFieldsIncluded$, ProgressBarCtrl If bDebug Then MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sFile$ + "< vernacular entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).VernacularLast) + " roman entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).RomanLast) End If End If End If iCtr% = iCtr% + 1 Loop ' bLoaded = True End Sub Public Sub DumpRomanizationTables() Dim iCtr%, iCtr2%, iCtr3% For iCtr% = 1 To gbliRomanizationTableLast% With gblaRomanizationTable(iCtr%) Debug.Print "Name: " + .Name Debug.Print "Roman to vernacular" For iCtr2% = 1 To .RomanLast With .Roman(iCtr2%) For iCtr3% = 1 To .DetailLast Debug.Print vbTab + .Detail(iCtr3%).FullString + vbTab + .Detail(iCtr3%).Equivalent Next ' ictr3% End With Next ' ictr2% Debug.Print "Vernacular to roman" For iCtr2% = 1 To .VernacularLast With .Vernacular(iCtr2%) For iCtr3% = 1 To .DetailLast Debug.Print vbTab + .Detail(iCtr3%).FullString + vbTab + .Detail(iCtr3%).Equivalent Next ' ictr3% End With Next ' ictr2% End With Next ' ictr% End Sub Public Sub LoadListOfScriptsIntoControl(ByRef c As Control) Dim iCtr% With c If c.style = vbListBoxCheckbox Then c.Clear For iCtr% = 1 To gbliRomanizationScriptLast% .AddItem gblaRomanizationScript(iCtr%).Name .Selected(iCtr% - 1) = gblaRomanizationScript(iCtr%).LoadScript Next ' ictr% Else If .ListCount = 0 Then For iCtr% = 1 To gbliRomanizationTableLast% .AddItem gblaRomanizationTable(iCtr%).Name Next ' ictr% If .ListCount > 0 Then .ListIndex = 0 End If End If End If End With End Sub Private Function ReRomanizeTextDetails(ByVal sText$, ByRef oRomanizationTable As Object, ByRef RomanizationTable() As ROMANIZATIONDETAILARRAY, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalMarcCharacter As Utf8CharClass, ByVal bRoman2Vernacular As Boolean, ByVal iRomanizationTable%) Dim iLen%, iLengthBeforeApostropheSubstitution% Dim lPtr As Long, lPtr2 As Long, lMember As Long, lCtr As Long, lEnd As Long Dim sOut$, sPreviousCharacter$, sSyllable$, sChar1$, sChar2$, sOriginalSyllable$ Dim bFound As Boolean, bFirstCharacter As Boolean, bFirstCharacterIsUppercase As Boolean Dim bApostrophes As Boolean, bWholeThingIsUppercase As Boolean, bChanged As Boolean Dim bAllowCaseVariation ' we have to manipulate pointers directly, ourselves, because ' of varying character length lPtr = 1 lEnd = Len(sText$) bApostrophes = gblaRomanizationTable(iRomanizationTable%).ApostropheCharactersPresent If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then bAllowCaseVariation = True End If If Not gblaRomanizationTable(iRomanizationTable%).BySyllables Then ' we're working by characters bFirstCharacter = True Do While lPtr <= lEnd bFound = False If lPtr > 1 Then sPreviousCharacter$ = LocalMarcCharacter.Utf8Char If sPreviousCharacter$ = " " Then bFirstCharacterIsUppercase = False End If End If LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr) ' 20061129: if we're going to be ignoring case, then ' convert to lowercase If bAllowCaseVariation Then If LocalMarcCharacter.Utf8CharCategory = "Lu" Then LocalMarcCharacter.Utf8Char = LocalMarcRecordObject.SafeLCase(LocalMarcCharacter.Utf8Char) If bFirstCharacter Or sPreviousCharacter$ = " " Then bFirstCharacterIsUppercase = True End If End If End If If InStr("Lu Ll Lo", LocalMarcCharacter.Utf8CharCategory) > 0 Then bFirstCharacter = False End If If LocalMarcCharacter.Utf8Char = LocalMarcCharacter.MarcDelimiter Then sOut$ = sOut$ + Mid(sText$, lPtr, 2) ' delimiter and subfield code lPtr = lPtr + 1 ' we'll add one more at the bottom of the loop as per usual iLen% = 1 ' make sure we only skip one more! Else ' not at a delimiter: must be some character worthy of inspection iLen% = LocalMarcCharacter.Utf8CharOctets If oRomanizationTable.Exists(LocalMarcCharacter.Utf8Char) Then lMember = oRomanizationTable.item(LocalMarcCharacter.Utf8Char) With RomanizationTable(lMember) For lCtr = 1 To .DetailLast If .Detail(lCtr).InitialOnly Then ' 20100103 added by Bucknum: ' we are expecting more character(s) to follow, so the ' following 2 statements check for end of the word If lPtr + .Detail(lCtr).FullStringLengthInBytes >= lEnd Then ' this is the end of the word; so no dice GoTo RRTD_NextDetail ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then ' this is also the end of the word; so no dice GoTo RRTD_NextDetail ElseIf lPtr = 1 Then ' this is OK: first character in the string is taken ' to be start of a word ' 20180801: Bucknum added left bracket and parenthesis ElseIf InStr(" -""[(", Mid(sText$, lPtr - 1, 1)) > 0 Then ' this is OK, too: previous character is a word-breaker ' (following space, hyphen, quote, bracket or parenthesis), so current ' character is the first in this word ElseIf lPtr > 2 Then If Mid(sText$, lPtr - 2, 1) = LocalMarcRecordObject.MarcDelimiter Then ' this is OK, too: character is first in its subfield Else GoTo RRTD_NextDetail End If Else ' not at the beginning of a word GoTo RRTD_NextDetail End If ElseIf .Detail(lCtr).TerminalOnly Then ' 20070731: we were using iLen% here as the length; but we should be using ' the length of the character(s) in the defined terminal-only string ' (for example, the current character may be "o" but if we're looking for ' terminal "ot" then we need to compare and skip over 2 characters, not 1) ' fortunately, we already have FullStringLengthInBytes giving the length of ' the string to be found in the original record If lPtr + .Detail(lCtr).FullStringLengthInBytes > lEnd Then ' this is OK: must be last character in the string ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then ' this is OK, too: next character is a word-breaker, ' so current character is the last in this word Else ' not at the end of a word GoTo RRTD_NextDetail End If ' if we get here then we're at the end of the word and so ready ' to test the characters ElseIf .Detail(lCtr).MedialOnly Then ' can not be either the beginning or the ending of a word ' we'll simply reverse all of the above tests; in this case the ' leftovers are the things that aren't either beginning or ' end--they must be medial If lPtr = 1 Then ' initial: so no dice GoTo RRTD_NextDetail ElseIf InStr(" -""[(", Mid(sText$, lPtr - 1, 1)) > 0 Then ' initial (following space, hyphen, quote, bracket or parenthesis): so no dice ' 20180801: Bucknum added left bracket and parenthesis GoTo RRTD_NextDetail ElseIf lPtr > 2 Then If Mid(sText$, lPtr - 2, 1) = LocalMarcRecordObject.MarcDelimiter Then ' beginning of a subfield: so no dice GoTo RRTD_NextDetail End If ' 20070731: see comment above (at TerminalOnly) regarding the ' length to be used in the following 2 statements ElseIf lPtr + .Detail(lCtr).FullStringLengthInBytes >= lEnd Then ' this is the end of the word; so no dice GoTo RRTD_NextDetail ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then ' this is also the end of the word; so no dice GoTo RRTD_NextDetail End If ' if we get here, then we're somewhere within a word and ready to ' test the characters End If ' if we get here, either we don't care what position the character ' bears within its word, or whatever conditions were specified have ' been met If bRoman2Vernacular Then If LocalMarcCharacter.Utf8CharCategory = "Lu" Then If Not bApostrophes Then If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then bFound = True If .Detail(lCtr).EquivalentUpperCasePresent Then If Len(sPreviousCharacter$) = 0 Then sOut$ = sOut$ + .Detail(lCtr).Equivalent Else LocalMarcCharacter.Utf8Char = sPreviousCharacter$ If LocalMarcCharacter.Utf8CharCategory = "Lu" Then sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If End If bChanged = True iLen% = .Detail(lCtr).FullStringLengthInBytes Else If bFirstCharacterIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If bChanged = True iLen% = .Detail(lCtr).FullStringLengthInBytes End If Exit For End If Else ' apostrophes were defined If ReRomanizeTextDetailsReplaceApostrophes(LocalMarcRecordObject.SafeUCase(LocalMarcRecordObject.SafeMid(sText, lPtr, .Detail(lCtr).FullStringLengthInCharacters)), iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%) = .Detail(lCtr).FullString Then bFound = True If .Detail(lCtr).EquivalentUpperCasePresent Then If Len(sPreviousCharacter$) = 0 Then sOut$ = sOut$ + .Detail(lCtr).Equivalent Else LocalMarcCharacter.Utf8Char = sPreviousCharacter$ If LocalMarcCharacter.Utf8CharCategory = "Lu" Then sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If End If bChanged = True iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters Else If bFirstCharacterIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If bChanged = True iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters End If Exit For End If End If Else ' category is not letter/uppercase If Not bApostrophes Then If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Or (bAllowCaseVariation And LCase(Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes)) = .Detail(lCtr).FullString) Then 'If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then bFound = True If .Detail(lCtr).EquivalentUpperCasePresent Then If Len(sPreviousCharacter$) = 0 Then sOut$ = sOut$ + .Detail(lCtr).Equivalent Else LocalMarcCharacter.Utf8Char = sPreviousCharacter$ 'Debug.Print "Previous " + sPreviousCharacter$ + " category " + LocalMarcCharacter.Utf8CharCategory If LocalMarcCharacter.Utf8CharCategory = "Lu" Then sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If End If bChanged = True iLen% = .Detail(lCtr).FullStringLengthInBytes Else If bFirstCharacterIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If bChanged = True iLen% = .Detail(lCtr).FullStringLengthInBytes End If Exit For End If Else ' apostrophes are defined If ReRomanizeTextDetailsReplaceApostrophes(LocalMarcRecordObject.SafeLCase(LocalMarcRecordObject.SafeMid(sText, lPtr, .Detail(lCtr).FullStringLengthInCharacters)), iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%) = .Detail(lCtr).FullString Then bFound = True If .Detail(lCtr).EquivalentUpperCasePresent Then If Len(sPreviousCharacter$) = 0 Then sOut$ = sOut$ + .Detail(lCtr).Equivalent Else LocalMarcCharacter.Utf8Char = sPreviousCharacter$ 'Debug.Print "Previous " + sPreviousCharacter$ + " category " + LocalMarcCharacter.Utf8CharCategory If LocalMarcCharacter.Utf8CharCategory = "Lu" Then sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If End If iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters Else If bFirstCharacterIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If iLen% = iLengthBeforeApostropheSubstitution% ' .Detail(lCtr).FullStringLengthInCharacters End If Exit For End If End If End If Else ' vernacular to roman 'Debug.Print "Considering " + str(.Detail(lCtr).FullStringLengthInBytes) + "< and >" + .Detail(lCtr).FullString + "<" If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then bFound = True sOut$ = sOut$ + .Detail(lCtr).Equivalent iLen% = .Detail(lCtr).FullStringLengthInBytes If Right(sOut$, 1) = " " Then lPtr2 = lPtr + iLen% If lPtr2 <= lEnd Then LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr2) If Mid(LocalMarcCharacter.Utf8CharCategory, 1, 1) = "P" Then sOut$ = RTrim(sOut$) End If End If End If Exit For End If End If RRTD_NextDetail: ' NOTE label in left margin Next ' lctr End With Else bFound = False End If If Not bFound Then sOut$ = sOut$ + LocalMarcCharacter.Utf8Char End If 'Debug.Print "Disposition: " + str(bFound) + " >" + LocalMarcCharacter.Utf8Char + "< >" + sOut$ + "<" End If lPtr = lPtr + iLen% Loop 'Debug.Print "LC PATTERN? " + str(gblaRomanizationTable(iRomanizationTable%).R2VIncludeFormattingCharactersLcPattern) + " " + str(bChanged) ' 20070703: it seems simplest to throw this on at the end ' LC wants a RTL marker before and after each delimiter, ' EXCEPT immediately following the $6 marker itself ' note that this can ONLY apply to things done character-by-character; doesn't apply ' to "by syllables" (I think!) If gblaRomanizationTable(iRomanizationTable%).R2VIncludeFormattingCharactersLcPattern And bChanged Then For lPtr = Len(sOut$) - 1 To 1 Step -1 If Mid(sOut$, lPtr, 1) = LocalMarcRecordObject.MarcDelimiter Then lPtr2 = InStr(Mid(sOut$, lPtr + 1), LocalMarcRecordObject.MarcDelimiter) 'Debug.Print "At delim: " + str(lPtr) + " " + str(lPtr2) + " >" + sOut$ + "< marker >" + LocalMarcRecordObject.MarcRightToLeftMarker + "< " + str(Len(LocalMarcRecordObject.MarcRightToLeftMarker)) If lPtr2 <> 0 Then sOut$ = LocalMarcRecordObject.SafeStuff(sOut$, lPtr + lPtr2, 0, LocalMarcRecordObject.MarcRightToLeftMarker) End If ' there should not be a $6 in the text! If Mid(sOut$, lPtr + 1, 1) <> "6" Then sOut$ = LocalMarcRecordObject.SafeStuff(sOut$, lPtr + 2, 0, LocalMarcRecordObject.MarcRightToLeftMarker) End If 'Debug.Print "After: >" + sOut$ + "<" End If Next ' lptr End If Else ' we *are* proceeding by syllables ' move any troublesome lead characters to the output, so we end up pointed ' to the first "real" character in the first syllable--as close as we can ' determine it, anyway ' we'll include the apostrophe here, because it's only *internal* ones that ' we need to pay attention to ' todo: this might be better if done via the character object, and with ' character categories ... bFirstCharacter = True Do Select Case Mid(sText$, lPtr, 1) Case "-", " ", ".", ";", ":", "(", ")", "[", "]", "!", "?", "'", Chr(34) lPtr = lPtr + 1 Case LocalMarcRecordObject.MarcDelimiter lPtr = lPtr + 2 Case Else Exit Do End Select If lPtr > lEnd Then Exit Do End If Loop ' attach any skipped characters to the output If lPtr > 1 Then sOut$ = Mid(sText$, 1, lPtr - 1) End If ' when we arrive here, lPtr points to the first character of real interest Do While lPtr <= lEnd ' starting from the character pointed to by lPtr, which we will assume ' to be the first character in a "syllable", find the end of the ' next syllable iLen% = 0 ' do NOT here break at a hyphen! For lPtr2 = lPtr + 1 To lEnd If InStr("- .;:)([]!?" + Chr(34) + LocalMarcRecordObject.MarcDelimiter, Mid(sText, lPtr2, 1)) > 0 Then iLen% = lPtr2 - lPtr Exit For End If Next ' lptr2 ' if we didn't find any more words, we assume that ' we're at the end of the string altogether If iLen% = 0 Then iLen% = Len(Mid(sText$, lPtr)) End If sSyllable$ = Mid(sText, lPtr, iLen%) If Right(sSyllable$, 1) = "'" Then iLen% = iLen% - 1 lPtr2 = lPtr2 - 1 sSyllable$ = Mid(sSyllable$, 1, Len(sSyllable$) - 1) End If sOriginalSyllable$ = sSyllable$ ' in the next paragraph, we're determining whether the first character ' is uppercase, or the whole thing is uppercase--we'll preserve ' case in the finished string to the extent possible #If True Then ' 20070109: paradigm changed (now much simpler); changed mostly because ' the old one didn't work properly anyway If sSyllable$ = LocalMarcRecordObject.SafeUCase(sSyllable$) Then ' the only way this can happen is if it's all uppercase bWholeThingIsUppercase = True bFirstCharacterIsUppercase = False If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$) End If ElseIf sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$) Then bWholeThingIsUppercase = False bFirstCharacterIsUppercase = False Else ' there is some difference between the lowercase and uppercase versions: ' for Wade-Giles, we *should* be able to assume that the difference ' is on the first character bWholeThingIsUppercase = False bFirstCharacterIsUppercase = True If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$) End If End If LocalMarcCharacter.Utf8Char = sSyllable$ #Else ' get the first character of this syllable LocalMarcCharacter.Utf8Char = sSyllable$ If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then If LocalMarcCharacter.Utf8CharCategory = "Lu" Then bFirstCharacterIsUppercase = True bWholeThingIsUppercase = True Do sSyllable$ = Mid(sSyllable$, LocalMarcCharacter.Utf8CharOctets + 1) If Len(sSyllable$) = 0 Then Exit Do End If 'Debug.Print "Remaining syllable: >" + sSyllable$ + "<" LocalMarcCharacter.Utf8Char = sSyllable$ 'Debug.Print "Category: >" + LocalMarcCharacter.Utf8CharCategory + "<" If LocalMarcCharacter.Utf8CharCategory <> "Lu" Then bWholeThingIsUppercase = False Exit Do End If Loop ' re-get the whole syllable sSyllable$ = Mid(sText, lPtr, iLen%) LocalMarcCharacter.Utf8Char = sSyllable$ End If ' in any case, because case variation is allowed, we'll ' convert the syllable to lowercase sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$) LocalMarcCharacter.Utf8Char = sSyllable$ End If #End If ' alternative methods for determining casing of the existing syllable ' deal with things that look like apostrophes If bApostrophes Then sSyllable$ = ReRomanizeTextDetailsReplaceApostrophes(sSyllable$, iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%) End If bFound = False If oRomanizationTable.Exists(LocalMarcCharacter.Utf8Char) Then lMember = oRomanizationTable.item(LocalMarcCharacter.Utf8Char) With RomanizationTable(lMember) For lCtr = 1 To .DetailLast If bRoman2Vernacular Then If sSyllable$ = .Detail(lCtr).FullString Then bFound = True If bWholeThingIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.SafeUCase(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False ElseIf bFirstCharacterIsUppercase Then sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent) bFirstCharacterIsUppercase = False Else sOut$ = sOut$ + .Detail(lCtr).Equivalent End If Exit For End If Else ' vernacular to roman If sSyllable$ = .Detail(lCtr).FullString Then bFound = True sOut$ = sOut$ + .Detail(lCtr).Equivalent Exit For End If End If Next ' lctr End With Else sSyllable$ = sOriginalSyllable$ bFound = False End If If Not bFound Then sOut$ = sOut$ + sSyllable$ End If ' skip the syllable in input lPtr = lPtr + iLen% If lPtr > lEnd Then ' no more input: all done Exit Do End If ' move additional characters to the output string until ' you hit the first that's not a "division" character Do Select Case Mid(sText$, lPtr, 1) Case "-", " ", ".", ";", ":", "(", ")", "[", "]", "!", "?", "'", Chr(34) sOut$ = sOut$ + Mid(sText$, lPtr, 1) lPtr = lPtr + 1 If lPtr > lEnd Then Exit Do End If Case LocalMarcRecordObject.MarcDelimiter sOut$ = sOut$ + Mid(sText$, lPtr, 2) lPtr = lPtr + 2 If lPtr > lEnd Then Exit Do End If Case Else Exit Do End Select Loop If lPtr > lEnd Then Exit Do End If Loop ' for each syllable End If 'DumpRomanizationTables ReRomanizeTextDetails = sOut$ End Function Public Function EvaluateFirstCharacter(ByVal sText$, ByVal iRomanizationTable%, ByRef LocalMarcCharacter As Utf8CharClass) As Integer Dim lPtr As Long, lLength As Long Dim iLength% EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Unknown% If iRomanizationTable% < 1 Or iRomanizationTable% > gbliRomanizationTableLast% Then ' do nothing: already set to unknown Else With gblaRomanizationTable(iRomanizationTable%) ' first determination: are we converting script from vernacular into ' roman or from roman into vernacular: the first charcter will tell ' us everything we need to know lPtr = 1 lLength = Len(sText$) Do While lPtr <= lLength LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr) If LocalMarcCharacter.Utf8Char = LocalMarcCharacter.MarcDelimiter Then ' we'll skip this, and the following character, but do nothing ' about either of 'em iLength% = 2 Else iLength% = LocalMarcCharacter.Utf8CharOctets #If EvaluateFirstCharacterDebug = -1 Then Debug.Print "Char: >" + LocalMarcCharacter.Utf8Char + "< " + str(iLength%) #End If If .Roman2Vernacular.Exists(LocalMarcCharacter.Utf8Char) Then EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Roman2Vernacular% Exit Do ElseIf .Vernacular2Roman.Exists(LocalMarcCharacter.Utf8Char) Then EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Vernacular2Roman% Exit Do End If End If lPtr = lPtr + iLength% Loop End With End If End Function Public Function ReRomanizeTextDetailsReplaceApostrophes(ByVal sString$, ByVal iRomanizationTable%, ByRef LocalCharacterObject As Utf8CharClass, ByRef iLengthBeforeApostropheSubstitution%) As String Dim lPtr As Long Dim iLen% Dim sSaveIncomingCharacter$, sOut$ 'Debug.Print "RRTDRA received: >" + sString$ + "<" iLengthBeforeApostropheSubstitution% = Len(sString$) If Not gblaRomanizationTable(iRomanizationTable%).ApostropheCharactersPresent Then sOut$ = sString$ Else sSaveIncomingCharacter$ = LocalCharacterObject.Utf8Char lPtr = 1 Do While lPtr <= iLengthBeforeApostropheSubstitution% LocalCharacterObject.Utf8Char = Mid(sString$, lPtr) If InStr(gblaRomanizationTable(iRomanizationTable%).ApostropheCharacters, LocalCharacterObject.Utf8Char) > 0 Then sOut$ = sOut$ + "'" Else sOut$ = sOut$ + LocalCharacterObject.Utf8Char End If lPtr = lPtr + LocalCharacterObject.Utf8CharOctets Loop LocalCharacterObject.Utf8Char = sSaveIncomingCharacter$ End If ReRomanizeTextDetailsReplaceApostrophes = sOut$ 'Debug.Print "RRTDRA output: >" + sOut$ + "<" End Function Public Function RomanizationAssistance(ByVal iAction As RomanizationAction, ByRef LocalRichTextBox As Control, ByVal iScript%, ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass, ByRef LocalMarcCharacterObject As Utf8CharClass, ByVal iFldTextFormattedOption%, Optional ByVal sFontNameForDisplay$ = TextFormattedDefaultFont$, Optional ByVal iFontSizeForDisplay% = 10, Optional ByVal iFixedFieldDisplayConvention% = 2) As Integer Dim sField$, sTag$, sTagToFind$, sIndicators$, s880Indicators$, sNative6$, s8806$, sLeftEnd$, sRecord$, sSubfield6Code$ Dim sSelText$, sLeft$, sLeft2$, sRight$, sRight2$, sRightAfterSelection$, sWholeField$ Dim sWord$, sNewField$, sOldField$, sFile$, sTempFile$, sLine$, sNewCharacter$ Dim sFieldRemainderRight$, sFieldRemainderLeft$, s6$, sOriginalField$, sType$ Dim sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$, sNewFields$, sOldFields$ Dim sSubfieldsExcludedUniversally$, sSubfieldsExcludedByTag$, sOriginalLeft$, sOriginalRight$ Dim sNonfilingString$, sIntermediate$ Dim sRLM$, sLRE$, sPDF$ Dim sRtfFontName$ Dim iRc%, iRc2%, iRepeat%, iNext6%, iRomanizationStyle%, iDirection%, iIn%, iOut%, iElement% Dim iLen% Dim lPtr As Long, lPtr2 As Long, lSelLength As Long, lSelStart As Long, lStart As Long Dim lFldPointer As Long, lFldPointer2 As Long, lEnd As Long, lOriginalSelStart As Long Dim bFound As Boolean, bSkipTagTest As Boolean, bStringHasTerminalSpace As Boolean Dim bOnlyMarc8 As Boolean, bCreateEmpty880s As Boolean, bLcPattern As Boolean 'Const sLineEnd = "\line" Const sLineEnd$ = "\par" Const iLineEndLen% = 5 ' 20180926 Bucknum: check for and use custom language/script font for RTF display ' overrides the default Unicode font setting sRtfFontName$ = gblaRomanizationTable(iScript%).FontName If LenB(sRtfFontName$) = 0 Or Not IsFontInstalled(sRtfFontName$) Then sRtfFontName$ = sFontNameForDisplay$ End If If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then ' 20070425: pick up a script identification code if it's been defined ' otherwise, we'll attempt to match it to the language code in 008/35-37 ' we'll include this in $6 of "empty" 880 fields ' 20070830: LC addition: if there is no such code, pick up ' a transmogrification of the langauge code instead; area reorganized sSubfield6Code$ = gblaRomanizationTable(iScript%).R2VSubfield6Code If LenB(sSubfield6Code$) = 0 Then sSubfield6Code$ = Language2ScriptCode(LocalMarcRecordObjectAlreadyLoadedWithRecord.Get008Value(35, 3)) End If If LenB(sSubfield6Code$) > 0 Then If sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_HebrewAsG0$ Or _ sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ Then ' add R2L orientation code sSubfield6Code$ = sSubfield6Code$ & "/r" End If ' add "/" prefix sSubfield6Code$ = "/" + sSubfield6Code$ End If End If If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Or _ InStr(sSubfield6Code$, "/r") > 0 Then ' set IncludeFormattingCharactersLcPattern = True to insert UFCs ' 20070830: Bucknum code forces value of this here; but we think ' this should come from the configuration file ' instead, we're going to set directly what DB was using this ' as a proxy for 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = True bLcPattern = True ' 20070710: set a variable for the MarcRightToLeftMarker ' LC wants a RTL marker before and after each delimiter, ' EXCEPT immediately following the $6 code itself With LocalMarcRecordObjectAlreadyLoadedWithRecord sRLM$ = .MarcRightToLeftMarker sLRE$ = .MarcLeftToRightEmbedding sPDF$ = .MarcPopDirectionalFormatting End With Else ' set IncludeFormattingCharactersLcPattern = False to not insert UFCs ' 20070830: Bucknum code forces value of this here; but we think ' this should come from the configuration file ' instead, we're going to leave sRLM at its ground state of null, ' which seems to be the point of all of this, anyway 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = False bLcPattern = False End If sType$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRecordFormat ' assume everything will be OK RomanizationAssistance = ROMANIZATIONRESULT_Success% Select Case iAction Case ROMANIZATIONACTION_RomanizeHighlightedText%, ROMANIZATIONACTION_LCaseWord%, ROMANIZATIONACTION_UCaseWord%, ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_UCaseEach%, ROMANIZATIONACTION_Define% ' 20070830: NoRomanization added If gblaRomanizationTable(iScript%).NoRomanization Then If iAction = ROMANIZATIONACTION_Define% Then GoTo RomanizationAssistanceNoFileOpenResume End If End If ' these have similar complicated beginnings, so we'll do some code-sharing ' get the current state of the MARC record ' isolate the selected text, remove any carriage returns and line feeds sField$ = LocalRichTextBox.SelRTF ' for some reason, delimiters are getting converted to something we don't recognize ... sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\'87", "\u8225?") ' 20180926 added by Bucknum: for some reason, the rich text box is inserting alternating font codes ' (e.g., "\f0") into the selected text, which is corrupting it, so we're going to strip them out If InStr(sField$, "\f0 ") Or InStr(sField$, "\f1 ") Then sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\f0 "), "\f1 ") ElseIf InStr(sField$, "\f0") Or InStr(sField$, "\f1") Then sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\f0"), "\f1") End If 'Debug.Print "Initial extraction of field: >" + sField$ + "< len " + str(LocalRichTextBox.SelLength) If Len(sField$) = 0 Or LocalRichTextBox.SelLength = 0 Then 'Debug.Print "Action: " + str(ROMANIZATIONACTION_RomanizeHighlightedText%) If iAction = ROMANIZATIONACTION_RomanizeHighlightedText% Then ' 20070830: if we are clicked somewhere within a field and the selection length ' is zero, we'll assume that what we really want to do is convert the ' whole field lPtr = FindFieldCurrentlyPointedTo(LocalRichTextBox, LocalMarcRecordObjectAlreadyLoadedWithRecord) 'Debug.Print "Ptr: " + str(lPtr) ' 20100402 changed by Bucknum to allow for returned default of -1 (i.e. no text selected): 'If lPtr = 0 Then If lPtr <= 0 Then RomanizationAssistance = ROMANIZATIONRESULT_TextNotHighlighted% Exit Function End If Else RomanizationAssistance = ROMANIZATIONRESULT_TextNotHighlighted% Exit Function End If ' if we get here, we've found the field of interest LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lPtr sFieldRemainderLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd sFieldRemainderRight$ = "" sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText ' 20100202 added by Bucknum: to enable ' non-empty field transliteration below sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText GoTo RA_WeHaveOurFieldTheEasyWay End If ' if we ended up with carriage returns or line feeds, remove them (inserting no space) sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, vbCr, ""), vbLf, "") ' we'll use these two values in a bit, to find the field ' within the non-RTF version of the record ' NOTE that the TextRTF returns delimiters correctly (as opposed to SelRTF, as ' shown above) so we don't need to do any conversion here; in any case, this ' step appears to be irrelevant, because we replace this value of sRecord with ' a fresh copy of the TextFormatted(rtf) version of the record before we ' ever use sRecord for anything; go figure ' see note below about the contents of SelStart for rich text boxes lSelStart = LocalRichTextBox.SelStart lOriginalSelStart = lSelStart RomanizationAssistanceReloop: sRecord$ = LocalRichTextBox.TextRTF ' remove the closing brace from the selected text If Right(sField$, 1) = "}" Then sField$ = Mid(sField$, 1, Len(sField$) - 1) End If ' remove the RTF prefix from the selected text iRc% = InStr(sField$, "}}") If iRc% > 0 Then sField$ = Trim(Mid(sField$, iRc% + 2)) End If ' text should now start with some additional 'slash' commands, which ' we will proceed to remove Do While Mid(sField$, 1, 1) = "\" If Mid(sField$, 1, 2) = "\u" Then If InStr("0123456789", Mid(sField$, 3, 1)) > 0 Then Exit Do End If End If sField$ = Mid(sField$, 2) iRc% = InStr(sField$, "\") If iRc% = 0 Then iRc% = InStr(sField$, " ") If iRc% > 0 Then sField$ = Mid(sField$, iRc% + 1) Exit Do End If Else iRc2% = InStr(sField$, " ") If iRc2% > 0 Then If iRc% < iRc2% Then sField$ = Mid(sField$, iRc%) Else sField$ = Mid(sField$, iRc2% + 1) Exit Do End If Else sField$ = Mid(sField$, iRc%) End If End If Loop ' remove any trailing 'par' command iRc% = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sField$, "\par") If iRc% > 0 Then sField$ = Mid(sField$, 1, iRc% - 1) End If If Len(sField$) = 0 Then RomanizationAssistance = ROMANIZATIONRESULT_HighlightedTextBecomesNothing% Exit Function End If ' wrapping spaces are irrelevant sField$ = Trim(sField$) ' we should now have the raw text of interest, isolated in sField$ ' oddly enough, the SelStart property of the rich text box ' refers to the plain text version ' of the field; there doesn't seem to be a corresponding SelStartRtf ' or anything else useful; so we're going to use the supplied SelStart ' property as a rough guide for finding the selection ourselves ' remembering that SelStart is zero-based (so we don't have to back up 1 ' from lSelStart to find the "real" end of the preceding text, and we ' have to add 1 to the combined start and length to find the beginning ' of whatever follows the text (which is, from our point of view, possibly ' irrelevant) sFieldRemainderLeft$ = Mid(LocalRichTextBox.Text, 1, lSelStart) lPtr = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sFieldRemainderLeft$, vbLf) If lPtr > 0 Then sFieldRemainderLeft$ = Trim(Mid(sFieldRemainderLeft$, lPtr + 1) + sField$) sTagToFind$ = Mid(sFieldRemainderLeft$, 1, 3) Else RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable% Exit Function End If Select Case LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRecordFormat Case "A" sNonfilingString$ = sAuthorityNonfilingString$ Case "B", "D", "F", "M", "P", "S", "U" sNonfilingString$ = sBibliographicNonfilingString$ 'Case else: ignore the whole issue End Select ' to help us find the highlighted text within the record, ' give us the RTF version of the whole MARC record again ' we don't need to worry here about specification for fixed fields or ' font size, because they don't affect what we're up to here sRecord$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText) lStart = 1 Do ' find the next occurrence of our text in the record lSelStart = InStr(lStart, sRecord$, sField$) DoEvents If lSelStart = 0 Then If lStart = 1 Then RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable% Exit Function End If ' we found at least one place already; so let's back up to find ' the first one (assuming that the first one is the right one!) lSelStart = InStr(1, sRecord$, sField$) If lSelStart = 0 Then RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable% Exit Function End If bSkipTagTest = True Else lStart = lSelStart + 1 End If sLeft$ = Mid(sRecord$, 1, lSelStart - 1) sRight$ = Mid(sRecord$, lSelStart + Len(sField$)) ' sLeft$ = all of the record up to our selected text ' sRight$ = and all of the record that follows the selected text ' we want to back up in sLeft to the beginning of the current "line" (i.e., variable field) lSelStart = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sLeft$, sLineEnd$) If lSelStart > 0 Then sFieldRemainderLeft$ = LTrim(Mid(sLeft$, lSelStart + 5)) If Mid(sFieldRemainderLeft$, 1, 2) = "\f" Then sLeft$ = sLeft$ + Mid(sFieldRemainderLeft$, 1, 4) sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, 5) End If Else sFieldRemainderLeft$ = "" End If If Mid(LTrim(sFieldRemainderLeft$ + sField$), 1, 3) = sTagToFind$ Or bSkipTagTest Then ' we want to include from sRight any remainder of the current line (i.e., the ' remainder of our variable field) lSelStart = InStr(sRight$, sLineEnd$) If lSelStart > 1 Then sFieldRemainderRight$ = Mid(sRight$, 1, lSelStart - 1) Else sFieldRemainderRight$ = "" End If sFieldRemainderLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sFieldRemainderLeft$) sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sField$)) sFieldRemainderRight$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sFieldRemainderRight$) sWholeField$ = Trim(sFieldRemainderLeft$ + sField$ + sFieldRemainderRight$) Exit Do End If Loop 'Debug.Print "Easy way" Select Case iAction Case ROMANIZATIONACTION_RomanizeHighlightedText% sTag$ = Mid(sWholeField$, 1, 3) ' the tag of the current field sIndicators$ = Mid(sWholeField$, 5, 2) sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(Trim(Mid(sWholeField$, 8))) If Mid(sWholeField$, 1, 2) = "\f" Then sWholeField$ = Mid(sWholeField$, 4) End If RA_WeHaveOurFieldTheEasyWay: 'Debug.Print "Pieces: >" + sTag$ + "< >" + sIndicators$ + "< >" + sWholeField$ + "<" ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified) If sTag$ >= 600 And sTag$ <= 651 Then s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4" Else s880Indicators$ = sIndicators$ End If iRc% = InStr(sWholeField$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6") If iRc% > 0 Then ' 20070830: NoRomanization added If gblaRomanizationTable(iScript%).NoRomanization Then ' if we we're not actually converting text then there's nothing for us to do ' if $6 is present GoTo RomanizationAssistanceNoFileOpenResume End If s6$ = Mid(sWholeField$, iRc% + 2) iRc% = InStr(s6$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter) If iRc% > 0 Then s6$ = Mid(s6$, 1, iRc% - 1) End If Else ' field does not yet contain $6 ' calculate the next value for sequence of subfield $6 LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveNext If LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdFindFirst("6") Then iRc% = InStr(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, "-") If iRc% > 0 Then iRepeat% = Val(Trim(Mid(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iRc% + 1))) If iRepeat% > iNext6% Then iNext6% = iRepeat% End If End If End If Loop iNext6% = iNext6% + 1 ' 20070830: NoRomanization added If gblaRomanizationTable(iScript%).NoRomanization Then ' if we're not actually converting text, then (until we hear more ' from David B. at LC) we're going to add $6 to the current field and ' copy the current field to 880 ' we can do this much, now that we've got the next repeat number ' calculated bFound = False LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$) If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer bFound = True End If Loop If Not bFound Then RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound% Exit Function End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified) If sTag$ >= 600 And sTag$ <= 651 Then s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4" Else s880Indicators$ = sIndicators$ End If sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst bOnlyMarc8 = LocalMarcRecordObjectAlreadyLoadedWithRecord.Utf8TextContainsOnlyMarc8Characters(sField$) 'Debug.Print "Only marc 8? " + str(bOnlyMarc8) ' 20100412 changed by David Bucknum: since we're romanizing the field above ' original version: 'LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdAdd "6", "880-" + Right("00" + Trim(str(iNext6%)), 2) ' replacement: With LocalMarcRecordObjectAlreadyLoadedWithRecord .FldDelete .FldAdd .FldTag, .FldInd, .MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sField$ End With ' adding subfield $6 has the effect of deleting the original field and replacing ' it with a new one; so we need to reset the pointer too lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer ' 20100412 changed by David Bucknum: since we're romanizing the field above ' original version: 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", s880Indicators$, sField$ 'LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdAdd "6", sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2) ' replacement: With LocalMarcRecordObjectAlreadyLoadedWithRecord .FldAdd .FldTag, .FldInd, .MarcDelimiter + "6" + sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sField$ End With lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer ' now, the matrix of options If bOnlyMarc8 Then ' the field we copied into the 880 contains only MARC-8 characters; so ' we assume that this is romanized text for which we need to ' supply the vernacular form 'Debug.Print "Create empty 1? " + str(gblaRomanizationTable(iScript%).R2VCreateEmpty880s) If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer2 LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst Do While True If InStr("68", LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) = 0 Then ' include this subfield, but change it to a plus sign ' 20070831: in the new "empty" 880 field: ' add RLMs before and after the delimiter/subfield codes, ' as appropriate, but *only* if the Right2LeftMark variable is set If bLcPattern Then ' 20070831: add a LeftToRightEmbedding character (LRE) only before ' and add a POPDirectionalFormatting character (PDF) only ' at the end of the 880 $6 260-xx $c [dates] ' 20121121: added 264 (RDA) to logic If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then ' if the 260 ends with a period, place the period after the PDF If Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, 1) = "." Then LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + sLRE$ + "+" + sPDF$ + "." Else LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + sLRE$ + "+" + sPDF$ End If Else LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + "+" + sRLM$ End If Else LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = "+" End If Else ' 20070831: add an RLM at the end of $6 as appropriate If bLcPattern Then LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText + sSubfield6Code$ + sRLM$ Else LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText + sSubfield6Code$ End If End If If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then ' 20070831: remove the final RLM at the end of the field If bLcPattern And Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, 3) = sRLM$ Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = Left(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, Len(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText) - 3) End If Exit Do End If Loop End If Else ' the field we copied into the 880 contains non-MARC-8 characters; so ' we assume that this is vernacular text and the original field ' needs to be romanized 'Debug.Print "Create empty 2? " + str(gblaRomanizationTable(iScript%).V2RCreateEmptyFields) If gblaRomanizationTable(iScript%).V2RCreateEmptyFields Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst sField$ = "" Do While True If InStr("68", LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) = 0 Then ' include this subfield, but change it to a plus sign sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + "+" Else sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText End If If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then Exit Do End If Loop LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sField$ End If End If ' LocalMarcRecordObjectAlreadyLoadedWithRecord.DumpArray "100 880", True GoTo RomanAssist_DisplayTheFinishedRecord End If End If iRomanizationStyle% = EvaluateFirstCharacter(sField$, iScript%, LocalMarcCharacterObject) If iRomanizationStyle% = ROMANIZATIONDIRECTION_Unknown% Then RomanizationAssistance = ROMANIZATIONRESULT_ActionUnclear% Exit Function End If ' at this point we need to make the critical determination: are we converting ' romanized text into vernacular, or are we converting vernacular text into romanized? ' here go the scenarios we've developed, based on a ' matrix of these factors: ' 1) whether the field is 880, or something else ' 2) whether the field already contains subfield $6 ' 3) whether the highlighted text is vernacular or romanized If sTag$ <> "880" Then If Len(s6$) = 0 Then ' we need lFldPointer regardless of what happens ' to remaining scenarios here bFound = False LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$) 'Debug.Print "Comparing: >" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText + "< >" + sWholeField$ + "<" If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer bFound = True End If Loop If Not bFound Then RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound% Exit Function End If If iRomanizationStyle% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then ' not an 880 field; no $6 yet; we're moving from vernacular to romanized ' copy the current field as 880 (which adds $6 to the ' original field and also the new 880 field); otherwise ' leave the 880 field alone iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then ' it sure better be! RomanAssist_ReplayWithSubstitution: ' find the original field (again!) and get a copy of it LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer LocalMarcRecordObjectAlreadyLoadedWithRecord.FldLoadInfo sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$ lFldPointer2 = lFldPointer ' copy the field as it stands to an 880, with $6 added LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", sIndicatorsToCopy$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + sTagToCopy$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sFieldToCopy$ ' save the pointer to the new 880 field for later use in resolving ' the nonfiling characters indicator lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer ' isolate the bits that we're NOT going to romanize sLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + Mid(sWholeField$, 1, iRc% - 1) If Right(sLeft$, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1) sIntermediate$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter ElseIf Mid(Right(sLeft$, 2), 1, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then sIntermediate$ = Right(sLeft$, 2) sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 2) End If sRight$ = Mid(sWholeField$, iRc% + Len(sField$)) sField$ = sIntermediate$ + sField$ ' change the text of the native field to match LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer2 If Right(sField$, 1) = " " Then bStringHasTerminalSpace = True Else bStringHasTerminalSpace = False End If ' 20070731: make sure first word is uppercased sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject)) If Not bStringHasTerminalSpace Then sField$ = RTrim(sField$) End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sField$ + sRight$ ' just in case we've done a delete/re-add lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer ' adjust nonfiling characters as necessary #If RomanizationAssistanceDebug = -1 Then Debug.Print "Adjust NON #1" #End If ReRomanizeAdjustNonfilingIndicators iScript%, sNonfilingString$, lFldPointer, lFldPointer2, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject GoTo RomanAssist_DisplayTheFinishedRecord Else iRc% = InStr(sField$, sWholeField$) If iRc% > 0 Then sField$ = sWholeField$ iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then GoTo RomanAssist_ReplayWithSubstitution End If End If ' todo: if we get here, nothing is going to happen; tell the operator? End If Else ' not an 880 field; no $6 yet; we're moving from romanized to vernacular ' find the field in the bib record ' INCLUDES Wade-Giles to Pinyin iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then ' it sure better be! RomanAssist_ReplayWithSubstitution2: ' isolate the bits that we're NOT going to romanize sRight$ = Mid(sWholeField$, iRc% + Len(sField$)) LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer sTagToCopy$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag If gblaRomanizationTable(iScript%).DoNotUse880Field Then ' probably wade-giles to pinyin sLeft$ = Mid(sWholeField$, 1, iRc% - 1) LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sRight$ Else sLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + Mid(sWholeField$, 1, iRc% - 1) ' add subfield $6 to the original field (to make things easier, we'll ' actually achieve this with a delete/insert operation) 'Debug.Print "Text before delete: " + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDelete ' 20070703: in the original version (retained here as a comment), we use the text of the new field ' as run through the ReRomanize function. the reason for this is not clear, and ' at least in the Hebrew stuff we're testing with just now this results in ' a field with uppercase letters rendered as lowercase ' the obvious solution appears to be to use the original field text in the ' new field, without any changes ' perhaps only time will reveal the need that led to our use of ReRomanize ' here in the first place ... ' original version: 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter sTagToCopy$, sIndicators$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, 2) ' replacement: ' 20100809 Bucknum added: remove temporary VowelMarker character before export If LenB(gblaRomanizationTable(iScript%).R2VVowelMarker) > 0 Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, gblaRomanizationTable(iScript%).R2VVowelMarker) End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter sTagToCopy$, sIndicators$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText ' pointer to the "changed" field lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer ' 20070719: convert the text for the 880 here, instead of below sField$ = ReRomanizeText(sType$, sTagToCopy$, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) ' add right-to-left marker to the end of subfield $6 as appropriate If bLcPattern Then lPtr = InStr(sLeft$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6") If lPtr > 0 Then sLeft$ = sLeft$ & LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRightToLeftMarker End If ' add LRE and PDF markers to the 880 $6 260-xx $c [dates] ' after the $c RLM and at the end of the subfield ' 20121121: added 264 (RDA) to logic lPtr2 = InStr(sField$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "c") If lPtr2 <> 0 And sTagToCopy$ Like "26[04]" Then sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sField$, lPtr2 + 5, 0, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcLeftToRightEmbedding) ' if the subfield ends with a period, place the period after the PDF If Right(sField$, 1) = "." Then sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sField$, InStrRev(sField$, "."), 1, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcPopDirectionalFormatting + ".") Else sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcPopDirectionalFormatting End If End If End If ' create an 880 field with text converted ' 20070719 changed by David Bucknum: since we're romanizing the field above ' original version: 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter "880", s880Indicators$, sLeft$ + ReRomanizeText(sType$, sTagToCopy$, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sRight$ ' replacement: LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter "880", s880Indicators$, sLeft$ + sField$ + sRight$ ' this is, for our purposes, the "original" field lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer 'LocalMarcRecordObjectAlreadyLoadedWithRecord.DumpArray "", False #If RomanizationAssistanceDebug = -1 Then Debug.Print "Adjust NON #2" #End If ReRomanizeAdjustNonfilingIndicators iScript%, sNonfilingString$, lFldPointer, lFldPointer2, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject ' does this achieve anything at all? LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer End If GoTo RomanAssist_DisplayTheFinishedRecord Else iRc% = InStr(sField$, sWholeField$) If iRc% > 0 Then sField$ = sWholeField$ iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then GoTo RomanAssist_ReplayWithSubstitution2 End If End If ' todo: if we get here, nothing is going to happen; tell the operator? End If End If Else ' tag not 880, subfield $6 is present If iRomanizationStyle% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then ' not an 880 field; already contains $6; moving from vernacular to roman ' todo: romanize the text in place, leaving the 880 field alone ' NOTE that if field already contains $6, we're not going to ' do anything about initial articles RomanAssist_ReRomanizeInPlace: bFound = False sTag$ = Mid(sFieldRemainderLeft$, 1, 3) LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$) If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer bFound = True End If Loop If Not bFound Then RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound% Exit Function Else LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer If Len(sFieldRemainderLeft$) > 0 Then lFldPointer = InStr(sFieldRemainderLeft$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter) If lFldPointer > 0 Then sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, lFldPointer) End If End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sFieldRemainderLeft$ + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sFieldRemainderRight$ GoTo RomanAssist_DisplayTheFinishedRecord End If Else ' not an 880 field; already contains $6; we're moving from romanized to vernacular ' todo: find the parallel text in the 880 field, and vernacularize the ' parallel text in the 880 field; leave the user-marked field alone End If End If Else ' the operator selected text within an 880 field If Len(s6$) = 0 Then RomanizationAssistance = ROMANIZATIONRESULT_880WithNoSubfield6% Exit Function Else ' 880 field; field already contains $6 GoTo RomanAssist_ReRomanizeInPlace End If End If Case ROMANIZATIONACTION_LCaseWord%, ROMANIZATIONACTION_UCaseWord%, ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_UCaseEach%, ROMANIZATIONACTION_Define% sTag$ = Mid(sWholeField$, 1, 3) ' the tag of the current field sIndicators$ = Mid(sWholeField$, 5, 2) sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(Trim(Mid(sWholeField$, 8))) If Mid(sWholeField$, 1, 2) = "\f" Then sWholeField$ = Mid(sWholeField$, 4) End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$) If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer bFound = True End If Loop If Not bFound Then RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound% Exit Function End If iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then ' it sure better be! iRc% = InStr(sWholeField$, sField$) If iRc% > 0 Then ' it sure better be! ' find the original field (again!) and get a copy of it LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer LocalMarcRecordObjectAlreadyLoadedWithRecord.FldLoadInfo sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$ ' isolate the bits that we're NOT going to romanize sLeft$ = Mid(sWholeField$, 1, iRc% - 1) If Right(sLeft$, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1) sIntermediate$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter ElseIf Mid(Right(sLeft$, 2), 1, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then sIntermediate$ = Right(sLeft$, 2) sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 2) End If sRight$ = Mid(sWholeField$, iRc% + Len(sField$)) sField$ = sIntermediate$ + sField$ sOriginalField$ = sField$ Select Case iAction Case ROMANIZATIONACTION_LCaseWord% LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.LCaseFirstWord(sField$) + sRight$ Case ROMANIZATIONACTION_UCaseWord% LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(sField$) + sRight$ Case ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_Define% sNewField$ = "" sOriginalLeft$ = sLeft$ sOriginalRight$ = sRight$ Do While Len(sField$) > 0 If Asc(Mid(sField$, 1, 1)) > 127 Then LocalMarcCharacterObject.Utf8Char = sField$ sField$ = Mid(sField$, LocalMarcCharacterObject.Utf8CharOctets + 1) sNewField$ = sNewField$ + "{U+" + LocalMarcCharacterObject.UcsHex + "}" Else sNewField$ = sNewField$ + Mid(sField$, 1, 1) sField$ = Mid(sField$, 2) End If Loop If iAction = ROMANIZATIONACTION_Define% Then sFile$ = gblaRomanizationTable(iScript%).FullFileName sTempFile$ = sFile$ iRc2% = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sTempFile$, "\") If iRc2% = 0 Then Exit Function End If sTempFile$ = Mid(sTempFile$, 1, iRc2%) + "Temp.$$$" On Error GoTo RomanizationAssistanceNoFileOpen iOut% = FreeFile Open sTempFile$ For Output As #iOut% On Error GoTo 0 iIn% = FreeFile Open sFile$ For Input As #iIn% iRc% = InStr(sNewField$, "{U+") If iRc% = 0 Then RomanizationAssistance = ROMANIZATIONRESULT_NoCharacterToDefine% Exit Function End If ' iRc% points to the character in question ' PRESERVE THE VALUE OF iRC! sField$ = InputBox("Please supply the replacement text for U+" + Mid(sNewField$, iRc% + 3, 4) + ". (Supply empty text to cancel.)", "Define replacement for vernacular character", "") If Len(sField$) = 0 Then Close #iIn% Close #iOut% Exit Function ' operation canceled End If ' iRc% still points to the character in question ' PRESERVE THE VALUE OF iRC! If sField$ = Mid(sNewField$, iRc% + 3, 4) Then Close #iIn% Close #iOut% Exit Function ' operator didn't make a change: nothing to do End If ' iRc% still points to the character in question ' PRESERVE THE VALUE OF iRC! ' todo: if we need to allow for the possibility of Unicode ' notations within the replacement text, handle them here ' (not needed for Chinese, which is the object of this ' exercise) ' add a new line to the configuration file, ' defining this new character (we opened the files ' above, so we could make sure we're allowed to do this ' before we actually go to work) ' ' 20070606 added by David Bucknum sField$ = Trim(sField$) & " " Do While Not EOF(iIn%) DoEvents Line Input #iIn%, sLine$ Print #iOut%, sLine$ ' 20070727 (comment only; no change) this puts the new ' character at the top of the stanza, whether we want ' it there or somewhere else; this is "probably" good ' enough, given the context ... If sLine$ = "[ScriptToRoman]" Then Print #iOut%, "U+" + Mid(sNewField$, iRc% + 3, 4) + "=" + LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, " ", "_") End If Loop Close #iIn% Close #iOut% On Error GoTo RomanizationAssistanceBadKill Kill sFile$ DoEvents FileCopy sTempFile$, sFile$ DoEvents Kill sTempFile$ ' add the character to the current version of the ' romanization tables in memory 'sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "_", " ") ' this is the "native" representation of the whole raw string (which should ' just be one character) 'Debug.Print "RA 1" sNewCharacter$ = RomanizeConvertText("U+" + Mid(sNewField$, iRc% + 3, 4), LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) LocalMarcCharacterObject.UcsHex = Mid(sNewField$, iRc% + 3, 4) ' isolating the first character (there should only be the one) If gblaRomanizationTable(iScript%).Vernacular2Roman.Exists(LocalMarcCharacterObject.Utf8Char) Then iElement% = gblaRomanizationTable(iScript%).Vernacular2Roman.item(LocalMarcCharacterObject.Utf8Char) Else gblaRomanizationTable(iScript%).VernacularLast = gblaRomanizationTable(iScript%).VernacularLast + 1 If gblaRomanizationTable(iScript%).VernacularLast > gblaRomanizationTable(iScript%).VernacularMax Then gblaRomanizationTable(iScript%).VernacularMax = gblaRomanizationTable(iScript%).VernacularMax + 10 ReDim Preserve gblaRomanizationTable(iScript%).Vernacular(0 To gblaRomanizationTable(iScript%).VernacularMax) End If iElement% = gblaRomanizationTable(iScript%).VernacularLast gblaRomanizationTable(iScript%).Vernacular2Roman.Add LocalMarcCharacterObject.Utf8Char, iElement% End If gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast = gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast + 1 If gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast > gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax Then gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax = gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax + 5 ReDim Preserve gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(0 To gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax) End If sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "_", " ") gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeLen(sNewCharacter$) gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullStringLengthInBytes = Len(sNewCharacter$) gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullString = sNewCharacter$ gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).Equivalent = sField$ gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).EquivalentUpperCasePresent = False 'Debug.Print "Defined equivalent >" + gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).Equivalent + "< for >" + "Y" + "<" If Right(sField$, 1) = " " Then sOriginalField$ = sOriginalLeft$ + sOriginalField$ + sOriginalRight$ iRc% = InStr(sOriginalField$, sNewCharacter$) Do While iRc% > 0 Select Case Mid(sOriginalField$, iRc% + Len(sNewCharacter$), 1) Case " " sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), sField$) Case Chr(34), "'", ";", ":", ",", ".", "/", "<", ">", "?", "[", "]", "\", "{", "}", "|", "-", "=", "!", "@", "#", "$%", "^", "&", "*", "(", ")", "_", "+", "" sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), Trim(sField$)) Case Else sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), sField$) End Select iRc% = InStr(sOriginalField$, sNewCharacter$) Loop LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveRepeatedCharacters(sOriginalField$, " ") Else LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveRepeatedCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sOriginalLeft$ + sOriginalField$ + sOriginalRight$, sNewCharacter$, sField$), " ") End If Else sNewField$ = InputBox("Please supply the replacement text. Non-ASCII characters are shown as Unicode(TM) values within curly braces." + vbLf + "Original: " + sNewField$, "Replace text", sNewField$) If Len(sNewField$) > 0 Then Do iRc% = InStr(sNewField$, "{U+") If iRc% = 0 Then Exit Do End If sLeft2$ = Mid(sNewField$, 1, iRc% - 1) sNewField$ = Mid(sNewField$, iRc% + 3) iRc% = InStr(sNewField$, "}") If iRc% > 1 Then sRight2$ = Mid(sNewField$, iRc% + 1) LocalMarcCharacterObject.UcsHex = Mid(sNewField$, 1, iRc% - 1) sNewField$ = LocalMarcCharacterObject.Utf8Char Else sRight2$ = "" End If sNewField$ = sLeft2$ + sNewField$ + sRight2$ Loop LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sNewField$ + sRight$ End If End If Case ROMANIZATIONACTION_UCaseEach% sNewField$ = "" Do While Len(sField$) > 0 GetNextPiece sField$, sWord$, " " sNewField$ = Trim(sNewField$ + " " + LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(sWord$)) Loop LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sNewField$ + sRight$ End Select GoTo RomanAssist_DisplayTheFinishedRecord End If End If End Select Case ROMANIZATIONACTION_RomanizeWholeRecord% ' 20070830: NoRomanization added ' If gblaRomanizationTable(iScript%).NoRomanization Then ' GoTo RomanizationAssistanceNoFileOpenResume ' End If iRc% = RomanizationAssistanceConvertWholeRecord(sType$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) If iRc% <> 0 Then RomanizationAssistance = iRc% Exit Function End If GoTo RomanAssist_DisplayTheFinishedRecord Case ROMANIZATIONACTION_DisplayMarcRecord% RomanAssist_DisplayTheFinishedRecord: If iFldTextFormattedOption% = 99 Then Select Case iFixedFieldDisplayConvention% Case 2 ' FixedFieldDisplay_OCLCMonospaced% LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, OclcMonospaced, "", True, sRtfFontName$, iFontSizeForDisplay%) Case 1 ' FixedFieldDisplay_OCLC LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, oclc, "", True, sRtfFontName$, iFontSizeForDisplay%) Case Else ' zero; notis LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, notis, "", True, sRtfFontName$, iFontSizeForDisplay%) End Select Else Select Case iFixedFieldDisplayConvention% Case 2 ' FixedFieldDisplay_OCLCMonospaced% LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, OclcMonospaced, "", True, sRtfFontName$, iFontSizeForDisplay%) Case 1 ' FixedFieldDisplay_OCLC LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, oclc, "", True, sRtfFontName$, iFontSizeForDisplay%) Case Else ' zero; notis LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, notis, "", True, sRtfFontName$, iFontSizeForDisplay%) End Select End If End Select RomanizationAssistanceNoFileOpenResume: Exit Function RomanizationAssistanceBadKill: RomanizationAssistanceNoFileOpen: RomanizationAssistance = ROMANIZATIONRESULT_FileOpen% On Error GoTo 0 Resume RomanizationAssistanceNoFileOpenResume End Function Public Function FindFieldCurrentlyPointedTo(ByRef cRichTextBox As Control, ByRef LocalMarcRecord As Utf8MarcRecordClass, Optional ByVal bSearch As Boolean = False) As Long ' 20070207: created (so OK for Unicode already) ' find in a MARC record the field that corresponds to the field-currently-clicked-on ' in the rich text box ' return the pointer to that field (if the pointer is nonzero, the MARC record object also ' is currently pointed to that field, but the caller should probably not assume this) Dim lSelStart As Long, lOriginalSelStart As Long, lPtr As Long, lStart As Long Dim sField$, sRecord$, sFieldRemainderLeft$, sFieldRemainderRight$ Dim sTagToFind$, sNonfilingString$ Dim sLeft$, sRight$, sLineEnd$, sWholeField$ Dim iRc%, iRc2% Dim bSkipTagTest As Boolean ' assume that we didn't find anything FindFieldCurrentlyPointedTo = -1 ' this is a useful thing to have, either way lSelStart = cRichTextBox.SelStart If Len(cRichTextBox.SelText) > 0 Then ' the easier way out: at least one character is highlighted (we've ' already figured this out for the toolkit's re-romanization button, so we'll ' just translate that bit of business for the context here) lOriginalSelStart = lSelStart sField$ = cRichTextBox.SelRTF sRecord$ = cRichTextBox.TextRTF ' remove the closing brace from the selected text If Right(sField$, 1) = "}" Then sField$ = Mid(sField$, 1, Len(sField$) - 1) End If ' remove the RTF prefix from the selected text iRc% = InStr(sField$, "}}") If iRc% > 0 Then sField$ = Trim(Mid(sField$, iRc% + 2)) End If ' text should now start with some additional 'slash' commands, which ' we will proceed to remove Do While Mid(sField$, 1, 1) = "\" If Mid(sField$, 1, 2) = "\u" Then If InStr("0123456789", Mid(sField$, 3, 1)) > 0 Then Exit Do End If End If sField$ = Mid(sField$, 2) iRc% = InStr(sField$, "\") If iRc% = 0 Then iRc% = InStr(sField$, " ") If iRc% > 0 Then sField$ = Mid(sField$, iRc% + 1) Exit Do End If Else iRc2% = InStr(sField$, " ") If iRc2% > 0 Then If iRc% < iRc2% Then sField$ = Mid(sField$, iRc%) Else sField$ = Mid(sField$, iRc2% + 1) Exit Do End If Else sField$ = Mid(sField$, iRc%) End If End If Loop ' remove any trailing 'par' command iRc% = LocalMarcRecord.Rat(sField$, "\par") If iRc% > 0 Then sField$ = Mid(sField$, 1, iRc% - 1) End If ' wrapping spaces are irrelevant sField$ = Trim(sField$) If Len(sField$) = 0 Then ' maybe we can work this out using just the ' SelStart pointer? GoTo FFCPT_UseJustSelStart End If ' in sField$ we should now have the raw RTF text of interest minus the wrapper ' oddly enough, the SelStart property of the rich text box ' refers to the plain text version ' of the field; there doesn't seem to be a corresponding SelStartRtf ' or anything else useful; so we're going to use the supplied SelStart ' property as a rough guide for finding the selection ourselves ' remembering that SelStart is zero-based (so we don't have to back up 1 ' from lSelStart to find the "real" end of the preceding text, and we ' have to add 1 to the combined start and length to find the beginning ' of whatever follows the text (which is, from our point of view, possibly ' irrelevant) sFieldRemainderLeft$ = Mid(cRichTextBox.Text, 1, lSelStart) lPtr = LocalMarcRecord.Rat(sFieldRemainderLeft$, vbLf) If lPtr > 0 Then sFieldRemainderLeft$ = Trim(Mid(sFieldRemainderLeft$, lPtr + 1) + sField$) sTagToFind$ = Mid(sFieldRemainderLeft$, 1, 3) Else GoTo FFCPT_UseJustSelStart End If Select Case LocalMarcRecord.MarcRecordFormat Case "A" sNonfilingString$ = sAuthorityNonfilingString$ Case "B", "D", "F", "M", "P", "S", "U" sNonfilingString$ = sBibliographicNonfilingString$ 'Case else: ignore the whole issue End Select ' to help us find the highlighted text within the record, ' give us the RTF version of the whole MARC record again ' we don't need to worry here about specification for fixed fields or ' font size, because they don't affect what we're up to here sRecord$ = LocalMarcRecord.TextFormatted(rtfText, OclcMonospaced) lStart = 1 Do ' find the next occurrence of our text in the record lSelStart = InStr(lStart, sRecord$, sField$) DoEvents If lSelStart = 0 Then If lStart = 1 Then GoTo FFCPT_UseJustSelStart End If ' we found at least one place already; so let's back up to find ' the first one (assuming that the first one is the right one!) lSelStart = InStr(1, sRecord$, sField$) If lSelStart = 0 Then GoTo FFCPT_UseJustSelStart End If bSkipTagTest = True Else lStart = lSelStart + 1 End If sLeft$ = Mid(sRecord$, 1, lSelStart - 1) sRight$ = Mid(sRecord$, lSelStart + Len(sField$)) ' sLeft$ = all of the record up to our selected text ' sRight$ = and all of the record that follows the selected text ' we want to back up in sLeft to the beginning of the current "line" (i.e., variable field) lSelStart = LocalMarcRecord.Rat(sLeft$, sLineEnd$) If lSelStart > 0 Then sFieldRemainderLeft$ = LTrim(Mid(sLeft$, lSelStart + 5)) If Mid(sFieldRemainderLeft$, 1, 2) = "\f" Then sLeft$ = sLeft$ + Mid(sFieldRemainderLeft$, 1, 4) sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, 5) End If Else sFieldRemainderLeft$ = "" End If If Mid(LTrim(sFieldRemainderLeft$ + sField$), 1, 3) = sTagToFind$ Or bSkipTagTest Then ' this is the field we want! hooray! FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer Exit Function End If Loop ' if we get here, we didn't find what we wanted, given the text highlighted by the ' operator ' we'll fall through and try the second method, using just the starting point of the ' highlight End If ' if we get here, either the operator didn't highlight any text at all, or ' we failed in the above attempt to find the highlighted text FFCPT_UseJustSelStart: ' if we *branch to* here, there was something amiss with the text selected by the ' operator--maybe the operator just selected a space? ' no matter how we get here, we're going to try a second and more difficult/complicated ' operation, using just the start of the selection ' this is a bit more difficult, because the SelStart pointer relates to ' the plain-text version, not the RTF version; and in the plain text ' the fancy characters are all replaced by question marks ' isolate the text of the field ' put the text to the right of the insert point into sRight, and ' the text to the left of the insert point into sLeft sLeft$ = Mid(cRichTextBox.Text, 1, lSelStart) sRight$ = Mid(cRichTextBox.Text, lSelStart + 1) 'Debug.Print "Text of interest:" 'Debug.Print sLeft$ + sRight$ ' remove parts of any following fields from the right bit of the record, ' leaving only the right part of the one field lPtr = LocalMarcRecord.Rat(sLeft$, vbLf) If lPtr = 0 Then lPtr = LocalMarcRecord.Rat(sLeft$, vbCr) End If If lPtr > 0 Then ' it better be! sLeft$ = Mid(sLeft$, lPtr + 1) End If ' remove parts of any preceding fields from the left bit of the record, leaving ' only the left part of the one field lPtr = InStr(sRight$, vbCr) If lPtr = 0 Then lPtr = LocalMarcRecord.Rat(sRight$, vbLf) End If If lPtr > 0 Then ' it better be! sRight$ = Mid(sRight$, 1, lPtr - 1) End If ' and here's the whole field sField$ = Trim(sLeft$ + sRight$) ' if now we don't have anything, then we're in serious trouble If Len(sField$) = 0 Then Exit Function ' with default return value of zero End If ' isolate the field's tag, and make sure that it's all numeric sTagToFind$ = Mid(sField$, 1, 3) If InStr("0123456789", Mid(sTagToFind$, 1, 1)) = 0 Or InStr("0123456789", Mid(sTagToFind$, 2, 1)) = 0 Or InStr("0123456789", Mid(sTagToFind$, 3, 1)) = 0 Then Exit Function ' with default return value of zero End If ' we only move 010 and higher If sTagToFind$ < "010" Then If Not bSearch Or (bSearch And sTagToFind$ <> "001") Then Exit Function End If End If ' does the field exist at all? LocalMarcRecord.FldMoveTop If Not LocalMarcRecord.FldFindFirst(sTagToFind$) Then Exit Function ' with default return value of zero End If ' if there is only one occurrence of the field, then ' that one occurrence *must* be the one we want If Not LocalMarcRecord.FldFindNext(sTagToFind$) Then ' back up to the field we found just above LocalMarcRecord.FldFindFirst sTagToFind$ FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer Exit Function End If ' OK, so there is more than one field with this tag; we'll have ' to do this the hard way and hope for the best ' the RTF version uses character 135 for the delimiter; translating that ' back to the 'real' delimiter means that we won't have to do the ' translation in the other direction for each field in the record sField$ = LocalMarcRecord.ReplaceCharacters(sField$, Chr(135), LocalMarcRecord.MarcDelimiter) LocalMarcRecord.FldMoveTop Do While LocalMarcRecord.FldFindNext(sTagToFind$) sLeft$ = LocalMarcRecord.FldTag + ":" + LocalMarcRecord.FldInd + ": " + LocalMarcRecord.AddSpacesAroundDelimiters(LocalMarcRecord.FldText) ' replace all of the 'special' characters with question marks For lPtr = Len(sLeft$) To 1 Step -1 Select Case Asc(Mid(sLeft$, lPtr, 1)) Case Is > 191 ' begins 1110 or 1100: first character in multi-byte sequence sLeft$ = LocalMarcRecord.SafeStuff(sLeft$, lPtr, 1, "?") Case Is > 127 ' second or third character in multi-byte sequence sLeft$ = LocalMarcRecord.SafeStuff(sLeft$, lPtr, 1, "") End Select Next ' lptr If sField$ = sLeft$ Then FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer Exit Function End If Loop ' if we fall through to here, we were not able to find the field either way; ' 20100402: changed by David Bucknum from zero to -1: ' so we'll return with the default return value of -1 End Function Public Function RomanizationAssistanceConvertWholeRecord(ByVal sRecordType$, ByVal iScript%, ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass, ByRef LocalMarcCharacterObject As Utf8CharClass) As Integer Dim sField$, sTag$, sTagToFind$, sIndicators$, s880Indicators$, sNative6$, s8806$, sLeftEnd$, sRecord$ Dim sSelText$, sLeft$, sRight$, sRightAfterSelection$, sWholeField$, sWord$, sNewField$, sOldField$ Dim sFieldRemainderRight$, sFieldRemainderLeft$, s6$, sOriginalField$, sSfd$, s066$ Dim sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$, sNewFields$, sOldFields$ Dim sSubfieldsExcludedUniversally$, sSubfieldsExcludedByTag$, sSubfield6Code$ Dim sRLM$, sLRE$, sPDF$ Dim iRc%, iRc2%, iRepeat%, iNext6%, iRomanizationStyle%, iDirection% Dim lPtr As Long, lSelLength As Long, lSelStart As Long, lStart As Long Dim lFldPointer As Long, lEnd As Long Dim bFound As Boolean, bSkipTagTest As Boolean Dim bCreateEmptyFields As Boolean, bCreateEmpty880s As Boolean Dim bLcPattern As Boolean Const sLineEnd = "\par" Const iLineEndLen = 5 If gblaRomanizationTable(iScript%).DoNotUse880Field Then RomanizationAssistanceConvertWholeRecord = ROMANIZATIONRESULT_880NotAllowed% Exit Function End If If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindFirst("880") Then RomanizationAssistanceConvertWholeRecord = ROMANIZATIONRESULT_880AlreadyPresent% Exit Function End If ' if the record contains *any* vernacular, then we assume that we're going ' from vernacular to roman; otherwise, we assume that we're going from ' roman to vernacular ' we need to know the direction before we meet up the first field during ' translation, so we know which set of tags to apply With LocalMarcRecordObjectAlreadyLoadedWithRecord iDirection% = ROMANIZATIONDIRECTION_Roman2Vernacular% .FldMoveTop Do While .FldMoveNext '20101213: Bucknum changed to "V2RFieldsIncluded" check to fix R2V/V2R logic below 'If .FldTag > "009" Then If InStr(gblaRomanizationTable(iScript%).V2RFieldsIncluded, .FldTag) > 0 Then Do 'Debug.Print "Evaluating " + .FldTag + ":" + .SfdCode + ":" + .SfdText If gblaRomanizationTable(iScript%).V2RCreateEmptyFields = True And _ .Utf8TextContainsOnlyMarc8Characters(.SfdText) = False Then iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% GoTo RomanAssist_HaveDirection ElseIf EvaluateFirstCharacter(.SfdText, iScript%, LocalMarcCharacterObject) = ROMANIZATIONDIRECTION_Vernacular2Roman% Then iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% GoTo RomanAssist_HaveDirection End If If Not .SfdMoveNext Then Exit Do End If Loop End If Loop RomanAssist_HaveDirection: End With ' 20070227: if we're going from romanized to vernacular, then ' figure out if we're going to try to do the work, or just ' create dummy fields for the operator to complete If iDirection% = ROMANIZATIONDIRECTION_Roman2Vernacular% Then If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then bCreateEmpty880s = True ' 20070425: pick up a script code if it's been defined--we'll include this ' in $6 of "empty" 880 fields, and also in 066 ' 20070830: LC addition: if there is no such code, pick up ' a transmogrification of the langauge code instead; area reorganized sSubfield6Code$ = gblaRomanizationTable(iScript%).R2VSubfield6Code If LenB(sSubfield6Code$) = 0 Then sSubfield6Code$ = Language2ScriptCode(LocalMarcRecordObjectAlreadyLoadedWithRecord.Get008Value(35, 3)) End If If LenB(sSubfield6Code$) > 0 Then s066$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "c" + sSubfield6Code$ If sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_HebrewAsG0$ Or _ sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ Then ' add R2L orientation code sSubfield6Code$ = sSubfield6Code$ & "/r" End If ' add "/" prefix sSubfield6Code$ = "/" + sSubfield6Code$ End If End If ' 20070710: set a variable for the MarcRightToLeftMarker ' LC wants a RTL marker before and after each delimiter, ' EXCEPT immediately following the $6 code itself If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Or _ InStr(sSubfield6Code$, "/r") > 0 Then ' set IncludeFormattingCharactersLcPattern = True to insert UFCs ' 20070830: Bucknum code forces value of this here; but we think ' this should come from the configuration file ' instead, we're going to set directly what DB was using this ' as a proxy for 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = True bLcPattern = True With LocalMarcRecordObjectAlreadyLoadedWithRecord sRLM$ = .MarcRightToLeftMarker sLRE$ = .MarcLeftToRightEmbedding sPDF$ = .MarcPopDirectionalFormatting End With Else ' set IncludeFormattingCharactersLcPattern = False to not insert UFCs ' 20070830: Bucknum code forces value of this here; but we think ' this should come from the configuration file ' instead, we're going to leave sRLM at its ground state of null, ' which seems to be the point of all of this, anyway 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = False bLcPattern = False End If Else If gblaRomanizationTable(iScript%).V2RCreateEmptyFields = True Then bCreateEmptyFields = True End If End If ' go through the record one field at a time ' if the field contains vernacular data, copy the field to 880 and create the ' parallel normal field with romanized vernacular data ' if the field contains no vernacular data, copy the field to 880, converting ' romanized text to vernacular as you go LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveNext DoEvents If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDeleted Then If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman Then If InStr(gblaRomanizationTable(iScript%).V2RFieldsIncluded, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag) = 0 Then 'Debug.Print LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + " field excluded V2$" GoTo RomanAssist_WholeRecordNextField End If sSubfieldsExcludedUniversally$ = gblaRomanizationTable(iScript%).V2RSubfieldsAlwaysExcluded sSubfieldsExcludedByTag$ = gblaRomanizationTable(iScript%).V2ROtherSubfieldsExcludedByTag Else If InStr(gblaRomanizationTable(iScript%).R2VFieldsIncluded, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag) = 0 Then GoTo RomanAssist_WholeRecordNextField End If sSubfieldsExcludedUniversally$ = gblaRomanizationTable(iScript%).R2VSubfieldsAlwaysExcluded sSubfieldsExcludedByTag$ = gblaRomanizationTable(iScript%).R2VOtherSubfieldsExcludedByTag End If sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag sNewField$ = "" sOldField$ = "" LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst Do ' 20070710: add RLMs before and after the delimiter/subfield codes, ' as appropriate, but *only* if the Right2LeftMark variable is set ' 20070713: add a LeftToRightEmbedding character (LRE) only ' before the 880 $6 260-xx $c [dates] - a PDF is added below ' 20121121: added 264 (RDA) to logic If bLcPattern Then sNewField$ = sNewField$ + sRLM$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + sRLM$ If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then sNewField$ = sNewField$ + sLRE$ End If Else sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode End If sOldField$ = sOldField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText If bCreateEmpty880s Or bCreateEmptyFields Then ' added 20070308 by David Bucknum #If True Then ' replacement proposed by Bucknum ' include this subfield, but change it to a plus sign ' if the 260 $c contains an ending period, add it for PDF processing ' 20121121: added 264 (RDA) to logic If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" And Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, 1) = "." Then sNewField$ = sNewField$ + "+." Else sNewField$ = sNewField$ + "+" End If #Else ' include this subfield without attampting to change it sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText #End If ElseIf InStr(sSubfieldsExcludedUniversally$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) > 0 Then ' include this subfield attempting to change it sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText ElseIf InStr(sSubfieldsExcludedByTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "/" + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) > 0 Then ' include this subfield without attampting to change it sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText Else ' we attempt to change this subfield Select Case iDirection% ' EvaluateFirstCharacter(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcCharacterObject) Case ROMANIZATIONDIRECTION_Vernacular2Roman%, ROMANIZATIONDIRECTION_Roman2Vernacular% If LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "a" Then sSfd$ = ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%) 'Debug.Print "Subfield changed: >" + sSfd$ + "<" If sSfd$ <> LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText Then sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) Else sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) End If Else sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) End If Case Else sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText End Select End If ' 20070713: add a POPDirectionalFormatting character (PDF) only ' at the end of the 880 $6 260-xx $c [dates] - an LRE is added above ' 20121121: added 264 (RDA) to logic If bLcPattern Then If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then ' if the subfield ends with a period, place the period after the PDF If Right(sNewField$, 1) = "." Then sNewField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sNewField$, InStrRev(sNewField$, "."), 1, sPDF$ + ".") Else sNewField$ = sNewField$ + sPDF$ End If End If End If If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then Exit Do End If Loop sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified) If sTag$ >= 600 And sTag$ <= 651 Then s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4" Else s880Indicators$ = sIndicators$ End If If bCreateEmpty880s Then ' we're only creating an "empty" 880 field iNext6% = iNext6% + 1 If Len(sNewFields$) > 0 Then sNewFields$ = sNewFields$ + vbLf sOldFields$ = sOldFields$ + vbLf End If ' 20070425 script code added if available (only available if roman-to-vernacular) #If True Then ' changed 20070308 by David Bucknum ' use this line if you want a truly empty 880 field *OR* fields with "+" as subfield text If bLcPattern Then sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sRLM$ + sNewField$ Else sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sNewField$ End If #Else ' use this line if you want the 880 field to start out with text as given in the original field If bLcPattern Then sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sRLM$ + sOldField$ Else sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sOldField$ End If #End If sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$ ElseIf bCreateEmptyFields Then ' we're only creating an "empty" romanized field iNext6% = iNext6% + 1 If Len(sNewFields$) > 0 Then sNewFields$ = sNewFields$ + vbLf sOldFields$ = sOldFields$ + vbLf End If #If True Then ' changed 20090524 by David Bucknum ' use this line if you want a truly empty romanized field *OR* fields with "+" as subfield text sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$ #Else ' use this line if you want the 880 field to start out with text as given in the original field sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$ #End If sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$ Else If sNewField$ <> sOldField$ Then ' we changed *something*! iNext6% = iNext6% + 1 If Len(sNewFields$) > 0 Then sNewFields$ = sNewFields$ + vbLf sOldFields$ = sOldFields$ + vbLf End If If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$ sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$ Else sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$ sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$ End If End If End If End If RomanAssist_WholeRecordNextField: Loop Do While Len(sOldFields$) > 0 DoEvents GetNextPiece sOldFields$, sField$, vbLf If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then GetNextPiece sField$, sTag$, vbTab LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = Val(sTag$) LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDelete LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", Mid(sField$, 1, 2), Mid(sField$, 3) Else GetNextPiece sField$, sTag$, vbTab LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = Val(sTag$) ' 20100809 Bucknum added: remove temporary VowelMarker character before export If LenB(gblaRomanizationTable(iScript%).R2VVowelMarker) > 0 Then sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, gblaRomanizationTable(iScript%).R2VVowelMarker) End If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sField$ End If Loop Do While Len(sNewFields$) > 0 GetNextPiece sNewFields$, sField$, vbLf If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd Mid(sField$, 1, 3), Mid(sField$, 4, 2), LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(Mid(sField$, 6)) Else LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd Mid(sField$, 1, 3), Mid(sField$, 4, 2), Mid(sField$, 6) End If Loop ' 20070425 build an 066 if the script identification code is available ' only possible if building empty 880s and if roman-to-vernacular If bCreateEmpty880s And LenB(s066$) > 0 Then If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindFirst("066") Then LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "066", " ", s066$ End If End If End Function Public Sub ReRomanizeAdjustNonfilingIndicators(iScript%, ByVal sNonfilingTagString$, ByVal lPointerToOriginalField As Long, ByVal lPointerToNewField As Long, ByRef LocalMarcRecord As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass) Dim iNonfiling%, iNonfilingIndicator%, iRc%, iLen% Dim sOriginal$ With LocalMarcRecord .FldPointer = lPointerToOriginalField If .SfdFindFirst("a") Then If .FldTag = "880" Then If .SfdFindFirst("6") Then iRc% = InStr(sNonfilingTagString$, Mid(.SfdText, 1, 3)) End If .SfdFindFirst "a" Else iRc% = InStr(sNonfilingTagString$, .FldTag) End If If iRc% > 0 Then iNonfiling% = Val(Mid(sNonfilingTagString$, iRc% + 4, 1)) If iNonfiling% > 0 Then ' we're going to ignore nonfiling indicator values of 1, ' because they almost certainly refer to an error (such as ' skipping an opening quotation mark) iNonfilingIndicator% = Val(Mid(.FldInd, iNonfiling%, 1)) If iNonfilingIndicator% > 0 Then sOriginal$ = .SafeMid(.SfdText, 1, iNonfilingIndicator%) .FldPointer = lPointerToNewField If .SfdFindFirst("a") Then If Mid(.SfdText, 1, Len(sOriginal$)) <> sOriginal$ Then ' the beginning of subfield $a in the modified field is ' not same as the beginning of subfield $a in the original ' field: therefore, the current operation changed the value ' of subfield $a, and we need to address the problem of the ' initial articla ' at this point we have to know whether the conversion was ' vernacular-to-script or script-to-vernacular If .FldTag = "880" Then ' the tag of the new field is 880; therefore, the conversion ' was from romanized-to-vernacular; sOriginal$ contains the ' romanized form of the critical text sOriginal$ = ReRomanizeText("B", "500", sOriginal$, iScript%, LocalMarcRecord, LocalCharacterObject, ROMANIZATIONDIRECTION_Roman2Vernacular%) Else ' the tag of the new field is NOT 880; therefore, the conversion ' was from vernacular-to-romanized; sOriginal$ contains the ' romanized form of the critical text sOriginal$ = ReRomanizeText("B", "500", sOriginal$, iScript%, LocalMarcRecord, LocalCharacterObject, ROMANIZATIONDIRECTION_Vernacular2Roman%) End If If Mid(.SfdText, 1, Len(sOriginal$)) = sOriginal$ Then iLen% = .SafeLen(sOriginal$) If iLen% < 9 Then 'Debug.Print ">" + .FldInd + "< " + str(iNonfiling%) + " " + str(iLen%) .FldInd = .SafeStuff(.FldInd, iNonfiling%, 1, Trim(str(iLen%))) 'Debug.Print "After change: >" + .FldInd + "<" End If End If End If End If End If End If End If End If End With End Sub Public Function Language2ScriptCode(ByVal sLanguageCode$) As String Select Case sLanguageCode$ ' Case "" ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicAsG0$ Case "heb", "yid" Language2ScriptCode = CHARACTERSET_CODES_FOR_880_HebrewAsG0$ Case "bel", "mac", "rus", "scc", "ukr" Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicCyrillicAsG0$ Case "ara", "per", "urd" Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ Case "gre" Language2ScriptCode = CHARACTERSET_CODES_FOR_880_GreekAsG0$ Case "chi", "jap", "kor" Language2ScriptCode = CHARACTERSET_CODES_FOR_880_CJKAsG0$ ' don't know which, if any, languages belong here by default: ' Case "" ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedCyrillicAsG1$ ' Case "" ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedArabicAsG1$ ' Case "" ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedLatinAsG1$ Case Else Language2ScriptCode = "" End Select End Function Public Function ReSequencePairedFields(ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass) Dim iCtr% Dim lPtr& Dim sSfdText$ Dim bMatchFound As Boolean gbliReSequenceTableLast% = 0 With LocalMarcRecordObjectAlreadyLoadedWithRecord ' loop through record to find non-880s with subfield $6 .FldMoveTop Do While .FldMoveNext ' create array of non-880 fields with subfield $6 ' with new consecutive sequence numbers If .FldTag <> "880" Then If .SfdFindFirst("6") = True Then If Mid$(.SfdText, 5, 2) <> "00" Then gbliReSequenceTableLast% = gbliReSequenceTableLast% + 1 ReDim Preserve gblaReSequenceTable(gbliReSequenceTableLast%) gblaReSequenceTable(gbliReSequenceTableLast%).Tag = .FldTag gblaReSequenceTable(gbliReSequenceTableLast%).Field = .FldText gblaReSequenceTable(gbliReSequenceTableLast%).Sequence = gbliReSequenceTableLast% ' "00" (non-paired) should not appear in a non-880 subfield $6 ' but we'll not delete it for now ' Else: .SfdDelete End If End If End If Loop ' cannot resequence, if no non-880 subfield $6s are found If gbliReSequenceTableLast% = 0 Then Exit Function ' loop through the record again to match 880s with non-880s .FldMoveTop Do While .FldMoveNext ' add paired and non-paired 880s to the array If .FldTag = "880" Then If .SfdFindFirst("6") = True Then ' make sure 880 $6 6xx-xx 2nd indicators are set to "4" (source not specified) If Mid$(.SfdText, 1, 3) >= 600 And Mid$(.SfdText, 1, 3) <= 651 Then .FldInd2 = "4" End If If Mid$(.SfdText, 5, 2) <> "00" Then bMatchFound = False For iCtr% = 1 To gbliReSequenceTableLast% ' first make sure the 880 sequence number is zero If gblaReSequenceTable(iCtr%).Sequence880 = 0 Then ' if there is a match, pair the sequence numbers ' add the link tag and field text for comparison later If Mid$(.SfdText, 1, 3) = gblaReSequenceTable(iCtr%).Tag Then gblaReSequenceTable(iCtr%).LinkTag = gblaReSequenceTable(iCtr%).Tag gblaReSequenceTable(iCtr%).Field880 = .FldText gblaReSequenceTable(iCtr%).Sequence880 = gblaReSequenceTable(iCtr%).Sequence bMatchFound = True Exit For End If End If Next ' iCtr% End If ' add non-paired 880s to the array with a "00" sequence number If bMatchFound = False Or Mid$(.SfdText, 5, 2) = "00" Then gbliReSequenceTableLast% = gbliReSequenceTableLast% + 1 ReDim Preserve gblaReSequenceTable(gbliReSequenceTableLast%) gblaReSequenceTable(gbliReSequenceTableLast%).Tag = .FldTag gblaReSequenceTable(gbliReSequenceTableLast%).Field = .FldText gblaReSequenceTable(gbliReSequenceTableLast%).Sequence = 0 gblaReSequenceTable(gbliReSequenceTableLast%).Sequence880 = 0 End If End If End If Loop ' loop through record again to resequence the paired fields .FldMoveTop Do While .FldMoveNext ' get field pointer lPtr& = .FldPointer If Val(.FldTag) > 99 Then If .SfdFindFirst("6") = True Then ' loop through the field/sequence array For iCtr% = 1 To gbliReSequenceTableLast% ' 20080826: compare the tags and field data, if matched, ' adjust the sequence numbers in the field, and ' delete the field data to prevent a rematch ' non-880s If .FldTag = gblaReSequenceTable(iCtr%).Tag And _ .FldText = gblaReSequenceTable(iCtr%).Field Then .SfdText = .SafeStuff(.SfdText, 5, 2, Right("00" & CStr(gblaReSequenceTable(iCtr%).Sequence), 2)) ' change field text to avoid re-matching an "empty" field (i.e. with "+" subfields) gblaReSequenceTable(iCtr%).Field = "" Exit For ' 880s ElseIf Mid$(.SfdText, 1, 3) = gblaReSequenceTable(iCtr%).LinkTag And _ .FldText = gblaReSequenceTable(iCtr%).Field880 Then .SfdText = .SafeStuff(.SfdText, 5, 2, Right("00" & CStr(gblaReSequenceTable(iCtr%).Sequence880), 2)) ' change field text to avoid re-matching an "empty" 880 (i.e. with "+" subfields) gblaReSequenceTable(iCtr%).Field880 = "" Exit For End If Next ' iCtr% End If End If ' reset field pointer .FldPointer = lPtr& Loop End With ' clear the array from memory Erase gblaReSequenceTable End Function Public Function AddCharSetCodes2Utf8Record(ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass, ByVal iScript%) Dim iPtr%, iCtr%, iNonfiling%, iIndicator% Dim bChanged As Boolean, bError As Boolean Dim sTag$, sIndicators$, sField$, sNonfiling$, sChar$ Dim sCharacterSetsPresent$, s066$, sSfd6$, sPiece$ Dim bLcPattern As Boolean If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Then bLcPattern = True With LocalMarcRecordObjectAlreadyLoadedWithRecord .FldMoveTop Do While .FldMoveNext iPtr% = .FldPointer ' remove any existing 066 fields, but *not* in records with "empty" 880s If .FldTag = "066" And gblaRomanizationTable(iScript%).R2VCreateEmpty880s = False Then .FldDelete ' get the $6, including script codes, using a fake Utf82Marc translation If .FldTag = "880" Then .FldLoadInfo sTag$, sIndicators$, sField$ .TranslateUtf82MarcOneField sCharacterSetsPresent$, sTag$, sField$, bChanged, bError If bChanged Then If .SfdFindFirst("6") = True And _ .ExtractSubfield(sField$, "6", sSfd6$) > 0 Then ' 20070710: add RLM to the end of subfield $6 in "empty" fields for R2L scripts If bLcPattern Or InStr(sSfd6$, "/r") > 0 Then sSfd6$ = sSfd6$ & .MarcRightToLeftMarker End If .SfdChange "6", sSfd6$ End If End If ' 20070710: check for and add the RLMs in the 880 fields for ' the R2L scripts, if they have not been inserted elsewhere If bLcPattern Or InStr(sSfd6$, "/r") > 0 Then .FldText = .TranslateMarc2Utf8OneFieldLcPattern("880", .FldText) ' remove any multiple UFCs from the field .FldText = .RemoveRepeatedCharacters(.FldText, .MarcRightToLeftMarker) .FldText = .RemoveRepeatedCharacters(.FldText, .MarcLeftToRightEmbedding) .FldText = .RemoveRepeatedCharacters(.FldText, .MarcPopDirectionalFormatting) End If End If .FldPointer = iPtr% Loop ' convert the string of codes representing character sets present in the record into ' an 066 field, and add it to or change it in the record, but *not* in records with "empty" 880s ' remove multiple spaces from the string sCharacterSetsPresent$ = .RemoveRepeatedCharacters(Trim(sCharacterSetsPresent$), " ") s066$ = .TranslateUtf82MarcCharacterSetString(sCharacterSetsPresent$, .MarcDelimiter + "c") If Len(s066$) > 0 Then If Not .FldFindFirst("066") Or gblaRomanizationTable(iScript%).R2VCreateEmpty880s = False Then .FldAddGeneric "066", " ", s066$, 3 ElseIf .FldText <> s066$ Then .FldChange "066", " ", s066$ End If End If End With End Function Public Function RomanizeConvertDecimalChars(ByVal sIn$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass) As String ' convert "&#\d{4,5}" numeric character references to the equivalent, leaving other stuff as you find it Dim lPtr As Long Dim sLeader$, sOriginal$, sHexChar$ Dim iDigits% Dim bShow As Boolean 'If InStr(sIn$, "&#") > 0 Then ' bShow = True ' sOriginal$ = sIn$ 'End If sLeader$ = "&#" Do lPtr = InStr(sIn$, sLeader$) Do While lPtr > 0 ' allow conversion of up to 5-digit character references iDigits% = Len(CStr(Val(Mid$(sIn$, lPtr + 2, 5)))) sHexChar$ = Hex$(Mid$(sIn$, lPtr + 2, iDigits%)) LocalCharacterObject.UcsHex = Right$(String$(4 - Len(sHexChar$), "0") & sHexChar$, 4) sIn$ = LocalMarcRecordObject.SafeStuff(sIn$, lPtr, iDigits% + 2, LocalCharacterObject.Utf8Char) lPtr = InStr(sIn$, sLeader$) Loop Select Case sLeader$ Case "&#" ' scossu: added a third backslash because 2 backslashes mess up syntax coloring in Vim. sLeader$ = "\\\" ' scossu: added a third backslash because 2 backslashes mess up syntax coloring in Vim. Case "\\\" Exit Do End Select Loop RomanizeConvertDecimalChars = sIn$ End Function Public Function FindScriptByKeyPress(ByRef c As Control, ByRef KeyAscii As Integer) Dim cb As Long Dim FindString As String If KeyAscii < 32 Or KeyAscii > 127 Then Exit Function If c.SelLength = 0 Then FindString = c.Text & Chr$(KeyAscii) Else FindString = Left$(c.Text, c.SelStart) & Chr$(KeyAscii) End If cb = SendMessage(c.hWnd, CB_FINDSTRING, -1, ByVal FindString) If cb <> CB_ERR Then c.ListIndex = cb c.SelStart = Len(FindString) c.SelLength = Len(c.Text) - c.SelStart End If KeyAscii = 0 End Function Public Function IsFontInstalled(FontName As String) As Boolean ' Returns true in function name ' if parameter font name exists Dim oFont As New StdFont On Error Resume Next IsFontInstalled = False If LenB(FontName) > 0 Then With oFont .Name = FontName If StrComp(FontName, .Name, vbTextCompare) = 0 Then IsFontInstalled = True End With End If Set oFont = Nothing End Function Public Function CreateRomanizationScriptList(ByRef sConfigurationFilePath$, ByRef sScripts2Load As String) Dim sMasterFile$, sFile$ Dim sScripts2LoadList$() Dim iCtr%, iPtr% Dim bLoadAllScripts As Boolean sMasterFile$ = sConfigurationFilePath$ + "RomanizationMaster.cfg" If sScripts2Load$ = vbNullString Then bLoadAllScripts = True Else sScripts2LoadList$() = Split(sScripts2Load$) End If gbliRomanizationScriptLast% = 0 gbliRomanizationTablesBytes# = 0 Do iCtr% = gbliRomanizationScriptLast% + 1 sFile$ = ReadIniFileOrNothing(sMasterFile$, "Files", Trim(str(iCtr%)), 250) If LenB(sFile$) = 0 Then Exit Do gbliRomanizationScriptLast% = gbliRomanizationScriptLast% + 1 ReDim Preserve gblaRomanizationScript(gbliRomanizationScriptLast%) If InStr(sFile$, "\") = 0 Then If LenB(Dir$(sConfigurationFilePath$ + sFile$)) Then gblaRomanizationScript(gbliRomanizationScriptLast%).Name = ReadIniFileOrNothing(sConfigurationFilePath$ + sFile$, "General", "Name", 100) gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize = FileLen(sConfigurationFilePath$ + sFile$) End If Else If LenB(Dir$(sFile$)) Then gblaRomanizationScript(gbliRomanizationScriptLast%).Name = ReadIniFileOrNothing(sFile$, "General", "Name", 100) gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize = FileLen(sFile$) End If End If If bLoadAllScripts Then gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = True gbliRomanizationTablesBytes# = gbliRomanizationTablesBytes# + gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize Else gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = False For iPtr% = 0 To UBound(sScripts2LoadList$) If CInt(sScripts2LoadList$(iPtr%)) = gbliRomanizationScriptLast% Then gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = True gbliRomanizationTablesBytes# = gbliRomanizationTablesBytes# + gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize End If Next ' iPtr% End If Loop End Function Public Sub LoadRomanizationTablesProgress(l As Long, ProgressBarCtrl As Control) If ProgressBarCtrl.Value < (ProgressBarCtrl.Max - l) Then ProgressBarCtrl.Value = ProgressBarCtrl.Value + l End If End Sub