diff options
Diffstat (limited to 'wizards/source/scriptforge/SF_Region.xba')
| -rw-r--r-- | wizards/source/scriptforge/SF_Region.xba | 861 |
1 files changed, 861 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_Region.xba b/wizards/source/scriptforge/SF_Region.xba new file mode 100644 index 000000000..d3eacfae0 --- /dev/null +++ b/wizards/source/scriptforge/SF_Region.xba @@ -0,0 +1,861 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Region" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Region +''' ========= +''' Singleton class implementing the "ScriptForge.Region" service +''' Implemented as a usual Basic module +''' +''' A collection of functions about languages, countries and timezones +''' - Locales +''' - Currencies +''' - Numbers and dates formatting +''' - Calendars +''' - Timezones conversions +''' - Numbers transformed to text +''' +''' Definitions: +''' Locale or Region +''' A combination of a language (2 or 3 lower case characters) and a country (2 upper case characters) +''' Most properties and methods require a locale as argument. +''' Some of them accept either the complete locale or only the language or country parts. +''' When absent, the considered locale is the locale used in the LibreOffice user interface. +''' (see the SF_Platform.OfficeLocale property) +''' Timezone +''' Specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00". +''' The time offset between the timezone and the Greenwich Meridian Time (GMT) is expressed in minutes. +''' The Daylight Saving Time (DST) is an additional offset. +''' Both offsets can be positive or negative. +''' More info on +''' https://timezonedb.com/time-zones +''' https://en.wikipedia.org/wiki/Time_zone +''' +''' Service invocation example: +''' Dim regio As Object +''' Set regio = CreateScriptService("Region") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_region.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================= PRIVATE MEMBERS + +Private UserLocale As String ' platform.OfficeLocale + +' Reference tables +Private LocaleData As Variant ' com.sun.star.i18n.LocaleData +Private LocaleNames As Variant ' Array of all available "la-CO" strings + +Private UserIndex As Integer ' Index of UserLocale in reference tables + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_Region Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get Country(Optional ByVal Region As Variant) As String +''' Returns the english country name applicable in the given region. +''' The region expressed either as a +''' - locale combining language-COUNTRY (la-CO) +''' - country only (CO) +''' Example: +''' MsgBox Regio.Country("IT") ' Italy + Country = _PropertyGet("Country", Region) +End Property ' ScriptForge.SF_Region.Country (get) + +REM ----------------------------------------------------------------------------- +Property Get Currency(Optional ByVal Region As Variant) As String +''' Returns the currency applicable in the given region. +''' The region is expressed either as a +''' - locale combining language-COUNTRY (la-CO) +''' - country only (CO) +''' Example: +''' MsgBox Regio.Currency("IT") ' EUR + Currency = _PropertyGet("Currency", Region) +End Property ' ScriptForge.SF_Region.Currency (get) + +REM ----------------------------------------------------------------------------- +Public Function DatePatterns(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of date acceptance patterns for the given region. +''' Patterns with input combinations that are accepted as incomplete date input, such as M/D or D.M +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.DatePatterns("it-IT"), ",") ' D/M/Y,D/M + DatePatterns = _PropertyGet("DatePatterns", Region) +End Function ' ScriptForge.SF_Region.DatePatterns (get) + +REM ----------------------------------------------------------------------------- +Property Get DateSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used in dates applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.DateSeparator("it-IT") ' / + DateSeparator = _PropertyGet("DateSeparator", Region) +End Property ' ScriptForge.SF_Region.DateSeparator (get) + +REM ----------------------------------------------------------------------------- +Public Function DayAbbrevNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of abbreviated names of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayAbbrevNames("it-IT"), ",") ' lun,mar,mer,gio,ven,sab,dom + DayAbbrevNames = _PropertyGet("DayAbbrevNames", Region) +End Function ' ScriptForge.SF_Region.DayAbbrevNames (get) + +REM ----------------------------------------------------------------------------- +Public Function DayNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of names of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayNames("it-IT"), ",") ' lunedì,martedì,mercoledì,giovedì,venerdì,sabato,domenica + DayNames = _PropertyGet("DayNames", Region) +End Function ' ScriptForge.SF_Region.DayNames (get) + +REM ----------------------------------------------------------------------------- +Public Function DayNarrowNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of initials of weekdays applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. The 1st in the list [0] is the Monday. +''' Example: +''' MsgBox Join(Regio.DayNarrowNames("it-IT"), ",") ' l,m,m,g,v,s,d + DayNarrowNames = _PropertyGet("DayNarrowNames", Region) +End Function ' ScriptForge.SF_Region.DayNarrowNames (get) + +REM ----------------------------------------------------------------------------- +Property Get DecimalPoint(Optional ByVal Region As Variant) As String +''' Returns the decimal separator used in numbers applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.DecimalPoint("it-IT") ' . + DecimalPoint = _PropertyGet("DecimalPoint", Region) +End Property ' ScriptForge.SF_Region.DecimalPoint (get) + +REM ----------------------------------------------------------------------------- +Property Get Language(Optional ByVal Region As Variant) As String +''' Returns the english Language name applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' Example: +''' MsgBox Regio.Language("it-IT") ' Italian + Language = _PropertyGet("Language", Region) +End Property ' ScriptForge.SF_Region.Language (get) + +REM ----------------------------------------------------------------------------- +Property Get ListSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used in lists applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.ListSeparator("it-IT") ' ; + ListSeparator = _PropertyGet("ListSeparator", Region) +End Property ' ScriptForge.SF_Region.ListSeparator (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthAbbrevNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of abbreviated names of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthAbbrevNames("it-IT"), ",") ' gen,feb,mar,apr,mag,giu,lug,ago,set,ott,nov,dic + MonthAbbrevNames = _PropertyGet("MonthAbbrevNames", Region) +End Function ' ScriptForge.SF_Region.MonthAbbrevNames (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of names of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthNames("it-IT"), ",") ' gennaio,febbraio,marzo,aprile,maggio,giugno,luglio,agosto,settembre,ottobre,novembre,dicembre + MonthNames = _PropertyGet("MonthNames", Region) +End Function ' ScriptForge.SF_Region.MonthNames (get) + +REM ----------------------------------------------------------------------------- +Public Function MonthNarrowNames(Optional ByVal Region As Variant) As Variant ' Function better than Property when return value is an array +''' Returns list of initials of months applicable in the given region. +''' The region expressed as a +''' - locale combining language-COUNTRY (la-CO) +''' - language only (la) +''' The list is zero-based. +''' Example: +''' MsgBox Join(Regio.MonthNarrowNames("it-IT"), ",") ' g,f,m,a,m,g,l,a,s,o,n,d + MonthNarrowNames = _PropertyGet("MonthNarrowNames", Region) +End Function ' ScriptForge.SF_Region.MonthNarrowNames (get) + +REM ----------------------------------------------------------------------------- +Property Get ObjectType As String +''' Only to enable object representation + ObjectType = "SF_Region" +End Property ' ScriptForge.SF_Region.ObjectType + +REM ----------------------------------------------------------------------------- +Property Get ServiceName As String +''' Internal use + ServiceName = "ScriptForge.Region" +End Property ' ScriptForge.SF_Region.ServiceName + +REM ----------------------------------------------------------------------------- +Property Get ThousandSeparator(Optional ByVal Region As Variant) As String +''' Returns the thousands separator used in numbers applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.ThousandSeparator("it-IT") ' . + ThousandSeparator = _PropertyGet("ThousandSeparator", Region) +End Property ' ScriptForge.SF_Region.ThousandSeparator (get) + +REM ----------------------------------------------------------------------------- +Property Get TimeSeparator(Optional ByVal Region As Variant) As String +''' Returns the separator used to format times applicable in the given region. +''' The region is expressed as a locale combining language-COUNTRY (la-CO) +''' Example: +''' MsgBox Regio.TimeSeparator("it-IT") ' : + TimeSeparator = _PropertyGet("TimeSeparator", Region) +End Property ' ScriptForge.SF_Region.TimeSeparator (get) + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function DSTOffset(Optional ByVal LocalDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Integer +''' Computes the additional offset due to daylight saving ("summer time") +''' Args +''' LocalDateTime: local date and time as a Date. DST offset varies during the year. +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The offset in minutes +''' Examples: +''' regio.DSTOffset(DateSerial(2022, 8, 20) + TimeSerial(16, 58, 17), "Europe/Brussels", "fr-BE") ' 60 + +Dim iDSTOffset As Integer ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.DSTOffset" +Const cstSubArgs = "LocalDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iDSTOffset = 0 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(LocaldateTime) + iDSTOffset = .getValue(com.sun.star.i18n.CalendarFieldIndex.DST_OFFSET) + End With + +Finally: + DSTOffset = iDSTOffset + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.DSTOffset + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant _ + , Optional Region As Variant _ + ) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Region: the language-COUNTRY combination (la-CO) or the country (CO- or the language (la) +''' Returns: +''' The actual value of the property +''' Exceptions: +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "Region.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If IsMissing(Region) Or IsEmpty(Region) Then Region = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(Region, "Region", V_STRING) Then GoTo Catch + End If + +Try: + If Len(Region) = 0 Then + GetProperty = _PropertyGet(PropertyName) + Else + GetProperty = _PropertyGet(PropertyName, Region) + End If + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function LocalDateTime(Optional ByVal UTCDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the local date and time from a UTC date and time +''' Args +''' UTCDateTime: the universal date and time to be converted to local time +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The local time converted from the corresponding UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the timezone is not recognized +''' Examples: +''' regio.LocalDateTime(DateSerial(2022, 3, 20) + TimeSerial(16, 58, 17), "Europe/Brussels", "fr-BE") +''' ' 2022-03-20 17:58:17 + +Dim dLocalDateTime As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.LocalDateTime" +Const cstSubArgs = "UTCDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dLocalDateTime = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setDateTime(UTCDateTime) + dLocalDateTime = .getLocalDateTime() + End With + +Finally: + LocalDateTime = CDate(dLocalDateTime) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.LocalDateTime + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Region class as an array + + Methods = Array( _ + "DSTOffset" _ + , "LocalDateTime" _ + , "Number2Text" _ + , "TimeZoneOffset" _ + , "UTCDateTime" _ + , "UTCNow" _ + ) + +End Function ' ScriptForge.SF_Region.Methods + +REM ----------------------------------------------------------------------------- +Public Function Number2Text(Optional ByVal Number As Variant _ + , Optional ByVal Locale As Variant _ + ) As String +''' Convert numbers and money amounts in many languages into words +''' Args +''' Number: the number to spell out +''' Accepted types: strings or numeric values (integer or real numbers) +''' When a string, a variety of prefixes is supported +''' The string "help" provides helpful tips about allowed prefixes by language +''' Example for french +''' un, deux, trois +''' feminine: une, deux, trois +''' masculine: un, deux, trois +''' ordinal: premier, deuxième, troisième +''' ordinal-feminine: première, deuxième, troisième +''' ordinal-masculine: premier, deuxième, troisième +''' informal: onze-cents, douze-cents, treize-cents +''' Numbers may be prefixed by ISO currency codes (EUR, USD, ...) +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or language alone (la) +''' The list of supported languages can be found on +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1linguistic2_1_1XNumberText.html +''' Return: +''' The number or amount transformed in words +''' Examples: +''' regio.Number2Text("help", "fr") ' See above +''' regio.Number2Text("79,93", "fr-BE") ' septante-neuf virgule nonante-trois +''' regio.Number2Text(Pi(), "pt-BR") ' três vírgula um quatro um cinco nove dois seis cinco três cinco oito nove sete nove +''' regio.Number2Text("EUR 1234.56", "it") ' milleduecentotrentaquattro euro cinquantasei centesimi + +Dim sNumber2Text As String ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oNumber2Text As Object ' com.sun.star.linguistic2.NumberText +Const cstThisSub = "Region.Number2Text" +Const cstSubArgs = "Number, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sNumber2Text = "" + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(Number, "Number", Array(V_STRING, V_NUMERIC)) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbLanguage := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oNumber2Text = SF_Utils._GetUNOService("Number2Text") + sNumber2Text = oNumber2Text.getNumberText(Number, oLocale) + +Finally: + Number2Text = sNumber2Text + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.Number2Text + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Region class as an array + + Properties = Array( _ + "Country" _ + , "Currency" _ + , "DatePatterns" _ + , "DateSeparator" _ + , "DayAbbrevNames" _ + , "DayNames" _ + , "DayNarrowNames" _ + , "DecimalPoint" _ + , "Language" _ + , "ListSeparator" _ + , "MonthAbbrevNames" _ + , "MonthNames" _ + , "MonthNarrowNames" _ + , "ThousandSeparator" _ + , "TimeSeparator" _ + ) + +End Function ' ScriptForge.SF_Region.Properties + +REM ----------------------------------------------------------------------------- +Public Function TimeZoneOffset(Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Integer +''' Computes the offset between GMT and the given timezone and locale +''' Args +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The offset in minutes +''' Examples: +''' regio.TimeZoneOffset("Europe/Brussels", "fr-BE") ' 60 + +Dim iTimeZoneOffset As Integer ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.TimeZoneOffset" +Const cstSubArgs = "TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + iTimeZoneOffset = 0 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + iTimeZoneOffset = .getValue(com.sun.star.i18n.CalendarFieldIndex.ZONE_OFFSET) + End With + +Finally: + TimeZoneOffset = iTimeZoneOffset + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.TimeZoneOffset + +REM ----------------------------------------------------------------------------- +Public Function UTCDateTime(Optional ByVal LocalDateTime As Variant _ + , Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the UTC date and time of a given local date and time +''' Args +''' LocalDateTime: the date and time measured in a given timezone +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The local time converted to the corresponding UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the the timezone is not recognized +''' Examples: +''' regio.UTCDateTime(DateSerial(2022, 3, 20) + TimeSerial(17, 58, 17), "Europe/Brussels", "fr-BE") +''' ' 2022-03-20 16:58:17 + +Dim dUTCDateTime As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.UTCDateTime" +Const cstSubArgs = "LocalDateTime, TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dUTCDateTime = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(LocalDateTime, "LocalDateTime", V_DATE) Then GoTo Finally + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(LocalDateTime) + dUTCDateTime = .getDateTime() + End With + +Finally: + UTCDateTime = CDate(dUTCDateTime) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.UTCDateTime + +REM ----------------------------------------------------------------------------- +Public Function UTCNow(Optional ByVal TimeZone As Variant _ + , Optional ByVal Locale As Variant _ + ) As Date +''' Computes the actual UTC date and time +''' Args +''' TimeZone: specified as "Region/City" name like "Europe/Berlin", or a custom time zone ID such as "UTC" or "GMT-8:00" +''' Locale: expressed as a locale combining language-COUNTRY (la-CO), or COUNTRY alone (CO) +''' Return: +''' The actual UTC date and time as a Date +''' If the returned value is before 1900, it is likely that the Locale is not recognized +''' If the returned value matches the local time, it is likely that the the timezone is not recognized +''' Examples: +''' regio.UTCNow("Europe/Brussels", "fr-BE") ' 2022-03-20 16:58:17 + +Dim dUTCNow As Double ' Return value +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Const cstThisSub = "Region.UTCNow" +Const cstSubArgs = "TimeZone, [Locale=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dUTCNow = -1 + +Check: + If IsMissing(Locale) Or IsEmpty(Locale) Then Locale = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(TimeZone, "TimeZone", V_STRING) Then GoTo Finally + If Not SF_Utils._Validate(Locale, "Locale", V_STRING) Then GoTo Finally + End If + + Set oLocale = SF_Region._GetLocale(Locale, pbCountry := True) + If IsNull(oLocale) Then GoTo Finally + +Try: + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendarTZ(oLocale, TimeZone) + .setLocalDateTime(Now()) + dUTCNow = .getDateTime() + End With + +Finally: + UTCNow = CDate(dUTCNow) + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Region.UTCNow + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _GetLocale(ByVal psLocale As String _ + , Optional ByVal pbCountry As Variant _ + , Optional ByVal pbLanguage As Variant _ + ) As Object +''' Convert a locale given as a string to a com.sun.star.lang.Locale object +''' Args: +''' psLocale: the input string, as "la-CO", "la" or "CO" +''' pbCountry: True when "CO" only is admitted +''' pbLanguage: True when "la" only is admitted +''' At most one out of pbLanguage or pbCountry may be True +''' Returns: +''' com.sun.star.lang.Locale + +Dim sLocale As String ' "la-CO" +Dim iLocale As Integer ' Index in reference tables +Dim oLocale As Object ' Return value com.sun.star.lang.Locale +Dim i As Integer + + If IsMissing(pbCountry) Or IsEmpty(pbCountry) Then pbCountry = False + If IsMissing(pbLanguage) Or IsEmpty(pbLanguage) Then pbLanguage = False + + _LoadAllLocales() ' Initialize locale reference tables + +Check: + ' The argument may be a language "la", a country "CO" or a Locale "la-CO" + ' Scan the reference tables to find a valid locale as a com.sun.star.lang.Locale + Set oLocale = Nothing : sLocale = "" : iLocale = -1 + If Len(psLocale) = 0 Then ' Default value is the office com.sun.star.i18n.Locale + sLocale = UserLocale + iLocale = UserIndex + ElseIf InStr(psLocale, "-") = 0 Then ' Language only or country only + Select Case True + Case pbLanguage + ' Find any locale having the argument as language + For i = 0 To UBound(LocaleNames) + ' A language is presumed 2 or 3 characters long + If Split(LocaleNames(i), "-")(0) = LCase(psLocale) Then + sLocale = LocaleNames(i) + iLocale = i + Exit For + End If + Next i + Case pbCountry + ' Find any locale having the argument as country + For i = 0 To UBound(LocaleNames) + ' A country is presumed exactly 2 characters long + If Right(LocaleNames(i), 2) = UCase(psLocale) Then + sLocale = LocaleNames(i) + iLocale = i + Exit For + End If + Next i + Case Else + End Select + Else ' A full locale is given + iLocale = SF_Array.IndexOf(LocaleNames, psLocale, CaseSensitive := False) + If iLocale >= 0 Then sLocale = LocaleNames(iLocale) + End If + +Try: + ' Build error message when relevant + If iLocale < 0 Then + If Not SF_Utils._Validate(psLocale, "Locale", V_STRING, LocaleNames) Then GoTo Finally + Else + Set oLocale = CreateUnoStruct("com.sun.star.lang.Locale") + oLocale.Language = Split(sLocale, "-")(0) ' A language is 2 or 3 characters long + oLocale.Country = Right(sLocale, 2) + End If + +Finally: + Set _GetLocale = oLocale + Exit Function +End Function ' ScriptForge.SF_Region._GetLocale + +REM ----------------------------------------------------------------------------- +Private Sub _LoadAllLocales() +''' Initialize the LocaleNames array = the list of all available locales in the LibreOffice installation + +Dim oOffice As Object ' com.sun.star.lang.Locale +Dim vLocales As Variant ' Array of com.sun.star.lang.Locale +Dim iTop As Integer ' Upper bound of LocaleNames +Dim i As Integer + +Try: + ' Office locale + If Len(UserLocale) = 0 Then + Set oOffice = SF_Utils._GetUNOService("OfficeLocale") + UserLocale = oOffice.Language & "-" & oOffice.Country + End If + + ' LocaleData, localeNames and UserIndex + If IsEmpty(LocaleData) Or IsNull(LocaleData) Or Not IsArray(LocaleNames) Then + LocaleData = SF_Utils._GetUNOService("LocaleData") + vLocales = LocaleData.getAllInstalledLocaleNames() + LocaleNames = Array() + iTop = UBound(vLocales) + ReDim LocaleNames(0 To iTop) + For i = 0 To iTop + LocaleNames(i) = vLocales(i).Language & "-" & vLocales(i).Country + If LocaleNames(i) = UserLocale Then UserIndex = i + Next i + End If + +End Sub ' ScriptForge.SF_Region._LoadAllLocales + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional ByVal pvLocale As Variant) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property +''' pvLocale: a locale in the form language-COUNTRY (la-CO) or language only, or country only +''' When language or country only, any locale matching either the language or the country is selected + +Dim oLocale As Object ' com.sun.star.lang.Locale +Dim vCurrencies As Variant ' Array of com.sun.star.i18n.Currency +Dim oCurrency As Object ' com.sun.star.i18n.Currency +Dim oLanguageCountryInfo As Object ' com.sun.star.i18n.LanguageCountryInfo +Dim oLocaleDataItem2 As Object ' com.sun.star.i18n.LocaleDataItem2 +Dim oCalendarImpl As Object ' com.sun.star.i18n.CalendarImpl +Dim oCalItem As Object ' com.sun.star.i18n.CalendarItem2 +Dim vCalItems() As Variant ' Array of days/months +Dim i As Integer, j As Integer + +Dim cstThisSub As String +Const cstSubArgs = "" + + cstThisSub = "Region.Get" & psProperty + SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + +Check: + If IsMissing(pvLocale) Or IsEmpty(pvLocale) Then pvLocale = "" + If Not SF_Utils._Validate(pvLocale, "Locale", V_STRING) Then GoTo Finally + + Select Case psProperty + Case "Currency", "Country" + Set oLocale = SF_Region._GetLocale(pvLocale, pbCountry := True) ' Country only is admitted + Case "Language", "DayNames", "DayAbbrevNames", "DayNarrowNames" _ + , "MonthNames", "MonthAbbrevNames", "MonthNarrowNames" + Set oLocale = SF_Region._GetLocale(pvLocale, pbLanguage := True) ' Language only is admitted + Case Else + Set oLocale = SF_Region._GetLocale(pvLocale) + End Select + If IsNull(oLocale) Then GoTo Finally + +Try: + Select Case psProperty + Case "Country", "Language" + Set oLanguageCountryInfo = LocaleData.getLanguageCountryInfo(oLocale) + With oLanguageCountryInfo + If psProperty = "Country" Then _PropertyGet = .CountryDefaultName Else _PropertyGet = .LanguageDefaultName + End With + Case "Currency" + vCurrencies = LocaleData.getAllCurrencies(oLocale) + _PropertyGet = "" + For Each oCurrency In vCurrencies + If oCurrency.Default Then + _PropertyGet = oCurrency.BankSymbol + Exit For + End If + Next oCurrency + Case "DatePatterns" + _PropertyGet = LocaleData.getDateAcceptancePatterns(oLocale) + Case "DateSeparator", "DecimalPoint", "ListSeparator", "ThousandSeparator", "TimeSeparator" + Set oLocaleDataItem2 = LocaleData.getLocaleItem2(oLocale) + With oLocaleDataItem2 + Select Case psProperty + Case "DateSeparator" : _PropertyGet = .dateSeparator + Case "DecimalPoint" : _PropertyGet = .decimalSeparator + Case "ListSeparator" : _PropertyGet = .listSeparator + Case "ThousandSeparator" : _PropertyGet = .thousandSeparator + Case "TimeSeparator" : _PropertyGet = .timeSeparator + End Select + End With + Case "DayAbbrevNames", "DayNames", "DayNarrowNames" + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendar(oLocale) + vCalItems = Array() : ReDim vCalItems(0 To 6) + For i = 0 To UBound(.Days2) + Set oCalItem = .Days2(i) + j = Iif(i = 0, 6, i - 1) + Select Case psProperty + Case "DayNames" : vCalItems(j) = oCalItem.FullName + Case "DayAbbrevNames" : vCalItems(j) = oCalItem.AbbrevName + Case "DayNarrowNames" : vCalItems(j) = oCalItem.NarrowName + End Select + Next i + _PropertyGet = vCalItems + End With + Case "MonthAbbrevNames", "MonthNames", "MonthNarrowNames" + Set oCalendarImpl = SF_Utils._GetUNOService("CalendarImpl") + With oCalendarImpl + .loadDefaultCalendar(oLocale) + vCalItems = Array() : ReDim vCalItems(0 To 11) + For i = 0 To UBound(.Months2) + Set oCalItem = .Months2(i) + Select Case psProperty + Case "MonthNames" : vCalItems(i) = oCalItem.FullName + Case "MonthAbbrevNames" : vCalItems(i) = oCalItem.AbbrevName + Case "MonthNarrowNames" : vCalItems(i) = oCalItem.NarrowName + End Select + Next i + _PropertyGet = vCalItems + End With + Case Else + _PropertyGet = "" + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' ScriptForge.SF_Region._PropertyGet + +REM ================================================ END OF SCRIPTFORGE.SF_REGION +</script:module>
\ No newline at end of file |