ReRomanizeRecord_nodbug.bas 193 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423
  1. Attribute VB_Name = "ReRomanize"
  2. Option Explicit
  3. #Const EvaluateFirstCharacterDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1
  4. #Const FindFieldCurrentlyPointedToDebug = 0 ' -1
  5. #Const ReRomanizeAdjustNFIDebug = 0 ' -1
  6. #Const ReRomanizeTextDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1
  7. #Const ReRomanizeTextDetailsDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1
  8. #Const ReRomanizeTextDetailsBasicsDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1
  9. #Const RomanizationAssistanceDebug = 0 ' -1 ' 0 ' -1 ' 0 ' -1 ' 0 ' -1
  10. #Const RomanizeHighlightedTextDebug = 0 ' -1
  11. #Const RomanizeWholeRecordDebug = 0 ' -1 ' 0 '-1
  12. ' 20180926 Bucknum: added Unicode-compliant font constants for RTF formatting
  13. Private Const ArialUnicodeMS$ = "Arial Unicode MS" ' Monotype
  14. Private Const LucidaSansUnicode$ = "Lucida Sans Unicode" ' Microsoft
  15. Private Const NotoSans$ = "Noto Sans" ' Google
  16. Private Const NotoSerif$ = "Noto Serif" ' Google
  17. Private Const TextFormattedDefaultFont$ = ArialUnicodeMS$
  18. Private Const sAuthorityNonfilingString$ = "130:2 430:2 530:2"
  19. Private Const sBibliographicNonfilingString$ = "130:1 240:2 242:2 243:2 245:2 440:2 630:1 730:1 740:1 830:2"
  20. Private Const sCommunityInfoNonfilingString$ = "245:2 440:2 630:1 730:1 740:1"
  21. Private prvsRightToLeftMarker$, prvsLeftToRightMarker$
  22. Private Const CHARACTERSET_CODES_FOR_880_BasicAsG0$ = "(B"
  23. Private Const CHARACTERSET_CODES_FOR_880_HebrewAsG0$ = "(2"
  24. Private Const CHARACTERSET_CODES_FOR_880_BasicCyrillicAsG0$ = "(N"
  25. Private Const CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ = "(3"
  26. Private Const CHARACTERSET_CODES_FOR_880_GreekAsG0$ = "(S"
  27. Private Const CHARACTERSET_CODES_FOR_880_CJKAsG0$ = "$1"
  28. Private Const CHARACTERSET_CODES_FOR_880_ExtendedCyrillicAsG1$ = ")Q"
  29. Private Const CHARACTERSET_CODES_FOR_880_ExtendedArabicAsG1$ = ")4"
  30. Private Const CHARACTERSET_CODES_FOR_880_ExtendedLatinAsG1$ = ")!E"
  31. ' convert this constant into its ASCII value subtract 48; and multiply this
  32. ' remainder by 6 to transform it into an offset into the following hyphen-delimited string
  33. ' the first character (0) is the MARC-8'code table' number; same as above, with extensions
  34. ' the second character (1) is the code to use for the set in non-880 fields after escape ("?"=illegal in non-880);
  35. ' 4rd-5th chars (3-4) are the code to use after escape in 880 field
  36. ' ignore other characters--turned out not to be needed
  37. ' 1 2 3 4 5 6 7 8 9 : ;
  38. ' 012345 012345 012345 012345 012345 012345 012345 012345 012345 012345 012345
  39. Private Const CharSetU2MTranslation$ = "*****-1s s -2g*g *-3b b -4p p -5? (2 -6? (N -7? (3 -8g*(S*-9? $1 -:? (Q -;? (4 "
  40. Global Const ROMANIZATIONACTION_DisplayMarcRecord% = 1
  41. Global Const ROMANIZATIONACTION_RomanizeHighlightedText% = 2
  42. Global Const ROMANIZATIONACTION_RomanizeWholeRecord% = 3
  43. Global Const ROMANIZATIONACTION_UCaseWord% = 4
  44. Global Const ROMANIZATIONACTION_LCaseWord% = 5
  45. Global Const ROMANIZATIONACTION_ReplaceText% = 6
  46. Global Const ROMANIZATIONACTION_UCaseEach% = 7
  47. Global Const ROMANIZATIONACTION_Define% = 8
  48. Enum RomanizationAction
  49. DefineSubstitution = ROMANIZATIONACTION_Define%
  50. DisplayMarcRecord = ROMANIZATIONACTION_DisplayMarcRecord%
  51. LowercaseWord = ROMANIZATIONACTION_LCaseWord%
  52. ReplaceText = ROMANIZATIONACTION_ReplaceText%
  53. RomanizeHighlightedText = ROMANIZATIONACTION_RomanizeHighlightedText%
  54. RomanizeWholeRecord = ROMANIZATIONACTION_RomanizeWholeRecord%
  55. UppercaseWord = ROMANIZATIONACTION_UCaseWord%
  56. UppercaseEachWord = ROMANIZATIONACTION_UCaseEach%
  57. End Enum
  58. Global Const ROMANIZATIONRESULT_Success% = 0
  59. Global Const ROMANIZATIONRESULT_TextNotHighlighted% = 1
  60. Global Const ROMANIZATIONRESULT_HighlightedTextBecomesNothing% = 2
  61. Global Const ROMANIZATIONRESULT_TextNotFindable% = 3
  62. Global Const ROMANIZATIONRESULT_ActionUnclear% = 4
  63. Global Const ROMANIZATIONRESULT_FieldNotFound% = 5
  64. Global Const ROMANIZATIONRESULT_880WithNoSubfield6% = 6
  65. Global Const ROMANIZATIONRESULT_880NotAllowed% = 7
  66. Global Const ROMANIZATIONRESULT_880AlreadyPresent% = 8
  67. Global Const ROMANIZATIONRESULT_NoCharacterToDefine% = 9
  68. Global Const ROMANIZATIONRESULT_FileOpen% = 10
  69. Global Const ROMANIZATIONDIRECTION_Unknown% = 0
  70. Global Const ROMANIZATIONDIRECTION_Roman2Vernacular% = 1
  71. Global Const ROMANIZATIONDIRECTION_Vernacular2Roman% = 2
  72. Type ROMANIZATIONDETAILTYPE
  73. FullString As String
  74. Equivalent As String
  75. EquivalentUpperCase As String
  76. FullStringLengthInCharacters As Integer
  77. FullStringLengthInBytes As Integer
  78. EquivalentUpperCasePresent As Boolean
  79. InitialOnly As Boolean
  80. TerminalOnly As Boolean
  81. MedialOnly As Boolean
  82. End Type
  83. Type ROMANIZATIONDETAILARRAY
  84. Detail() As ROMANIZATIONDETAILTYPE
  85. DetailLast As Long
  86. DetailMax As Long
  87. End Type
  88. Type ROMANIZATIONTABLETYPE
  89. Vernacular2Roman As Object
  90. Roman2Vernacular As Object
  91. Name As String
  92. FullFileName As String
  93. Vernacular() As ROMANIZATIONDETAILARRAY
  94. Roman() As ROMANIZATIONDETAILARRAY
  95. VernacularLast As Long
  96. VernacularMax As Long
  97. RomanLast As Long
  98. RomanMax As Long
  99. AllowCaseVariation As Boolean
  100. AllowDefineButton As Boolean
  101. ApostropheCharacters As String
  102. ApostropheCharactersPresent As Boolean
  103. BySyllables As Boolean
  104. DoNotUse880Field As Boolean
  105. FontName As String
  106. NoRomanization As Boolean
  107. ' things that pertain only to romanized-to-vernacular
  108. R2VCreateEmpty880s As Boolean
  109. R2VFieldsIncluded As String
  110. R2VIncludeFormattingCharactersLcPattern As Boolean
  111. R2VOtherSubfieldsExcludedByTag As String
  112. R2VSubfieldsAlwaysExcluded As String
  113. R2VSubfield6Code As String
  114. R2VVowelMarker As String
  115. ' things that pertain only to vernacular-to-romanized
  116. V2RCreateEmptyFields As Boolean
  117. V2RFieldsIncluded As String
  118. V2ROtherSubfieldsExcludedByTag As String
  119. V2RSubfieldsAlwaysExcluded As String
  120. V2RUppercaseFirstCharacterInSubfield As String
  121. V2RPersonalNameUppercase As Boolean
  122. End Type
  123. Type RESEQUENCETABLETYPE
  124. Tag As String * 3
  125. LinkTag As String * 3
  126. Field As String
  127. Field880 As String
  128. Sequence As Integer
  129. Sequence880 As Integer
  130. End Type
  131. Public Type ROMANIZATIONSCRIPTTYPE
  132. Name As String
  133. LoadScript As Boolean
  134. FileSize As Long
  135. End Type
  136. Global gblaReSequenceTable() As RESEQUENCETABLETYPE
  137. Global gblaRomanizationScript() As ROMANIZATIONSCRIPTTYPE
  138. Global gblaRomanizationTable() As ROMANIZATIONTABLETYPE
  139. Global gbliReSequenceTableLast%
  140. Global gbliRomanizationScriptLast%
  141. Global gbliRomanizationTableLast%, gbliRomanizationTableMax%
  142. Global gbliRomanizationTablesBytes#
  143. 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
  144. Dim sOut$, sLeft$, sRight$, sWord$
  145. Dim iLength%
  146. Dim lPtr As Long, lLength As Long
  147. Dim bFound As Boolean
  148. On Error GoTo 0
  149. If iRomanizationTable% < 1 Or iRomanizationTable% > gbliRomanizationTableLast% Then
  150. sOut$ = sText$
  151. Else
  152. If iRomanizationDirection% = -1 Then
  153. iRomanizationDirection% = EvaluateFirstCharacter(sText$, iRomanizationTable%, LocalMarcCharacter)
  154. End If
  155. Select Case iRomanizationDirection%
  156. Case ROMANIZATIONDIRECTION_Unknown%
  157. sOut$ = sText$
  158. Case ROMANIZATIONDIRECTION_Roman2Vernacular%
  159. sOut$ = ReRomanizeTextDetails(sText$, gblaRomanizationTable(iRomanizationTable%).Roman2Vernacular, gblaRomanizationTable(iRomanizationTable%).Roman(), LocalMarcRecordObject, LocalMarcCharacter, True, iRomanizationTable%)
  160. Case ROMANIZATIONDIRECTION_Vernacular2Roman%
  161. sOut$ = ReRomanizeTextDetails(sText$, gblaRomanizationTable(iRomanizationTable%).Vernacular2Roman, gblaRomanizationTable(iRomanizationTable%).Vernacular(), LocalMarcRecordObject, LocalMarcCharacter, False, iRomanizationTable%)
  162. If gblaRomanizationTable(iRomanizationTable%).V2RPersonalNameUppercase Then
  163. ' todo: in reality, we should *only* add the comma if the first
  164. ' indicator is one or two (regardless of indicator, we should
  165. ' uppercase every word in the string)
  166. Select Case sRecordType$
  167. Case "A"
  168. If InStr("100 400 500", sTag$) > 0 Then
  169. ReRomanizeTextPersonalNameHandling:
  170. lPtr = InStr(sOut$, LocalMarcRecordObject.MarcDelimiter + "a")
  171. If lPtr > 0 Then
  172. sLeft$ = Mid(sOut$, 1, lPtr + 1)
  173. sOut$ = Mid(sOut$, lPtr + 2)
  174. ElseIf Mid(sOut$, 1, 1) = LocalMarcRecordObject.MarcDelimiter Then
  175. GoTo ReRomanizeTextNoPNH
  176. Else
  177. sLeft$ = ""
  178. End If
  179. lPtr = InStr(sOut$, LocalMarcRecordObject.MarcDelimiter)
  180. If lPtr > 0 Then
  181. sRight$ = Mid(sOut$, lPtr)
  182. sOut$ = Mid(sOut$, 1, lPtr - 1)
  183. Else
  184. sRight$ = ""
  185. End If
  186. sOut$ = Trim(sOut$)
  187. ' first "word" in the heading remains as such
  188. lPtr = InStr(sOut$, " ")
  189. If lPtr > 0 Then
  190. sLeft$ = sLeft$ + LocalMarcRecordObject.UCaseFirstWord(Mid(sOut$, 1, lPtr - 1) + ",")
  191. sOut$ = Trim(Mid(sOut$, lPtr + 1))
  192. Do While Len(sOut$) > 0
  193. GetNextPiece sOut$, sWord$, " "
  194. sLeft$ = sLeft$ + " " + LocalMarcRecordObject.UCaseFirstWord(sWord$)
  195. Loop
  196. End If
  197. sOut$ = sLeft$ + sOut$ + sRight$
  198. End If
  199. ReRomanizeTextNoPNH: ' NOTE label in left margin
  200. Case "B"
  201. If InStr("100 400 600 700 800", sTag$) > 0 Then
  202. GoTo ReRomanizeTextPersonalNameHandling
  203. End If
  204. End Select
  205. End If
  206. If Len(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield) > 0 Then
  207. If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$) > 0 Then
  208. If InStr(sOut$, LocalMarcRecordObject.MarcDelimiter) > 0 Then
  209. ' potentially interesting
  210. For lPtr = Len(sOut$) - 2 To 1 Step -1
  211. If Mid(sOut$, lPtr, 1) = LocalMarcRecordObject.MarcDelimiter Then
  212. If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$ + "/" + Mid(sOut$, lPtr + 1, 1)) > 0 Then
  213. sOut$ = Mid(sOut$, 1, lPtr + 1) + LocalMarcRecordObject.UCaseFirstWord(Mid(sOut$, lPtr + 2))
  214. End If
  215. End If
  216. Next ' lptr
  217. ElseIf Len(sSubfieldCode$) > 0 Then
  218. If InStr(gblaRomanizationTable(iRomanizationTable%).V2RUppercaseFirstCharacterInSubfield, sTag$ + "/" + sSubfieldCode$) > 0 Then
  219. sOut$ = LocalMarcRecordObject.UCaseFirstWord(sOut$)
  220. End If
  221. End If
  222. End If
  223. End If
  224. End Select
  225. End If
  226. ReRomanizeText = LocalMarcRecordObject.RemoveRepeatedCharacters(sOut$, " ")
  227. 'DumpRomanizationTables
  228. End Function
  229. Public Sub LoadOneRomanizationTable(ByVal sFileNameIncludingPath$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass, ByRef sDefaultFieldsIncluded$, Optional ByRef ProgressBarCtrl As Control = Nothing)
  230. ' we're going to read the file line-by-line, even though it has the
  231. ' general appearance of an INI file, because it may be more than
  232. ' 32K (for Chinese)
  233. Dim iIn%, iMode%, iElement%, iRc%, iRc2%, iRc3%
  234. Dim sRight$, sLeft$, sUpperCase$, sTruncation$, sOriginal$
  235. Dim bLeft As Boolean, bRight As Boolean
  236. sTruncation$ = "%"
  237. iIn% = FreeFile
  238. On Error GoTo LRFT_FileOpenError
  239. Open sFileNameIncludingPath$ For Input As #iIn%
  240. On Error GoTo 0
  241. ' if we get this far we must have *something*
  242. gbliRomanizationTableLast% = gbliRomanizationTableLast% + 1
  243. If gbliRomanizationTableLast% > gbliRomanizationTableMax% Then
  244. gbliRomanizationTableMax% = gbliRomanizationTableMax% + 5
  245. ReDim Preserve gblaRomanizationTable(0 To gbliRomanizationTableMax%)
  246. End If
  247. With gblaRomanizationTable(gbliRomanizationTableLast%)
  248. ' save the file name, in case we need to add to it later
  249. .FullFileName = sFileNameIncludingPath$
  250. ' by default, include everything 100 through 840
  251. .R2VFieldsIncluded = sDefaultFieldsIncluded$
  252. .V2RFieldsIncluded = sDefaultFieldsIncluded$
  253. ' these subfields are always excluded
  254. .R2VSubfieldsAlwaysExcluded = "uvxy0123456789"
  255. .V2RSubfieldsAlwaysExcluded = "uvxy0123456789"
  256. ' there is no additional tag-based exclusion of subfields
  257. .R2VOtherSubfieldsExcludedByTag = ""
  258. .V2ROtherSubfieldsExcludedByTag = ""
  259. ' 20070703: added IncludeFormattingCharactersLcPattern; default False
  260. .R2VIncludeFormattingCharactersLcPattern = False
  261. ' set default script identification code
  262. .R2VSubfield6Code = ""
  263. ' 20100809 Bucknum added: VowelMarker
  264. ' set default script vowel marker
  265. .R2VVowelMarker = ""
  266. Set .Roman2Vernacular = CreateObject("Scripting.Dictionary")
  267. Set .Vernacular2Roman = CreateObject("Scripting.Dictionary")
  268. .AllowDefineButton = False
  269. .FontName = ""
  270. Do While Not EOF(iIn%)
  271. Line Input #iIn%, sRight$
  272. '20090322 added by Bucknum:
  273. 'monitor progress of romanization table load
  274. If Not ProgressBarCtrl Is Nothing Then
  275. DoEvents
  276. 'add 2 to the line input for line-feed characters
  277. LoadRomanizationTablesProgress Len(sRight$) + 2, ProgressBarCtrl
  278. End If
  279. If Len(sRight$) > 0 Then
  280. If Mid(sRight$, 1, 1) <> "#" Then
  281. If Mid(sRight$, 1, 1) = "[" Then
  282. Select Case Trim(UCase(sRight$))
  283. Case "[GENERAL]"
  284. iMode% = 1
  285. Case "[ROMANTOSCRIPT]"
  286. iMode% = 2
  287. Case "[SCRIPTTOROMAN]"
  288. iMode% = 3
  289. Case Else
  290. If .NoRomanization Then ' 20070830 added
  291. Exit Do
  292. End If
  293. iMode% = 4 ' we'll ignore all of this!
  294. End Select
  295. Else
  296. Select Case iMode%
  297. Case 1 ' general stanza: options and switches
  298. GetNextPiece sRight$, sLeft$, "="
  299. Select Case sLeft$
  300. Case "Name"
  301. .Name = sRight$
  302. Case "FontName"
  303. ' 20180928 added for font customization by language/script
  304. ' for Swiss-type, proportionally-spaced, sans-serif fonts
  305. .FontName = sRight$
  306. Case "NoRomanization"
  307. ' 20070830 added NoRomanization concept
  308. .NoRomanization = LocalMarcRecordObject.IsTrue(sRight$)
  309. Case "DoNotUse880Field"
  310. .DoNotUse880Field = LocalMarcRecordObject.IsTrue(sRight$)
  311. Case "AllowCaseVariation"
  312. .AllowCaseVariation = LocalMarcRecordObject.IsTrue(sRight$)
  313. Case "ApostropheCharacters"
  314. 'Debug.Print "RA 2"
  315. .ApostropheCharacters = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject)
  316. If Len(.ApostropheCharacters) > 0 Then
  317. .ApostropheCharactersPresent = True
  318. End If
  319. Case "AllowDefineButton"
  320. .AllowDefineButton = LocalMarcRecordObject.IsTrue(sRight$)
  321. Case "BySyllables"
  322. .BySyllables = LocalMarcRecordObject.IsTrue(sRight$)
  323. Case "Truncation"
  324. sTruncation$ = sRight$
  325. End Select
  326. Case 2 ' roman to vernacular script (including Wade-Giles to Pinyin)
  327. If InStr(sRight$, "=") > 0 Then
  328. GetNextPiece sRight$, sLeft$, "="
  329. Select Case sLeft$
  330. Case "FieldsIncluded"
  331. .R2VFieldsIncluded = sRight$
  332. GoTo LORT_NextLine
  333. Case "IncludeFormattingCharactersLcPattern"
  334. ' 20070703: added
  335. .R2VIncludeFormattingCharactersLcPattern = True
  336. GoTo LORT_NextLine
  337. Case "CreateEmpty880s"
  338. .R2VCreateEmpty880s = True
  339. GoTo LORT_NextLine
  340. Case "Subfield6Code"
  341. .R2VSubfield6Code = sRight$
  342. GoTo LORT_NextLine
  343. Case "SubfieldsAlwaysExcluded"
  344. .R2VSubfieldsAlwaysExcluded = sRight$
  345. GoTo LORT_NextLine
  346. Case "OtherSubfieldsExcludedByTag"
  347. .R2VOtherSubfieldsExcludedByTag = sRight$
  348. GoTo LORT_NextLine
  349. Case "VowelMarker"
  350. ' 20100809 Bucknum added:
  351. .R2VVowelMarker = sRight$
  352. GoTo LORT_NextLine
  353. End Select
  354. LORT_RTV_ContinueWithDividedLine: ' NOTE label in left margin
  355. bLeft = False
  356. bRight = False
  357. If Mid(sLeft$, 1, 1) = sTruncation$ Then
  358. bLeft = True
  359. sLeft$ = Mid(sLeft$, 2)
  360. End If
  361. If Right(sLeft$, 1) = sTruncation$ Then
  362. bRight = True
  363. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1)
  364. End If
  365. 'Debug.Print "RA 3"
  366. sRight$ = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject)
  367. sLeft$ = RomanizeConvertText(sLeft$, LocalMarcRecordObject, LocalCharacterObject)
  368. 'If Mid(sLeft$, 1, 1) = "v" Then
  369. ' Debug.Print "After 3: >" + sLeft$ + "< >" + sRight$ + "<"
  370. 'End If
  371. iRc% = InStr(sRight$, "/")
  372. If iRc% > 0 Then
  373. sUpperCase$ = Mid(sRight$, 1, iRc% - 1)
  374. sRight$ = Mid(sRight$, iRc% + 1)
  375. Else
  376. sUpperCase$ = ""
  377. End If
  378. LocalCharacterObject.Utf8Char = sLeft$ ' isolating the first character
  379. If .Roman2Vernacular.Exists(LocalCharacterObject.Utf8Char) Then
  380. iElement% = .Roman2Vernacular.item(LocalCharacterObject.Utf8Char)
  381. Else
  382. .RomanLast = .RomanLast + 1
  383. If .RomanLast > .RomanMax Then
  384. .RomanMax = .RomanMax + 10
  385. ReDim Preserve .Roman(0 To .RomanMax)
  386. End If
  387. iElement% = .RomanLast
  388. .Roman2Vernacular.Add LocalCharacterObject.Utf8Char, iElement%
  389. End If
  390. .Roman(iElement%).DetailLast = .Roman(iElement%).DetailLast + 1
  391. If .Roman(iElement%).DetailLast > .Roman(iElement%).DetailMax Then
  392. .Roman(iElement%).DetailMax = .Roman(iElement%).DetailMax + 5
  393. ReDim Preserve .Roman(iElement%).Detail(0 To .Roman(iElement%).DetailMax)
  394. End If
  395. If .AllowCaseVariation Then
  396. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString = LocalMarcRecordObject.SafeLCase(sLeft$)
  397. 'Debug.Print "Before and after: >" + sLeft$ + "< >" + .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString + "<"
  398. Else
  399. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullString = sLeft$
  400. End If
  401. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObject.SafeLen(sLeft$)
  402. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).FullStringLengthInBytes = Len(sLeft$)
  403. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).Equivalent = sRight$
  404. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCasePresent = False
  405. If Len(sUpperCase$) > 0 Then
  406. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCase = sUpperCase$
  407. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).EquivalentUpperCasePresent = True
  408. End If
  409. If bLeft Then
  410. If bRight Then
  411. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).MedialOnly = True
  412. Else
  413. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).TerminalOnly = True
  414. End If
  415. ElseIf bRight Then
  416. .Roman(iElement%).Detail(.Roman(iElement%).DetailLast).InitialOnly = True
  417. End If
  418. ElseIf InStr(sRight$, vbTab) > 0 Then
  419. GetNextPiece sRight$, sLeft$, vbTab
  420. GoTo LORT_RTV_ContinueWithDividedLine
  421. End If
  422. Case 3 ' vernacular script to roman
  423. If InStr(sRight$, "=") > 0 Then
  424. GetNextPiece sRight$, sLeft$, "="
  425. Select Case sLeft$
  426. Case "CreateEmptyFields" ' added 20070830
  427. .V2RCreateEmptyFields = True
  428. GoTo LORT_NextLine
  429. Case "FieldsIncluded"
  430. .V2RFieldsIncluded = sRight$
  431. GoTo LORT_NextLine
  432. Case "SubfieldsAlwaysExcluded"
  433. .V2RSubfieldsAlwaysExcluded = sRight$
  434. GoTo LORT_NextLine
  435. Case "OtherSubfieldsExcludedByTag"
  436. .V2ROtherSubfieldsExcludedByTag = sRight$
  437. GoTo LORT_NextLine
  438. Case "UppercaseFirstCharacterInSubfield"
  439. .V2RUppercaseFirstCharacterInSubfield = sRight$
  440. GoTo LORT_NextLine
  441. Case "PersonalNameHandling"
  442. .V2RPersonalNameUppercase = LocalMarcRecordObject.IsTrue(sRight$)
  443. GoTo LORT_NextLine
  444. End Select
  445. LORT_VTR_ContinueWithDividedLine:
  446. bLeft = False
  447. bRight = False
  448. If Mid(sLeft$, 1, 1) = sTruncation$ Then
  449. bLeft = True
  450. sLeft$ = Mid(sLeft$, 2)
  451. End If
  452. If Right(sLeft$, 1) = sTruncation$ Then
  453. bRight = True
  454. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1)
  455. End If
  456. 'Debug.Print "RA 4"
  457. sRight$ = RomanizeConvertText(sRight$, LocalMarcRecordObject, LocalCharacterObject)
  458. sLeft$ = RomanizeConvertText(sLeft$, LocalMarcRecordObject, LocalCharacterObject)
  459. iRc% = InStr(sRight$, "/")
  460. If iRc% > 0 Then
  461. sUpperCase$ = Mid(sRight$, 1, iRc% - 1)
  462. sRight$ = Mid(sRight$, iRc% + 1)
  463. Else
  464. sUpperCase$ = ""
  465. End If
  466. LocalCharacterObject.Utf8Char = sLeft$ ' isolating the first character
  467. If .Vernacular2Roman.Exists(LocalCharacterObject.Utf8Char) Then
  468. iElement% = .Vernacular2Roman.item(LocalCharacterObject.Utf8Char)
  469. Else
  470. .VernacularLast = .VernacularLast + 1
  471. If .VernacularLast > .VernacularMax Then
  472. .VernacularMax = .VernacularMax + 10
  473. ReDim Preserve .Vernacular(0 To .VernacularMax)
  474. End If
  475. iElement% = .VernacularLast
  476. .Vernacular2Roman.Add LocalCharacterObject.Utf8Char, iElement%
  477. End If
  478. .Vernacular(iElement%).DetailLast = .Vernacular(iElement%).DetailLast + 1
  479. If .Vernacular(iElement%).DetailLast > .Vernacular(iElement%).DetailMax Then
  480. .Vernacular(iElement%).DetailMax = .Vernacular(iElement%).DetailMax + 5
  481. ReDim Preserve .Vernacular(iElement%).Detail(0 To .Vernacular(iElement%).DetailMax)
  482. End If
  483. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullString = sLeft$
  484. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObject.SafeLen(sLeft$)
  485. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).FullStringLengthInBytes = Len(sLeft$)
  486. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).Equivalent = sRight$
  487. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).EquivalentUpperCasePresent = False
  488. If bLeft Then
  489. If bRight Then
  490. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).MedialOnly = True
  491. Else
  492. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).TerminalOnly = True
  493. End If
  494. ElseIf bRight Then
  495. .Vernacular(iElement%).Detail(.Vernacular(iElement%).DetailLast).InitialOnly = True
  496. End If
  497. ' main condition is: contains equals sign?
  498. ElseIf InStr(sRight$, vbTab) > 0 Then
  499. GetNextPiece sRight$, sLeft$, vbTab
  500. GoTo LORT_VTR_ContinueWithDividedLine
  501. End If
  502. End Select
  503. End If
  504. End If
  505. End If
  506. LORT_NextLine:
  507. Loop
  508. If Len(.Name) = 0 Then
  509. .Name = "Unknown script #" + Trim(str(gbliRomanizationTableLast%))
  510. End If
  511. End With
  512. Close #iIn%
  513. LRFT_FileOpenErrorresume:
  514. Exit Sub
  515. LRFT_FileOpenError:
  516. Resume LRFT_FileOpenErrorresume
  517. End Sub
  518. Public Function RomanizeConvertText(ByVal sIn$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass) As String
  519. ' convert "&H notations to the equivalent, leaving other stuff as you find it
  520. Dim lPtr As Long
  521. Dim sLeader$, sOriginal$
  522. Dim bShow As Boolean
  523. ' If InStr(sIn$, "U+") > 0 Then
  524. ' bShow = True
  525. ' sOriginal$ = sIn$
  526. ' End If
  527. sIn$ = LocalMarcRecordObject.ReplaceCharacters(sIn$, "_", " ")
  528. sLeader$ = "&H"
  529. Do
  530. lPtr = InStr(sIn$, sLeader$)
  531. Do While lPtr > 0
  532. LocalCharacterObject.UcsHex = Mid(sIn$, lPtr + 2, 4)
  533. sIn$ = LocalMarcRecordObject.SafeStuff(sIn$, lPtr, 6, LocalCharacterObject.Utf8Char)
  534. lPtr = InStr(sIn$, sLeader$)
  535. Loop
  536. Select Case sLeader$
  537. Case "&H"
  538. sLeader$ = "U+"
  539. Case "U+"
  540. sLeader$ = "&x"
  541. Case "&x"
  542. sLeader$ = "&X"
  543. Case "&X"
  544. sLeader$ = "&h"
  545. Case "&h"
  546. Exit Do
  547. End Select
  548. Loop
  549. ' If bShow Then
  550. ' Debug.Print "RCT >" + sOriginal$ + "< >" + sIn$ + "<"
  551. ' End If
  552. RomanizeConvertText = sIn$
  553. End Function
  554. Public Sub LoadRomanizationTables(ByVal sConfigurationFilePath$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass, Optional ByRef ProgressBarCtrl As Control = Nothing)
  555. Dim sMasterFile$, sFile$, sDefaultFieldsIncluded$
  556. Dim iCtr%
  557. ' Static bLoaded As Boolean
  558. Dim bDebug As Boolean
  559. ' 20090322 changed by Bucknum:
  560. ' removed bLoaded to allow reloading tables
  561. ' If bLoaded Then
  562. ' Exit Sub
  563. ' End If
  564. 'prvsRightToLeftMarker$ , prvsLeftToRightMarker$
  565. 'prvsRightToLeftMarker$ = LocalMarcRecordObject.MarcRightToLeftMarker
  566. 'prvsLeftToRightMarker$ = LocalMarcRecordObject.MarcLeftToRightMarker
  567. For iCtr% = 100 To 840
  568. sDefaultFieldsIncluded$ = sDefaultFieldsIncluded$ + " " + Trim(str(iCtr%))
  569. Next ' irc%
  570. sMasterFile$ = sConfigurationFilePath$ + "RomanizationMaster.cfg"
  571. bDebug = LocalMarcRecordObject.IsTrue(ReadIniFile(sMasterFile$, "Files", "Debug", "False", 15))
  572. iCtr% = 1
  573. Do
  574. sFile$ = ReadIniFileOrNothing(sMasterFile$, "Files", Trim(str(iCtr%)), 250)
  575. If Len(sFile$) = 0 Then
  576. If bDebug Then
  577. MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sFile$ + "<"
  578. End If
  579. Exit Do
  580. End If
  581. If InStr(sFile$, "\") = 0 Then
  582. If LenB(Dir$(sConfigurationFilePath$ + sFile$)) > 0 And gblaRomanizationScript(iCtr%).LoadScript Then
  583. LoadOneRomanizationTable sConfigurationFilePath$ + sFile$, LocalMarcRecordObject, LocalCharacterObject, sDefaultFieldsIncluded$, ProgressBarCtrl
  584. If bDebug Then
  585. MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sConfigurationFilePath$ + sFile$ + "< vernacular entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).VernacularLast) + " roman entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).RomanLast)
  586. End If
  587. End If
  588. Else
  589. If LenB(Dir$(sFile$)) > 0 And gblaRomanizationScript(iCtr%).LoadScript Then
  590. LoadOneRomanizationTable sFile$, LocalMarcRecordObject, LocalCharacterObject, sDefaultFieldsIncluded$, ProgressBarCtrl
  591. If bDebug Then
  592. MsgBox "For " + Trim(str(iCtr%)) + " read: >" + sFile$ + "< vernacular entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).VernacularLast) + " roman entries " + str(gblaRomanizationTable(gbliRomanizationTableLast%).RomanLast)
  593. End If
  594. End If
  595. End If
  596. iCtr% = iCtr% + 1
  597. Loop
  598. ' bLoaded = True
  599. End Sub
  600. Public Sub DumpRomanizationTables()
  601. Dim iCtr%, iCtr2%, iCtr3%
  602. For iCtr% = 1 To gbliRomanizationTableLast%
  603. With gblaRomanizationTable(iCtr%)
  604. Debug.Print "Name: " + .Name
  605. Debug.Print "Roman to vernacular"
  606. For iCtr2% = 1 To .RomanLast
  607. With .Roman(iCtr2%)
  608. For iCtr3% = 1 To .DetailLast
  609. Debug.Print vbTab + .Detail(iCtr3%).FullString + vbTab + .Detail(iCtr3%).Equivalent
  610. Next ' ictr3%
  611. End With
  612. Next ' ictr2%
  613. Debug.Print "Vernacular to roman"
  614. For iCtr2% = 1 To .VernacularLast
  615. With .Vernacular(iCtr2%)
  616. For iCtr3% = 1 To .DetailLast
  617. Debug.Print vbTab + .Detail(iCtr3%).FullString + vbTab + .Detail(iCtr3%).Equivalent
  618. Next ' ictr3%
  619. End With
  620. Next ' ictr2%
  621. End With
  622. Next ' ictr%
  623. End Sub
  624. Public Sub LoadListOfScriptsIntoControl(ByRef c As Control)
  625. Dim iCtr%
  626. With c
  627. If c.style = vbListBoxCheckbox Then
  628. c.Clear
  629. For iCtr% = 1 To gbliRomanizationScriptLast%
  630. .AddItem gblaRomanizationScript(iCtr%).Name
  631. .Selected(iCtr% - 1) = gblaRomanizationScript(iCtr%).LoadScript
  632. Next ' ictr%
  633. Else
  634. If .ListCount = 0 Then
  635. For iCtr% = 1 To gbliRomanizationTableLast%
  636. .AddItem gblaRomanizationTable(iCtr%).Name
  637. Next ' ictr%
  638. If .ListCount > 0 Then
  639. .ListIndex = 0
  640. End If
  641. End If
  642. End If
  643. End With
  644. End Sub
  645. 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%)
  646. Dim iLen%, iLengthBeforeApostropheSubstitution%
  647. Dim lPtr As Long, lPtr2 As Long, lMember As Long, lCtr As Long, lEnd As Long
  648. Dim sOut$, sPreviousCharacter$, sSyllable$, sChar1$, sChar2$, sOriginalSyllable$
  649. Dim bFound As Boolean, bFirstCharacter As Boolean, bFirstCharacterIsUppercase As Boolean
  650. Dim bApostrophes As Boolean, bWholeThingIsUppercase As Boolean, bChanged As Boolean
  651. Dim bAllowCaseVariation
  652. ' we have to manipulate pointers directly, ourselves, because
  653. ' of varying character length
  654. lPtr = 1
  655. lEnd = Len(sText$)
  656. bApostrophes = gblaRomanizationTable(iRomanizationTable%).ApostropheCharactersPresent
  657. If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then
  658. bAllowCaseVariation = True
  659. End If
  660. If Not gblaRomanizationTable(iRomanizationTable%).BySyllables Then
  661. ' we're working by characters
  662. bFirstCharacter = True
  663. Do While lPtr <= lEnd
  664. bFound = False
  665. If lPtr > 1 Then
  666. sPreviousCharacter$ = LocalMarcCharacter.Utf8Char
  667. If sPreviousCharacter$ = " " Then
  668. bFirstCharacterIsUppercase = False
  669. End If
  670. End If
  671. LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr)
  672. ' 20061129: if we're going to be ignoring case, then
  673. ' convert to lowercase
  674. If bAllowCaseVariation Then
  675. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  676. LocalMarcCharacter.Utf8Char = LocalMarcRecordObject.SafeLCase(LocalMarcCharacter.Utf8Char)
  677. If bFirstCharacter Or sPreviousCharacter$ = " " Then
  678. bFirstCharacterIsUppercase = True
  679. End If
  680. End If
  681. End If
  682. If InStr("Lu Ll Lo", LocalMarcCharacter.Utf8CharCategory) > 0 Then
  683. bFirstCharacter = False
  684. End If
  685. If LocalMarcCharacter.Utf8Char = LocalMarcCharacter.MarcDelimiter Then
  686. sOut$ = sOut$ + Mid(sText$, lPtr, 2) ' delimiter and subfield code
  687. lPtr = lPtr + 1 ' we'll add one more at the bottom of the loop as per usual
  688. iLen% = 1 ' make sure we only skip one more!
  689. Else ' not at a delimiter: must be some character worthy of inspection
  690. iLen% = LocalMarcCharacter.Utf8CharOctets
  691. If oRomanizationTable.Exists(LocalMarcCharacter.Utf8Char) Then
  692. lMember = oRomanizationTable.item(LocalMarcCharacter.Utf8Char)
  693. With RomanizationTable(lMember)
  694. For lCtr = 1 To .DetailLast
  695. If .Detail(lCtr).InitialOnly Then
  696. ' 20100103 added by Bucknum:
  697. ' we are expecting more character(s) to follow, so the
  698. ' following 2 statements check for end of the word
  699. If lPtr + .Detail(lCtr).FullStringLengthInBytes >= lEnd Then
  700. ' this is the end of the word; so no dice
  701. GoTo RRTD_NextDetail
  702. ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then
  703. ' this is also the end of the word; so no dice
  704. GoTo RRTD_NextDetail
  705. ElseIf lPtr = 1 Then
  706. ' this is OK: first character in the string is taken
  707. ' to be start of a word
  708. ' 20180801: Bucknum added left bracket and parenthesis
  709. ElseIf InStr(" -""[(", Mid(sText$, lPtr - 1, 1)) > 0 Then
  710. ' this is OK, too: previous character is a word-breaker
  711. ' (following space, hyphen, quote, bracket or parenthesis), so current
  712. ' character is the first in this word
  713. ElseIf lPtr > 2 Then
  714. If Mid(sText$, lPtr - 2, 1) = LocalMarcRecordObject.MarcDelimiter Then
  715. ' this is OK, too: character is first in its subfield
  716. Else
  717. GoTo RRTD_NextDetail
  718. End If
  719. Else
  720. ' not at the beginning of a word
  721. GoTo RRTD_NextDetail
  722. End If
  723. ElseIf .Detail(lCtr).TerminalOnly Then
  724. ' 20070731: we were using iLen% here as the length; but we should be using
  725. ' the length of the character(s) in the defined terminal-only string
  726. ' (for example, the current character may be "o" but if we're looking for
  727. ' terminal "ot" then we need to compare and skip over 2 characters, not 1)
  728. ' fortunately, we already have FullStringLengthInBytes giving the length of
  729. ' the string to be found in the original record
  730. If lPtr + .Detail(lCtr).FullStringLengthInBytes > lEnd Then
  731. ' this is OK: must be last character in the string
  732. ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then
  733. ' this is OK, too: next character is a word-breaker,
  734. ' so current character is the last in this word
  735. Else
  736. ' not at the end of a word
  737. GoTo RRTD_NextDetail
  738. End If
  739. ' if we get here then we're at the end of the word and so ready
  740. ' to test the characters
  741. ElseIf .Detail(lCtr).MedialOnly Then
  742. ' can not be either the beginning or the ending of a word
  743. ' we'll simply reverse all of the above tests; in this case the
  744. ' leftovers are the things that aren't either beginning or
  745. ' end--they must be medial
  746. If lPtr = 1 Then
  747. ' initial: so no dice
  748. GoTo RRTD_NextDetail
  749. ElseIf InStr(" -""[(", Mid(sText$, lPtr - 1, 1)) > 0 Then
  750. ' initial (following space, hyphen, quote, bracket or parenthesis): so no dice
  751. ' 20180801: Bucknum added left bracket and parenthesis
  752. GoTo RRTD_NextDetail
  753. ElseIf lPtr > 2 Then
  754. If Mid(sText$, lPtr - 2, 1) = LocalMarcRecordObject.MarcDelimiter Then
  755. ' beginning of a subfield: so no dice
  756. GoTo RRTD_NextDetail
  757. End If
  758. ' 20070731: see comment above (at TerminalOnly) regarding the
  759. ' length to be used in the following 2 statements
  760. ElseIf lPtr + .Detail(lCtr).FullStringLengthInBytes >= lEnd Then
  761. ' this is the end of the word; so no dice
  762. GoTo RRTD_NextDetail
  763. ElseIf InStr(" -.?,;:!""])" + LocalMarcRecordObject.MarcDelimiter, Mid(sText$, lPtr + .Detail(lCtr).FullStringLengthInBytes, 1)) > 0 Then
  764. ' this is also the end of the word; so no dice
  765. GoTo RRTD_NextDetail
  766. End If
  767. ' if we get here, then we're somewhere within a word and ready to
  768. ' test the characters
  769. End If
  770. ' if we get here, either we don't care what position the character
  771. ' bears within its word, or whatever conditions were specified have
  772. ' been met
  773. If bRoman2Vernacular Then
  774. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  775. If Not bApostrophes Then
  776. If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then
  777. bFound = True
  778. If .Detail(lCtr).EquivalentUpperCasePresent Then
  779. If Len(sPreviousCharacter$) = 0 Then
  780. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  781. Else
  782. LocalMarcCharacter.Utf8Char = sPreviousCharacter$
  783. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  784. sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase
  785. Else
  786. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  787. End If
  788. End If
  789. bChanged = True
  790. iLen% = .Detail(lCtr).FullStringLengthInBytes
  791. Else
  792. If bFirstCharacterIsUppercase Then
  793. sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent)
  794. bFirstCharacterIsUppercase = False
  795. Else
  796. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  797. End If
  798. bChanged = True
  799. iLen% = .Detail(lCtr).FullStringLengthInBytes
  800. End If
  801. Exit For
  802. End If
  803. Else ' apostrophes were defined
  804. If ReRomanizeTextDetailsReplaceApostrophes(LocalMarcRecordObject.SafeUCase(LocalMarcRecordObject.SafeMid(sText, lPtr, .Detail(lCtr).FullStringLengthInCharacters)), iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%) = .Detail(lCtr).FullString Then
  805. bFound = True
  806. If .Detail(lCtr).EquivalentUpperCasePresent Then
  807. If Len(sPreviousCharacter$) = 0 Then
  808. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  809. Else
  810. LocalMarcCharacter.Utf8Char = sPreviousCharacter$
  811. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  812. sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase
  813. Else
  814. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  815. End If
  816. End If
  817. bChanged = True
  818. iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters
  819. Else
  820. If bFirstCharacterIsUppercase Then
  821. sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent)
  822. bFirstCharacterIsUppercase = False
  823. Else
  824. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  825. End If
  826. bChanged = True
  827. iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters
  828. End If
  829. Exit For
  830. End If
  831. End If
  832. Else ' category is not letter/uppercase
  833. If Not bApostrophes Then
  834. If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Or (bAllowCaseVariation And LCase(Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes)) = .Detail(lCtr).FullString) Then
  835. 'If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then
  836. bFound = True
  837. If .Detail(lCtr).EquivalentUpperCasePresent Then
  838. If Len(sPreviousCharacter$) = 0 Then
  839. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  840. Else
  841. LocalMarcCharacter.Utf8Char = sPreviousCharacter$
  842. 'Debug.Print "Previous " + sPreviousCharacter$ + " category " + LocalMarcCharacter.Utf8CharCategory
  843. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  844. sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase
  845. Else
  846. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  847. End If
  848. End If
  849. bChanged = True
  850. iLen% = .Detail(lCtr).FullStringLengthInBytes
  851. Else
  852. If bFirstCharacterIsUppercase Then
  853. sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent)
  854. bFirstCharacterIsUppercase = False
  855. Else
  856. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  857. End If
  858. bChanged = True
  859. iLen% = .Detail(lCtr).FullStringLengthInBytes
  860. End If
  861. Exit For
  862. End If
  863. Else ' apostrophes are defined
  864. If ReRomanizeTextDetailsReplaceApostrophes(LocalMarcRecordObject.SafeLCase(LocalMarcRecordObject.SafeMid(sText, lPtr, .Detail(lCtr).FullStringLengthInCharacters)), iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%) = .Detail(lCtr).FullString Then
  865. bFound = True
  866. If .Detail(lCtr).EquivalentUpperCasePresent Then
  867. If Len(sPreviousCharacter$) = 0 Then
  868. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  869. Else
  870. LocalMarcCharacter.Utf8Char = sPreviousCharacter$
  871. 'Debug.Print "Previous " + sPreviousCharacter$ + " category " + LocalMarcCharacter.Utf8CharCategory
  872. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  873. sOut$ = sOut$ + .Detail(lCtr).EquivalentUpperCase
  874. Else
  875. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  876. End If
  877. End If
  878. iLen% = iLengthBeforeApostropheSubstitution% '.Detail(lCtr).FullStringLengthInCharacters
  879. Else
  880. If bFirstCharacterIsUppercase Then
  881. sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent)
  882. bFirstCharacterIsUppercase = False
  883. Else
  884. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  885. End If
  886. iLen% = iLengthBeforeApostropheSubstitution% ' .Detail(lCtr).FullStringLengthInCharacters
  887. End If
  888. Exit For
  889. End If
  890. End If
  891. End If
  892. Else ' vernacular to roman
  893. 'Debug.Print "Considering " + str(.Detail(lCtr).FullStringLengthInBytes) + "< and >" + .Detail(lCtr).FullString + "<"
  894. If Mid(sText, lPtr, .Detail(lCtr).FullStringLengthInBytes) = .Detail(lCtr).FullString Then
  895. bFound = True
  896. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  897. iLen% = .Detail(lCtr).FullStringLengthInBytes
  898. If Right(sOut$, 1) = " " Then
  899. lPtr2 = lPtr + iLen%
  900. If lPtr2 <= lEnd Then
  901. LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr2)
  902. If Mid(LocalMarcCharacter.Utf8CharCategory, 1, 1) = "P" Then
  903. sOut$ = RTrim(sOut$)
  904. End If
  905. End If
  906. End If
  907. Exit For
  908. End If
  909. End If
  910. RRTD_NextDetail: ' NOTE label in left margin
  911. Next ' lctr
  912. End With
  913. Else
  914. bFound = False
  915. End If
  916. If Not bFound Then
  917. sOut$ = sOut$ + LocalMarcCharacter.Utf8Char
  918. End If
  919. 'Debug.Print "Disposition: " + str(bFound) + " >" + LocalMarcCharacter.Utf8Char + "< >" + sOut$ + "<"
  920. End If
  921. lPtr = lPtr + iLen%
  922. Loop
  923. 'Debug.Print "LC PATTERN? " + str(gblaRomanizationTable(iRomanizationTable%).R2VIncludeFormattingCharactersLcPattern) + " " + str(bChanged)
  924. ' 20070703: it seems simplest to throw this on at the end
  925. ' LC wants a RTL marker before and after each delimiter,
  926. ' EXCEPT immediately following the $6 marker itself
  927. ' note that this can ONLY apply to things done character-by-character; doesn't apply
  928. ' to "by syllables" (I think!)
  929. If gblaRomanizationTable(iRomanizationTable%).R2VIncludeFormattingCharactersLcPattern And bChanged Then
  930. For lPtr = Len(sOut$) - 1 To 1 Step -1
  931. If Mid(sOut$, lPtr, 1) = LocalMarcRecordObject.MarcDelimiter Then
  932. lPtr2 = InStr(Mid(sOut$, lPtr + 1), LocalMarcRecordObject.MarcDelimiter)
  933. 'Debug.Print "At delim: " + str(lPtr) + " " + str(lPtr2) + " >" + sOut$ + "< marker >" + LocalMarcRecordObject.MarcRightToLeftMarker + "< " + str(Len(LocalMarcRecordObject.MarcRightToLeftMarker))
  934. If lPtr2 <> 0 Then
  935. sOut$ = LocalMarcRecordObject.SafeStuff(sOut$, lPtr + lPtr2, 0, LocalMarcRecordObject.MarcRightToLeftMarker)
  936. End If
  937. ' there should not be a $6 in the text!
  938. If Mid(sOut$, lPtr + 1, 1) <> "6" Then
  939. sOut$ = LocalMarcRecordObject.SafeStuff(sOut$, lPtr + 2, 0, LocalMarcRecordObject.MarcRightToLeftMarker)
  940. End If
  941. 'Debug.Print "After: >" + sOut$ + "<"
  942. End If
  943. Next ' lptr
  944. End If
  945. Else ' we *are* proceeding by syllables
  946. ' move any troublesome lead characters to the output, so we end up pointed
  947. ' to the first "real" character in the first syllable--as close as we can
  948. ' determine it, anyway
  949. ' we'll include the apostrophe here, because it's only *internal* ones that
  950. ' we need to pay attention to
  951. ' todo: this might be better if done via the character object, and with
  952. ' character categories ...
  953. bFirstCharacter = True
  954. Do
  955. Select Case Mid(sText$, lPtr, 1)
  956. Case "-", " ", ".", ";", ":", "(", ")", "[", "]", "!", "?", "'", Chr(34)
  957. lPtr = lPtr + 1
  958. Case LocalMarcRecordObject.MarcDelimiter
  959. lPtr = lPtr + 2
  960. Case Else
  961. Exit Do
  962. End Select
  963. If lPtr > lEnd Then
  964. Exit Do
  965. End If
  966. Loop
  967. ' attach any skipped characters to the output
  968. If lPtr > 1 Then
  969. sOut$ = Mid(sText$, 1, lPtr - 1)
  970. End If
  971. ' when we arrive here, lPtr points to the first character of real interest
  972. Do While lPtr <= lEnd
  973. ' starting from the character pointed to by lPtr, which we will assume
  974. ' to be the first character in a "syllable", find the end of the
  975. ' next syllable
  976. iLen% = 0
  977. ' do NOT here break at a hyphen!
  978. For lPtr2 = lPtr + 1 To lEnd
  979. If InStr("- .;:)([]!?" + Chr(34) + LocalMarcRecordObject.MarcDelimiter, Mid(sText, lPtr2, 1)) > 0 Then
  980. iLen% = lPtr2 - lPtr
  981. Exit For
  982. End If
  983. Next ' lptr2
  984. ' if we didn't find any more words, we assume that
  985. ' we're at the end of the string altogether
  986. If iLen% = 0 Then
  987. iLen% = Len(Mid(sText$, lPtr))
  988. End If
  989. sSyllable$ = Mid(sText, lPtr, iLen%)
  990. If Right(sSyllable$, 1) = "'" Then
  991. iLen% = iLen% - 1
  992. lPtr2 = lPtr2 - 1
  993. sSyllable$ = Mid(sSyllable$, 1, Len(sSyllable$) - 1)
  994. End If
  995. sOriginalSyllable$ = sSyllable$
  996. ' in the next paragraph, we're determining whether the first character
  997. ' is uppercase, or the whole thing is uppercase--we'll preserve
  998. ' case in the finished string to the extent possible
  999. #If True Then
  1000. ' 20070109: paradigm changed (now much simpler); changed mostly because
  1001. ' the old one didn't work properly anyway
  1002. If sSyllable$ = LocalMarcRecordObject.SafeUCase(sSyllable$) Then
  1003. ' the only way this can happen is if it's all uppercase
  1004. bWholeThingIsUppercase = True
  1005. bFirstCharacterIsUppercase = False
  1006. If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then
  1007. sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$)
  1008. End If
  1009. ElseIf sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$) Then
  1010. bWholeThingIsUppercase = False
  1011. bFirstCharacterIsUppercase = False
  1012. Else
  1013. ' there is some difference between the lowercase and uppercase versions:
  1014. ' for Wade-Giles, we *should* be able to assume that the difference
  1015. ' is on the first character
  1016. bWholeThingIsUppercase = False
  1017. bFirstCharacterIsUppercase = True
  1018. If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then
  1019. sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$)
  1020. End If
  1021. End If
  1022. LocalMarcCharacter.Utf8Char = sSyllable$
  1023. #Else
  1024. ' get the first character of this syllable
  1025. LocalMarcCharacter.Utf8Char = sSyllable$
  1026. If gblaRomanizationTable(iRomanizationTable%).AllowCaseVariation Then
  1027. If LocalMarcCharacter.Utf8CharCategory = "Lu" Then
  1028. bFirstCharacterIsUppercase = True
  1029. bWholeThingIsUppercase = True
  1030. Do
  1031. sSyllable$ = Mid(sSyllable$, LocalMarcCharacter.Utf8CharOctets + 1)
  1032. If Len(sSyllable$) = 0 Then
  1033. Exit Do
  1034. End If
  1035. 'Debug.Print "Remaining syllable: >" + sSyllable$ + "<"
  1036. LocalMarcCharacter.Utf8Char = sSyllable$
  1037. 'Debug.Print "Category: >" + LocalMarcCharacter.Utf8CharCategory + "<"
  1038. If LocalMarcCharacter.Utf8CharCategory <> "Lu" Then
  1039. bWholeThingIsUppercase = False
  1040. Exit Do
  1041. End If
  1042. Loop
  1043. ' re-get the whole syllable
  1044. sSyllable$ = Mid(sText, lPtr, iLen%)
  1045. LocalMarcCharacter.Utf8Char = sSyllable$
  1046. End If
  1047. ' in any case, because case variation is allowed, we'll
  1048. ' convert the syllable to lowercase
  1049. sSyllable$ = LocalMarcRecordObject.SafeLCase(sSyllable$)
  1050. LocalMarcCharacter.Utf8Char = sSyllable$
  1051. End If
  1052. #End If ' alternative methods for determining casing of the existing syllable
  1053. ' deal with things that look like apostrophes
  1054. If bApostrophes Then
  1055. sSyllable$ = ReRomanizeTextDetailsReplaceApostrophes(sSyllable$, iRomanizationTable%, LocalMarcCharacter, iLengthBeforeApostropheSubstitution%)
  1056. End If
  1057. bFound = False
  1058. If oRomanizationTable.Exists(LocalMarcCharacter.Utf8Char) Then
  1059. lMember = oRomanizationTable.item(LocalMarcCharacter.Utf8Char)
  1060. With RomanizationTable(lMember)
  1061. For lCtr = 1 To .DetailLast
  1062. If bRoman2Vernacular Then
  1063. If sSyllable$ = .Detail(lCtr).FullString Then
  1064. bFound = True
  1065. If bWholeThingIsUppercase Then
  1066. sOut$ = sOut$ + LocalMarcRecordObject.SafeUCase(.Detail(lCtr).Equivalent)
  1067. bFirstCharacterIsUppercase = False
  1068. ElseIf bFirstCharacterIsUppercase Then
  1069. sOut$ = sOut$ + LocalMarcRecordObject.UCaseFirstWord(.Detail(lCtr).Equivalent)
  1070. bFirstCharacterIsUppercase = False
  1071. Else
  1072. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  1073. End If
  1074. Exit For
  1075. End If
  1076. Else ' vernacular to roman
  1077. If sSyllable$ = .Detail(lCtr).FullString Then
  1078. bFound = True
  1079. sOut$ = sOut$ + .Detail(lCtr).Equivalent
  1080. Exit For
  1081. End If
  1082. End If
  1083. Next ' lctr
  1084. End With
  1085. Else
  1086. sSyllable$ = sOriginalSyllable$
  1087. bFound = False
  1088. End If
  1089. If Not bFound Then
  1090. sOut$ = sOut$ + sSyllable$
  1091. End If
  1092. ' skip the syllable in input
  1093. lPtr = lPtr + iLen%
  1094. If lPtr > lEnd Then
  1095. ' no more input: all done
  1096. Exit Do
  1097. End If
  1098. ' move additional characters to the output string until
  1099. ' you hit the first that's not a "division" character
  1100. Do
  1101. Select Case Mid(sText$, lPtr, 1)
  1102. Case "-", " ", ".", ";", ":", "(", ")", "[", "]", "!", "?", "'", Chr(34)
  1103. sOut$ = sOut$ + Mid(sText$, lPtr, 1)
  1104. lPtr = lPtr + 1
  1105. If lPtr > lEnd Then
  1106. Exit Do
  1107. End If
  1108. Case LocalMarcRecordObject.MarcDelimiter
  1109. sOut$ = sOut$ + Mid(sText$, lPtr, 2)
  1110. lPtr = lPtr + 2
  1111. If lPtr > lEnd Then
  1112. Exit Do
  1113. End If
  1114. Case Else
  1115. Exit Do
  1116. End Select
  1117. Loop
  1118. If lPtr > lEnd Then
  1119. Exit Do
  1120. End If
  1121. Loop ' for each syllable
  1122. End If
  1123. 'DumpRomanizationTables
  1124. ReRomanizeTextDetails = sOut$
  1125. End Function
  1126. Public Function EvaluateFirstCharacter(ByVal sText$, ByVal iRomanizationTable%, ByRef LocalMarcCharacter As Utf8CharClass) As Integer
  1127. Dim lPtr As Long, lLength As Long
  1128. Dim iLength%
  1129. EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Unknown%
  1130. If iRomanizationTable% < 1 Or iRomanizationTable% > gbliRomanizationTableLast% Then
  1131. ' do nothing: already set to unknown
  1132. Else
  1133. With gblaRomanizationTable(iRomanizationTable%)
  1134. ' first determination: are we converting script from vernacular into
  1135. ' roman or from roman into vernacular: the first charcter will tell
  1136. ' us everything we need to know
  1137. lPtr = 1
  1138. lLength = Len(sText$)
  1139. Do While lPtr <= lLength
  1140. LocalMarcCharacter.Utf8Char = Mid(sText$, lPtr)
  1141. If LocalMarcCharacter.Utf8Char = LocalMarcCharacter.MarcDelimiter Then
  1142. ' we'll skip this, and the following character, but do nothing
  1143. ' about either of 'em
  1144. iLength% = 2
  1145. Else
  1146. iLength% = LocalMarcCharacter.Utf8CharOctets
  1147. #If EvaluateFirstCharacterDebug = -1 Then
  1148. Debug.Print "Char: >" + LocalMarcCharacter.Utf8Char + "< " + str(iLength%)
  1149. #End If
  1150. If .Roman2Vernacular.Exists(LocalMarcCharacter.Utf8Char) Then
  1151. EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Roman2Vernacular%
  1152. Exit Do
  1153. ElseIf .Vernacular2Roman.Exists(LocalMarcCharacter.Utf8Char) Then
  1154. EvaluateFirstCharacter = ROMANIZATIONDIRECTION_Vernacular2Roman%
  1155. Exit Do
  1156. End If
  1157. End If
  1158. lPtr = lPtr + iLength%
  1159. Loop
  1160. End With
  1161. End If
  1162. End Function
  1163. Public Function ReRomanizeTextDetailsReplaceApostrophes(ByVal sString$, ByVal iRomanizationTable%, ByRef LocalCharacterObject As Utf8CharClass, ByRef iLengthBeforeApostropheSubstitution%) As String
  1164. Dim lPtr As Long
  1165. Dim iLen%
  1166. Dim sSaveIncomingCharacter$, sOut$
  1167. 'Debug.Print "RRTDRA received: >" + sString$ + "<"
  1168. iLengthBeforeApostropheSubstitution% = Len(sString$)
  1169. If Not gblaRomanizationTable(iRomanizationTable%).ApostropheCharactersPresent Then
  1170. sOut$ = sString$
  1171. Else
  1172. sSaveIncomingCharacter$ = LocalCharacterObject.Utf8Char
  1173. lPtr = 1
  1174. Do While lPtr <= iLengthBeforeApostropheSubstitution%
  1175. LocalCharacterObject.Utf8Char = Mid(sString$, lPtr)
  1176. If InStr(gblaRomanizationTable(iRomanizationTable%).ApostropheCharacters, LocalCharacterObject.Utf8Char) > 0 Then
  1177. sOut$ = sOut$ + "'"
  1178. Else
  1179. sOut$ = sOut$ + LocalCharacterObject.Utf8Char
  1180. End If
  1181. lPtr = lPtr + LocalCharacterObject.Utf8CharOctets
  1182. Loop
  1183. LocalCharacterObject.Utf8Char = sSaveIncomingCharacter$
  1184. End If
  1185. ReRomanizeTextDetailsReplaceApostrophes = sOut$
  1186. 'Debug.Print "RRTDRA output: >" + sOut$ + "<"
  1187. End Function
  1188. 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
  1189. Dim sField$, sTag$, sTagToFind$, sIndicators$, s880Indicators$, sNative6$, s8806$, sLeftEnd$, sRecord$, sSubfield6Code$
  1190. Dim sSelText$, sLeft$, sLeft2$, sRight$, sRight2$, sRightAfterSelection$, sWholeField$
  1191. Dim sWord$, sNewField$, sOldField$, sFile$, sTempFile$, sLine$, sNewCharacter$
  1192. Dim sFieldRemainderRight$, sFieldRemainderLeft$, s6$, sOriginalField$, sType$
  1193. Dim sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$, sNewFields$, sOldFields$
  1194. Dim sSubfieldsExcludedUniversally$, sSubfieldsExcludedByTag$, sOriginalLeft$, sOriginalRight$
  1195. Dim sNonfilingString$, sIntermediate$
  1196. Dim sRLM$, sLRE$, sPDF$
  1197. Dim sRtfFontName$
  1198. Dim iRc%, iRc2%, iRepeat%, iNext6%, iRomanizationStyle%, iDirection%, iIn%, iOut%, iElement%
  1199. Dim iLen%
  1200. Dim lPtr As Long, lPtr2 As Long, lSelLength As Long, lSelStart As Long, lStart As Long
  1201. Dim lFldPointer As Long, lFldPointer2 As Long, lEnd As Long, lOriginalSelStart As Long
  1202. Dim bFound As Boolean, bSkipTagTest As Boolean, bStringHasTerminalSpace As Boolean
  1203. Dim bOnlyMarc8 As Boolean, bCreateEmpty880s As Boolean, bLcPattern As Boolean
  1204. 'Const sLineEnd = "\line"
  1205. Const sLineEnd$ = "\par"
  1206. Const iLineEndLen% = 5
  1207. ' 20180926 Bucknum: check for and use custom language/script font for RTF display
  1208. ' overrides the default Unicode font setting
  1209. sRtfFontName$ = gblaRomanizationTable(iScript%).FontName
  1210. If LenB(sRtfFontName$) = 0 Or Not IsFontInstalled(sRtfFontName$) Then
  1211. sRtfFontName$ = sFontNameForDisplay$
  1212. End If
  1213. If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then
  1214. ' 20070425: pick up a script identification code if it's been defined
  1215. ' otherwise, we'll attempt to match it to the language code in 008/35-37
  1216. ' we'll include this in $6 of "empty" 880 fields
  1217. ' 20070830: LC addition: if there is no such code, pick up
  1218. ' a transmogrification of the langauge code instead; area reorganized
  1219. sSubfield6Code$ = gblaRomanizationTable(iScript%).R2VSubfield6Code
  1220. If LenB(sSubfield6Code$) = 0 Then
  1221. sSubfield6Code$ = Language2ScriptCode(LocalMarcRecordObjectAlreadyLoadedWithRecord.Get008Value(35, 3))
  1222. End If
  1223. If LenB(sSubfield6Code$) > 0 Then
  1224. If sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_HebrewAsG0$ Or _
  1225. sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ Then
  1226. ' add R2L orientation code
  1227. sSubfield6Code$ = sSubfield6Code$ & "/r"
  1228. End If
  1229. ' add "/" prefix
  1230. sSubfield6Code$ = "/" + sSubfield6Code$
  1231. End If
  1232. End If
  1233. If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Or _
  1234. InStr(sSubfield6Code$, "/r") > 0 Then
  1235. ' set IncludeFormattingCharactersLcPattern = True to insert UFCs
  1236. ' 20070830: Bucknum code forces value of this here; but we think
  1237. ' this should come from the configuration file
  1238. ' instead, we're going to set directly what DB was using this
  1239. ' as a proxy for
  1240. 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = True
  1241. bLcPattern = True
  1242. ' 20070710: set a variable for the MarcRightToLeftMarker
  1243. ' LC wants a RTL marker before and after each delimiter,
  1244. ' EXCEPT immediately following the $6 code itself
  1245. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  1246. sRLM$ = .MarcRightToLeftMarker
  1247. sLRE$ = .MarcLeftToRightEmbedding
  1248. sPDF$ = .MarcPopDirectionalFormatting
  1249. End With
  1250. Else
  1251. ' set IncludeFormattingCharactersLcPattern = False to not insert UFCs
  1252. ' 20070830: Bucknum code forces value of this here; but we think
  1253. ' this should come from the configuration file
  1254. ' instead, we're going to leave sRLM at its ground state of null,
  1255. ' which seems to be the point of all of this, anyway
  1256. 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = False
  1257. bLcPattern = False
  1258. End If
  1259. sType$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRecordFormat
  1260. ' assume everything will be OK
  1261. RomanizationAssistance = ROMANIZATIONRESULT_Success%
  1262. Select Case iAction
  1263. Case ROMANIZATIONACTION_RomanizeHighlightedText%, ROMANIZATIONACTION_LCaseWord%, ROMANIZATIONACTION_UCaseWord%, ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_UCaseEach%, ROMANIZATIONACTION_Define%
  1264. ' 20070830: NoRomanization added
  1265. If gblaRomanizationTable(iScript%).NoRomanization Then
  1266. If iAction = ROMANIZATIONACTION_Define% Then
  1267. GoTo RomanizationAssistanceNoFileOpenResume
  1268. End If
  1269. End If
  1270. ' these have similar complicated beginnings, so we'll do some code-sharing
  1271. ' get the current state of the MARC record
  1272. ' isolate the selected text, remove any carriage returns and line feeds
  1273. sField$ = LocalRichTextBox.SelRTF
  1274. ' for some reason, delimiters are getting converted to something we don't recognize ...
  1275. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\'87", "\u8225?")
  1276. ' 20180926 added by Bucknum: for some reason, the rich text box is inserting alternating font codes
  1277. ' (e.g., "\f0") into the selected text, which is corrupting it, so we're going to strip them out
  1278. If InStr(sField$, "\f0 ") Or InStr(sField$, "\f1 ") Then
  1279. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\f0 "), "\f1 ")
  1280. ElseIf InStr(sField$, "\f0") Or InStr(sField$, "\f1") Then
  1281. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "\f0"), "\f1")
  1282. End If
  1283. 'Debug.Print "Initial extraction of field: >" + sField$ + "< len " + str(LocalRichTextBox.SelLength)
  1284. If Len(sField$) = 0 Or LocalRichTextBox.SelLength = 0 Then
  1285. 'Debug.Print "Action: " + str(ROMANIZATIONACTION_RomanizeHighlightedText%)
  1286. If iAction = ROMANIZATIONACTION_RomanizeHighlightedText% Then
  1287. ' 20070830: if we are clicked somewhere within a field and the selection length
  1288. ' is zero, we'll assume that what we really want to do is convert the
  1289. ' whole field
  1290. lPtr = FindFieldCurrentlyPointedTo(LocalRichTextBox, LocalMarcRecordObjectAlreadyLoadedWithRecord)
  1291. 'Debug.Print "Ptr: " + str(lPtr)
  1292. ' 20100402 changed by Bucknum to allow for returned default of -1 (i.e. no text selected):
  1293. 'If lPtr = 0 Then
  1294. If lPtr <= 0 Then
  1295. RomanizationAssistance = ROMANIZATIONRESULT_TextNotHighlighted%
  1296. Exit Function
  1297. End If
  1298. Else
  1299. RomanizationAssistance = ROMANIZATIONRESULT_TextNotHighlighted%
  1300. Exit Function
  1301. End If
  1302. ' if we get here, we've found the field of interest
  1303. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lPtr
  1304. sFieldRemainderLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd
  1305. sFieldRemainderRight$ = ""
  1306. sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText
  1307. ' 20100202 added by Bucknum: to enable
  1308. ' non-empty field transliteration below
  1309. sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag
  1310. sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd
  1311. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText
  1312. GoTo RA_WeHaveOurFieldTheEasyWay
  1313. End If
  1314. ' if we ended up with carriage returns or line feeds, remove them (inserting no space)
  1315. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, vbCr, ""), vbLf, "")
  1316. ' we'll use these two values in a bit, to find the field
  1317. ' within the non-RTF version of the record
  1318. ' NOTE that the TextRTF returns delimiters correctly (as opposed to SelRTF, as
  1319. ' shown above) so we don't need to do any conversion here; in any case, this
  1320. ' step appears to be irrelevant, because we replace this value of sRecord with
  1321. ' a fresh copy of the TextFormatted(rtf) version of the record before we
  1322. ' ever use sRecord for anything; go figure
  1323. ' see note below about the contents of SelStart for rich text boxes
  1324. lSelStart = LocalRichTextBox.SelStart
  1325. lOriginalSelStart = lSelStart
  1326. RomanizationAssistanceReloop:
  1327. sRecord$ = LocalRichTextBox.TextRTF
  1328. ' remove the closing brace from the selected text
  1329. If Right(sField$, 1) = "}" Then
  1330. sField$ = Mid(sField$, 1, Len(sField$) - 1)
  1331. End If
  1332. ' remove the RTF prefix from the selected text
  1333. iRc% = InStr(sField$, "}}")
  1334. If iRc% > 0 Then
  1335. sField$ = Trim(Mid(sField$, iRc% + 2))
  1336. End If
  1337. ' text should now start with some additional 'slash' commands, which
  1338. ' we will proceed to remove
  1339. Do While Mid(sField$, 1, 1) = "\"
  1340. If Mid(sField$, 1, 2) = "\u" Then
  1341. If InStr("0123456789", Mid(sField$, 3, 1)) > 0 Then
  1342. Exit Do
  1343. End If
  1344. End If
  1345. sField$ = Mid(sField$, 2)
  1346. iRc% = InStr(sField$, "\")
  1347. If iRc% = 0 Then
  1348. iRc% = InStr(sField$, " ")
  1349. If iRc% > 0 Then
  1350. sField$ = Mid(sField$, iRc% + 1)
  1351. Exit Do
  1352. End If
  1353. Else
  1354. iRc2% = InStr(sField$, " ")
  1355. If iRc2% > 0 Then
  1356. If iRc% < iRc2% Then
  1357. sField$ = Mid(sField$, iRc%)
  1358. Else
  1359. sField$ = Mid(sField$, iRc2% + 1)
  1360. Exit Do
  1361. End If
  1362. Else
  1363. sField$ = Mid(sField$, iRc%)
  1364. End If
  1365. End If
  1366. Loop
  1367. ' remove any trailing 'par' command
  1368. iRc% = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sField$, "\par")
  1369. If iRc% > 0 Then
  1370. sField$ = Mid(sField$, 1, iRc% - 1)
  1371. End If
  1372. If Len(sField$) = 0 Then
  1373. RomanizationAssistance = ROMANIZATIONRESULT_HighlightedTextBecomesNothing%
  1374. Exit Function
  1375. End If
  1376. ' wrapping spaces are irrelevant
  1377. sField$ = Trim(sField$)
  1378. ' we should now have the raw text of interest, isolated in sField$
  1379. ' oddly enough, the SelStart property of the rich text box
  1380. ' refers to the plain text version
  1381. ' of the field; there doesn't seem to be a corresponding SelStartRtf
  1382. ' or anything else useful; so we're going to use the supplied SelStart
  1383. ' property as a rough guide for finding the selection ourselves
  1384. ' remembering that SelStart is zero-based (so we don't have to back up 1
  1385. ' from lSelStart to find the "real" end of the preceding text, and we
  1386. ' have to add 1 to the combined start and length to find the beginning
  1387. ' of whatever follows the text (which is, from our point of view, possibly
  1388. ' irrelevant)
  1389. sFieldRemainderLeft$ = Mid(LocalRichTextBox.Text, 1, lSelStart)
  1390. lPtr = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sFieldRemainderLeft$, vbLf)
  1391. If lPtr > 0 Then
  1392. sFieldRemainderLeft$ = Trim(Mid(sFieldRemainderLeft$, lPtr + 1) + sField$)
  1393. sTagToFind$ = Mid(sFieldRemainderLeft$, 1, 3)
  1394. Else
  1395. RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable%
  1396. Exit Function
  1397. End If
  1398. Select Case LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRecordFormat
  1399. Case "A"
  1400. sNonfilingString$ = sAuthorityNonfilingString$
  1401. Case "B", "D", "F", "M", "P", "S", "U"
  1402. sNonfilingString$ = sBibliographicNonfilingString$
  1403. 'Case else: ignore the whole issue
  1404. End Select
  1405. ' to help us find the highlighted text within the record,
  1406. ' give us the RTF version of the whole MARC record again
  1407. ' we don't need to worry here about specification for fixed fields or
  1408. ' font size, because they don't affect what we're up to here
  1409. sRecord$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText)
  1410. lStart = 1
  1411. Do
  1412. ' find the next occurrence of our text in the record
  1413. lSelStart = InStr(lStart, sRecord$, sField$)
  1414. DoEvents
  1415. If lSelStart = 0 Then
  1416. If lStart = 1 Then
  1417. RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable%
  1418. Exit Function
  1419. End If
  1420. ' we found at least one place already; so let's back up to find
  1421. ' the first one (assuming that the first one is the right one!)
  1422. lSelStart = InStr(1, sRecord$, sField$)
  1423. If lSelStart = 0 Then
  1424. RomanizationAssistance = ROMANIZATIONRESULT_TextNotFindable%
  1425. Exit Function
  1426. End If
  1427. bSkipTagTest = True
  1428. Else
  1429. lStart = lSelStart + 1
  1430. End If
  1431. sLeft$ = Mid(sRecord$, 1, lSelStart - 1)
  1432. sRight$ = Mid(sRecord$, lSelStart + Len(sField$))
  1433. ' sLeft$ = all of the record up to our selected text
  1434. ' sRight$ = and all of the record that follows the selected text
  1435. ' we want to back up in sLeft to the beginning of the current "line" (i.e., variable field)
  1436. lSelStart = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sLeft$, sLineEnd$)
  1437. If lSelStart > 0 Then
  1438. sFieldRemainderLeft$ = LTrim(Mid(sLeft$, lSelStart + 5))
  1439. If Mid(sFieldRemainderLeft$, 1, 2) = "\f" Then
  1440. sLeft$ = sLeft$ + Mid(sFieldRemainderLeft$, 1, 4)
  1441. sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, 5)
  1442. End If
  1443. Else
  1444. sFieldRemainderLeft$ = ""
  1445. End If
  1446. If Mid(LTrim(sFieldRemainderLeft$ + sField$), 1, 3) = sTagToFind$ Or bSkipTagTest Then
  1447. ' we want to include from sRight any remainder of the current line (i.e., the
  1448. ' remainder of our variable field)
  1449. lSelStart = InStr(sRight$, sLineEnd$)
  1450. If lSelStart > 1 Then
  1451. sFieldRemainderRight$ = Mid(sRight$, 1, lSelStart - 1)
  1452. Else
  1453. sFieldRemainderRight$ = ""
  1454. End If
  1455. sFieldRemainderLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sFieldRemainderLeft$)
  1456. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sField$))
  1457. sFieldRemainderRight$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.TranslateRTF2Marc(sFieldRemainderRight$)
  1458. sWholeField$ = Trim(sFieldRemainderLeft$ + sField$ + sFieldRemainderRight$)
  1459. Exit Do
  1460. End If
  1461. Loop
  1462. 'Debug.Print "Easy way"
  1463. Select Case iAction
  1464. Case ROMANIZATIONACTION_RomanizeHighlightedText%
  1465. sTag$ = Mid(sWholeField$, 1, 3) ' the tag of the current field
  1466. sIndicators$ = Mid(sWholeField$, 5, 2)
  1467. sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(Trim(Mid(sWholeField$, 8)))
  1468. If Mid(sWholeField$, 1, 2) = "\f" Then
  1469. sWholeField$ = Mid(sWholeField$, 4)
  1470. End If
  1471. RA_WeHaveOurFieldTheEasyWay:
  1472. 'Debug.Print "Pieces: >" + sTag$ + "< >" + sIndicators$ + "< >" + sWholeField$ + "<"
  1473. ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified)
  1474. If sTag$ >= 600 And sTag$ <= 651 Then
  1475. s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4"
  1476. Else
  1477. s880Indicators$ = sIndicators$
  1478. End If
  1479. iRc% = InStr(sWholeField$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6")
  1480. If iRc% > 0 Then
  1481. ' 20070830: NoRomanization added
  1482. If gblaRomanizationTable(iScript%).NoRomanization Then
  1483. ' if we we're not actually converting text then there's nothing for us to do
  1484. ' if $6 is present
  1485. GoTo RomanizationAssistanceNoFileOpenResume
  1486. End If
  1487. s6$ = Mid(sWholeField$, iRc% + 2)
  1488. iRc% = InStr(s6$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter)
  1489. If iRc% > 0 Then
  1490. s6$ = Mid(s6$, 1, iRc% - 1)
  1491. End If
  1492. Else
  1493. ' field does not yet contain $6
  1494. ' calculate the next value for sequence of subfield $6
  1495. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  1496. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveNext
  1497. If LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdFindFirst("6") Then
  1498. iRc% = InStr(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, "-")
  1499. If iRc% > 0 Then
  1500. iRepeat% = Val(Trim(Mid(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iRc% + 1)))
  1501. If iRepeat% > iNext6% Then
  1502. iNext6% = iRepeat%
  1503. End If
  1504. End If
  1505. End If
  1506. Loop
  1507. iNext6% = iNext6% + 1
  1508. ' 20070830: NoRomanization added
  1509. If gblaRomanizationTable(iScript%).NoRomanization Then
  1510. ' if we're not actually converting text, then (until we hear more
  1511. ' from David B. at LC) we're going to add $6 to the current field and
  1512. ' copy the current field to 880
  1513. ' we can do this much, now that we've got the next repeat number
  1514. ' calculated
  1515. bFound = False
  1516. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  1517. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$)
  1518. If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then
  1519. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1520. bFound = True
  1521. End If
  1522. Loop
  1523. If Not bFound Then
  1524. RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound%
  1525. Exit Function
  1526. End If
  1527. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1528. sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag
  1529. sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd
  1530. ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified)
  1531. If sTag$ >= 600 And sTag$ <= 651 Then
  1532. s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4"
  1533. Else
  1534. s880Indicators$ = sIndicators$
  1535. End If
  1536. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText
  1537. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst
  1538. bOnlyMarc8 = LocalMarcRecordObjectAlreadyLoadedWithRecord.Utf8TextContainsOnlyMarc8Characters(sField$)
  1539. 'Debug.Print "Only marc 8? " + str(bOnlyMarc8)
  1540. ' 20100412 changed by David Bucknum: since we're romanizing the field above
  1541. ' original version:
  1542. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdAdd "6", "880-" + Right("00" + Trim(str(iNext6%)), 2)
  1543. ' replacement:
  1544. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  1545. .FldDelete
  1546. .FldAdd .FldTag, .FldInd, .MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sField$
  1547. End With
  1548. ' adding subfield $6 has the effect of deleting the original field and replacing
  1549. ' it with a new one; so we need to reset the pointer too
  1550. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1551. ' 20100412 changed by David Bucknum: since we're romanizing the field above
  1552. ' original version:
  1553. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", s880Indicators$, sField$
  1554. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdAdd "6", sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2)
  1555. ' replacement:
  1556. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  1557. .FldAdd .FldTag, .FldInd, .MarcDelimiter + "6" + sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sField$
  1558. End With
  1559. lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1560. ' now, the matrix of options
  1561. If bOnlyMarc8 Then
  1562. ' the field we copied into the 880 contains only MARC-8 characters; so
  1563. ' we assume that this is romanized text for which we need to
  1564. ' supply the vernacular form
  1565. 'Debug.Print "Create empty 1? " + str(gblaRomanizationTable(iScript%).R2VCreateEmpty880s)
  1566. If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then
  1567. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer2
  1568. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst
  1569. Do While True
  1570. If InStr("68", LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) = 0 Then
  1571. ' include this subfield, but change it to a plus sign
  1572. ' 20070831: in the new "empty" 880 field:
  1573. ' add RLMs before and after the delimiter/subfield codes,
  1574. ' as appropriate, but *only* if the Right2LeftMark variable is set
  1575. If bLcPattern Then
  1576. ' 20070831: add a LeftToRightEmbedding character (LRE) only before
  1577. ' and add a POPDirectionalFormatting character (PDF) only
  1578. ' at the end of the 880 $6 260-xx $c [dates]
  1579. ' 20121121: added 264 (RDA) to logic
  1580. If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then
  1581. ' if the 260 ends with a period, place the period after the PDF
  1582. If Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, 1) = "." Then
  1583. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + sLRE$ + "+" + sPDF$ + "."
  1584. Else
  1585. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + sLRE$ + "+" + sPDF$
  1586. End If
  1587. Else
  1588. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = sRLM$ + "+" + sRLM$
  1589. End If
  1590. Else
  1591. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = "+"
  1592. End If
  1593. Else
  1594. ' 20070831: add an RLM at the end of $6 as appropriate
  1595. If bLcPattern Then
  1596. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText + sSubfield6Code$ + sRLM$
  1597. Else
  1598. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText = LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText + sSubfield6Code$
  1599. End If
  1600. End If
  1601. If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then
  1602. ' 20070831: remove the final RLM at the end of the field
  1603. If bLcPattern And Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, 3) = sRLM$ Then
  1604. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = Left(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, Len(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText) - 3)
  1605. End If
  1606. Exit Do
  1607. End If
  1608. Loop
  1609. End If
  1610. Else
  1611. ' the field we copied into the 880 contains non-MARC-8 characters; so
  1612. ' we assume that this is vernacular text and the original field
  1613. ' needs to be romanized
  1614. 'Debug.Print "Create empty 2? " + str(gblaRomanizationTable(iScript%).V2RCreateEmptyFields)
  1615. If gblaRomanizationTable(iScript%).V2RCreateEmptyFields Then
  1616. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1617. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst
  1618. sField$ = ""
  1619. Do While True
  1620. If InStr("68", LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) = 0 Then
  1621. ' include this subfield, but change it to a plus sign
  1622. sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + "+"
  1623. Else
  1624. sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  1625. End If
  1626. If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then
  1627. Exit Do
  1628. End If
  1629. Loop
  1630. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sField$
  1631. End If
  1632. End If
  1633. ' LocalMarcRecordObjectAlreadyLoadedWithRecord.DumpArray "100 880", True
  1634. GoTo RomanAssist_DisplayTheFinishedRecord
  1635. End If
  1636. End If
  1637. iRomanizationStyle% = EvaluateFirstCharacter(sField$, iScript%, LocalMarcCharacterObject)
  1638. If iRomanizationStyle% = ROMANIZATIONDIRECTION_Unknown% Then
  1639. RomanizationAssistance = ROMANIZATIONRESULT_ActionUnclear%
  1640. Exit Function
  1641. End If
  1642. ' at this point we need to make the critical determination: are we converting
  1643. ' romanized text into vernacular, or are we converting vernacular text into romanized?
  1644. ' here go the scenarios we've developed, based on a
  1645. ' matrix of these factors:
  1646. ' 1) whether the field is 880, or something else
  1647. ' 2) whether the field already contains subfield $6
  1648. ' 3) whether the highlighted text is vernacular or romanized
  1649. If sTag$ <> "880" Then
  1650. If Len(s6$) = 0 Then
  1651. ' we need lFldPointer regardless of what happens
  1652. ' to remaining scenarios here
  1653. bFound = False
  1654. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  1655. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$)
  1656. 'Debug.Print "Comparing: >" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText + "< >" + sWholeField$ + "<"
  1657. If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then
  1658. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1659. bFound = True
  1660. End If
  1661. Loop
  1662. If Not bFound Then
  1663. RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound%
  1664. Exit Function
  1665. End If
  1666. If iRomanizationStyle% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  1667. ' not an 880 field; no $6 yet; we're moving from vernacular to romanized
  1668. ' copy the current field as 880 (which adds $6 to the
  1669. ' original field and also the new 880 field); otherwise
  1670. ' leave the 880 field alone
  1671. iRc% = InStr(sWholeField$, sField$)
  1672. If iRc% > 0 Then ' it sure better be!
  1673. RomanAssist_ReplayWithSubstitution:
  1674. ' find the original field (again!) and get a copy of it
  1675. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1676. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldLoadInfo sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$
  1677. lFldPointer2 = lFldPointer
  1678. ' copy the field as it stands to an 880, with $6 added
  1679. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", sIndicatorsToCopy$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + sTagToCopy$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sFieldToCopy$
  1680. ' save the pointer to the new 880 field for later use in resolving
  1681. ' the nonfiling characters indicator
  1682. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1683. ' isolate the bits that we're NOT going to romanize
  1684. sLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + Mid(sWholeField$, 1, iRc% - 1)
  1685. If Right(sLeft$, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then
  1686. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1)
  1687. sIntermediate$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter
  1688. ElseIf Mid(Right(sLeft$, 2), 1, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then
  1689. sIntermediate$ = Right(sLeft$, 2)
  1690. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 2)
  1691. End If
  1692. sRight$ = Mid(sWholeField$, iRc% + Len(sField$))
  1693. sField$ = sIntermediate$ + sField$
  1694. ' change the text of the native field to match
  1695. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer2
  1696. If Right(sField$, 1) = " " Then
  1697. bStringHasTerminalSpace = True
  1698. Else
  1699. bStringHasTerminalSpace = False
  1700. End If
  1701. ' 20070731: make sure first word is uppercased
  1702. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject))
  1703. If Not bStringHasTerminalSpace Then
  1704. sField$ = RTrim(sField$)
  1705. End If
  1706. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sField$ + sRight$
  1707. ' just in case we've done a delete/re-add
  1708. lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1709. ' adjust nonfiling characters as necessary
  1710. #If RomanizationAssistanceDebug = -1 Then
  1711. Debug.Print "Adjust NON #1"
  1712. #End If
  1713. ReRomanizeAdjustNonfilingIndicators iScript%, sNonfilingString$, lFldPointer, lFldPointer2, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject
  1714. GoTo RomanAssist_DisplayTheFinishedRecord
  1715. Else
  1716. iRc% = InStr(sField$, sWholeField$)
  1717. If iRc% > 0 Then
  1718. sField$ = sWholeField$
  1719. iRc% = InStr(sWholeField$, sField$)
  1720. If iRc% > 0 Then
  1721. GoTo RomanAssist_ReplayWithSubstitution
  1722. End If
  1723. End If
  1724. ' todo: if we get here, nothing is going to happen; tell the operator?
  1725. End If
  1726. Else ' not an 880 field; no $6 yet; we're moving from romanized to vernacular
  1727. ' find the field in the bib record
  1728. ' INCLUDES Wade-Giles to Pinyin
  1729. iRc% = InStr(sWholeField$, sField$)
  1730. If iRc% > 0 Then ' it sure better be!
  1731. RomanAssist_ReplayWithSubstitution2:
  1732. ' isolate the bits that we're NOT going to romanize
  1733. sRight$ = Mid(sWholeField$, iRc% + Len(sField$))
  1734. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1735. sTagToCopy$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag
  1736. If gblaRomanizationTable(iScript%).DoNotUse880Field Then
  1737. ' probably wade-giles to pinyin
  1738. sLeft$ = Mid(sWholeField$, 1, iRc% - 1)
  1739. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sRight$
  1740. Else
  1741. sLeft$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + sTag$ + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + Mid(sWholeField$, 1, iRc% - 1)
  1742. ' add subfield $6 to the original field (to make things easier, we'll
  1743. ' actually achieve this with a delete/insert operation)
  1744. 'Debug.Print "Text before delete: " + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText
  1745. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDelete
  1746. ' 20070703: in the original version (retained here as a comment), we use the text of the new field
  1747. ' as run through the ReRomanize function. the reason for this is not clear, and
  1748. ' at least in the Hebrew stuff we're testing with just now this results in
  1749. ' a field with uppercase letters rendered as lowercase
  1750. ' the obvious solution appears to be to use the original field text in the
  1751. ' new field, without any changes
  1752. ' perhaps only time will reveal the need that led to our use of ReRomanize
  1753. ' here in the first place ...
  1754. ' original version:
  1755. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter sTagToCopy$, sIndicators$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, 2)
  1756. ' replacement:
  1757. ' 20100809 Bucknum added: remove temporary VowelMarker character before export
  1758. If LenB(gblaRomanizationTable(iScript%).R2VVowelMarker) > 0 Then
  1759. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText, gblaRomanizationTable(iScript%).R2VVowelMarker)
  1760. End If
  1761. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter sTagToCopy$, sIndicators$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText
  1762. ' pointer to the "changed" field
  1763. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1764. ' 20070719: convert the text for the 880 here, instead of below
  1765. sField$ = ReRomanizeText(sType$, sTagToCopy$, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject)
  1766. ' add right-to-left marker to the end of subfield $6 as appropriate
  1767. If bLcPattern Then
  1768. lPtr = InStr(sLeft$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6")
  1769. If lPtr > 0 Then
  1770. sLeft$ = sLeft$ & LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcRightToLeftMarker
  1771. End If
  1772. ' add LRE and PDF markers to the 880 $6 260-xx $c [dates]
  1773. ' after the $c RLM and at the end of the subfield
  1774. ' 20121121: added 264 (RDA) to logic
  1775. lPtr2 = InStr(sField$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "c")
  1776. If lPtr2 <> 0 And sTagToCopy$ Like "26[04]" Then
  1777. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sField$, lPtr2 + 5, 0, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcLeftToRightEmbedding)
  1778. ' if the subfield ends with a period, place the period after the PDF
  1779. If Right(sField$, 1) = "." Then
  1780. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sField$, InStrRev(sField$, "."), 1, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcPopDirectionalFormatting + ".")
  1781. Else
  1782. sField$ = sField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcPopDirectionalFormatting
  1783. End If
  1784. End If
  1785. End If
  1786. ' create an 880 field with text converted
  1787. ' 20070719 changed by David Bucknum: since we're romanizing the field above
  1788. ' original version:
  1789. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter "880", s880Indicators$, sLeft$ + ReRomanizeText(sType$, sTagToCopy$, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sRight$
  1790. ' replacement:
  1791. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInsertAfter "880", s880Indicators$, sLeft$ + sField$ + sRight$
  1792. ' this is, for our purposes, the "original" field
  1793. lFldPointer2 = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1794. 'LocalMarcRecordObjectAlreadyLoadedWithRecord.DumpArray "", False
  1795. #If RomanizationAssistanceDebug = -1 Then
  1796. Debug.Print "Adjust NON #2"
  1797. #End If
  1798. ReRomanizeAdjustNonfilingIndicators iScript%, sNonfilingString$, lFldPointer, lFldPointer2, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject
  1799. ' does this achieve anything at all?
  1800. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1801. End If
  1802. GoTo RomanAssist_DisplayTheFinishedRecord
  1803. Else
  1804. iRc% = InStr(sField$, sWholeField$)
  1805. If iRc% > 0 Then
  1806. sField$ = sWholeField$
  1807. iRc% = InStr(sWholeField$, sField$)
  1808. If iRc% > 0 Then
  1809. GoTo RomanAssist_ReplayWithSubstitution2
  1810. End If
  1811. End If
  1812. ' todo: if we get here, nothing is going to happen; tell the operator?
  1813. End If
  1814. End If
  1815. Else ' tag not 880, subfield $6 is present
  1816. If iRomanizationStyle% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  1817. ' not an 880 field; already contains $6; moving from vernacular to roman
  1818. ' todo: romanize the text in place, leaving the 880 field alone
  1819. ' NOTE that if field already contains $6, we're not going to
  1820. ' do anything about initial articles
  1821. RomanAssist_ReRomanizeInPlace:
  1822. bFound = False
  1823. sTag$ = Mid(sFieldRemainderLeft$, 1, 3)
  1824. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  1825. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$)
  1826. If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then
  1827. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1828. bFound = True
  1829. End If
  1830. Loop
  1831. If Not bFound Then
  1832. RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound%
  1833. Exit Function
  1834. Else
  1835. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1836. If Len(sFieldRemainderLeft$) > 0 Then
  1837. lFldPointer = InStr(sFieldRemainderLeft$, LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter)
  1838. If lFldPointer > 0 Then
  1839. sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, lFldPointer)
  1840. End If
  1841. End If
  1842. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sFieldRemainderLeft$ + ReRomanizeText(sType$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag, sField$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject) + sFieldRemainderRight$
  1843. GoTo RomanAssist_DisplayTheFinishedRecord
  1844. End If
  1845. Else
  1846. ' not an 880 field; already contains $6; we're moving from romanized to vernacular
  1847. ' todo: find the parallel text in the 880 field, and vernacularize the
  1848. ' parallel text in the 880 field; leave the user-marked field alone
  1849. End If
  1850. End If
  1851. Else
  1852. ' the operator selected text within an 880 field
  1853. If Len(s6$) = 0 Then
  1854. RomanizationAssistance = ROMANIZATIONRESULT_880WithNoSubfield6%
  1855. Exit Function
  1856. Else
  1857. ' 880 field; field already contains $6
  1858. GoTo RomanAssist_ReRomanizeInPlace
  1859. End If
  1860. End If
  1861. Case ROMANIZATIONACTION_LCaseWord%, ROMANIZATIONACTION_UCaseWord%, ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_UCaseEach%, ROMANIZATIONACTION_Define%
  1862. sTag$ = Mid(sWholeField$, 1, 3) ' the tag of the current field
  1863. sIndicators$ = Mid(sWholeField$, 5, 2)
  1864. sWholeField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveSpacesAroundDelimiters(Trim(Mid(sWholeField$, 8)))
  1865. If Mid(sWholeField$, 1, 2) = "\f" Then
  1866. sWholeField$ = Mid(sWholeField$, 4)
  1867. End If
  1868. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  1869. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindNext(sTag$)
  1870. If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sWholeField$ Then
  1871. lFldPointer = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer
  1872. bFound = True
  1873. End If
  1874. Loop
  1875. If Not bFound Then
  1876. RomanizationAssistance = ROMANIZATIONRESULT_FieldNotFound%
  1877. Exit Function
  1878. End If
  1879. iRc% = InStr(sWholeField$, sField$)
  1880. If iRc% > 0 Then ' it sure better be!
  1881. iRc% = InStr(sWholeField$, sField$)
  1882. If iRc% > 0 Then ' it sure better be!
  1883. ' find the original field (again!) and get a copy of it
  1884. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = lFldPointer
  1885. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldLoadInfo sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$
  1886. ' isolate the bits that we're NOT going to romanize
  1887. sLeft$ = Mid(sWholeField$, 1, iRc% - 1)
  1888. If Right(sLeft$, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then
  1889. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 1)
  1890. sIntermediate$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter
  1891. ElseIf Mid(Right(sLeft$, 2), 1, 1) = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter Then
  1892. sIntermediate$ = Right(sLeft$, 2)
  1893. sLeft$ = Mid(sLeft$, 1, Len(sLeft$) - 2)
  1894. End If
  1895. sRight$ = Mid(sWholeField$, iRc% + Len(sField$))
  1896. sField$ = sIntermediate$ + sField$
  1897. sOriginalField$ = sField$
  1898. Select Case iAction
  1899. Case ROMANIZATIONACTION_LCaseWord%
  1900. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.LCaseFirstWord(sField$) + sRight$
  1901. Case ROMANIZATIONACTION_UCaseWord%
  1902. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(sField$) + sRight$
  1903. Case ROMANIZATIONACTION_ReplaceText%, ROMANIZATIONACTION_Define%
  1904. sNewField$ = ""
  1905. sOriginalLeft$ = sLeft$
  1906. sOriginalRight$ = sRight$
  1907. Do While Len(sField$) > 0
  1908. If Asc(Mid(sField$, 1, 1)) > 127 Then
  1909. LocalMarcCharacterObject.Utf8Char = sField$
  1910. sField$ = Mid(sField$, LocalMarcCharacterObject.Utf8CharOctets + 1)
  1911. sNewField$ = sNewField$ + "{U+" + LocalMarcCharacterObject.UcsHex + "}"
  1912. Else
  1913. sNewField$ = sNewField$ + Mid(sField$, 1, 1)
  1914. sField$ = Mid(sField$, 2)
  1915. End If
  1916. Loop
  1917. If iAction = ROMANIZATIONACTION_Define% Then
  1918. sFile$ = gblaRomanizationTable(iScript%).FullFileName
  1919. sTempFile$ = sFile$
  1920. iRc2% = LocalMarcRecordObjectAlreadyLoadedWithRecord.Rat(sTempFile$, "\")
  1921. If iRc2% = 0 Then
  1922. Exit Function
  1923. End If
  1924. sTempFile$ = Mid(sTempFile$, 1, iRc2%) + "Temp.$$$"
  1925. On Error GoTo RomanizationAssistanceNoFileOpen
  1926. iOut% = FreeFile
  1927. Open sTempFile$ For Output As #iOut%
  1928. On Error GoTo 0
  1929. iIn% = FreeFile
  1930. Open sFile$ For Input As #iIn%
  1931. iRc% = InStr(sNewField$, "{U+")
  1932. If iRc% = 0 Then
  1933. RomanizationAssistance = ROMANIZATIONRESULT_NoCharacterToDefine%
  1934. Exit Function
  1935. End If
  1936. ' iRc% points to the character in question
  1937. ' PRESERVE THE VALUE OF iRC!
  1938. sField$ = InputBox("Please supply the replacement text for U+" + Mid(sNewField$, iRc% + 3, 4) + ". (Supply empty text to cancel.)", "Define replacement for vernacular character", "")
  1939. If Len(sField$) = 0 Then
  1940. Close #iIn%
  1941. Close #iOut%
  1942. Exit Function ' operation canceled
  1943. End If
  1944. ' iRc% still points to the character in question
  1945. ' PRESERVE THE VALUE OF iRC!
  1946. If sField$ = Mid(sNewField$, iRc% + 3, 4) Then
  1947. Close #iIn%
  1948. Close #iOut%
  1949. Exit Function ' operator didn't make a change: nothing to do
  1950. End If
  1951. ' iRc% still points to the character in question
  1952. ' PRESERVE THE VALUE OF iRC!
  1953. ' todo: if we need to allow for the possibility of Unicode
  1954. ' notations within the replacement text, handle them here
  1955. ' (not needed for Chinese, which is the object of this
  1956. ' exercise)
  1957. ' add a new line to the configuration file,
  1958. ' defining this new character (we opened the files
  1959. ' above, so we could make sure we're allowed to do this
  1960. ' before we actually go to work)
  1961. '
  1962. ' 20070606 added by David Bucknum
  1963. sField$ = Trim(sField$) & " "
  1964. Do While Not EOF(iIn%)
  1965. DoEvents
  1966. Line Input #iIn%, sLine$
  1967. Print #iOut%, sLine$
  1968. ' 20070727 (comment only; no change) this puts the new
  1969. ' character at the top of the stanza, whether we want
  1970. ' it there or somewhere else; this is "probably" good
  1971. ' enough, given the context ...
  1972. If sLine$ = "[ScriptToRoman]" Then
  1973. Print #iOut%, "U+" + Mid(sNewField$, iRc% + 3, 4) + "=" + LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, " ", "_")
  1974. End If
  1975. Loop
  1976. Close #iIn%
  1977. Close #iOut%
  1978. On Error GoTo RomanizationAssistanceBadKill
  1979. Kill sFile$
  1980. DoEvents
  1981. FileCopy sTempFile$, sFile$
  1982. DoEvents
  1983. Kill sTempFile$
  1984. ' add the character to the current version of the
  1985. ' romanization tables in memory
  1986. 'sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "_", " ")
  1987. ' this is the "native" representation of the whole raw string (which should
  1988. ' just be one character)
  1989. 'Debug.Print "RA 1"
  1990. sNewCharacter$ = RomanizeConvertText("U+" + Mid(sNewField$, iRc% + 3, 4), LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject)
  1991. LocalMarcCharacterObject.UcsHex = Mid(sNewField$, iRc% + 3, 4) ' isolating the first character (there should only be the one)
  1992. If gblaRomanizationTable(iScript%).Vernacular2Roman.Exists(LocalMarcCharacterObject.Utf8Char) Then
  1993. iElement% = gblaRomanizationTable(iScript%).Vernacular2Roman.item(LocalMarcCharacterObject.Utf8Char)
  1994. Else
  1995. gblaRomanizationTable(iScript%).VernacularLast = gblaRomanizationTable(iScript%).VernacularLast + 1
  1996. If gblaRomanizationTable(iScript%).VernacularLast > gblaRomanizationTable(iScript%).VernacularMax Then
  1997. gblaRomanizationTable(iScript%).VernacularMax = gblaRomanizationTable(iScript%).VernacularMax + 10
  1998. ReDim Preserve gblaRomanizationTable(iScript%).Vernacular(0 To gblaRomanizationTable(iScript%).VernacularMax)
  1999. End If
  2000. iElement% = gblaRomanizationTable(iScript%).VernacularLast
  2001. gblaRomanizationTable(iScript%).Vernacular2Roman.Add LocalMarcCharacterObject.Utf8Char, iElement%
  2002. End If
  2003. gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast = gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast + 1
  2004. If gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast > gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax Then
  2005. gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax = gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax + 5
  2006. ReDim Preserve gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(0 To gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailMax)
  2007. End If
  2008. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, "_", " ")
  2009. gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullStringLengthInCharacters = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeLen(sNewCharacter$)
  2010. gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullStringLengthInBytes = Len(sNewCharacter$)
  2011. gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).FullString = sNewCharacter$
  2012. gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).Equivalent = sField$
  2013. gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).EquivalentUpperCasePresent = False
  2014. 'Debug.Print "Defined equivalent >" + gblaRomanizationTable(iScript%).Vernacular(iElement%).Detail(gblaRomanizationTable(iScript%).Vernacular(iElement%).DetailLast).Equivalent + "< for >" + "Y" + "<"
  2015. If Right(sField$, 1) = " " Then
  2016. sOriginalField$ = sOriginalLeft$ + sOriginalField$ + sOriginalRight$
  2017. iRc% = InStr(sOriginalField$, sNewCharacter$)
  2018. Do While iRc% > 0
  2019. Select Case Mid(sOriginalField$, iRc% + Len(sNewCharacter$), 1)
  2020. Case " "
  2021. sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), sField$)
  2022. Case Chr(34), "'", ";", ":", ",", ".", "/", "<", ">", "?", "[", "]", "\", "{", "}", "|", "-", "=", "!", "@", "#", "$%", "^", "&", "*", "(", ")", "_", "+", ""
  2023. sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), Trim(sField$))
  2024. Case Else
  2025. sOriginalField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sOriginalField$, iRc%, Len(sNewCharacter$), sField$)
  2026. End Select
  2027. iRc% = InStr(sOriginalField$, sNewCharacter$)
  2028. Loop
  2029. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveRepeatedCharacters(sOriginalField$, " ")
  2030. Else
  2031. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = LocalMarcRecordObjectAlreadyLoadedWithRecord.RemoveRepeatedCharacters(LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sOriginalLeft$ + sOriginalField$ + sOriginalRight$, sNewCharacter$, sField$), " ")
  2032. End If
  2033. Else
  2034. 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$)
  2035. If Len(sNewField$) > 0 Then
  2036. Do
  2037. iRc% = InStr(sNewField$, "{U+")
  2038. If iRc% = 0 Then
  2039. Exit Do
  2040. End If
  2041. sLeft2$ = Mid(sNewField$, 1, iRc% - 1)
  2042. sNewField$ = Mid(sNewField$, iRc% + 3)
  2043. iRc% = InStr(sNewField$, "}")
  2044. If iRc% > 1 Then
  2045. sRight2$ = Mid(sNewField$, iRc% + 1)
  2046. LocalMarcCharacterObject.UcsHex = Mid(sNewField$, 1, iRc% - 1)
  2047. sNewField$ = LocalMarcCharacterObject.Utf8Char
  2048. Else
  2049. sRight2$ = ""
  2050. End If
  2051. sNewField$ = sLeft2$ + sNewField$ + sRight2$
  2052. Loop
  2053. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sNewField$ + sRight$
  2054. End If
  2055. End If
  2056. Case ROMANIZATIONACTION_UCaseEach%
  2057. sNewField$ = ""
  2058. Do While Len(sField$) > 0
  2059. GetNextPiece sField$, sWord$, " "
  2060. sNewField$ = Trim(sNewField$ + " " + LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(sWord$))
  2061. Loop
  2062. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sLeft$ + sNewField$ + sRight$
  2063. End Select
  2064. GoTo RomanAssist_DisplayTheFinishedRecord
  2065. End If
  2066. End If
  2067. End Select
  2068. Case ROMANIZATIONACTION_RomanizeWholeRecord%
  2069. ' 20070830: NoRomanization added
  2070. ' If gblaRomanizationTable(iScript%).NoRomanization Then
  2071. ' GoTo RomanizationAssistanceNoFileOpenResume
  2072. ' End If
  2073. iRc% = RomanizationAssistanceConvertWholeRecord(sType$, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject)
  2074. If iRc% <> 0 Then
  2075. RomanizationAssistance = iRc%
  2076. Exit Function
  2077. End If
  2078. GoTo RomanAssist_DisplayTheFinishedRecord
  2079. Case ROMANIZATIONACTION_DisplayMarcRecord%
  2080. RomanAssist_DisplayTheFinishedRecord:
  2081. If iFldTextFormattedOption% = 99 Then
  2082. Select Case iFixedFieldDisplayConvention%
  2083. Case 2 ' FixedFieldDisplay_OCLCMonospaced%
  2084. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, OclcMonospaced, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2085. Case 1 ' FixedFieldDisplay_OCLC
  2086. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, oclc, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2087. Case Else ' zero; notis
  2088. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfText, notis, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2089. End Select
  2090. Else
  2091. Select Case iFixedFieldDisplayConvention%
  2092. Case 2 ' FixedFieldDisplay_OCLCMonospaced%
  2093. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, OclcMonospaced, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2094. Case 1 ' FixedFieldDisplay_OCLC
  2095. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, oclc, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2096. Case Else ' zero; notis
  2097. LocalRichTextBox.TextRTF = LocalMarcRecordObjectAlreadyLoadedWithRecord.TextFormatted(rtfTextwithlabels, notis, "", True, sRtfFontName$, iFontSizeForDisplay%)
  2098. End Select
  2099. End If
  2100. End Select
  2101. RomanizationAssistanceNoFileOpenResume:
  2102. Exit Function
  2103. RomanizationAssistanceBadKill:
  2104. RomanizationAssistanceNoFileOpen:
  2105. RomanizationAssistance = ROMANIZATIONRESULT_FileOpen%
  2106. On Error GoTo 0
  2107. Resume RomanizationAssistanceNoFileOpenResume
  2108. End Function
  2109. Public Function FindFieldCurrentlyPointedTo(ByRef cRichTextBox As Control, ByRef LocalMarcRecord As Utf8MarcRecordClass, Optional ByVal bSearch As Boolean = False) As Long
  2110. ' 20070207: created (so OK for Unicode already)
  2111. ' find in a MARC record the field that corresponds to the field-currently-clicked-on
  2112. ' in the rich text box
  2113. ' return the pointer to that field (if the pointer is nonzero, the MARC record object also
  2114. ' is currently pointed to that field, but the caller should probably not assume this)
  2115. Dim lSelStart As Long, lOriginalSelStart As Long, lPtr As Long, lStart As Long
  2116. Dim sField$, sRecord$, sFieldRemainderLeft$, sFieldRemainderRight$
  2117. Dim sTagToFind$, sNonfilingString$
  2118. Dim sLeft$, sRight$, sLineEnd$, sWholeField$
  2119. Dim iRc%, iRc2%
  2120. Dim bSkipTagTest As Boolean
  2121. ' assume that we didn't find anything
  2122. FindFieldCurrentlyPointedTo = -1
  2123. ' this is a useful thing to have, either way
  2124. lSelStart = cRichTextBox.SelStart
  2125. If Len(cRichTextBox.SelText) > 0 Then
  2126. ' the easier way out: at least one character is highlighted (we've
  2127. ' already figured this out for the toolkit's re-romanization button, so we'll
  2128. ' just translate that bit of business for the context here)
  2129. lOriginalSelStart = lSelStart
  2130. sField$ = cRichTextBox.SelRTF
  2131. sRecord$ = cRichTextBox.TextRTF
  2132. ' remove the closing brace from the selected text
  2133. If Right(sField$, 1) = "}" Then
  2134. sField$ = Mid(sField$, 1, Len(sField$) - 1)
  2135. End If
  2136. ' remove the RTF prefix from the selected text
  2137. iRc% = InStr(sField$, "}}")
  2138. If iRc% > 0 Then
  2139. sField$ = Trim(Mid(sField$, iRc% + 2))
  2140. End If
  2141. ' text should now start with some additional 'slash' commands, which
  2142. ' we will proceed to remove
  2143. Do While Mid(sField$, 1, 1) = "\"
  2144. If Mid(sField$, 1, 2) = "\u" Then
  2145. If InStr("0123456789", Mid(sField$, 3, 1)) > 0 Then
  2146. Exit Do
  2147. End If
  2148. End If
  2149. sField$ = Mid(sField$, 2)
  2150. iRc% = InStr(sField$, "\")
  2151. If iRc% = 0 Then
  2152. iRc% = InStr(sField$, " ")
  2153. If iRc% > 0 Then
  2154. sField$ = Mid(sField$, iRc% + 1)
  2155. Exit Do
  2156. End If
  2157. Else
  2158. iRc2% = InStr(sField$, " ")
  2159. If iRc2% > 0 Then
  2160. If iRc% < iRc2% Then
  2161. sField$ = Mid(sField$, iRc%)
  2162. Else
  2163. sField$ = Mid(sField$, iRc2% + 1)
  2164. Exit Do
  2165. End If
  2166. Else
  2167. sField$ = Mid(sField$, iRc%)
  2168. End If
  2169. End If
  2170. Loop
  2171. ' remove any trailing 'par' command
  2172. iRc% = LocalMarcRecord.Rat(sField$, "\par")
  2173. If iRc% > 0 Then
  2174. sField$ = Mid(sField$, 1, iRc% - 1)
  2175. End If
  2176. ' wrapping spaces are irrelevant
  2177. sField$ = Trim(sField$)
  2178. If Len(sField$) = 0 Then
  2179. ' maybe we can work this out using just the
  2180. ' SelStart pointer?
  2181. GoTo FFCPT_UseJustSelStart
  2182. End If
  2183. ' in sField$ we should now have the raw RTF text of interest minus the wrapper
  2184. ' oddly enough, the SelStart property of the rich text box
  2185. ' refers to the plain text version
  2186. ' of the field; there doesn't seem to be a corresponding SelStartRtf
  2187. ' or anything else useful; so we're going to use the supplied SelStart
  2188. ' property as a rough guide for finding the selection ourselves
  2189. ' remembering that SelStart is zero-based (so we don't have to back up 1
  2190. ' from lSelStart to find the "real" end of the preceding text, and we
  2191. ' have to add 1 to the combined start and length to find the beginning
  2192. ' of whatever follows the text (which is, from our point of view, possibly
  2193. ' irrelevant)
  2194. sFieldRemainderLeft$ = Mid(cRichTextBox.Text, 1, lSelStart)
  2195. lPtr = LocalMarcRecord.Rat(sFieldRemainderLeft$, vbLf)
  2196. If lPtr > 0 Then
  2197. sFieldRemainderLeft$ = Trim(Mid(sFieldRemainderLeft$, lPtr + 1) + sField$)
  2198. sTagToFind$ = Mid(sFieldRemainderLeft$, 1, 3)
  2199. Else
  2200. GoTo FFCPT_UseJustSelStart
  2201. End If
  2202. Select Case LocalMarcRecord.MarcRecordFormat
  2203. Case "A"
  2204. sNonfilingString$ = sAuthorityNonfilingString$
  2205. Case "B", "D", "F", "M", "P", "S", "U"
  2206. sNonfilingString$ = sBibliographicNonfilingString$
  2207. 'Case else: ignore the whole issue
  2208. End Select
  2209. ' to help us find the highlighted text within the record,
  2210. ' give us the RTF version of the whole MARC record again
  2211. ' we don't need to worry here about specification for fixed fields or
  2212. ' font size, because they don't affect what we're up to here
  2213. sRecord$ = LocalMarcRecord.TextFormatted(rtfText, OclcMonospaced)
  2214. lStart = 1
  2215. Do
  2216. ' find the next occurrence of our text in the record
  2217. lSelStart = InStr(lStart, sRecord$, sField$)
  2218. DoEvents
  2219. If lSelStart = 0 Then
  2220. If lStart = 1 Then
  2221. GoTo FFCPT_UseJustSelStart
  2222. End If
  2223. ' we found at least one place already; so let's back up to find
  2224. ' the first one (assuming that the first one is the right one!)
  2225. lSelStart = InStr(1, sRecord$, sField$)
  2226. If lSelStart = 0 Then
  2227. GoTo FFCPT_UseJustSelStart
  2228. End If
  2229. bSkipTagTest = True
  2230. Else
  2231. lStart = lSelStart + 1
  2232. End If
  2233. sLeft$ = Mid(sRecord$, 1, lSelStart - 1)
  2234. sRight$ = Mid(sRecord$, lSelStart + Len(sField$))
  2235. ' sLeft$ = all of the record up to our selected text
  2236. ' sRight$ = and all of the record that follows the selected text
  2237. ' we want to back up in sLeft to the beginning of the current "line" (i.e., variable field)
  2238. lSelStart = LocalMarcRecord.Rat(sLeft$, sLineEnd$)
  2239. If lSelStart > 0 Then
  2240. sFieldRemainderLeft$ = LTrim(Mid(sLeft$, lSelStart + 5))
  2241. If Mid(sFieldRemainderLeft$, 1, 2) = "\f" Then
  2242. sLeft$ = sLeft$ + Mid(sFieldRemainderLeft$, 1, 4)
  2243. sFieldRemainderLeft$ = Mid(sFieldRemainderLeft$, 5)
  2244. End If
  2245. Else
  2246. sFieldRemainderLeft$ = ""
  2247. End If
  2248. If Mid(LTrim(sFieldRemainderLeft$ + sField$), 1, 3) = sTagToFind$ Or bSkipTagTest Then
  2249. ' this is the field we want! hooray!
  2250. FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer
  2251. Exit Function
  2252. End If
  2253. Loop
  2254. ' if we get here, we didn't find what we wanted, given the text highlighted by the
  2255. ' operator
  2256. ' we'll fall through and try the second method, using just the starting point of the
  2257. ' highlight
  2258. End If
  2259. ' if we get here, either the operator didn't highlight any text at all, or
  2260. ' we failed in the above attempt to find the highlighted text
  2261. FFCPT_UseJustSelStart:
  2262. ' if we *branch to* here, there was something amiss with the text selected by the
  2263. ' operator--maybe the operator just selected a space?
  2264. ' no matter how we get here, we're going to try a second and more difficult/complicated
  2265. ' operation, using just the start of the selection
  2266. ' this is a bit more difficult, because the SelStart pointer relates to
  2267. ' the plain-text version, not the RTF version; and in the plain text
  2268. ' the fancy characters are all replaced by question marks
  2269. ' isolate the text of the field
  2270. ' put the text to the right of the insert point into sRight, and
  2271. ' the text to the left of the insert point into sLeft
  2272. sLeft$ = Mid(cRichTextBox.Text, 1, lSelStart)
  2273. sRight$ = Mid(cRichTextBox.Text, lSelStart + 1)
  2274. 'Debug.Print "Text of interest:"
  2275. 'Debug.Print sLeft$ + sRight$
  2276. ' remove parts of any following fields from the right bit of the record,
  2277. ' leaving only the right part of the one field
  2278. lPtr = LocalMarcRecord.Rat(sLeft$, vbLf)
  2279. If lPtr = 0 Then
  2280. lPtr = LocalMarcRecord.Rat(sLeft$, vbCr)
  2281. End If
  2282. If lPtr > 0 Then ' it better be!
  2283. sLeft$ = Mid(sLeft$, lPtr + 1)
  2284. End If
  2285. ' remove parts of any preceding fields from the left bit of the record, leaving
  2286. ' only the left part of the one field
  2287. lPtr = InStr(sRight$, vbCr)
  2288. If lPtr = 0 Then
  2289. lPtr = LocalMarcRecord.Rat(sRight$, vbLf)
  2290. End If
  2291. If lPtr > 0 Then ' it better be!
  2292. sRight$ = Mid(sRight$, 1, lPtr - 1)
  2293. End If
  2294. ' and here's the whole field
  2295. sField$ = Trim(sLeft$ + sRight$)
  2296. ' if now we don't have anything, then we're in serious trouble
  2297. If Len(sField$) = 0 Then
  2298. Exit Function ' with default return value of zero
  2299. End If
  2300. ' isolate the field's tag, and make sure that it's all numeric
  2301. sTagToFind$ = Mid(sField$, 1, 3)
  2302. 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
  2303. Exit Function ' with default return value of zero
  2304. End If
  2305. ' we only move 010 and higher
  2306. If sTagToFind$ < "010" Then
  2307. If Not bSearch Or (bSearch And sTagToFind$ <> "001") Then
  2308. Exit Function
  2309. End If
  2310. End If
  2311. ' does the field exist at all?
  2312. LocalMarcRecord.FldMoveTop
  2313. If Not LocalMarcRecord.FldFindFirst(sTagToFind$) Then
  2314. Exit Function ' with default return value of zero
  2315. End If
  2316. ' if there is only one occurrence of the field, then
  2317. ' that one occurrence *must* be the one we want
  2318. If Not LocalMarcRecord.FldFindNext(sTagToFind$) Then
  2319. ' back up to the field we found just above
  2320. LocalMarcRecord.FldFindFirst sTagToFind$
  2321. FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer
  2322. Exit Function
  2323. End If
  2324. ' OK, so there is more than one field with this tag; we'll have
  2325. ' to do this the hard way and hope for the best
  2326. ' the RTF version uses character 135 for the delimiter; translating that
  2327. ' back to the 'real' delimiter means that we won't have to do the
  2328. ' translation in the other direction for each field in the record
  2329. sField$ = LocalMarcRecord.ReplaceCharacters(sField$, Chr(135), LocalMarcRecord.MarcDelimiter)
  2330. LocalMarcRecord.FldMoveTop
  2331. Do While LocalMarcRecord.FldFindNext(sTagToFind$)
  2332. sLeft$ = LocalMarcRecord.FldTag + ":" + LocalMarcRecord.FldInd + ": " + LocalMarcRecord.AddSpacesAroundDelimiters(LocalMarcRecord.FldText)
  2333. ' replace all of the 'special' characters with question marks
  2334. For lPtr = Len(sLeft$) To 1 Step -1
  2335. Select Case Asc(Mid(sLeft$, lPtr, 1))
  2336. Case Is > 191 ' begins 1110 or 1100: first character in multi-byte sequence
  2337. sLeft$ = LocalMarcRecord.SafeStuff(sLeft$, lPtr, 1, "?")
  2338. Case Is > 127 ' second or third character in multi-byte sequence
  2339. sLeft$ = LocalMarcRecord.SafeStuff(sLeft$, lPtr, 1, "")
  2340. End Select
  2341. Next ' lptr
  2342. If sField$ = sLeft$ Then
  2343. FindFieldCurrentlyPointedTo = LocalMarcRecord.FldPointer
  2344. Exit Function
  2345. End If
  2346. Loop
  2347. ' if we fall through to here, we were not able to find the field either way;
  2348. ' 20100402: changed by David Bucknum from zero to -1:
  2349. ' so we'll return with the default return value of -1
  2350. End Function
  2351. Public Function RomanizationAssistanceConvertWholeRecord(ByVal sRecordType$, ByVal iScript%, ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass, ByRef LocalMarcCharacterObject As Utf8CharClass) As Integer
  2352. Dim sField$, sTag$, sTagToFind$, sIndicators$, s880Indicators$, sNative6$, s8806$, sLeftEnd$, sRecord$
  2353. Dim sSelText$, sLeft$, sRight$, sRightAfterSelection$, sWholeField$, sWord$, sNewField$, sOldField$
  2354. Dim sFieldRemainderRight$, sFieldRemainderLeft$, s6$, sOriginalField$, sSfd$, s066$
  2355. Dim sTagToCopy$, sIndicatorsToCopy$, sFieldToCopy$, sNewFields$, sOldFields$
  2356. Dim sSubfieldsExcludedUniversally$, sSubfieldsExcludedByTag$, sSubfield6Code$
  2357. Dim sRLM$, sLRE$, sPDF$
  2358. Dim iRc%, iRc2%, iRepeat%, iNext6%, iRomanizationStyle%, iDirection%
  2359. Dim lPtr As Long, lSelLength As Long, lSelStart As Long, lStart As Long
  2360. Dim lFldPointer As Long, lEnd As Long
  2361. Dim bFound As Boolean, bSkipTagTest As Boolean
  2362. Dim bCreateEmptyFields As Boolean, bCreateEmpty880s As Boolean
  2363. Dim bLcPattern As Boolean
  2364. Const sLineEnd = "\par"
  2365. Const iLineEndLen = 5
  2366. If gblaRomanizationTable(iScript%).DoNotUse880Field Then
  2367. RomanizationAssistanceConvertWholeRecord = ROMANIZATIONRESULT_880NotAllowed%
  2368. Exit Function
  2369. End If
  2370. If LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindFirst("880") Then
  2371. RomanizationAssistanceConvertWholeRecord = ROMANIZATIONRESULT_880AlreadyPresent%
  2372. Exit Function
  2373. End If
  2374. ' if the record contains *any* vernacular, then we assume that we're going
  2375. ' from vernacular to roman; otherwise, we assume that we're going from
  2376. ' roman to vernacular
  2377. ' we need to know the direction before we meet up the first field during
  2378. ' translation, so we know which set of tags to apply
  2379. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  2380. iDirection% = ROMANIZATIONDIRECTION_Roman2Vernacular%
  2381. .FldMoveTop
  2382. Do While .FldMoveNext
  2383. '20101213: Bucknum changed to "V2RFieldsIncluded" check to fix R2V/V2R logic below
  2384. 'If .FldTag > "009" Then
  2385. If InStr(gblaRomanizationTable(iScript%).V2RFieldsIncluded, .FldTag) > 0 Then
  2386. Do
  2387. 'Debug.Print "Evaluating " + .FldTag + ":" + .SfdCode + ":" + .SfdText
  2388. If gblaRomanizationTable(iScript%).V2RCreateEmptyFields = True And _
  2389. .Utf8TextContainsOnlyMarc8Characters(.SfdText) = False Then
  2390. iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman%
  2391. GoTo RomanAssist_HaveDirection
  2392. ElseIf EvaluateFirstCharacter(.SfdText, iScript%, LocalMarcCharacterObject) = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  2393. iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman%
  2394. GoTo RomanAssist_HaveDirection
  2395. End If
  2396. If Not .SfdMoveNext Then
  2397. Exit Do
  2398. End If
  2399. Loop
  2400. End If
  2401. Loop
  2402. RomanAssist_HaveDirection:
  2403. End With
  2404. ' 20070227: if we're going from romanized to vernacular, then
  2405. ' figure out if we're going to try to do the work, or just
  2406. ' create dummy fields for the operator to complete
  2407. If iDirection% = ROMANIZATIONDIRECTION_Roman2Vernacular% Then
  2408. If gblaRomanizationTable(iScript%).R2VCreateEmpty880s Then
  2409. bCreateEmpty880s = True
  2410. ' 20070425: pick up a script code if it's been defined--we'll include this
  2411. ' in $6 of "empty" 880 fields, and also in 066
  2412. ' 20070830: LC addition: if there is no such code, pick up
  2413. ' a transmogrification of the langauge code instead; area reorganized
  2414. sSubfield6Code$ = gblaRomanizationTable(iScript%).R2VSubfield6Code
  2415. If LenB(sSubfield6Code$) = 0 Then
  2416. sSubfield6Code$ = Language2ScriptCode(LocalMarcRecordObjectAlreadyLoadedWithRecord.Get008Value(35, 3))
  2417. End If
  2418. If LenB(sSubfield6Code$) > 0 Then
  2419. s066$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "c" + sSubfield6Code$
  2420. If sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_HebrewAsG0$ Or _
  2421. sSubfield6Code$ = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$ Then
  2422. ' add R2L orientation code
  2423. sSubfield6Code$ = sSubfield6Code$ & "/r"
  2424. End If
  2425. ' add "/" prefix
  2426. sSubfield6Code$ = "/" + sSubfield6Code$
  2427. End If
  2428. End If
  2429. ' 20070710: set a variable for the MarcRightToLeftMarker
  2430. ' LC wants a RTL marker before and after each delimiter,
  2431. ' EXCEPT immediately following the $6 code itself
  2432. If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Or _
  2433. InStr(sSubfield6Code$, "/r") > 0 Then
  2434. ' set IncludeFormattingCharactersLcPattern = True to insert UFCs
  2435. ' 20070830: Bucknum code forces value of this here; but we think
  2436. ' this should come from the configuration file
  2437. ' instead, we're going to set directly what DB was using this
  2438. ' as a proxy for
  2439. 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = True
  2440. bLcPattern = True
  2441. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  2442. sRLM$ = .MarcRightToLeftMarker
  2443. sLRE$ = .MarcLeftToRightEmbedding
  2444. sPDF$ = .MarcPopDirectionalFormatting
  2445. End With
  2446. Else
  2447. ' set IncludeFormattingCharactersLcPattern = False to not insert UFCs
  2448. ' 20070830: Bucknum code forces value of this here; but we think
  2449. ' this should come from the configuration file
  2450. ' instead, we're going to leave sRLM at its ground state of null,
  2451. ' which seems to be the point of all of this, anyway
  2452. 'gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern = False
  2453. bLcPattern = False
  2454. End If
  2455. Else
  2456. If gblaRomanizationTable(iScript%).V2RCreateEmptyFields = True Then
  2457. bCreateEmptyFields = True
  2458. End If
  2459. End If
  2460. ' go through the record one field at a time
  2461. ' if the field contains vernacular data, copy the field to 880 and create the
  2462. ' parallel normal field with romanized vernacular data
  2463. ' if the field contains no vernacular data, copy the field to 880, converting
  2464. ' romanized text to vernacular as you go
  2465. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveTop
  2466. Do While LocalMarcRecordObjectAlreadyLoadedWithRecord.FldMoveNext
  2467. DoEvents
  2468. If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDeleted Then
  2469. If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman Then
  2470. If InStr(gblaRomanizationTable(iScript%).V2RFieldsIncluded, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag) = 0 Then
  2471. 'Debug.Print LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + " field excluded V2$"
  2472. GoTo RomanAssist_WholeRecordNextField
  2473. End If
  2474. sSubfieldsExcludedUniversally$ = gblaRomanizationTable(iScript%).V2RSubfieldsAlwaysExcluded
  2475. sSubfieldsExcludedByTag$ = gblaRomanizationTable(iScript%).V2ROtherSubfieldsExcludedByTag
  2476. Else
  2477. If InStr(gblaRomanizationTable(iScript%).R2VFieldsIncluded, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag) = 0 Then
  2478. GoTo RomanAssist_WholeRecordNextField
  2479. End If
  2480. sSubfieldsExcludedUniversally$ = gblaRomanizationTable(iScript%).R2VSubfieldsAlwaysExcluded
  2481. sSubfieldsExcludedByTag$ = gblaRomanizationTable(iScript%).R2VOtherSubfieldsExcludedByTag
  2482. End If
  2483. sTag$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag
  2484. sNewField$ = ""
  2485. sOldField$ = ""
  2486. LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveFirst
  2487. Do
  2488. ' 20070710: add RLMs before and after the delimiter/subfield codes,
  2489. ' as appropriate, but *only* if the Right2LeftMark variable is set
  2490. ' 20070713: add a LeftToRightEmbedding character (LRE) only
  2491. ' before the 880 $6 260-xx $c [dates] - a PDF is added below
  2492. ' 20121121: added 264 (RDA) to logic
  2493. If bLcPattern Then
  2494. sNewField$ = sNewField$ + sRLM$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + sRLM$
  2495. If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then
  2496. sNewField$ = sNewField$ + sLRE$
  2497. End If
  2498. Else
  2499. sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode
  2500. End If
  2501. sOldField$ = sOldField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  2502. If bCreateEmpty880s Or bCreateEmptyFields Then
  2503. ' added 20070308 by David Bucknum
  2504. #If True Then
  2505. ' replacement proposed by Bucknum
  2506. ' include this subfield, but change it to a plus sign
  2507. ' if the 260 $c contains an ending period, add it for PDF processing
  2508. ' 20121121: added 264 (RDA) to logic
  2509. If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" And Right(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, 1) = "." Then
  2510. sNewField$ = sNewField$ + "+."
  2511. Else
  2512. sNewField$ = sNewField$ + "+"
  2513. End If
  2514. #Else
  2515. ' include this subfield without attampting to change it
  2516. sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  2517. #End If
  2518. ElseIf InStr(sSubfieldsExcludedUniversally$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) > 0 Then
  2519. ' include this subfield attempting to change it
  2520. sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  2521. ElseIf InStr(sSubfieldsExcludedByTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "/" + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode) > 0 Then
  2522. ' include this subfield without attampting to change it
  2523. sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  2524. Else ' we attempt to change this subfield
  2525. Select Case iDirection% ' EvaluateFirstCharacter(LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcCharacterObject)
  2526. Case ROMANIZATIONDIRECTION_Vernacular2Roman%, ROMANIZATIONDIRECTION_Roman2Vernacular%
  2527. If LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "a" Then
  2528. sSfd$ = ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%)
  2529. 'Debug.Print "Subfield changed: >" + sSfd$ + "<"
  2530. If sSfd$ <> LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText Then
  2531. sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode)
  2532. Else
  2533. sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode)
  2534. End If
  2535. Else
  2536. sNewField$ = sNewField$ + ReRomanizeText(sRecordType$, sTag$, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText, iScript%, LocalMarcRecordObjectAlreadyLoadedWithRecord, LocalMarcCharacterObject, iDirection%, LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode)
  2537. End If
  2538. Case Else
  2539. sNewField$ = sNewField$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdText
  2540. End Select
  2541. End If
  2542. ' 20070713: add a POPDirectionalFormatting character (PDF) only
  2543. ' at the end of the 880 $6 260-xx $c [dates] - an LRE is added above
  2544. ' 20121121: added 264 (RDA) to logic
  2545. If bLcPattern Then
  2546. If sTag$ Like "26[04]" And LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdCode = "c" Then
  2547. ' if the subfield ends with a period, place the period after the PDF
  2548. If Right(sNewField$, 1) = "." Then
  2549. sNewField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.SafeStuff(sNewField$, InStrRev(sNewField$, "."), 1, sPDF$ + ".")
  2550. Else
  2551. sNewField$ = sNewField$ + sPDF$
  2552. End If
  2553. End If
  2554. End If
  2555. If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.SfdMoveNext Then
  2556. Exit Do
  2557. End If
  2558. Loop
  2559. sIndicators$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.FldInd
  2560. ' change 880 $6 6xx-xx 2nd indicator to "4" (source not specified)
  2561. If sTag$ >= 600 And sTag$ <= 651 Then
  2562. s880Indicators$ = Mid$(sIndicators$, 1, 1) & "4"
  2563. Else
  2564. s880Indicators$ = sIndicators$
  2565. End If
  2566. If bCreateEmpty880s Then
  2567. ' we're only creating an "empty" 880 field
  2568. iNext6% = iNext6% + 1
  2569. If Len(sNewFields$) > 0 Then
  2570. sNewFields$ = sNewFields$ + vbLf
  2571. sOldFields$ = sOldFields$ + vbLf
  2572. End If
  2573. ' 20070425 script code added if available (only available if roman-to-vernacular)
  2574. #If True Then
  2575. ' changed 20070308 by David Bucknum
  2576. ' use this line if you want a truly empty 880 field *OR* fields with "+" as subfield text
  2577. If bLcPattern Then
  2578. sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sRLM$ + sNewField$
  2579. Else
  2580. sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sNewField$
  2581. End If
  2582. #Else
  2583. ' use this line if you want the 880 field to start out with text as given in the original field
  2584. If bLcPattern Then
  2585. sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sRLM$ + sOldField$
  2586. Else
  2587. sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sSubfield6Code$ + sOldField$
  2588. End If
  2589. #End If
  2590. sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$
  2591. ElseIf bCreateEmptyFields Then
  2592. ' we're only creating an "empty" romanized field
  2593. iNext6% = iNext6% + 1
  2594. If Len(sNewFields$) > 0 Then
  2595. sNewFields$ = sNewFields$ + vbLf
  2596. sOldFields$ = sOldFields$ + vbLf
  2597. End If
  2598. #If True Then
  2599. ' changed 20090524 by David Bucknum
  2600. ' use this line if you want a truly empty romanized field *OR* fields with "+" as subfield text
  2601. sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$
  2602. #Else
  2603. ' use this line if you want the 880 field to start out with text as given in the original field
  2604. sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$
  2605. #End If
  2606. sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$
  2607. Else
  2608. If sNewField$ <> sOldField$ Then ' we changed *something*!
  2609. iNext6% = iNext6% + 1
  2610. If Len(sNewFields$) > 0 Then
  2611. sNewFields$ = sNewFields$ + vbLf
  2612. sOldFields$ = sOldFields$ + vbLf
  2613. End If
  2614. If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  2615. sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$
  2616. sNewFields$ = sNewFields$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + sIndicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6880-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$
  2617. Else
  2618. sNewFields$ = sNewFields$ + "880" + s880Indicators$ + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + LocalMarcRecordObjectAlreadyLoadedWithRecord.FldTag + "-" + Right("00" + Trim(str(iNext6%)), 2) + sNewField$
  2619. sOldFields$ = sOldFields$ + Trim(str(LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer)) + vbTab + LocalMarcRecordObjectAlreadyLoadedWithRecord.MarcDelimiter + "6" + "880-" + Right("00" + Trim(str(iNext6%)), 2) + sOldField$
  2620. End If
  2621. End If
  2622. End If
  2623. End If
  2624. RomanAssist_WholeRecordNextField:
  2625. Loop
  2626. Do While Len(sOldFields$) > 0
  2627. DoEvents
  2628. GetNextPiece sOldFields$, sField$, vbLf
  2629. If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  2630. GetNextPiece sField$, sTag$, vbTab
  2631. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = Val(sTag$)
  2632. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldDelete
  2633. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "880", Mid(sField$, 1, 2), Mid(sField$, 3)
  2634. Else
  2635. GetNextPiece sField$, sTag$, vbTab
  2636. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldPointer = Val(sTag$)
  2637. ' 20100809 Bucknum added: remove temporary VowelMarker character before export
  2638. If LenB(gblaRomanizationTable(iScript%).R2VVowelMarker) > 0 Then
  2639. sField$ = LocalMarcRecordObjectAlreadyLoadedWithRecord.ReplaceCharacters(sField$, gblaRomanizationTable(iScript%).R2VVowelMarker)
  2640. End If
  2641. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldText = sField$
  2642. End If
  2643. Loop
  2644. Do While Len(sNewFields$) > 0
  2645. GetNextPiece sNewFields$, sField$, vbLf
  2646. If iDirection% = ROMANIZATIONDIRECTION_Vernacular2Roman% Then
  2647. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd Mid(sField$, 1, 3), Mid(sField$, 4, 2), LocalMarcRecordObjectAlreadyLoadedWithRecord.UCaseFirstWord(Mid(sField$, 6))
  2648. Else
  2649. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd Mid(sField$, 1, 3), Mid(sField$, 4, 2), Mid(sField$, 6)
  2650. End If
  2651. Loop
  2652. ' 20070425 build an 066 if the script identification code is available
  2653. ' only possible if building empty 880s and if roman-to-vernacular
  2654. If bCreateEmpty880s And LenB(s066$) > 0 Then
  2655. If Not LocalMarcRecordObjectAlreadyLoadedWithRecord.FldFindFirst("066") Then
  2656. LocalMarcRecordObjectAlreadyLoadedWithRecord.FldAdd "066", " ", s066$
  2657. End If
  2658. End If
  2659. End Function
  2660. Public Sub ReRomanizeAdjustNonfilingIndicators(iScript%, ByVal sNonfilingTagString$, ByVal lPointerToOriginalField As Long, ByVal lPointerToNewField As Long, ByRef LocalMarcRecord As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass)
  2661. Dim iNonfiling%, iNonfilingIndicator%, iRc%, iLen%
  2662. Dim sOriginal$
  2663. With LocalMarcRecord
  2664. .FldPointer = lPointerToOriginalField
  2665. If .SfdFindFirst("a") Then
  2666. If .FldTag = "880" Then
  2667. If .SfdFindFirst("6") Then
  2668. iRc% = InStr(sNonfilingTagString$, Mid(.SfdText, 1, 3))
  2669. End If
  2670. .SfdFindFirst "a"
  2671. Else
  2672. iRc% = InStr(sNonfilingTagString$, .FldTag)
  2673. End If
  2674. If iRc% > 0 Then
  2675. iNonfiling% = Val(Mid(sNonfilingTagString$, iRc% + 4, 1))
  2676. If iNonfiling% > 0 Then
  2677. ' we're going to ignore nonfiling indicator values of 1,
  2678. ' because they almost certainly refer to an error (such as
  2679. ' skipping an opening quotation mark)
  2680. iNonfilingIndicator% = Val(Mid(.FldInd, iNonfiling%, 1))
  2681. If iNonfilingIndicator% > 0 Then
  2682. sOriginal$ = .SafeMid(.SfdText, 1, iNonfilingIndicator%)
  2683. .FldPointer = lPointerToNewField
  2684. If .SfdFindFirst("a") Then
  2685. If Mid(.SfdText, 1, Len(sOriginal$)) <> sOriginal$ Then
  2686. ' the beginning of subfield $a in the modified field is
  2687. ' not same as the beginning of subfield $a in the original
  2688. ' field: therefore, the current operation changed the value
  2689. ' of subfield $a, and we need to address the problem of the
  2690. ' initial articla
  2691. ' at this point we have to know whether the conversion was
  2692. ' vernacular-to-script or script-to-vernacular
  2693. If .FldTag = "880" Then
  2694. ' the tag of the new field is 880; therefore, the conversion
  2695. ' was from romanized-to-vernacular; sOriginal$ contains the
  2696. ' romanized form of the critical text
  2697. sOriginal$ = ReRomanizeText("B", "500", sOriginal$, iScript%, LocalMarcRecord, LocalCharacterObject, ROMANIZATIONDIRECTION_Roman2Vernacular%)
  2698. Else
  2699. ' the tag of the new field is NOT 880; therefore, the conversion
  2700. ' was from vernacular-to-romanized; sOriginal$ contains the
  2701. ' romanized form of the critical text
  2702. sOriginal$ = ReRomanizeText("B", "500", sOriginal$, iScript%, LocalMarcRecord, LocalCharacterObject, ROMANIZATIONDIRECTION_Vernacular2Roman%)
  2703. End If
  2704. If Mid(.SfdText, 1, Len(sOriginal$)) = sOriginal$ Then
  2705. iLen% = .SafeLen(sOriginal$)
  2706. If iLen% < 9 Then
  2707. 'Debug.Print ">" + .FldInd + "< " + str(iNonfiling%) + " " + str(iLen%)
  2708. .FldInd = .SafeStuff(.FldInd, iNonfiling%, 1, Trim(str(iLen%)))
  2709. 'Debug.Print "After change: >" + .FldInd + "<"
  2710. End If
  2711. End If
  2712. End If
  2713. End If
  2714. End If
  2715. End If
  2716. End If
  2717. End If
  2718. End With
  2719. End Sub
  2720. Public Function Language2ScriptCode(ByVal sLanguageCode$) As String
  2721. Select Case sLanguageCode$
  2722. ' Case ""
  2723. ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicAsG0$
  2724. Case "heb", "yid"
  2725. Language2ScriptCode = CHARACTERSET_CODES_FOR_880_HebrewAsG0$
  2726. Case "bel", "mac", "rus", "scc", "ukr"
  2727. Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicCyrillicAsG0$
  2728. Case "ara", "per", "urd"
  2729. Language2ScriptCode = CHARACTERSET_CODES_FOR_880_BasicArabicAsG0$
  2730. Case "gre"
  2731. Language2ScriptCode = CHARACTERSET_CODES_FOR_880_GreekAsG0$
  2732. Case "chi", "jap", "kor"
  2733. Language2ScriptCode = CHARACTERSET_CODES_FOR_880_CJKAsG0$
  2734. ' don't know which, if any, languages belong here by default:
  2735. ' Case ""
  2736. ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedCyrillicAsG1$
  2737. ' Case ""
  2738. ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedArabicAsG1$
  2739. ' Case ""
  2740. ' Language2ScriptCode = CHARACTERSET_CODES_FOR_880_ExtendedLatinAsG1$
  2741. Case Else
  2742. Language2ScriptCode = ""
  2743. End Select
  2744. End Function
  2745. Public Function ReSequencePairedFields(ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass)
  2746. Dim iCtr%
  2747. Dim lPtr&
  2748. Dim sSfdText$
  2749. Dim bMatchFound As Boolean
  2750. gbliReSequenceTableLast% = 0
  2751. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  2752. ' loop through record to find non-880s with subfield $6
  2753. .FldMoveTop
  2754. Do While .FldMoveNext
  2755. ' create array of non-880 fields with subfield $6
  2756. ' with new consecutive sequence numbers
  2757. If .FldTag <> "880" Then
  2758. If .SfdFindFirst("6") = True Then
  2759. If Mid$(.SfdText, 5, 2) <> "00" Then
  2760. gbliReSequenceTableLast% = gbliReSequenceTableLast% + 1
  2761. ReDim Preserve gblaReSequenceTable(gbliReSequenceTableLast%)
  2762. gblaReSequenceTable(gbliReSequenceTableLast%).Tag = .FldTag
  2763. gblaReSequenceTable(gbliReSequenceTableLast%).Field = .FldText
  2764. gblaReSequenceTable(gbliReSequenceTableLast%).Sequence = gbliReSequenceTableLast%
  2765. ' "00" (non-paired) should not appear in a non-880 subfield $6
  2766. ' but we'll not delete it for now
  2767. ' Else: .SfdDelete
  2768. End If
  2769. End If
  2770. End If
  2771. Loop
  2772. ' cannot resequence, if no non-880 subfield $6s are found
  2773. If gbliReSequenceTableLast% = 0 Then Exit Function
  2774. ' loop through the record again to match 880s with non-880s
  2775. .FldMoveTop
  2776. Do While .FldMoveNext
  2777. ' add paired and non-paired 880s to the array
  2778. If .FldTag = "880" Then
  2779. If .SfdFindFirst("6") = True Then
  2780. ' make sure 880 $6 6xx-xx 2nd indicators are set to "4" (source not specified)
  2781. If Mid$(.SfdText, 1, 3) >= 600 And Mid$(.SfdText, 1, 3) <= 651 Then
  2782. .FldInd2 = "4"
  2783. End If
  2784. If Mid$(.SfdText, 5, 2) <> "00" Then
  2785. bMatchFound = False
  2786. For iCtr% = 1 To gbliReSequenceTableLast%
  2787. ' first make sure the 880 sequence number is zero
  2788. If gblaReSequenceTable(iCtr%).Sequence880 = 0 Then
  2789. ' if there is a match, pair the sequence numbers
  2790. ' add the link tag and field text for comparison later
  2791. If Mid$(.SfdText, 1, 3) = gblaReSequenceTable(iCtr%).Tag Then
  2792. gblaReSequenceTable(iCtr%).LinkTag = gblaReSequenceTable(iCtr%).Tag
  2793. gblaReSequenceTable(iCtr%).Field880 = .FldText
  2794. gblaReSequenceTable(iCtr%).Sequence880 = gblaReSequenceTable(iCtr%).Sequence
  2795. bMatchFound = True
  2796. Exit For
  2797. End If
  2798. End If
  2799. Next ' iCtr%
  2800. End If
  2801. ' add non-paired 880s to the array with a "00" sequence number
  2802. If bMatchFound = False Or Mid$(.SfdText, 5, 2) = "00" Then
  2803. gbliReSequenceTableLast% = gbliReSequenceTableLast% + 1
  2804. ReDim Preserve gblaReSequenceTable(gbliReSequenceTableLast%)
  2805. gblaReSequenceTable(gbliReSequenceTableLast%).Tag = .FldTag
  2806. gblaReSequenceTable(gbliReSequenceTableLast%).Field = .FldText
  2807. gblaReSequenceTable(gbliReSequenceTableLast%).Sequence = 0
  2808. gblaReSequenceTable(gbliReSequenceTableLast%).Sequence880 = 0
  2809. End If
  2810. End If
  2811. End If
  2812. Loop
  2813. ' loop through record again to resequence the paired fields
  2814. .FldMoveTop
  2815. Do While .FldMoveNext
  2816. ' get field pointer
  2817. lPtr& = .FldPointer
  2818. If Val(.FldTag) > 99 Then
  2819. If .SfdFindFirst("6") = True Then
  2820. ' loop through the field/sequence array
  2821. For iCtr% = 1 To gbliReSequenceTableLast%
  2822. ' 20080826: compare the tags and field data, if matched,
  2823. ' adjust the sequence numbers in the field, and
  2824. ' delete the field data to prevent a rematch
  2825. ' non-880s
  2826. If .FldTag = gblaReSequenceTable(iCtr%).Tag And _
  2827. .FldText = gblaReSequenceTable(iCtr%).Field Then
  2828. .SfdText = .SafeStuff(.SfdText, 5, 2, Right("00" & CStr(gblaReSequenceTable(iCtr%).Sequence), 2))
  2829. ' change field text to avoid re-matching an "empty" field (i.e. with "+" subfields)
  2830. gblaReSequenceTable(iCtr%).Field = ""
  2831. Exit For
  2832. ' 880s
  2833. ElseIf Mid$(.SfdText, 1, 3) = gblaReSequenceTable(iCtr%).LinkTag And _
  2834. .FldText = gblaReSequenceTable(iCtr%).Field880 Then
  2835. .SfdText = .SafeStuff(.SfdText, 5, 2, Right("00" & CStr(gblaReSequenceTable(iCtr%).Sequence880), 2))
  2836. ' change field text to avoid re-matching an "empty" 880 (i.e. with "+" subfields)
  2837. gblaReSequenceTable(iCtr%).Field880 = ""
  2838. Exit For
  2839. End If
  2840. Next ' iCtr%
  2841. End If
  2842. End If
  2843. ' reset field pointer
  2844. .FldPointer = lPtr&
  2845. Loop
  2846. End With
  2847. ' clear the array from memory
  2848. Erase gblaReSequenceTable
  2849. End Function
  2850. Public Function AddCharSetCodes2Utf8Record(ByRef LocalMarcRecordObjectAlreadyLoadedWithRecord As Utf8MarcRecordClass, ByVal iScript%)
  2851. Dim iPtr%, iCtr%, iNonfiling%, iIndicator%
  2852. Dim bChanged As Boolean, bError As Boolean
  2853. Dim sTag$, sIndicators$, sField$, sNonfiling$, sChar$
  2854. Dim sCharacterSetsPresent$, s066$, sSfd6$, sPiece$
  2855. Dim bLcPattern As Boolean
  2856. If gblaRomanizationTable(iScript%).R2VIncludeFormattingCharactersLcPattern Then bLcPattern = True
  2857. With LocalMarcRecordObjectAlreadyLoadedWithRecord
  2858. .FldMoveTop
  2859. Do While .FldMoveNext
  2860. iPtr% = .FldPointer
  2861. ' remove any existing 066 fields, but *not* in records with "empty" 880s
  2862. If .FldTag = "066" And gblaRomanizationTable(iScript%).R2VCreateEmpty880s = False Then .FldDelete
  2863. ' get the $6, including script codes, using a fake Utf82Marc translation
  2864. If .FldTag = "880" Then
  2865. .FldLoadInfo sTag$, sIndicators$, sField$
  2866. .TranslateUtf82MarcOneField sCharacterSetsPresent$, sTag$, sField$, bChanged, bError
  2867. If bChanged Then
  2868. If .SfdFindFirst("6") = True And _
  2869. .ExtractSubfield(sField$, "6", sSfd6$) > 0 Then
  2870. ' 20070710: add RLM to the end of subfield $6 in "empty" fields for R2L scripts
  2871. If bLcPattern Or InStr(sSfd6$, "/r") > 0 Then
  2872. sSfd6$ = sSfd6$ & .MarcRightToLeftMarker
  2873. End If
  2874. .SfdChange "6", sSfd6$
  2875. End If
  2876. End If
  2877. ' 20070710: check for and add the RLMs in the 880 fields for
  2878. ' the R2L scripts, if they have not been inserted elsewhere
  2879. If bLcPattern Or InStr(sSfd6$, "/r") > 0 Then
  2880. .FldText = .TranslateMarc2Utf8OneFieldLcPattern("880", .FldText)
  2881. ' remove any multiple UFCs from the field
  2882. .FldText = .RemoveRepeatedCharacters(.FldText, .MarcRightToLeftMarker)
  2883. .FldText = .RemoveRepeatedCharacters(.FldText, .MarcLeftToRightEmbedding)
  2884. .FldText = .RemoveRepeatedCharacters(.FldText, .MarcPopDirectionalFormatting)
  2885. End If
  2886. End If
  2887. .FldPointer = iPtr%
  2888. Loop
  2889. ' convert the string of codes representing character sets present in the record into
  2890. ' an 066 field, and add it to or change it in the record, but *not* in records with "empty" 880s
  2891. ' remove multiple spaces from the string
  2892. sCharacterSetsPresent$ = .RemoveRepeatedCharacters(Trim(sCharacterSetsPresent$), " ")
  2893. s066$ = .TranslateUtf82MarcCharacterSetString(sCharacterSetsPresent$, .MarcDelimiter + "c")
  2894. If Len(s066$) > 0 Then
  2895. If Not .FldFindFirst("066") Or gblaRomanizationTable(iScript%).R2VCreateEmpty880s = False Then
  2896. .FldAddGeneric "066", " ", s066$, 3
  2897. ElseIf .FldText <> s066$ Then
  2898. .FldChange "066", " ", s066$
  2899. End If
  2900. End If
  2901. End With
  2902. End Function
  2903. Public Function RomanizeConvertDecimalChars(ByVal sIn$, ByRef LocalMarcRecordObject As Utf8MarcRecordClass, ByRef LocalCharacterObject As Utf8CharClass) As String
  2904. ' convert "&#\d{4,5}" numeric character references to the equivalent, leaving other stuff as you find it
  2905. Dim lPtr As Long
  2906. Dim sLeader$, sOriginal$, sHexChar$
  2907. Dim iDigits%
  2908. Dim bShow As Boolean
  2909. 'If InStr(sIn$, "&#") > 0 Then
  2910. ' bShow = True
  2911. ' sOriginal$ = sIn$
  2912. 'End If
  2913. sLeader$ = "&#"
  2914. Do
  2915. lPtr = InStr(sIn$, sLeader$)
  2916. Do While lPtr > 0
  2917. ' allow conversion of up to 5-digit character references
  2918. iDigits% = Len(CStr(Val(Mid$(sIn$, lPtr + 2, 5))))
  2919. sHexChar$ = Hex$(Mid$(sIn$, lPtr + 2, iDigits%))
  2920. LocalCharacterObject.UcsHex = Right$(String$(4 - Len(sHexChar$), "0") & sHexChar$, 4)
  2921. sIn$ = LocalMarcRecordObject.SafeStuff(sIn$, lPtr, iDigits% + 2, LocalCharacterObject.Utf8Char)
  2922. lPtr = InStr(sIn$, sLeader$)
  2923. Loop
  2924. Select Case sLeader$
  2925. Case "&#"
  2926. ' scossu: added a third backslash because 2 backslashes mess up syntax coloring in Vim.
  2927. sLeader$ = "\\\"
  2928. ' scossu: added a third backslash because 2 backslashes mess up syntax coloring in Vim.
  2929. Case "\\\"
  2930. Exit Do
  2931. End Select
  2932. Loop
  2933. RomanizeConvertDecimalChars = sIn$
  2934. End Function
  2935. Public Function FindScriptByKeyPress(ByRef c As Control, ByRef KeyAscii As Integer)
  2936. Dim cb As Long
  2937. Dim FindString As String
  2938. If KeyAscii < 32 Or KeyAscii > 127 Then Exit Function
  2939. If c.SelLength = 0 Then
  2940. FindString = c.Text & Chr$(KeyAscii)
  2941. Else
  2942. FindString = Left$(c.Text, c.SelStart) & Chr$(KeyAscii)
  2943. End If
  2944. cb = SendMessage(c.hWnd, CB_FINDSTRING, -1, ByVal FindString)
  2945. If cb <> CB_ERR Then
  2946. c.ListIndex = cb
  2947. c.SelStart = Len(FindString)
  2948. c.SelLength = Len(c.Text) - c.SelStart
  2949. End If
  2950. KeyAscii = 0
  2951. End Function
  2952. Public Function IsFontInstalled(FontName As String) As Boolean
  2953. ' Returns true in function name
  2954. ' if parameter font name exists
  2955. Dim oFont As New StdFont
  2956. On Error Resume Next
  2957. IsFontInstalled = False
  2958. If LenB(FontName) > 0 Then
  2959. With oFont
  2960. .Name = FontName
  2961. If StrComp(FontName, .Name, vbTextCompare) = 0 Then IsFontInstalled = True
  2962. End With
  2963. End If
  2964. Set oFont = Nothing
  2965. End Function
  2966. Public Function CreateRomanizationScriptList(ByRef sConfigurationFilePath$, ByRef sScripts2Load As String)
  2967. Dim sMasterFile$, sFile$
  2968. Dim sScripts2LoadList$()
  2969. Dim iCtr%, iPtr%
  2970. Dim bLoadAllScripts As Boolean
  2971. sMasterFile$ = sConfigurationFilePath$ + "RomanizationMaster.cfg"
  2972. If sScripts2Load$ = vbNullString Then
  2973. bLoadAllScripts = True
  2974. Else
  2975. sScripts2LoadList$() = Split(sScripts2Load$)
  2976. End If
  2977. gbliRomanizationScriptLast% = 0
  2978. gbliRomanizationTablesBytes# = 0
  2979. Do
  2980. iCtr% = gbliRomanizationScriptLast% + 1
  2981. sFile$ = ReadIniFileOrNothing(sMasterFile$, "Files", Trim(str(iCtr%)), 250)
  2982. If LenB(sFile$) = 0 Then Exit Do
  2983. gbliRomanizationScriptLast% = gbliRomanizationScriptLast% + 1
  2984. ReDim Preserve gblaRomanizationScript(gbliRomanizationScriptLast%)
  2985. If InStr(sFile$, "\") = 0 Then
  2986. If LenB(Dir$(sConfigurationFilePath$ + sFile$)) Then
  2987. gblaRomanizationScript(gbliRomanizationScriptLast%).Name = ReadIniFileOrNothing(sConfigurationFilePath$ + sFile$, "General", "Name", 100)
  2988. gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize = FileLen(sConfigurationFilePath$ + sFile$)
  2989. End If
  2990. Else
  2991. If LenB(Dir$(sFile$)) Then
  2992. gblaRomanizationScript(gbliRomanizationScriptLast%).Name = ReadIniFileOrNothing(sFile$, "General", "Name", 100)
  2993. gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize = FileLen(sFile$)
  2994. End If
  2995. End If
  2996. If bLoadAllScripts Then
  2997. gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = True
  2998. gbliRomanizationTablesBytes# = gbliRomanizationTablesBytes# + gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize
  2999. Else
  3000. gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = False
  3001. For iPtr% = 0 To UBound(sScripts2LoadList$)
  3002. If CInt(sScripts2LoadList$(iPtr%)) = gbliRomanizationScriptLast% Then
  3003. gblaRomanizationScript(gbliRomanizationScriptLast%).LoadScript = True
  3004. gbliRomanizationTablesBytes# = gbliRomanizationTablesBytes# + gblaRomanizationScript(gbliRomanizationScriptLast%).FileSize
  3005. End If
  3006. Next ' iPtr%
  3007. End If
  3008. Loop
  3009. End Function
  3010. Public Sub LoadRomanizationTablesProgress(l As Long, ProgressBarCtrl As Control)
  3011. If ProgressBarCtrl.Value < (ProgressBarCtrl.Max - l) Then
  3012. ProgressBarCtrl.Value = ProgressBarCtrl.Value + l
  3013. End If
  3014. End Sub