ReRomanizeRecord.bas 208 KB

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