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