home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2004 January
/
PCWorld_2004-01_cd.bin
/
akce
/
openoffice
/
f_0183
/
CalendarMain.xba
< prev
next >
Wrap
Extensible Markup Language
|
2002-10-29
|
10KB
|
298 lines
<?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="CalendarMain" script:language="StarBasic">Option Explicit
Const _DEBUG = 0
' CalenderMain
Public sCurLangLocale as String
Public sCurCountryLocale as String
' This flag serves as a query if the individual Data should be saved
Public bCalOwnDataChanged as Boolean
'BankHoliday Functions
Public CalBankholidayName$ (1 To 374)
Public CalTypeOfBankHoliday% (1 To 374)
Public Const cHolidayType_None = 0
Public Const cHolidayType_Full = 1
Public Const cHolidayType_Half = 2
Public Const cHolidayType_Own = 4
Public cCalSubcmdDeleteSelect_DeleteSelEntry$
Public cCalSubcmdDeleteSelect_DeleteSelEntryTitle$
Public cCalSubcmdSwitchOwnDataOrGeneral_Back$
Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$
'Language
Public cCalLongMonthNames(11) as String
Public cCalShortMonthNames(11) as String
Public sBitmapFilename$
Public sCalendarTitle$, sMonthTitle$, sWizardTitle$, sError$
Public cCalStyleWorkday$, cCalStyleWeekend$
Public CalChoosenLand as Integer
Public oDocument as Object
Public oSheets as Object
Public oSheet as Object
Public oStatusLine as Object
Public bCancelTask as Boolean
Public oNumberFormatter as Object
' BL* means "BundesLand" (for german states only)
Public CONST CalBLBayern = 1
Public CONST CalBLBadenWuert = 2
Public CONST CalBLBerlin = 3
Public CONST CalBLBremen = 4
Public CONST CalBLBrandenburg = 5
Public CONST CalBLHamburg = 6
Public CONST CalBLHessen = 7
Public CONST CalBLMeckPomm = 8
Public CONST CalBLNiedersachsen = 9
Public CONST CalBLNordrheinWest = 10
Public CONST CalBLRheinlandPfalz = 11
Public CONST CalBLSaarland = 12
Public CONST CalBLSachsen = 13
Public CONST CalBLSachsenAnhalt = 14
Public CONST CalBLSchlHolstein = 15
Public CONST CalBLThueringen = 16
Public DlgCalendar as Object
Public DlgCalModel as Object
Public lDateFormat as Long
Public lDateStandardFormat as Long
Sub CalAutopilotTable()
Dim BitmapDir as String
Dim iThisMonth as Integer
'On Error Goto ErrorHandler
BasicLibraries.LoadLibrary("Tools")
bSelectByMouseMove = True
oDocument = ThisComponent
oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
ToggleWindow(False)
sCurLangLocale = oDocument.CharLocale.Language
sCurCountryLocale = oDocument.CharLocale.Country
DlgCalendar = LoadDialog("Schedule", "DlgCalendar")
DlgCalModel = DlgCalendar.Model
LoadLanguage(sCurLangLocale)
CalInitGlobalVariablesDate()
BitmapDir = GetOfficeSubPath("Template","wizard/bitmap")
DlgCalModel.imgCountry.ImageURL = BitmapDir & sBitmapFilename
CalChoosenLand = -2
CalLoadOwnData()
With DlgCalModel
.cmdDelete.Enabled = False
.lstMonth.StringItemList() = cCalShortMonthNames()
Select Case sCurLangLocale
Case cLANGUAGE_JAPANESE
.lstOwnData.FontName = "HG Mincho Light J"
.txtEvent.FontName = "HG Mincho Light J"
Case cLANGUAGE_CHINESE
If oDocument.CharLocale.Country = "CN" Then
.lstOwnData.FontName = "HG MSung Light SC"
.txtEvent.FontName = "HG MSung Light SC"
Else
.lstOwnData.FontName = "HG MSung Light TC"
.txtEvent.FontName = "HG MSung Light TC"
End If
Case "ko"
.lstOwnData.FontName = "HG MyeongJo Light K"
.txtEvent.FontName = "HG MyeongJo Light K"
End Select
.lstOwnEventMonth.StringItemList() = cCalShortMonthNames()
.optYear.State = 1
.txtYear.Value = Year(Now())
.txtYear.Tag = .txtYear.Value
.Step = 1
End With
SetupNumberFormatter(sCurLangLocale, sCurCountryLocale)
CalChooseCalendar() ' month
iThisMonth = Month(Now)
DlgCalendar.GetControl("lstMonth").SelectItemPos(iThisMonth-1, True)
DlgCalendar.GetControl("lstHolidays").SelectItemPos(0,True)
DlgCalModel.cmdGoOn.DefaultButton = True
ToggleWindow(True)
DlgCalendar.GetControl("lblHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN
DlgCalendar.GetControl("lstHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN
fHeightCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Height/198
fWidthCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Width/166
DlgCalendar.Execute()
DlgCalendar.Dispose()
Exit Sub
ErrorHandler:
MsgBox(sError$, 16, sWizardTitle$)
End Sub
Sub SetupNumberFormatter(sCurLangLocale as String, sCurCountryLocale as String)
Dim oFormats as Object
Dim DateFormatString as String
oFormats = oDocument.getNumberFormats()
Select Case sCurLangLocale
Case cLANGUAGE_GERMAN
DateFormatString = "TT.MMM"
Case cLANGUAGE_ENGLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_FRENCH
DateFormatString = "JJ/MMM"
Case cLANGUAGE_ITALIAN
DateFormatString = "GG/MMM"
Case cLANGUAGE_SPANISH
DateFormatString = "DD/MMM"
Case cLANGUAGE_PORTUGUESE
DateFormatString = "DD-MMM"
Case cLANGUAGE_DUTCH
DateFormatString = "DD-MMM"
Case cLANGUAGE_SWEDISH
DateFormatString = "MMM DD"
Case cLANGUAGE_DANISH
DateFormatString = "DD-MMM"
Case cLANGUAGE_POLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_RUSSIAN
DateFormatString = "MMM DD"
Case cLANGUAGE_JAPANESE
DateFormatString = "M月D日"
Case cLANGUAGE_CHINESE
If sCurCountryLocale = "TW" Then
DateFormatString = "MMMMD" &"""" & "µùÑ" & """"
Else
DateFormatString = "M" & """" & "月" & """" & "D" &"""" & "日" & """"
End If
Case cLANGUAGE_GREEK
DateFormatString = "DD/MMM"
Case cLANGUAGE_TURKISH
DateFormatString = "DD/MMM"
Case cLANGUAGE_POLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_FINNISH
DateFormatString = "PP.KKK"
End Select
lDateFormat = AddNumberFormat(oFormats, DateFormatString, oDocument.CharLocale)
lDateStandardFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocument.CharLocale)
' lDateStandardFormat = AddNumberFormat(oFormats, StandardDateFormatString, oDocument.CharLocale)
oNumberFormatter = createUNOService("com.sun.star.util.NumberFormatter")
oNumberFormatter.attachNumberFormatsSupplier(oDocument)
End Sub
Function AddNumberFormat(oNumberFormats as Object, FormatString as String, oLocale as Object) as Long
Dim lLocDateFormat as Long
lLocDateFormat = oNumberFormats.QueryKey(FormatString, oLocale, True)
If lLocDateFormat = -1 Then
lLocDateFormat = oNumberFormats.addNew(FormatString, oLocale)
End If
AddNumberFormat() = lLocDateFormat
End Function
Sub CalChooseCalendar()
With DlgCalModel
.lstMonth.Enabled = .optMonth.State = 1
.lblMonth.Enabled = .optMonth.State = 1
End With
End Sub
Sub CalcmdCancel()
Call CalSaveOwnData()
DlgCalendar.EndExecute
End Sub
Sub CalcmdOk()
' cmdOk is called when the Button 'Read' is clicked on
' It is either given out a month or a year
Dim i, iSelYear as Integer
Dim SelYear as String
' DlgCalendar.Visible = False
oSheets = oDocument.sheets
Call CalSaveOwnData()
UnprotectSheets(oSheets)
oSheets.RemovebyName(oSheets.GetbyIndex(0).Name)
iSelYear = DlgCalModel.txtYear.Value
Select Case sCurLangLocale
Case cLANGUAGE_GERMAN
If Ubound(DlgCalModel.lstHolidays.SelectedItems()) > -1 Then
CalChoosenLand = DlgCalModel.lstHolidays.SelectedItems(0)
Else
CalChoosenLand = 0
End If
Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand)
Case cLANGUAGE_ENGLISH
Call FindWholeYearHolidays_US(iSelYear)
Case cLANGUAGE_FRENCH
Call FindWholeYearHolidays_FRANCE(iSelYear)
Case cLANGUAGE_ITALIAN
Call FindWholeYearHolidays_ITA(iSelYear)
Case cLANGUAGE_SPANISH
Call FindWholeYearHolidays_SPAIN(iSelYear)
Case cLANGUAGE_PORTUGUESE
Call FindWholeYearHolidays_PORT(iSelYear)
Case cLANGUAGE_DUTCH
Call FindWholeYearHolidays_NL(iSelYear)
Case cLANGUAGE_SWEDISH
Call FindWholeYearHolidays_SWED(iSelYear)
Case cLANGUAGE_DANISH
Call FindWholeYearHolidays_DK(iSelYear)
Case cLANGUAGE_POLISH
Call FindWholeYearHolidays_PL(iSelYear)
Case cLANGUAGE_RUSSIAN
Call FindWholeYearHolidays_RU(iSelYear)
Case cLANGUAGE_JAPANESE
Call FindWholeYearHolidays_JP(iSelYear)
Case cLANGUAGE_CHINESE
If sCurCountryLocale = "TW" Then
Call FindWholeYearHolidays_TW(iSelYear)
Else
Call FindWholeYearHolidays_CN(iSelYear)
End If
Case cLANGUAGE_GREEK
Call FindWholeYearHolidays_GREEK(iSelYear)
Case cLANGUAGE_TURKISH
Call FindWholeYearHolidays_TRK(iSelYear)
Case cLANGUAGE_POLISH
Call FindWholeYearHolidays_PL(iSelYear)
Case cLANGUAGE_FINNISH
Call FindWholeYearHolidays_FI(iSelYear)
End Select
Call CalInsertOwnDataInTables(iSelYear)
If DlgCalModel.optYear.State = 1 Then
oSheets.RemovebyName(oSheets.GetbyIndex(0).Name)
oSheet = oSheets.GetbyIndex(0)
oSheet.Name = sCalendarTitle$ + " " + iSelYear
oDocument.AddActionLock
Call CalCreateYearTable(iSelYear)
ElseIf DlgCalModel.optMonth.State = 1 Then
Dim iMonth
iMonth = DlgCalModel.lstMonth.SelectedItems(0) + 1
oSheets.RemovebyName(oSheets.GetbyIndex(1).Name)
oSheet = oSheets.GetbyIndex(0)
If sMonthTitle = "" Then
oSheet.Name = cCalLongMonthNames(iMonth-1)
Else
oSheet.Name = sMonthTitle + " " + cCalLongMonthNames(iMonth-1)
End If
oDocument.AddActionLock
Call CalCreateMonthTable(iSelYear, iMonth)
End If
oDocument.RemoveActionLock
oSheet.protect("")
oStatusLine.End
DlgCalendar.EndExecute()
bCancelTask = True
End Sub
</script:module>