$APPTYPE GUI
$OPTIMIZE ON
$TYPECHECK ON
$ESCAPECHARS OFF
$INCLUDE "RAPIDQ.INC"
CONST Version = "2.2 SE"
CONST AppName = "Reminder " + Version
CONST Protokol = "ftp:|file:|http:|https:|mailto:"
CONST AlarmIndex = "0|1|3|5|8|15|22|33|66|99"
CONST fileHILFE = "liesmich.txt"
CONST htmlHILFE = "liesmich.htm"
CONST fileHELP = "readme.txt"
CONST htmlHELP = "readme.htm"
CONST LightBlue = &HAA0000
CONST NULL = CHR$(0)
CONST BELL = CHR$(7)
CONST TAB = CHR$(9)
CONST LF = CHR$(10)
CONST CR = CHR$(13)
CONST QUOTE = CHR$(34)
CONST VK_HOME = &H24
CONST VK_UP = &H26
CONST VK_DOWN = &H28
CONST WM_SIZE = &H5
CONST WM_PAINT = &HF
CONST WM_QUERYENDSESSION = &H11
CONST WM_KEYDOWN = &H100
CONST WM_SYSCOMMAND = &H112
CONST WM_LBUTTONDOWN = &H201
CONST WM_LBUTTONDBLCLK = &H203
CONST WM_RBUTTONDOWN = &H204
CONST WM_RBUTTONUP = &H205
CONST WM_USER = &H400
CONST WM_USERMINIMIZE = WM_USER + &H200
CONST WM_USERTRAYMSG = WM_USER + &H201
CONST SC_SIZE = &HF000
CONST SC_MINIMIZE = &HF020
CONST SC_MAXIMIZE = &HF030
CONST SC_CLOSE = &HF060
CONST SC_RESTORE = &HF120
CONST SW_SHOWNORMAL = &H1
CONST CSIDL_STARTUP = &H7
CONST FO_DELETE = &H3
CONST FOF_NOCONFIRMATION = &H10
CONST FOF_ALLOWUNDO = &H40
CONST NIM_ADD = &H0
CONST NIM_MESSAGE = &H1
CONST NIM_DELETE = &H2
CONST NIM_ICON = &H2
CONST NIM_TIP = &H4
CONST SWP_NOSIZE = &H1
CONST SWP_NOMOVE = &H2
CONST HWND_TOPMOST = (-1)
CONST GWL_WNDPROC = (-4)
CONST GWL_HWNDPARENT = (-8)
TYPE OSVERSIONINFO
dwOSVersionInfoSize AS LONG
dwMajorVersion AS LONG
dwMinorVersion AS LONG
dwBuildNumber AS LONG
dwPlatformId AS LONG
szCSDVersion AS STRING * 128
END TYPE
TYPE SHFILEOPSTRUCT
hWnd AS LONG
wFunc AS LONG
pFrom AS LONG
pTo AS LONG
fFlags AS INTEGER
fAborted AS LONG
hNameMaps AS LONG
sProgress AS LONG
END TYPE
TYPE ITEMIDLIST
mkid AS LONG
END TYPE
TYPE SYSTEMTIME
wYear AS WORD
wMonth AS WORD
wDayOfWeek AS WORD
wDay AS WORD
wHour AS WORD
wMinute AS WORD
wSecond AS WORD
wMilliseconds AS WORD
END TYPE
DECLARE SUB MenuExitClick (Sender AS QMAINMENU)
DECLARE SUB MenuInfoClick (Sender AS QMAINMENU)
DECLARE SUB MenuHelpClick (Sender AS QMAINMENU)
DECLARE SUB MenuTutorialClick (Sender AS QMAINMENU)
DECLARE SUB MenuSaveClick (Sender AS QMAINMENU)
DECLARE SUB MenuExportClick (Sender AS QMAINMENU)
DECLARE SUB MenuOpenClick (Sender AS QMENUITEM)
DECLARE SUB MenuEditClick (Sender AS QMENUITEM)
DECLARE SUB MenuCopyClick (Sender AS QMENUITEM)
DECLARE SUB MenuCopyAllClick (Sender AS QMENUITEM)
DECLARE SUB MenuCopyAlarmClick (Sender AS QMENUITEM)
DECLARE SUB MenuWordWrapClick (Sender AS QMENUITEM)
DECLARE SUB MenuOpenFlagClick (Sender AS QMENUITEM)
DECLARE SUB MenuExportFlagClick (Sender AS QMENUITEM)
DECLARE SUB MenuUseBasketClick (Sender AS QMENUITEM)
DECLARE SUB MenuShortcutClick (Sender AS QMENUITEM)
DECLARE SUB DatePrevClick (Sender AS QBUTTON)
DECLARE SUB DateCurrClick (Sender AS QBUTTON)
DECLARE SUB DateNextClick (Sender AS QBUTTON)
DECLARE SUB ButtonEditClick (Sender AS QBUTTON)
DECLARE SUB ButtonAddClick (Sender AS QBUTTON)
DECLARE SUB ButtonDeleteClick (Sender AS QBUTTON)
DECLARE SUB ButtonClearClick (Sender AS QBUTTON)
DECLARE SUB ButtonOkClick (Sender AS QBUTTON)
DECLARE SUB ButtonCancelClick (Sender AS QBUTTON)
DECLARE SUB ButtonCloseClick (Sender AS QBUTTON)
DECLARE SUB ButtonGermanClick (Sender AS QBUTTON)
DECLARE SUB ButtonEnglishClick (Sender AS QBUTTON)
DECLARE SUB ListBoxClick (Sender AS QLISTVIEW)
DECLARE SUB ListBoxDblClick (Sender AS QLISTVIEW)
DECLARE SUB ListViewDblClick (Sender AS QLISTVIEW)
DECLARE SUB ListBoxKey (key AS BYTE)
DECLARE SUB ListViewKey (key AS BYTE)
DECLARE SUB RadioButtonClick (Sender AS QRADIOBUTTON)
DECLARE SUB ComboBoxAlarmChange (Sender AS QCOMBOBOX)
DECLARE SUB ComboBoxFilterChange (Sender AS QCOMBOBOX)
DECLARE SUB ComboBoxCategoryChange (Sender AS QCOMBOBOX)
DECLARE SUB ListBoxChange (Index AS SHORT, Change AS BYTE)
DECLARE SUB EditChange (Sender AS QEDIT)
DECLARE SUB FormClose (Action AS INTEGER)
DECLARE SUB DefaultClose (Action AS INTEGER)
DECLARE SUB DefaultPaint (Sender AS QFORM)
DECLARE SUB MessageOkCancelClick (Sender AS QBUTTON)
DECLARE SUB MessageYesClick (Sender AS QBUTTON)
DECLARE SUB MessageNoClick (Sender AS QBUTTON)
DECLARE SUB MessageOpenClick (Sender AS QCOOLBTN)
DECLARE SUB MessageOnShow (Sender AS QFORM)
DECLARE SUB ImagePaintDark (Sender AS QCANVAS)
DECLARE SUB ImagePaintLight (Sender AS QCANVAS)
DECLARE SUB AlarmOnResize (Sender AS QFORM)
DECLARE SUB AlarmOnShow (Sender AS QFORM)
DECLARE SUB ChangesYesClick (Sender AS QBUTTON)
DECLARE SUB ChangesNoClick (Sender AS QBUTTON)
DECLARE SUB ChangesCancelClick (Sender AS QBUTTON)
DECLARE SUB DummyOnShow (Sender AS QFORM)
DECLARE SUB WndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)
DECLARE SUB TrayInterrupt
DECLARE SUB TrayOpen
DECLARE SUB TrayClose
DECLARE FUNCTION GetVersionExAPI LIB "kernel32" ALIAS "GetVersionExA" (lpVersionInformation AS OSVERSIONINFO) AS LONG
DECLARE FUNCTION FreeLibraryAPI LIB "kernel32" ALIAS "FreeLibrary" (BYVAL hModule AS LONG) AS LONG
DECLARE FUNCTION LoadLibraryAPI LIB "kernel32" ALIAS "LoadLibraryA" (BYVAL lpFileName AS STRING) AS LONG
DECLARE FUNCTION GetFullPathNameAPI LIB "kernel32" ALIAS "GetFullPathNameA" (BYVAL lpFileName AS STRING, BYVAL nBufferLength AS LONG, BYVAL lpBuffer AS LONG, BYVAL lpFilePart AS STRING) AS LONG
DECLARE FUNCTION Shell_NotifyIconAPI LIB "shell32" ALIAS "Shell_NotifyIconA" (BYVAL dwMessage AS LONG, BYVAL lpData AS QNOTIFYICONDATA) AS LONG
DECLARE FUNCTION ShellExecuteAPI LIB "shell32" ALIAS "ShellExecuteA" (BYVAL hWnd AS LONG, BYVAL lpOperation AS STRING, BYVAL lpFile AS STRING, BYVAL lpParameters AS STRING, BYVAL lpDirectory AS STRING, BYVAL nShowCmd AS LONG) AS LONG
DECLARE FUNCTION SHFileOperationAPI LIB "shell32" ALIAS "SHFileOperationA" (lpFileOp AS SHFILEOPSTRUCT) AS LONG
DECLARE FUNCTION SHGetPathFromIDListAPI LIB "shell32" ALIAS "SHGetPathFromIDListA" (BYVAL pidl AS LONG, BYVAL pszPath AS LONG) AS LONG
DECLARE FUNCTION fCreateShellLinkAPI LIB "stkit432" ALIAS "fCreateShellLink" (BYVAL lpstrFolderName AS STRING, BYVAL lpstrLinkName AS STRING, BYVAL lpstrLinkPath AS STRING, BYVAL lpstrLinkArgs AS STRING) AS LONG
DECLARE FUNCTION SHGetSpecialFolderLocationAPI LIB "shell32" ALIAS "SHGetSpecialFolderLocation" (BYVAL hwndOwner AS LONG, BYVAL nFolder AS LONG, BYVAL pidl AS LONG) AS LONG
DECLARE FUNCTION ShowWindowAPI LIB "user32" ALIAS "ShowWindow" (hWnd AS LONG, nCmdShow AS LONG) AS LONG
DECLARE FUNCTION SetForegroundWindowAPI LIB "user32" ALIAS "SetForegroundWindow" (hWnd AS LONG) AS LONG
DECLARE FUNCTION SetFocusAPI LIB "user32" ALIAS "SetFocus" (BYVAL hWnd AS LONG) AS LONG
DECLARE FUNCTION FindWindowAPI LIB "user32" ALIAS "FindWindowA" (BYVAL lpClassName AS STRING, BYVAL lpWindowName AS STRING) AS LONG
DECLARE FUNCTION DeleteMenuAPI LIB "user32" ALIAS "DeleteMenu" (BYVAL hMenu AS LONG, BYVAL nPosition AS LONG, BYVAL wFlags AS LONG) AS LONG
DECLARE FUNCTION GetSystemMenuAPI LIB "user32" ALIAS "GetSystemMenu" (BYVAL hWnd AS LONG, BYVAL bRevert AS LONG) AS LONG
DECLARE FUNCTION GetWindowLongAPI LIB "user32" ALIAS "GetWindowLongA" (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION SetWindowLongAPI LIB "user32" ALIAS "SetWindowLongA" (BYVAL hWnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG) AS LONG
DECLARE FUNCTION SetWindowPosAPI LIB "user32" ALIAS "SetWindowPos" (BYVAL hwnd AS LONG, BYVAL hWndInsertAfter AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG) AS LONG
DECLARE FUNCTION IsIconicAPI LIB "user32" ALIAS "IsIconic" (BYVAL hwnd AS LONG) AS LONG
DIM Font AS QFONT
Font.COLOR = clBlue
DIM Font2 AS QFONT
Font2.COLOR = LightBlue
DIM Font3 AS QFONT
Font3.AddStyles fsBold
DIM Font4 AS QFONT
CREATE Form AS QFORM
CAPTION = AppName
BorderStyle = bsSingle
DelBorderIcons biMaximize
Width = 640
Height = 480
Center
OnClose = FormClose
OnPaint = DefaultPaint
CREATE MainMenu AS QMAINMENU
CREATE FileMenu AS QMENUITEM
CAPTION = "&File"
CREATE SaveItem AS QMENUITEM
CAPTION = "&Save"
OnClick = MenuSaveClick
END CREATE
CREATE OpenItem AS QMENUITEM
CAPTION = "&Open"
Visible = 0
CREATE OpenItem1 AS QMENUITEM
CAPTION = ""
Visible = 0
OnClick = MenuOpenClick
END CREATE
CREATE OpenItem2 AS QMENUITEM
CAPTION = ""
Visible = 0
OnClick = MenuOpenClick
END CREATE
CREATE OpenItem3 AS QMENUITEM
CAPTION = ""
Visible = 0
OnClick = MenuOpenClick
END CREATE
CREATE OpenItem4 AS QMENUITEM
CAPTION = ""
Visible = 0
OnClick = MenuOpenClick
END CREATE
CREATE OpenItem5 AS QMENUITEM
CAPTION = ""
Visible = 0
OnClick = MenuOpenClick
END CREATE
END CREATE
CREATE BreakItem1 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE ExportItem AS QMENUITEM
CAPTION = "&Export as HTML"
OnClick = MenuExportClick
END CREATE
CREATE BreakItem2 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE ExitItem AS QMENUITEM
CAPTION = "E&xit"
OnClick = MenuExitClick
END CREATE
END CREATE
CREATE EditMenu AS QMENUITEM
CAPTION = "&Edit"
OnClick = MenuEditClick
CREATE CopyItem AS QMENUITEM
CAPTION = "&Copy to Clipboard"
CREATE CopyAllItem AS QMENUITEM
CAPTION = "All (marked) Items as &List"
OnClick = MenuCopyAllClick
END CREATE
CREATE CopyAlarmItem AS QMENUITEM
CAPTION = "&Alarm List"
OnClick = MenuCopyAlarmClick
END CREATE
CREATE BreakItem3 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE CopyCompleteItem AS QMENUITEM
CAPTION = "&Content of Data Fields"
OnClick = MenuCopyClick
END CREATE
CREATE CopyAddressItem AS QMENUITEM
CAPTION = "&Only Address"
OnClick = MenuCopyClick
END CREATE
CREATE CopyPhoneItem AS QMENUITEM
CAPTION = "Also &Phone and eMail"
OnClick = MenuCopyClick
END CREATE
END CREATE
CREATE BreakItem4 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE WordWrapItem AS QMENUITEM
CAPTION = "&Word Wrap in Comment Field"
Checked = 0
OnClick = MenuWordWrapClick
END CREATE
CREATE OpenFlagItem AS QMENUITEM
CAPTION = "Open &URL by Double Click"
Checked = 0
OnClick = MenuOpenFlagClick
END CREATE
CREATE ExportFlagItem AS QMENUITEM
CAPTION = "Open File after &Export"
Checked = 0
OnClick = MenuExportFlagClick
END CREATE
CREATE UseBasketItem AS QMENUITEM
CAPTION = "&Backup to Recycle Bin"
Checked = 1
OnClick = MenuUseBasketClick
END CREATE
CREATE BreakItem5 AS QMENUITEM
CAPTION = "-"
Visible = 0
END CREATE
CREATE ShortcutItem AS QMENUITEM
CAPTION = "Create Startup &Shortcut"
Visible = 0
OnClick = MenuShortcutClick
END CREATE
END CREATE
CREATE InfoMenu AS QMENUITEM
CAPTION = "&?"
CREATE HelpItem AS QMENUITEM
CAPTION = "&Help"
OnClick = MenuHelpClick
END CREATE
CREATE TutorialItem AS QMENUITEM
CAPTION = "&Tutorial"
OnClick = MenuTutorialClick
END CREATE
CREATE BreakItem6 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE AboutItem AS QMENUITEM
CAPTION = "&About"
OnClick = MenuInfoClick
END CREATE
END CREATE
END CREATE
CREATE Image AS QCANVAS
Top = 0
Left = 0
Width = Form.ClientWidth
Height = Form.ClientHeight
OnPaint = ImagePaintDark
END CREATE
CREATE Panel1 AS QPANEL
Left = 13
Top = 12
Height = 205
Width = 610
CREATE LabelFilter AS QLABEL
CAPTION = "Filter:"
Left = 500
Top = 10
Width = 65
END CREATE
CREATE ComboBoxFilter AS QCOMBOBOX
DropDownCount = 11
AddItems ""
Style = csDropDownList
ItemIndex = 0
Sorted = 1
Left = 500
Top = 26
Width = 96
TabOrder = 1
OnChange = ComboBoxFilterChange
END CREATE
CREATE LabelSort AS QLABEL
CAPTION = "Sort by ..."
Left = 500
Top = 55
Width = 96
END CREATE
CREATE RadioButtonName AS QRADIOBUTTON
CAPTION = "... Name"
Left = 510
Top = 72
Width = 86
TabOrder = 2
OnClick = RadioButtonClick
END CREATE
CREATE RadioButtonDate AS QRADIOBUTTON
CAPTION = "... Date"
Left = 510
Top = 89
Width = 86
TabOrder = 3
OnClick = RadioButtonClick
END CREATE
CREATE RadioButtonCategory AS QRADIOBUTTON
CAPTION = "... Category"
Left = 510
Top = 106
Width = 86
Checked = 1
TabOrder = 4
OnClick = RadioButtonClick
END CREATE
CREATE ListBox AS QLISTVIEW
Left = 14
Top = 10
Width = 460
Height = 183
MultiSelect = 1
ViewStyle = vsReport
AddColumns "Name", "Given/Sub Name", "Date", "Category"
Column(0).Width = 128
Column(1).Width = 128
Column(2).Width = 90
Column(3).Width = 90
ShowColumnHeaders = 1
ColumnClick = 0
ReadOnly = 1
RowSelect = 1
TabOrder = 5
OnClick = ListBoxClick
OnDblClick = ListBoxDblClick
OnChange = ListBoxChange
OnKeyPress = ListBoxKey
END CREATE
CREATE ButtonDelete AS QBUTTON
CAPTION = "Delete"
Enabled = 0
Left = 500
Top = 138
Width = 96
TabOrder = 6
OnClick = ButtonDeleteClick
END CREATE
CREATE DatePrev AS QBUTTON
CAPTION = "<"
Enabled = 0
Left = 500
Top = 168
Width = 28
TabOrder = 7
OnClick = DatePrevClick
END CREATE
CREATE DateCurr AS QBUTTON
CAPTION = "!"
Enabled = 0
Left = 534
Top = 168
Width = 28
TabOrder = 8
OnClick = DateCurrClick
END CREATE
CREATE DateNext AS QBUTTON
CAPTION = ">"
Enabled = 0
Left = 568
Top = 168
Width = 28
TabOrder = 9
OnClick = DateNextClick
END CREATE
END CREATE
CREATE Panel2 AS QPANEL
Left = 13
Top = 228
Width = 610
Height = 195
CREATE LabelName AS QLABEL
CAPTION = "Name:"
Left = 14
Top = 10
Width = 104
END CREATE
CREATE LabelGivenname AS QLABEL
CAPTION = "Given/Sub Name:"
Left = 130
Top = 10
Width = 104
END CREATE
CREATE LabelStreet AS QLABEL
CAPTION = "Street:"
Left = 14
Top = 55
Width = 219
END CREATE
CREATE LabelZip AS QLABEL
CAPTION = "Zip:"
Left = 14
Top = 100
Width = 67
END CREATE
CREATE LabelCity AS QLABEL
CAPTION = "City:"
Left = 92
Top = 100
Width = 141
END CREATE
CREATE LabelPhone AS QLABEL
CAPTION = "Phone 1:"
Left = 14
Top = 145
Width = 104
END CREATE
CREATE LabelFax AS QLABEL
CAPTION = "Phone 2:"
Left = 130
Top = 145
Width = 104
END CREATE
CREATE LabelDate AS QLABEL
CAPTION = "Date:"
Left = 255
Top = 10
Width = 75
END CREATE
CREATE LabelAlarm AS QLABEL
CAPTION = "Alarm:"
Left = 341
Top = 10
Width = 133
END CREATE
CREATE LabelComment AS QLABEL
CAPTION = "Comment:"
Left = 255
Top = 55
Width = 214
END CREATE
CREATE LabelMail AS QLABEL
CAPTION = "URL (eMail / Homepage):"
Left = 255
Top = 145
Width = 214
END CREATE
CREATE LabelCategory AS QLABEL
CAPTION = "Category:"
Left = 500
Top = 10
Width = 96
END CREATE
CREATE EditName AS QEDIT
Text = ""
Left = 14
Top = 26
Width = 104
TabOrder = 10
OnChange = EditChange
END CREATE
CREATE EditGivenname AS QEDIT
Text = ""
Left = 129
Top = 26
Width = 104
TabOrder = 11
OnChange = EditChange
END CREATE
CREATE EditStreet AS QEDIT
Text = ""
Left = 14
Top = 72
Width = 219
TabOrder = 12
OnChange = EditChange
END CREATE
CREATE EditZip AS QEDIT
Text = ""
Left = 14
Top = 116
Width = 67
TabOrder = 13
OnChange = EditChange
END CREATE
CREATE EditCity AS QEDIT
Text = ""
Left = 92
Top = 116
Width = 141
TabOrder = 14
OnChange = EditChange
END CREATE
CREATE EditPhone AS QEDIT
Text = ""
Left = 14
Top = 161
Width = 104
TabOrder = 15
OnChange = EditChange
END CREATE
CREATE EditFax AS QEDIT
Text = ""
Left = 129
Top = 161
Width = 104
TabOrder = 16
OnChange = EditChange
END CREATE
CREATE EditDate AS QEDIT
Text = ""
Left = 255
Top = 26
Width = 75
TabOrder = 17
OnChange = EditChange
END CREATE
CREATE ComboBoxAlarm AS QCOMBOBOX
DropDownCount = 1
AddItems "-"
Style = csDropDown
ItemIndex = 0
Left = 341
Top = 26
Width = 41
TabOrder = 18
OnChange = ComboBoxAlarmChange
END CREATE
CREATE Panel3 AS QPANEL
Left = 382
Top = 26
Width = 92
Height = ComboBoxAlarm.Height
BorderStyle = bsSingle
CREATE LabelAlarmText AS QLABEL
CAPTION = "Day(s) before"
Left = 2
Top = 2
Width = 82
Enabled = 0
END CREATE
END CREATE
CREATE EditComment AS QRICHEDIT
Text = ""
Left = 255
Top = 72
Width = 219
Height = 65
TabOrder = 19
Plaintext = 1
WordWrap = 0
HideScrollBars = 0
ScrollBars = ssVertical
OnChange = EditChange
END CREATE
CREATE EditMail AS QEDIT
Text = ""
Left = 255
Top = 161
Width = 219
TabOrder = 20
OnChange = EditChange
END CREATE
CREATE ComboBoxCategory AS QCOMBOBOX
DropDownCount = 10
Style = csDropDown
Sorted = 1
Left = 500
Top = 26
Width = 96
TabOrder = 21
OnChange = ComboBoxCategoryChange
END CREATE
CREATE Panel4 AS QPANEL
Left = 500
Top = 58
Width = 96
Height = ComboBoxAlarm.Height
BorderStyle = bsSingle
CREATE LabelNumber AS QLABEL
CAPTION = "- | 0 | 0"
Left = 2
Top = 2
Width = 86
Alignment = taRightJustify
END CREATE
END CREATE
CREATE ButtonEdit AS QBUTTON
CAPTION = "Edit"
Enabled = 0
Left = 500
Top = EditMail.Top - ButtonEdit.Height + EditMail.Height - 60
Width = 96
TabOrder = 22
OnClick = ButtonEditClick
END CREATE
CREATE ButtonAdd AS QBUTTON
CAPTION = "Add"
Left = 500
Top = EditMail.Top - ButtonAdd.Height + EditMail.Height - 30
Width = 96
TabOrder = 23
OnClick = ButtonAddClick
END CREATE
CREATE ButtonClear AS QBUTTON
CAPTION = "New"
Enabled = 1
Left = 500
Top = EditMail.Top - ButtonClear.Height + EditMail.Height
Width = 96
TabOrder = 24
OnClick = ButtonClearClick
END CREATE
END CREATE
END CREATE
CREATE Alarm AS QFORM
Center
Height = 275
Width = 496
BorderStyle = bsSingle
DelBorderIcons biMaximize
CAPTION = ""
OnShow = AlarmOnShow
OnClose = DefaultClose
OnPaint = DefaultPaint
CREATE Image2 AS QCANVAS
Top = 0
Left = 0
Width = Alarm.ClientWidth
Height = Alarm.ClientHeight
OnPaint = ImagePaintDark
END CREATE
CREATE Panel5 AS QPANEL
Top = 0
Left = 0
Width = Alarm.ClientWidth
Height = 196
BorderStyle = bsSingle
Visible = 0
CREATE AlarmLabelName AS QLABEL
CAPTION = "Name:"
Left = 14
Top = 10
Width = 104
END CREATE
CREATE AlarmLabelGivenname AS QLABEL
CAPTION = "Given/Sub Name:"
Left = 130
Top = 10
Width = 104
END CREATE
CREATE AlarmLabelStreet AS QLABEL
CAPTION = "Street:"
Left = 14
Top = 55
Width = 219
END CREATE
CREATE AlarmLabelZip AS QLABEL
CAPTION = "Zip:"
Left = 14
Top = 100
Width = 67
END CREATE
CREATE AlarmLabelCity AS QLABEL
CAPTION = "City:"
Left = 92
Top = 100
Width = 141
END CREATE
CREATE AlarmLabelPhone AS QLABEL
CAPTION = "Phone 1:"
Left = 14
Top = 145
Width = 104
END CREATE
CREATE AlarmLabelFax AS QLABEL
CAPTION = "Phone 2:"
Left = 130
Top = 145
Width = 104
END CREATE
CREATE AlarmLabelDate AS QLABEL
CAPTION = "Date:"
Left = 255
Top = 10
Width = 75
END CREATE
CREATE AlarmLabelAlarm AS QLABEL
CAPTION = "Alarm:"
Left = 341
Top = 10
Width = 133
END CREATE
CREATE AlarmLabelComment AS QLABEL
CAPTION = "Comment:"
Left = 255
Top = 55
Width = 214
END CREATE
CREATE AlarmLabelMail AS QLABEL
CAPTION = "URL (eMail / Homepage):"
Left = 255
Top = 145
Width = 214
END CREATE
CREATE AlarmLabelCategory AS QLABEL
CAPTION = "Category:"
Left = 500
Top = 10
Width = 96
END CREATE
CREATE AlarmEditName AS QEDIT
Text = ""
Left = 14
Top = 26
Width = 104
TabOrder = 10
ReadOnly = 1
END CREATE
CREATE AlarmEditGivenname AS QEDIT
Text = ""
Left = 129
Top = 26
Width = 104
TabOrder = 11
ReadOnly = 1
END CREATE
CREATE AlarmEditStreet AS QEDIT
Text = ""
Left = 14
Top = 72
Width = 219
TabOrder = 12
ReadOnly = 1
END CREATE
CREATE AlarmEditZip AS QEDIT
Text = ""
Left = 14
Top = 116
Width = 67
TabOrder = 13
ReadOnly = 1
END CREATE
CREATE AlarmEditCity AS QEDIT
Text = ""
Left = 92
Top = 116
Width = 141
TabOrder = 14
ReadOnly = 1
END CREATE
CREATE AlarmEditPhone AS QEDIT
Text = ""
Left = 14
Top = 161
Width = 104
TabOrder = 15
ReadOnly = 1
END CREATE
CREATE AlarmEditFax AS QEDIT
Text = ""
Left = 129
Top = 161
Width = 104
TabOrder = 16
ReadOnly = 1
END CREATE
CREATE AlarmEditDate AS QEDIT
Text = ""
Left = 255
Top = 26
Width = 75
TabOrder = 17
ReadOnly = 1
END CREATE
CREATE AlarmEditAlarm AS QEDIT
Text = ""
Left = 341
Top = 26
Width = 41
TabOrder = 18
ReadOnly = 1
END CREATE
CREATE Panel6 AS QPANEL
Left = 382
Top = 26
Width = 92
Height = AlarmEditAlarm.Height
BorderStyle = bsSingle
CREATE AlarmLabelAlarmText AS QLABEL
CAPTION = "Day(s) before"
Left = 2
Top = 2
Width = 82
END CREATE
END CREATE
CREATE AlarmEditComment AS QRICHEDIT
Text = ""
Left = 255
Top = 72
Width = 219
Height = 65
TabOrder = 19
Plaintext = 1
WordWrap = 0
HideScrollBars = 0
ScrollBars = ssVertical
ReadOnly = 1
END CREATE
CREATE AlarmEditMail AS QEDIT
Text = ""
Left = 255
Top = 161
Width = 219
TabOrder = 20
ReadOnly = 1
END CREATE
END CREATE
CREATE ListView AS QLISTVIEW
ColumnClick = 0
ReadOnly = 1
Enabled = 0
Width = Alarm.ClientWidth
Height = 196
ViewStyle = vsReport
ShowColumnHeaders = 1
AddColumns "", "Date", "Name", "Given/Sub Name", "Category"
Column(0).Width = 33
Column(1).Width = 80
Column(2).Width = 128
Column(3).Width = 128
Column(4).Width = 90
RowSelect = 1
OnKeyPress = ListViewKey
OnDblClick = ListViewDblClick
END CREATE
CREATE ButtonOk AS QBUTTON
CAPTION = "OK"
Enabled = 1
Left = 133
Top = 213
Width = 96
OnClick = ButtonOkClick
END CREATE
CREATE ButtonCancel AS QBUTTON
CAPTION = "Cancel"
Enabled = 1
Left = 263
Top = 213
Width = 96
OnClick = ButtonCancelClick
END CREATE
CREATE ButtonClose AS QBUTTON
CAPTION = "Close"
Enabled = 1
Left = 198
Top = 213
Width = 96
Visible = 0
OnClick = ButtonCloseClick
END CREATE
END CREATE
CREATE Dummy AS QFORM
WindowState = wsMinimized
OnClose = DefaultClose
OnShow = DummyOnShow
END CREATE
CREATE Intro AS QFORM
CAPTION = AppName
Center
COLOR = clBlack
BorderStyle = bsNone
Height = 160
Width = 300
OnClose = DefaultClose
CREATE IntroPanel AS QPANEL
Left = 2
Top = 2
Width = Intro.Width - 4
Height = Intro.Height - 4
CREATE Image4 AS QCANVAS
Top = 0
Left = 0
Width = IntroPanel.Width
Height = IntroPanel.Height
OnPaint = ImagePaintLight
END CREATE
CREATE IntroCaption AS QLABEL
CAPTION = "Welcome!" + CR + CR + "Please choose your language:"
Left = 30
Top = 20
Width = 200
Height = 50
Transparent = 1
END CREATE
CREATE ButtonEnglish AS QBUTTON
CAPTION = "English"
Enabled = 1
Left = 30
Top = 80
Width = 96
OnClick = ButtonEnglishClick
END CREATE
CREATE ButtonGerman AS QBUTTON
CAPTION = "Deutsch"
Enabled = 1
Left = 170
Top = 80
Width = 96
OnClick = ButtonGermanClick
END CREATE
CREATE CheckBoxLink AS QCHECKBOX
CAPTION = ""
Visible = 0
Left = 30
Top = 122
Width = 15
END CREATE
CREATE LabelLink AS QLABEL
CAPTION = "Create Desktop Shortcuts"
Visible = 0
Left = 50
Top = 124
Width = 215
Transparent = 1
END CREATE
END CREATE
END CREATE
CREATE Message AS QFORM
COLOR = clBlack
BorderStyle = bsNone
Width = 332
Height = 122
OnShow = MessageOnShow
OnClose = DefaultClose
CREATE MessagePanel AS QPANEL
Left = 2
Top = 2
Width = Message.Width - 4
Height = Message.Height - 4
CREATE Image3 AS QCANVAS
Top = 0
Left = 0
Width = MessagePanel.Width
Height = MessagePanel.Height
OnPaint = ImagePaintLight
END CREATE
CREATE MessageCaption AS QLABEL
CAPTION = ""
Left = 20
Top = 18
Width = 208
Transparent = 1
END CREATE
CREATE MessageText AS QLABEL
CAPTION = ""
Left = 20
Top = 18
Width = 288
Alignment = taCenter
Transparent = 1
END CREATE
CREATE MessageFreeware AS QLABEL
CAPTION = "FREEWARE"
Left = 228
Top = 18
Width = 80
Alignment = taRightJustify
Transparent = 1
END CREATE
CREATE MessageYes AS QBUTTON
CAPTION = "Yes"
Left = 24
Top = 70
Width = 84
TabOrder = 1
OnClick = MessageYesClick
END CREATE
CREATE MessageNo AS QBUTTON
CAPTION = "No"
Left = 122
Top = 70
Width = 84
TabOrder = 2
OnClick = MessageNoClick
END CREATE
CREATE MessageCancel AS QBUTTON
CAPTION = "Cancel"
Left = 220
Top = 70
Width = 84
TabOrder = 3
OnClick = MessageOkCancelClick
END CREATE
CREATE MessageOk AS QBUTTON
CAPTION = "OK"
Left = 122
Top = 70
Width = 84
Default = 1
OnClick = MessageOkCancelClick
END CREATE
CREATE MessageWWW AS QCOOLBTN
CAPTION = "http://mitglied.lycos.de/maweso/"
Left = 0
Top = Message.Height - 40
Width = Message.Width - 4
Height = 18
Flat = 1
Font = Font
OnClick = MessageOpenClick
END CREATE
CREATE MessageMail AS QCOOLBTN
CAPTION = "martin.wehner@firemail.de"
Left = 0
Top = Message.Height - 22
Width = Message.Width - 4
Height = 18
Flat = 1
Font = Font
OnClick = MessageOpenClick
END CREATE
END CREATE
END CREATE
CREATE Changes AS QFORM
Center
Height = 320
Width = 600
BorderStyle = bsSingle
DelBorderIcons biMaximize
CAPTION = ""
OnClose = DefaultClose
OnPaint = DefaultPaint
CREATE Image5 AS QCANVAS
Top = 0
Left = 0
Width = Changes.ClientWidth
Height = Changes.ClientHeight
OnPaint = ImagePaintDark
END CREATE
CREATE ChangesView AS QLISTVIEW
ColumnClick = 0
ReadOnly = 1
GridLines = 1
Width = Changes.ClientWidth
Height = 240
ViewStyle = vsReport
AddColumns "", "Before", "After"
Column(0).Width = 165
Column(1).Width = 210
Column(2).Width = 210
END CREATE
CREATE ChangesYes AS QBUTTON
CAPTION = "Yes"
Default = 1
Enabled = 1
Left = 130
Top = 260
Width = 96
OnClick = ChangesYesClick
END CREATE
CREATE ChangesNo AS QBUTTON
CAPTION = "No"
Enabled = 1
Left = 252
Top = 260
Width = 96
OnClick = ChangesNoClick
END CREATE
CREATE ChangesCancel AS QBUTTON
CAPTION = "Cancel"
Enabled = 1
Left = 374
Top = 260
Width = 96
OnClick = ChangesCancelClick
END CREATE
END CREATE
CREATE TrayMenu AS QPOPUPMENU
CREATE TrayOpenItem AS QMENUITEM
CAPTION = "&Open..."
OnClick = TrayOpen
END CREATE
CREATE TrayAboutItem AS QMENUITEM
CAPTION = "&About..."
OnClick = MenuInfoClick
END CREATE
CREATE TrayBreakItem1 AS QMENUITEM
CAPTION = "-"
END CREATE
CREATE TrayExitItem AS QMENUITEM
CAPTION = "E&xit"
OnClick = TrayClose
END CREATE
END CREATE
CREATE TrayForm AS QFORM
Width = 0
Height = 0
OnClose = TrayClose
WndProc = WndProc
CREATE TrayEdit AS QEDIT
END CREATE
END CREATE
CREATE TimerInterrupt AS QTIMER
Enabled = 0
Interval = 300000
OnTimer = TrayInterrupt
END CREATE
DIM nid AS QNOTIFYICONDATA
DIM dataList AS QSTRINGLIST
DIM alarmList AS QSTRINGLIST
DIM alarmIDs AS STRING
alarmIDs = "|"
DIM Pin AS STRING
Pin = ""
DIM Mode AS STRING
Mode = ""
DIM TrayMode AS INTEGER
TrayMode = 0
DIM OpenFlag AS INTEGER
OpenFlag = 0
DIM ExportFlag AS INTEGER
ExportFlag = 0
DIM UseBasket AS INTEGER
UseBasket = 1
DIM Separator AS STRING
Separator = "\"
DIM Language AS STRING
Language = "{E}"
DIM LastTicket AS STRING
LastTicket = ""
DIM ListOrder AS STRING
ListOrder = "0"
DIM HomeDir AS STRING
HomeDir = CURDIR$ + IIF(RIGHT$(CURDIR$, 1) = "\", "", "\")
DIM FileDir AS STRING
FileDir = CURDIR$
DIM LastVisit AS STRING
LastVisit = DATE$
DIM LineBreak AS STRING
LineBreak = BELL
DIM Filename AS STRING
Filename = "reminder.csv"
DIM FileEXE AS STRING
FileEXE = HomeDir + "reminder.exe"
DIM FileLNG AS STRING
FileLNG = HomeDir + "reminder.lng"
DIM FileBMP1 AS STRING
FileBMP1 = HomeDir + "bckgrnd1.bmp"
DIM FileBMP2 AS STRING
FileBMP2 = HomeDir + "bckgrnd2.bmp"
DIM ExportType AS STRING
ExportType = ".html"
DIM CaptionEdit AS STRING
CaptionEdit = "Edit"
DIM CaptionReplace AS STRING
CaptionReplace = "Edit"
DIM CaptionAdd AS STRING
CaptionAdd = "Add"
DIM CaptionCopy AS STRING
CaptionCopy = "Copy"
DIM CaptionClear AS STRING
CaptionClear = "Clear"
DIM CaptionNew AS STRING
CaptionNew = "New"
DIM msg01 AS STRING
msg01 = AppName
DIM msg02 AS STRING
msg02 = "HTML Files (*.html;*.htm)|*.html;*.htm|All Files (*.*)|*.*"
DIM msg03 AS STRING
msg03 = "You cannot use backslashes (\) in your input data."
DIM msg04 AS STRING
msg04 = "Cannot parse the expression in the date field. Correct it or delete the input the alarm field."
DIM msg05 AS STRING
msg05 = "The name field must not be empty."
DIM msg06 AS STRING
msg06 = "Save changes?"
DIM msg07 AS STRING
msg07 = "Overwrite existing file?"
DIM msg08 AS STRING
msg08 = "More than one entry has been marked! Do you really want to delete them?"
DIM msg09 AS STRING
msg09 = "Do you want the Startup Shortcut to launch the application as tray icon?"
DIM msg10 AS STRING
msg10 = "Error in creating file:"
DIM msg11 AS STRING
msg11 = "No more dates in the past."
DIM msg12 AS STRING
msg12 = "No more dates in the future."
DIM msg13 AS STRING
msg13 = "Entry has been added. Do you accept it?"
DIM msg14 AS STRING
msg14 = "Entry has been edited. Do you accept it?"
DIM msg15 AS STRING
msg15 = "Entry has been deleted. Do you accept it?"
DIM msg16 AS STRING
msg16 = "The database maybe corrupted because the size of the CSV file and the BAK file differs."
DIM msg17 AS STRING
msg17 = "File not found:"
DIM ChangesRC AS INTEGER
ChangesRC = 0
DIM NoChange AS INTEGER
NoChange = 0
DIM Edited AS INTEGER
Edited = 0
DIM Check AS INTEGER
Check = 0
DIM id AS INTEGER
id = 0
DIM DefaultWndProc AS LONG
DIM AlternateWndProc AS LONG
SUB DefaultClose (Action AS INTEGER)
IF TrayMode = 0 THEN
IF IsIconicAPI(Alarm.Handle) THEN SendMessage(Alarm.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
IF IsIconicAPI(Changes.Handle) THEN SendMessage(Changes.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
END IF
END SUB
SUB DefaultPaint (Sender AS QFORM)
IF AlternateWndProc <> 0 THEN SetWindowLongAPI(Sender.Handle, GWL_WNDPROC, AlternateWndProc)
END SUB
SUB ImagePaint (Sender AS QCANVAS, img AS STRING)
DIM BitMap AS QBITMAP
DIM i AS INTEGER, j AS INTEGER
IF FILEEXISTS(img) THEN
BitMap.BMP = img
i = 0
WHILE i < Form.Width
j = 0
WHILE j < Form.Height
Sender.Draw i, j, BitMap.BMP
j = j + Bitmap.Height
WEND
i = i + BitMap.Width
WEND
END IF
END SUB
SUB ImagePaintDark (Sender AS QCANVAS)
ImagePaint(Sender, FileBMP1)
END SUB
SUB ImagePaintLight (Sender AS QCANVAS)
ImagePaint(Sender, FileBMP2)
END SUB
SUB DisplayChanges (d AS STRING)
DIM str AS STRING
DIM i AS INTEGER
FOR i = 0 TO 8
ChangesView.AddSubItem(i, FIELD$(d, Separator, i + 1))
NEXT
str = FIELD$(d, Separator, 11)
ChangesView.AddSubItem(9, IIF(str = "", "", str + " " + LabelAlarmText.CAPTION))
ChangesView.AddSubItem(10, REPLACESUBSTR$(FIELD$(d, Separator, 10), LineBreak, " "))
ChangesView.AddSubItem(11, FIELD$(d, Separator, 12))
END SUB
SUB ShowChanges (title AS STRING, before AS STRING, after AS STRING)
DIM i AS INTEGER
IF ChangesRC <> -1 THEN
Changes.CAPTION = title
WITH ChangesView
.Clear
.AddItems(LabelName.CAPTION)
.AddItems(LabelGivenName.CAPTION)
.AddItems(LabelStreet.CAPTION)
.AddItems(LabelZip.CAPTION)
.AddItems(LabelCity.CAPTION)
.AddItems(LabelPhone.CAPTION)
.AddItems(LabelFax.CAPTION)
.AddItems(LabelMail.CAPTION)
.AddItems(LabelDate.CAPTION)
.AddItems(LabelAlarm.CAPTION)
.AddItems(LabelComment.CAPTION)
.AddItems(LabelCategory.CAPTION)
END WITH
IF before = "" THEN
FOR i = 0 TO 11
ChangesView.AddSubItem(i, "")
NEXT
ELSE
DisplayChanges(before)
END IF
IF after <> "" THEN DisplayChanges(after)
ChangesRC = 1
AlternateWndProc = 0
SetWindowLongAPI(Changes.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Changes.Handle)
DefaultWndProc = GetWindowLongAPI(Changes.Handle, GWL_WNDPROC)
Changes.WndProc = WndProc
Changes.SHOWMODAL
SetWindowLongAPI(Changes.Handle, GWL_WNDPROC, DefaultWndProc)
END IF
Edited = 1
END SUB
SUB ChangesYesClick (Sender AS QBUTTON)
Changes.CLOSE
ChangesRC = 1
END SUB
SUB ChangesNoClick (Sender AS QBUTTON)
Changes.CLOSE
ChangesRC = 0
END SUB
SUB ChangesCancelClick (Sender AS QBUTTON)
Changes.CLOSE
ChangesRC = -1
END SUB
FUNCTION GetFileName (str AS STRING) AS STRING
DIM n AS INTEGER
result = Filename
n = RINSTR(result, ".")
IF RINSTR(result, "\") < n THEN result = LEFT$(Filename, n - 1)
result = result + str
END FUNCTION
SUB DisplayMessage (str AS STRING)
DIM i AS INTEGER, j AS INTEGER
DIM s AS STRING
s = str
IF s = "!" THEN
MessageCaption.CAPTION = REPLACESUBSTR$(msg01, "&", "&&")
MessageText.CAPTION = "(C) 2002/2003 Martin Wehner"
MessageText.Left = 20
MessageWWW.Visible = 1
MessageMail.Visible = 1
MessageYes.Visible = 0
MessageNo.Visible = 0
MessageCancel.Visible = 0
MessageOk.Visible = 1
MessageCaption.Visible = 1
MessageFreeware.Visible = 1
MessageText.Alignment = taLeftJustify
MessageText.Top = 40
MessageOk.Top = 45
MessageOk.Left = 224
ELSE
MessageWWW.Visible = 0
MessageMail.Visible = 0
IF LEFT$(s, 1) = "?" THEN
MessageText.Left = 20
MessageYes.Visible = 1
MessageNo.Visible = 1
IF s = "??" OR s = "???" THEN
str = IIF(s = "??", msg07, msg08)
MessageCancel.Visible = 0
MessageYes.Left = 60
MessageNo.Left = 184
SetFocusAPI(MessageNo.Handle)
ELSE
MessageCancel.Visible = 1
MessageYes.Left = 24
MessageNo.Left = 122
IF s = "?" THEN
str = msg06
SetFocusAPI(MessageYes.Handle)
ELSE
str = msg09
SetFocusAPI(MessageCancel.Handle)
END IF
END IF
MessageOk.Visible = 0
ELSE
MessageYes.Visible = 0
MessageNo.Visible = 0
MessageCancel.Visible = 0
MessageOk.Visible = 1
MessageOk.Top = 70
MessageOk.Left = 122
END IF
MessageCaption.Visible = 0
MessageFreeware.Visible = 0
MessageText.Alignment = taCenter
MessageText.Top = 30
END IF
IF s <> "!" THEN
i = INSTR(str, " ")
WHILE 0 < i
s = LEFT$(str, i - 1)
MessageText.CAPTION = RIGHT$(s, LEN(s) - RINSTR(s, CR))
IF Message.Width - 40 < MessageText.Width THEN
IF 0 < INSTR(MessageText.CAPTION, " ") THEN
j = RINSTR(s, " ")
str = LEFT$(str, j - 1) + CR + RIGHT$(str, LEN(str) - j)
END IF
END IF
i = INSTR(i + 1, str + " ", " ")
WEND
i = TALLY(str, CR)
IF 1 = i THEN MessageText.Top = 22
IF 1 < i THEN MessageText.Top = 15
MessageText.CAPTION = str
MessageText.Left = (Message.Width - MessageText.Width - 4) SHR 1
END IF
i = NOT Form.Visible
IF NOT i THEN i = (Form.Top < 0) OR (Screen.Height < Form.Top + Form.Height)
IF NOT i THEN i = (Form.Left < 0) OR (Screen.Width < Form.Left + Form.Width)
IF i THEN
Message.Center
ELSE
Message.Top = Form.Top + ((Form.Height - Message.Height) SHR 1)
Message.Left = Form.Left + ((Form.Width - Message.Width) SHR 1)
END IF
Message.SHOWMODAL
IF Form.Visible THEN SetFocusAPI(Form.Handle)
Form.Height = Form.Height + 1
Form.Height = Form.Height - 1
END SUB
SUB MessageOnShow
SetWindowPosAPI(Message.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE OR SWP_NOMOVE)
END SUB
FUNCTION dataListSave (name AS STRING) AS INTEGER
DIM pFile AS QFILESTREAM
DIM i AS INTEGER, j AS INTEGER
DIM str AS STRING
result = 0
IF pFile.OPEN(name, fmCreate) THEN
str = DATE$
str = "[" + RIGHT$(str, 4) + "-" + LEFT$(str, 5) + "]" + STRING$(3, Separator)
str = str + IIF(ExportFlag = 1, "X", "") + Separator
str = str + IIF(UseBasket = 1, "S", "") + STRING$(3, Separator)
str = str + IIF(OpenFlag = 1, "O", "") + STRING$(2, Separator)
str = str + IIF(WordWrapItem.Checked, "W", "") + Separator
str = str + ListOrder + Separator
str = str + ComboBoxFilter.Text + Separator
str = str + Language
pFile.WriteLine(str)
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
j = INSTR(str, Separator) + 1
pFile.WriteLine(MID$(str, j, RINSTR(str, Separator) - j))
NEXT
result = pFile.Size
pFile.CLOSE
IF (Pin <> "") AND Edited THEN
name = GetFileName(".pin")
IF pFile.OPEN(name, fmOpenRead) THEN
str = pFile.ReadLine
pFile.CLOSE
IF pFile.OPEN(name, fmCreate) THEN
pFile.WriteLine(FIELD$(str, "-", 1) + "-" + Pin + "-" + RIGHT$(str, LEN(str) - INSTR(INSTR(str, "-") + 1, str, "-")))
pFile.CLOSE
ELSE
DisplayMessage(msg10 + " " + name)
END IF
END IF
Pin = ""
END IF
Edited = 0
ELSE
DisplayMessage(msg10 + " " + name)
END IF
END FUNCTION
SUB SaveToFile
DIM s AS STRING, t AS STRING
DIM shOP AS SHFILEOPSTRUCT
IF UseBasket = 1 THEN
IF FILEEXISTS(FileName) THEN
s = FileName + NULL + NULL
t = "" + NULL + NULL
WITH shOP
.hWnd = Application.Handle
.wFunc = FO_DELETE
.fFlags = FOF_NOCONFIRMATION OR FOF_ALLOWUNDO
.pFrom = VARPTR(s)
.pTo = VARPTR(t)
END WITH
SHFileOperationAPI(shOP)
END IF
END IF
dataListSave(Filename)
END SUB
SUB MessageOkCancelClick (Sender AS QBUTTON)
Message.CLOSE
END SUB
SUB MessageYesClick (Sender AS QBUTTON)
Message.CLOSE
MessageYes.Visible = 0
END SUB
SUB MessageNoClick (Sender AS QBUTTON)
Message.CLOSE
MessageNo.Visible = 0
END SUB
SUB MenuExitClick (Sender AS QMENUITEM)
Form.CLOSE
END SUB
SUB MenuHelpClick (Sender AS QMAINMENU)
ShellExecuteAPI(Application.Handle, "Open", IIF(Language = "{E}", fileHELP, fileHILFE), "", HomeDir, 1)
END SUB
SUB MenuTutorialClick (Sender AS QMAINMENU)
ShellExecuteAPI(Application.Handle, "Open", IIF(Language = "{E}", htmlHELP, htmlHILFE), "", HomeDir, 1)
END SUB
SUB MenuInfoClick (Sender AS QMAINMENU)
IF Message.Visible = 0 THEN DisplayMessage("!")
END SUB
SUB MenuSaveClick (Sender AS QMAINMENU)
SaveToFile
Edited = 0
END SUB
SUB OpenURL (url AS STRING)
DIM str AS STRING
DIM n AS INTEGER
n = TALLY(Protokol, "|") + 1
WHILE 0 < n
str = LCASE$(FIELD$(Protokol, "|", n))
IF str = LCASE$(LEFT$(url, LEN(str))) THEN n = 0
n = n - 1
WEND
IF (n = 0) AND (0 < INSTR(url, "@")) THEN url = "mailto:" + url
ShellExecuteAPI(Application.Handle, "Open", url, "", CURDIR$, 1)
END SUB
SUB MessageOpenClick (Sender AS QCOOLBTN)
OpenURL(Sender.CAPTION)
END SUB
SUB MenuOpenClick (Sender AS QMENUITEM)
DIM str AS STRING
str = Sender.CAPTION
ShellExecuteAPI(Application.Handle, "Open", RIGHT$(str, LEN(str) - 4), "", CURDIR$, 1)
END SUB
SUB MenuEditClick (Sender AS QMENUITEM)
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER
i = (EditName.Text <> "")
j = (0 < alarmList.ItemCount)
n = (0 < dataList.ItemCount)
CopyItem.Enabled = i OR j OR n
CopyAllItem.Visible = n
CopyAlarmItem.Visible = j
BreakItem3.Visible = i AND (j OR n)
CopyAddressItem.Visible = i
CopyPhoneItem.Visible = i
CopyCompleteItem.Visible = i
END SUB
SUB CopyClipboard (flag AS INTEGER)
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER
DIM s AS STRING, t AS STRING
s = LabelName.CAPTION + TAB
s = s + LabelGivenname.CAPTION + TAB
s = s + LabelStreet.CAPTION + TAB
s = s + LabelZip.CAPTION + TAB
s = s + LabelCity.CAPTION + TAB
s = s + LabelPhone.CAPTION + TAB
s = s + LabelFax.CAPTION + TAB
s = s + LabelMail.CAPTION + TAB
s = s + LabelDate.CAPTION + TAB
s = s + LabelComment.CAPTION + TAB
s = s + LabelAlarm.CAPTION + TAB
s = s + LabelCategory.CAPTION + CR + LF
i = 0
FOR n = 1 TO dataList.ItemCount
t = dataList.Item(n - 1)
j = 0
IF flag = 1 THEN
IF (FIELD$(t, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN
IF (ListBox.SelCount < 2) OR ListBox.Selected(i) THEN j = 1
END IF
i = i + 1
ELSE
j = INSTR(alarmIDs, "|" + FIELD$(t, Separator, 15) + "|")
END IF
IF j <> 0 THEN
j = INSTR(t, Separator) + 1
t = MID$(t, j, RINSTR(LEFT$(t, RINSTR(t, Separator) - 1), Separator) - j)
t = REPLACESUBSTR$(t, Separator, TAB)
t = REPLACESUBSTR$(t, LineBreak, " ")
s = s + t + CR + LF
END IF
NEXT
WITH ClipBoard
.OPEN
.Text = s
.CLOSE
END WITH
END SUB
SUB MenuCopyAllClick (Sender AS QMENUITEM)
CopyClipboard(1)
END SUB
SUB MenuCopyAlarmClick (Sender AS QMENUITEM)
CopyClipboard(0)
END SUB
SUB MenuCopyClick (Sender AS QMENUITEM)
DIM str AS STRING, s AS STRING
DIM i AS INTEGER, n AS INTEGER
s = CR + LF
str = EditName.Text
IF EditGivenName.Text <> "" THEN str = str + ", " + EditGivenName.Text
IF EditStreet.Text <> "" THEN str = str + s + EditStreet.Text
IF EditZip.Text <> "" THEN
str = str + s + EditZip.Text
IF EditCity.Text <> "" THEN str = str + " " + EditCity.Text
ELSEIF EditCity.Text <> "" THEN
str = str + s + EditCity.Text
END IF
IF Sender.CAPTION <> CopyAddressItem.CAPTION THEN
n = 0
i = LEN(LabelPhone.CAPTION)
IF n < i THEN n = i
i = LEN(LabelFax.CAPTION)
IF n < i THEN n = i
i = LEN(LabelMail.CAPTION)
IF n < i THEN n = i
n = n + 1
i = 0
IF EditPhone.Text <> "" THEN
IF i = 0 THEN str = str + s
str = str + s + LEFT$(LabelPhone.CAPTION + SPACE$(n), n) + EditPhone.Text
i = 1
END IF
IF EditFax.Text <> "" THEN
IF i = 0 THEN str = str + s
str = str + s + LEFT$(LabelFax.CAPTION + SPACE$(n), n) + EditFax.Text
i = 1
END IF
IF EditMail.Text <> "" THEN
IF i = 0 THEN str = str + s
str = str + s + LEFT$(LabelMail.CAPTION + SPACE$(n), n) + EditMail.Text
i = 1
END IF
END IF
IF Sender.CAPTION = CopyCompleteItem.CAPTION THEN
IF EditDate.Text <> "" THEN str = str + s + s + LabelDate.CAPTION + " " + EditDate.Text
IF EditComment.Text <> "" THEN str = str + s + s + REPLACESUBSTR$(EditComment.Text, LineBreak, s)
END IF
WITH ClipBoard
.OPEN
.Text = str
.CLOSE
END WITH
END SUB
SUB MenuWordWrapClick (Sender AS QMENUITEM)
DIM i AS INTEGER
i = 1 - WordWrapItem.Checked
WordWrapItem.Checked = i
NoChange = 1
EditComment.WordWrap = i
NoChange = 0
END SUB
SUB MenuOpenFlagClick (Sender AS QMENUITEM)
OpenFlag = 1 - OpenFlag
OpenFlagItem.Checked = OpenFlag
END SUB
SUB MenuExportFlagClick (Sender AS QMENUITEM)
ExportFlag = 1 - ExportFlag
ExportFlagItem.Checked = ExportFlag
END SUB
SUB MenuUseBasketClick (Sender AS QMENUITEM)
UseBasket = 1 - UseBasket
UseBasketItem.Checked = UseBasket
END SUB
FUNCTION GetSpecialFolder (csidl AS LONG) AS STRING
DIM idl AS ITEMIDLIST
DIM str AS STRING
result = ""
IF SHGetSpecialFolderLocationAPI(Application.Handle, csidl, idl) = 0 THEN
str = SPACE$(260)
IF SHGetPathFromIDListAPI(idl.mkid, VARPTR(str)) <> 0 THEN result = LEFT$(str, INSTR(str, NULL) - 1) & "\"
END IF
END FUNCTION
SUB MenuShortcutClick (Sender AS QMENUITEM)
DIM str AS STRING
DIM n AS INTEGER
DisplayMessage("????")
IF MessageYes.Visible = 0 OR MessageNo.Visible = 0 THEN
str = GetSpecialFolder(CSIDL_STARTUP)
ShellExecuteAPI(Application.Handle, "Open", str, "", HomeDir, 1)
n = LEN(str)
IF RIGHT$(str, 1) = "\" THEN
str = LEFT$(str, n - 1)
ELSE
n = n + 1
END IF
fCreateShellLinkAPI(RIGHT$(str, n - RINSTR(str, "\")), Application.Title + " - Check", FileEXE, QUOTE + Filename + QUOTE + IIF(MessageYes.Visible = 0, " /tray", "") + " /check")
END IF
END SUB
SUB ClearOpenMenu
OpenItem.Visible = 0
OpenItem1.Visible = 0
OpenItem2.Visible = 0
OpenItem3.Visible = 0
OpenItem4.Visible = 0
OpenItem5.Visible = 0
END SUB
FUNCTION FillOpenMenu (str AS STRING, flag AS INTEGER) AS STRING
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER, m AS INTEGER, f AS INTEGER
DIM r AS STRING, s AS STRING, t AS STRING
IF flag <> 0 THEN ClearOpenMenu
f = 0
i = TALLY(Protokol, "|") + 1
t = FIELD$(str, Separator, 9)
IF 0 < INSTR(t, "@") THEN
t = LCASE$(t)
IF INSTR(t, "mailto:") = 0 THEN
j = i
WHILE 0 < j
j = IIF(0 < INSTR(t, LCASE$(FIELD$(Protokol, "|", j))), -1, j - 1)
WEND
IF j = 0 THEN
t = ""
j = TALLY(str, Separator) - 2
WHILE j
t = FIELD$(str, Separator, j + 1) + t
IF j = 8 THEN
t = "mailto:" + LTRIM$(t)
f = 1
END IF
t = Separator + t
j = j - 1
WEND
str = FIELD$(str, Separator, 1) + t
END IF
END IF
END IF
r = "( )" + Separator + LineBreak + TAB
WHILE 0 < i
t = LCASE$(FIELD$(Protokol, "|", i))
j = INSTR(INSTR(str, Separator) + 1, LCASE$(str), t)
WHILE 0 < j
IF 1 < j THEN
IF INSTR(r, MID$(str, j - 1, 1)) = 0 THEN j = -j
END IF
IF 0 < j THEN
s = MID$(str, j, LEN(str) - j)
m = LEN(r)
WHILE 0 < m
n = INSTR(s, MID$(r, m, 1))
IF 0 < n THEN s = LEFT$(s, n - 1)
m = m - 1
WEND
n = LEN(s)
IF LCASE$(LEFT$(s, LEN(t))) = t THEN
IF flag <> 0 THEN
IF OpenItem1.Visible = 0 THEN
OpenItem1.CAPTION = "&1. " + s
OpenItem1.Visible = 1
ELSEIF OpenItem2.Visible = 0 THEN
OpenItem2.CAPTION = "&2. " + s
OpenItem2.Visible = 1
ELSEIF OpenItem3.Visible = 0 THEN
OpenItem3.CAPTION = "&3. " + s
OpenItem3.Visible = 1
ELSEIF OpenItem4.Visible = 0 THEN
OpenItem4.CAPTION = "&4. " + s
OpenItem4.Visible = 1
ELSEIF OpenItem5.Visible = 0 THEN
OpenItem5.CAPTION = "&5. " + s
OpenItem5.Visible = 1
END IF
OpenItem.Visible = 1
END IF
s = "<a href=" + QUOTE + s + QUOTE + ">" + s + "</a>"
str = LEFT$(str, j - 1) + s + RIGHT$(str, LEN(str) - j - n + 1)
j = j + LEN(s)
END IF
END IF
j = INSTR(ABS(j) + 1, LCASE$(str), t)
WEND
i = i - 1
WEND
IF f <> 0 THEN
DO
f = INSTR(f, LCASE$(str), ">mailto:")
IF f THEN
s = LEFT$(str, f)
IF TALLY(s, Separator) = 8 THEN str = s + RIGHT$(str, LEN(str) - f - 7)
f = f + 1
END IF
LOOP UNTIL f = 0
END IF
result = str
END FUNCTION
SUB MenuExportClick (Sender AS QMAINMENU)
DIM htmlFile AS QFILESTREAM
DIM SaveDialog AS QSAVEDIALOG
DIM str AS STRING, r AS STRING, s AS STRING, t AS STRING, fname AS STRING
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER, f AS INTEGER
DIM v AS SINGLE
SaveDialog.InitialDir = FileDir
SaveDialog.Filter = msg02
IF SaveDialog.EXECUTE THEN
FileDir = CURDIR$
fname = SaveDialog.FileName
IF RINSTR(fname, ".") <= RINSTR(fname, "\") THEN fname = fname + ExportType
IF FILEEXISTS(fname) THEN
DisplayMessage("??")
f = (MessageYes.Visible = 0)
ELSE
f = 1
END IF
IF f THEN
r = "<td valign=" + QUOTE + "top" + QUOTE + ">"
s = CR + LF
t = "##//##" + s
t = t + "<html>" + s
t = t + "<head>" + s
t = t + "<title>##00##</title>" + s
t = t + "</head>" + s
t = t + "<body bgcolor=" + QUOTE + "#FFFFFF" + QUOTE + ">" + s
t = t + "<table border=" + QUOTE + "1" + QUOTE + " cellspacing=" + QUOTE + "0" + QUOTE + " cellpadding=" + QUOTE + "2" + QUOTE + ">" + s
t = t + "<!-- ##--## -->" + s
t = t + "<tr>" + s
t = t + r + "##01##<br>##02##<br>##09##</td>" + s
t = t + r + "##06##<br>##07##<br>##08##</td>" + s
t = t + r + "##03##<br>##04## ##05##<br>##10##</td>" + s
t = t + "</tr>" + s
t = t + "<!-- ##--## -->" + s
t = t + "</table>" + s
t = t + "</body>" + s
t = t + "</html>" + s
str = GetFileName(".tpl")
IF FILEEXISTS(str) THEN
IF htmlFile.OPEN(str, fmOpenRead) THEN
n = htmlFile.Size
t = htmlFile.ReadStr(n)
htmlFile.CLOSE
t = LEFT$(t, n)
END IF
ELSEIF htmlFile.OPEN(str, fmCreate) THEN
htmlFile.WriteStr(t, LEN(t))
htmlFile.CLOSE
ELSE
DisplayMessage(msg10 + " " + str)
END IF
IF htmlFile.OPEN(fname, fmCreate) THEN
n = LEN(t)
t = REPLACESUBSTR$(t, "##//##", "")
f = IIF(n <> LEN(t), 1, 0)
IF f = 1 THEN n = LEN(t)
t = REPLACESUBSTR$(t, "##||##", "")
IF n <> LEN(t) THEN f = f + 2
IF 0 < TALLY(t, "##--##") THEN
str = DATE$
r = FIELD$(t, "##--##", 2)
s = FIELD$(t, "##--##", 1)
s = REPLACESUBSTR$(s, "##00##", msg01)
s = REPLACESUBSTR$(s, "##01##", Filename)
s = REPLACESUBSTR$(s, "##::##", RIGHT$(str, 4) + "-" + LEFT$(str, 5))
htmlFile.writeStr(s, LEN(s))
ELSE
r = t
END IF
n = 0
j = 0
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
IF (FIELD$(str, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN
IF (ListBox.SelCount < 2) OR ListBox.Selected(j) THEN
IF f AND 1 THEN str = FillOpenMenu(str, 0)
str = REPLACESUBSTR$(str, LineBreak, IIF(f AND 2, "<br>", " "))
n = n + 1
s = REPLACESUBSTR$(r, "##::##", STR$(n))
s = REPLACESUBSTR$(s, "##01##", FIELD$(str, Separator, 2))
s = REPLACESUBSTR$(s, "##02##", FIELD$(str, Separator, 3))
s = REPLACESUBSTR$(s, "##03##", FIELD$(str, Separator, 4))
s = REPLACESUBSTR$(s, "##04##", FIELD$(str, Separator, 5))
s = REPLACESUBSTR$(s, "##05##", FIELD$(str, Separator, 6))
s = REPLACESUBSTR$(s, "##06##", FIELD$(str, Separator, 7))
s = REPLACESUBSTR$(s, "##07##", FIELD$(str, Separator, 8))
s = REPLACESUBSTR$(s, "##08##", FIELD$(str, Separator, 9))
s = REPLACESUBSTR$(s, "##09##", FIELD$(str, Separator, 10))
s = REPLACESUBSTR$(s, "##10##", FIELD$(str, Separator, 11))
s = REPLACESUBSTR$(s, "##11##", FIELD$(str, Separator, 12))
s = REPLACESUBSTR$(s, "##00##", FIELD$(str, Separator, 13))
s = REPLACESUBSTR$(s, "##??##", FIELD$(str, Separator, 14))
htmlFile.writeStr(s, LEN(s))
END IF
j = j + 1
END IF
NEXT
s = FIELD$(t, "##--##", 3)
htmlFile.WriteStr(s, LEN(s))
htmlFile.CLOSE
IF ExportFlag <> 0 THEN
v = TIMER
WHILE ABS(TIMER - v) < 1.5
DOEVENTS
WEND
ShellExecuteAPI(Application.Handle, "Open", fname, "", CURDIR$, 1)
END IF
ELSE
DisplayMessage(msg10 + " " + fname)
END IF
END IF
END IF
END SUB
FUNCTION ConvertDate (date AS STRING) AS STRING
DIM day AS INTEGER, month AS INTEGER, year AS INTEGER
DIM flag AS INTEGER
result = ""
IF INSTR(date, "+") = 0 THEN
day = 0
month = 0
year = 0
flag = TALLY(date, "-")
IF flag = 1 THEN
day = VAL(FIELD$(date, "-", 2))
month = VAL(FIELD$(date, "-", 1))
ELSEIF 1 < flag THEN
IF LEFT$(date, 1) = "-" THEN date = RIGHT$(date, LEN(date) - 1)
IF TALLY(date, "-") = 2 THEN
day = VAL(FIELD$(date, "-", 3))
month = VAL(FIELD$(date, "-", 2))
year = VAL(FIELD$(date, "-", 1))
END IF
ELSEIF TALLY(date, ".") = 2 THEN
day = VAL(FIELD$(date, ".", 1))
month = VAL(FIELD$(date, ".", 2))
year = VAL(FIELD$(date, ".", 3))
ELSE
flag = TALLY(date, "/")
IF flag = 2 THEN
day = VAL(FIELD$(date, "/", 2))
month = VAL(FIELD$(date, "/", 1))
year = VAL(FIELD$(date, "/", 3))
ELSEIF flag = 1 THEN
day = VAL(FIELD$(date, "/", 2))
month = VAL(FIELD$(date, "/", 1))
END IF
END IF
flag = 1
IF (year < 0) OR (9999 < year) THEN
flag = 0
ELSEIF (month < 1) OR (12 < month) THEN
flag = 0
ELSEIF day < 1 THEN
flag = 0
ELSE
SELECT CASE month
CASE 1, 3, 5, 7, 8, 10, 12
IF 31 < day THEN flag = 0
CASE 4, 6, 9, 11
IF 30 < day THEN flag = 0
CASE 2
IF 29 < day THEN flag = 0
END SELECT
END IF
IF flag <> 0 THEN result = STR$(month) + "-" + STR$(day) + "-" + STR$(year)
END IF
END FUNCTION
FUNCTION CalcDays (i AS INTEGER, n AS INTEGER) AS INTEGER
result = n
IF 1 < i THEN result = result + 31
IF 2 < i THEN result = result + 29
IF 3 < i THEN result = result + 31
IF 4 < i THEN result = result + 30
IF 5 < i THEN result = result + 31
IF 6 < i THEN result = result + 30
IF 7 < i THEN result = result + 31
IF 8 < i THEN result = result + 31
IF 9 < i THEN result = result + 30
IF 10 < i THEN result = result + 31
IF 11 < i THEN result = result + 30
END FUNCTION
FUNCTION DateCheck (date AS STRING, flag AS INTEGER) AS INTEGER
DIM day AS INTEGER, month AS INTEGER, year AS INTEGER
DIM day2 AS INTEGER, month2 AS INTEGER
DIM days AS INTEGER
result = 2
IF flag <> -1 THEN
date = ConvertDate(date)
IF date <> "" THEN
year = VAL(FIELD$(date, "-", 3))
month = VAL(FIELD$(date, "-", 1))
day = CalcDays(month, VAL(FIELD$(date, "-", 2)))
IF flag = -2 THEN
date = LastVisit
ELSE
date = DATE$
END IF
month2 = VAL(FIELD$(date, "-", 1))
day2 = CalcDays(month2, VAL(FIELD$(date, "-", 2)))
days = day2 - day
date = FIELD$(date, "-", 3)
year = year - VAL(date)
IF 0 < year THEN days = days - (366 * year)
result = days
IF 0 <= flag THEN
IF 0 < days THEN days = days - 366
IF days <= 0 THEN
IF 60 <= day AND (day2 < 60 OR month < month2) THEN days = days + 1
result = IIF(days + flag < 0, 2 + SGN(result), days)
ELSE
result = 2
END IF
ELSEIF (flag = -3) AND (year <= 0) AND (0 < result) THEN
result = result - 366
END IF
END IF
END IF
END FUNCTION
FUNCTION GetAlarmText (str AS STRING) AS STRING
DIM n AS INTEGER
result = LTRIM$(RTRIM$(str))
IF 0 < INSTR(result, "-") + INSTR(result, "+") THEN result = ""
IF result <> "" THEN
n = VAL(str)
result = IIF(n < 99, STR$(n), "99")
END IF
END FUNCTION
SUB CreateAlarmList (flag AS INTEGER)
DIM n AS INTEGER, i AS INTEGER, j AS INTEGER, f AS INTEGER
DIM str AS STRING, r AS STRING, s AS STRING, t AS STRING
s = FIELD$(DATE$, "-", 3)
f = IIF(FIELD$(LastVisit, "-", 3) < s, VAL(s), -1)
alarmList.Clear
FOR n = 1 TO dataList.ItemCount
str = dataList.Item(n - 1)
s = GetAlarmText(FIELD$(str, Separator, 12))
i = -1
IF s <> "" THEN
IF INSTR(s, "-") + INSTR(s, "+") = 0 THEN i = VAL(s)
END IF
s = FIELD$(str, Separator, 10)
i = DateCheck(s, i)
t = RIGHT$("00" + STR$(ABS(i)), 3)
IF (i = 1) OR (i = 3) THEN
t = " 0"
IF f <> -1 THEN
IF VAL(FIELD$(ConvertDate(s), "-", 3)) < f THEN
i = 4 - i
IF i = 3 THEN t = " "
END IF
ELSEIF i = 3 THEN
t = " "
END IF
IF SGN(i - 2) * SGN(DateCheck(s, -2)) < 0 THEN i = -1
END IF
r = FIELD$(str, Separator, 15)
j = INSTR(alarmIDs, "|" + r + "|")
IF (0 < i) AND (0 < j) THEN
i = 0
t = " "
ELSEIF (i <= 0) AND (j = 0) THEN
alarmIDs = alarmIDs + r + "|"
END IF
IF i <= 0 THEN
str = FIELD$(str, Separator, 2) + Separator + FIELD$(str, Separator, 3) + Separator + FIELD$(str, Separator, 13) + Separator + s + Separator + r
s = ConvertDate(s)
str = t + RIGHT$("0" + FIELD$(s, "-", 1), 2) + RIGHT$("0" + FIELD$(s, "-", 2), 2) + Separator + str
alarmList.AddItems(str)
END IF
NEXT
n = alarmList.ItemCount - 1
IF 0 <= n THEN
alarmList.Sort
FOR i = 0 TO n
str = alarmList.Item(i)
s = MID$(FIELD$(str, Separator, 1), 2, 2)
IF LEFT$(s, 1) = " " THEN
s = "!"
ELSE
s = IIF(s = "00", "! ", " ") + s
END IF
WITH ListView
.AddItems(s)
.AddSubItem(i, FIELD$(str, Separator, 5))
.AddSubItem(i, FIELD$(str, Separator, 2))
.AddSubItem(i, FIELD$(str, Separator, 3))
.AddSubItem(i, FIELD$(str, Separator, 4))
END WITH
NEXT
IF flag THEN
AlternateWndProc = 0
DefaultWndProc = GetWindowLongAPI(Alarm.Handle, GWL_WNDPROC)
SetWindowLongAPI(Alarm.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Alarm.Handle)
Alarm.WndProc = WndProc
Alarm.SHOWMODAL
SetWindowLongAPI(Alarm.Handle, GWL_WNDPROC, DefaultWndProc)
END IF
END IF
END SUB
SUB AlarmOnShow
SetWindowPosAPI(Alarm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE OR SWP_NOMOVE)
END SUB
SUB ShowAlarmList
Panel5.Visible = 0
ButtonClose.Visible = 0
ButtonCancel.Visible = 1
ButtonOk.Visible = 1
ListView.Visible = 1
END SUB
SUB AlarmOnResize (Sender AS QFORM)
IF ButtonOk.CAPTION <> "" THEN
IF ListView.Enabled <> 0 THEN
SetWindowLongAPI(Alarm.Handle, GWL_WNDPROC, DefaultWndProc)
ListView.Clear
CreateAlarmList(0)
IF ListView.Visible = 0 THEN ShowAlarmList
SetFocusAPI(ButtonOK.Handle)
Alarm.WndProc = WndProc
ELSE
ListView.Enabled = 1
END IF
END IF
END SUB
SUB FillListBox (filter AS STRING)
DIM str AS STRING, flag AS STRING
DIM r AS STRING, s AS STRING, t AS STRING
DIM i AS INTEGER, n AS INTEGER
dataList.Sort
n = 0
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
flag = FIELD$(str, Separator, 13)
IF (flag = filter) OR (filter = "") THEN
flag = FIELD$(str, Separator, 2)
r = FIELD$(str, Separator, 3)
s = IIF(FIELD$(str, Separator, 12) <> "", "! ", " ") + FIELD$(str, Separator, 10)
t = FIELD$(str, Separator, 13)
WITH ListBox
IF n < .ItemCount THEN
.Item(n).CAPTION = flag
.SubItem(n, 0) = r
.SubItem(n, 1) = s
.SubItem(n, 2) = t
ELSE
.AddItems flag
.AddSubItem(n, r)
.AddSubItem(n, s)
.AddSubItem(n, t)
END IF
END WITH
n = n + 1
END IF
NEXT
WHILE n < ListBox.ItemCount
ListBox.DelItems ListBox.ItemCount - 1
WEND
LabelNumber.CAPTION = "- | " + STR$(n) + " | " + STR$(dataList.ItemCount)
END SUB
SUB ClearFields (flag AS INTEGER)
ComboBoxCategory.Text = ""
EditName.Text = ""
EditGivenname.Text = ""
EditStreet.Text = ""
EditZip.Text = ""
EditCity.Text = ""
EditPhone.Text = ""
EditFax.Text = ""
EditMail.Text = ""
EditDate.Text = ""
EditComment.Clear
ButtonEdit.Enabled = 0
LabelAlarmText.Enabled = 0
ComboBoxAlarm.ItemIndex = 0
IF flag THEN
IF ListBox.SelCount = 1 THEN ListBox.ItemIndex = -1
ListBox.Enabled = 1
ComboBoxFilter.Enabled = 1
RadioButtonName.Enabled = 1
RadioButtonDate.Enabled = 1
RadioButtonCategory.Enabled = 1
END IF
LabelNumber.CAPTION = "- | " + STR$(ListBox.ItemCount) + " | " + STR$(dataList.ItemCount)
ButtonClear.CAPTION = CaptionNew
ButtonEdit.CAPTION = CaptionEdit
ButtonAdd.CAPTION = CaptionAdd
DatePrev.Enabled = 0
DateNext.Enabled = 0
DateCurr.Enabled = IIF(ListBox.ItemCount, 1, 0)
ClearOpenMenu
END SUB
FUNCTION LoadLanguage AS STRING
DIM nameList AS QSTRINGLIST
DIM n AS INTEGER
result = ""
IF FILEEXISTS(FileLNG) THEN
WITH nameList
.LoadFromFile(FileLNG)
n = .ItemCount
IF 0 < n THEN ButtonGerman.CAPTION = .Item(0)
IF 1 < n THEN
msg01 = .Item(1)
Form.CAPTION = .Item(1)
END IF
IF 2 < n THEN
ListBox.Column(0).CAPTION = .Item(2)
ListView.Column(2).CAPTION = .Item(2)
END IF
IF 3 < n THEN
ListBox.Column(1).CAPTION = .Item(3)
ListView.Column(3).CAPTION = .Item(3)
END IF
IF 4 < n THEN
ListBox.Column(2).CAPTION = .Item(4)
ListView.Column(1).CAPTION = .Item(4)
END IF
IF 5 < n THEN
ListBox.Column(3).CAPTION = .Item(5)
ListView.Column(4).CAPTION = .Item(5)
END IF
IF 6 < n THEN
LabelName.CAPTION = .Item(6)
AlarmLabelName.CAPTION = .Item(6)
END IF
IF 7 < n THEN
LabelGivenname.CAPTION = .Item(7)
AlarmLabelGivenname.CAPTION = .Item(7)
END IF
IF 8 < n THEN
LabelStreet.CAPTION = .Item(8)
AlarmLabelStreet.CAPTION = .Item(8)
END IF
IF 9 < n THEN
LabelZip.CAPTION = .Item(9)
AlarmLabelZip.CAPTION = .Item(9)
END IF
IF 10 < n THEN
LabelCity.CAPTION = .Item(10)
AlarmLabelCity.CAPTION = .Item(10)
END IF
IF 11 < n THEN
LabelPhone.CAPTION = .Item(11)
AlarmLabelPhone.CAPTION = .Item(11)
END IF
IF 12 < n THEN
LabelFax.CAPTION = .Item(12)
AlarmLabelFax.CAPTION = .Item(12)
END IF
IF 13 < n THEN
LabelMail.CAPTION = .Item(13)
AlarmLabelMail.CAPTION = .Item(13)
END IF
IF 14 < n THEN
LabelDate.CAPTION = .Item(14)
AlarmLabelDate.CAPTION = .Item(14)
END IF
IF 15 < n THEN
LabelAlarm.CAPTION = .Item(15)
AlarmLabelAlarm.CAPTION = .Item(15)
END IF
IF 16 < n THEN
LabelComment.CAPTION = .Item(16)
AlarmLabelComment.CAPTION = .Item(16)
END IF
IF 17 < n THEN LabelCategory.CAPTION = .Item(17)
IF 18 < n THEN LabelFilter.CAPTION = .Item(18)
IF 19 < n THEN LabelSort.CAPTION = .Item(19)
IF 20 < n THEN
LabelAlarmText.CAPTION = .Item(20)
AlarmLabelAlarmText.CAPTION = .Item(20)
END IF
IF 21 < n THEN RadioButtonName.CAPTION = .Item(21)
IF 22 < n THEN RadioButtonDate.CAPTION = .Item(22)
IF 23 < n THEN RadioButtonCategory.CAPTION = .Item(23)
IF 24 < n THEN
ButtonEdit.CAPTION = .Item(24)
CaptionEdit = .Item(24)
END IF
IF 25 < n THEN CaptionReplace = .Item(25)
IF 26 < n THEN
ButtonAdd.CAPTION = .Item(26)
CaptionAdd = .Item(26)
END IF
IF 27 < n THEN CaptionCopy = .Item(27)
IF 28 < n THEN
ButtonClear.CAPTION = .Item(28)
CaptionNew = .Item(28)
END IF
IF 29 < n THEN CaptionClear = .Item(29)
IF 30 < n THEN ButtonDelete.CAPTION = .Item(30)
IF 31 < n THEN FileMenu.CAPTION = .Item(31)
IF 32 < n THEN SaveItem.CAPTION = .Item(32)
IF 33 < n THEN OpenItem.CAPTION = .Item(33)
IF 34 < n THEN ExportItem.CAPTION = .Item(34)
IF 35 < n THEN ExitItem.CAPTION = .Item(35)
IF 36 < n THEN EditMenu.CAPTION = .Item(36)
IF 37 < n THEN CopyItem.CAPTION = .Item(37)
IF 38 < n THEN CopyAllItem.CAPTION = .Item(38)
IF 39 < n THEN CopyAlarmItem.CAPTION = .Item(39)
IF 40 < n THEN CopyCompleteItem.CAPTION = .Item(40)
IF 41 < n THEN CopyAddressItem.CAPTION = .Item(41)
IF 42 < n THEN CopyPhoneItem.CAPTION = .Item(42)
IF 43 < n THEN WordWrapItem.CAPTION = .Item(43)
IF 44 < n THEN OpenFlagItem.CAPTION = .Item(44)
IF 45 < n THEN ExportFlagItem.CAPTION = .Item(45)
IF 46 < n THEN UseBasketItem.CAPTION = .Item(46)
IF 47 < n THEN ShortcutItem.CAPTION = .Item(47)
IF 48 < n THEN InfoMenu.CAPTION = .Item(48)
IF 49 < n THEN HelpItem.CAPTION = .Item(49)
IF 50 < n THEN TutorialItem.CAPTION = .Item(50)
IF 51 < n THEN AboutItem.CAPTION = .Item(51)
IF 52 < n THEN TrayOpenItem.CAPTION = .Item(52)
IF 53 < n THEN TrayAboutItem.CAPTION = .Item(53)
IF 54 < n THEN TrayExitItem.CAPTION = .Item(54)
IF 55 < n THEN result = .Item(55)
IF 56 < n THEN
MessageYes.CAPTION = .Item(56)
ChangesYes.CAPTION = .Item(56)
END IF
IF 57 < n THEN
MessageNo.CAPTION = .Item(57)
ChangesNo.CAPTION = .Item(57)
END IF
IF 58 < n THEN
ButtonOk.CAPTION = .Item(58)
MessageOk.CAPTION = .Item(58)
END IF
IF 59 < n THEN
MessageCancel.CAPTION = .Item(59)
ChangesCancel.CAPTION = .Item(59)
ButtonCancel.CAPTION = .Item(59)
END IF
IF 60 < n THEN ButtonClose.CAPTION = .Item(60)
IF 61 < n THEN ExportType = .Item(61)
IF 62 < n THEN msg02 = .Item(62)
IF 63 < n THEN msg03 = .Item(63)
IF 64 < n THEN msg04 = .Item(64)
IF 65 < n THEN msg05 = .Item(65)
IF 66 < n THEN msg06 = .Item(66)
IF 67 < n THEN msg07 = .Item(67)
IF 68 < n THEN msg08 = .Item(68)
IF 69 < n THEN msg09 = .Item(69)
IF 70 < n THEN msg10 = .Item(70)
IF 71 < n THEN msg11 = .Item(71)
IF 72 < n THEN msg12 = .Item(72)
IF 73 < n THEN msg13 = .Item(73)
IF 74 < n THEN msg14 = .Item(74)
IF 75 < n THEN msg15 = .Item(75)
IF 76 < n THEN msg16 = .Item(76)
IF 77 < n THEN msg17 = .Item(77)
IF 78 < n THEN ChangesView.Column(1).CAPTION = .Item(78)
IF 79 < n THEN ChangesView.Column(2).CAPTION = .Item(79)
END WITH
END IF
END FUNCTION
FUNCTION GetCategoryIndex (name AS STRING) AS INTEGER
DIM i AS INTEGER
result = -1
i = ComboBoxCategory.ItemCount
WHILE 0 < i
i = i - 1
IF name = ComboBoxCategory.Item(i) THEN
result = i
i = 0
END IF
WEND
END FUNCTION
FUNCTION GetSortFieldContent (str AS STRING) AS STRING
result = FIELD$(str, Separator, 12)
IF ListOrder = "1" THEN
result = FIELD$(str, Separator, 1)
ELSEIF ListOrder = "9" THEN
str = ConvertDate(FIELD$(str, Separator, 9))
IF str = "" THEN
result = "1300"
ELSE
result = RIGHT$("0" + FIELD$(str, "-", 1), 2) + RIGHT$("0" + FIELD$(str, "-", 2), 2)
END IF
END IF
result = result + " "
END FUNCTION
FUNCTION ConvertOldLineFormat (str AS STRING, f AS STRING) AS STRING
DIM i AS INTEGER, n AS INTEGER
DIM s AS STRING, t AS STRING
s = FIELD$(str, Separator, 11)
t = FIELD$(str, Separator, 12)
n = 3 + LEN(s) + LEN(t)
i = VAL(s)
IF (0 < i) AND (i <= TALLY(AlarmIndex, "|") + 1) THEN
s = FIELD$(AlarmIndex, "|", i)
ELSE
s = ""
END IF
IF t = "0" THEN
t = IIF(Language = "{E}", "Addresses", "Adressen")
ELSEIF t = "1" THEN
t = IIF(Language = "{E}", "Dates", "Termine")
ELSE
t = ""
END IF
result = LEFT$(str, LEN(str) - LEN(f) - n) + Separator + s + Separator + t + Separator + f
END FUNCTION
FUNCTION LoadFromFiles (n AS INTEGER) AS INTEGER
DIM pFile AS QFILESTREAM
DIM f AS STRING, str AS STRING, s AS STRING, t AS STRING
DIM i AS INTEGER
result = 0
IF FILEEXISTS(Filename) THEN
f = GetFileName(".bak")
IF FILEEXISTS(f) THEN
IF pFile.OPEN(f, fmOpenRead) THEN
LastVisit = MID$(pFile.ReadLine, 2, 10)
pFile.CLOSE
i = INSTR(LastVisit, "-")
IF 4 < i THEN LastVisit = RIGHT$(LastVisit, LEN(LastVisit) - i) + "-" + LEFT$(LastVisit, i - 1)
END IF
END IF
IF pFile.OPEN(Filename, fmOpenRead) THEN
result = pFile.Size
str = pFile.ReadLine
f = MID$(str, 13, 1)
IF f <> "" THEN Separator = f
Language = RIGHT$(str, 3)
ListOrder = FIELD$(str, Separator, 11)
f = FIELD$(str, Separator, 12)
ExportFlag = IIF(FIELD$(str, Separator, 4) = "X", 1, 0)
ExportFlagItem.Checked = ExportFlag
UseBasket = IIF(FIELD$(str, Separator, 5) = "S", 1, 0)
UseBasketItem.Checked = UseBasket
OpenFlag = IIF(FIELD$(str, Separator, 8) = "O", 1, 0)
OpenFlagItem.Checked = OpenFlag
n = IIF(FIELD$(str, Separator, 10) = "W", 1, 0)
WordWrapItem.Checked = n
EditComment.WordWrap = n
AlarmEditComment.WordWrap = n
DO
str = pFile.ReadLine
IF str <> "" THEN
s = FIELD$(str, Separator, 12)
IF s <> "" THEN
IF ListOrder = "" THEN
str = ConvertOldLineFormat(str, FIELD$(str, Separator, 13))
s = FIELD$(str, Separator, 12)
END IF
IF GetCategoryIndex(s) < 0 THEN
ComboBoxCategory.AddItems s
ComboBoxFilter.AddItems s
END IF
END IF
s = FIELD$(str, Separator, 11)
t = GetAlarmText(s)
IF s <> t THEN
n = RINSTR(LEFT$(str, RINSTR(str, Separator) - 1), Separator)
str = LEFT$(str, n - LEN(s) - 1) + t + RIGHT$(str, LEN(str) - n + 1)
END IF
id = id + 1
dataList.AddItems(GetSortFieldContent(str) + Separator + str + Separator + STR$(id))
END IF
LOOP UNTIL str = ""
pFile.CLOSE
IF ListOrder = "0" OR ListOrder = "" THEN RadioButtonCategory.Checked = 1
IF ListOrder = "1" THEN RadioButtonName.Checked = 1
IF ListOrder = "9" THEN RadioButtonDate.Checked = 1
n = ComboBoxFilter.ItemCount
WHILE 0 < n
n = n - 1
IF f = ComboBoxFilter.Item(n) THEN
ComboBoxFilter.ItemIndex = n
n = 0
END IF
WEND
END IF
FillListBox(ComboBoxFilter.Text)
IF dataList.ItemCount THEN DateCurr.Enabled = 1
ELSE
IF FILEEXISTS(FileLNG) THEN
IF pFile.OPEN(FileLNG, fmOpenRead) THEN
ButtonGerman.CAPTION = pFile.ReadLine
str = pFile.ReadLine
pFile.CLOSE
SetWindowLongAPI(Intro.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Intro.Handle)
Intro.SHOWMODAL
END IF
END IF
IF pFile.OPEN(Filename, fmCreate) THEN
pFile.WriteLine("[" + DATE$ + "]" + STRING$(4, Separator) + "S" + STRING$(6, Separator) + ListOrder + STRING$(2, Separator) + Language)
pFile.CLOSE
IF Language = "{E}" THEN
ShellExecuteAPI(Application.Handle, "Open", htmlHELP, "", HomeDir, 1)
str = AppName
ELSE
ShellExecuteAPI(Application.Handle, "Open", htmlHILFE, "", HomeDir, 1)
END IF
IF CheckBoxLink.Checked THEN
f = QUOTE + Filename + QUOTE
s = "..\..\Desktop"
fCreateShellLinkAPI(s, str, FileEXE, IIF(n = 0, "", f))
fCreateShellLinkAPI(s, str + " - Check", FileEXE, IIF(n = 0, "", f + " ") + "/check")
END IF
ELSE
DisplayMessage(msg10 + " " + Filename)
END IF
END IF
END FUNCTION
SUB CreatePin
DIM pinFile AS QFILESTREAM
DIM i AS INTEGER, n AS INTEGER
DIM str AS STRING
n = 0
FOR i = 1 TO LEN(Filename)
n = n + (i * ASC(RIGHT$(Filename, i)))
NEXT
IF Pin = "?" THEN
str = GetFileName(".pin")
IF pinFile.OPEN(str, fmCreate) THEN
pinFile.WriteLine(STR$(n) + "--" + Filename)
pinFile.CLOSE
ELSE
DisplayMessage(msg10 + " " + str)
END IF
END IF
Pin = Filename
END SUB
FUNCTION ConvertDataList (p AS STRING) AS STRING
DIM i AS INTEGER, j AS INTEGER
DIM str AS STRING
result = "00000000000000"
i = dataList.ItemCount
WHILE 0 < i
i = i - 1
str = dataList.Item(i)
j = RINSTR(LEFT$(str, RINSTR(str, Separator) - 1), Separator)
str = LEFT$(str, j) + p + "-" + RIGHT$(str, LEN(str) - j)
dataList.Item(i) = str
str = FIELD$(str, Separator, 14)
str = FIELD$(str, "-", 2)
IF result < str THEN result = str
WEND
SaveToFile
END FUNCTION
SUB keyMark (flag AS INTEGER)
DIM i AS INTEGER, n AS INTEGER
DIM str AS STRING, a AS STRING
i = dataList.ItemCount
WHILE 0 < i
i = i - 1
str = dataList.Item(i)
a = FIELD$(str, Separator, 14)
n = TALLY(a, "-")
IF flag THEN
IF n = 2 THEN
n = RINSTR(str, Separator) - 1
dataList.Item(i) = LEFT$(str, n) + "-" + RIGHT$(str, LEN(str) - n)
END IF
ELSEIF n = 3 THEN
ShowChanges(msg15, RIGHT$(str, LEN(str) - INSTR(str, Separator)), "")
IF ChangesRC THEN
dataList.DelItems i
ELSE
a = FIELD$(a, "-", 2) + "-" + FIELD$(a, "-", 3) + Separator + FIELD$(str, Separator, 15)
str = LEFT$(str, RINSTR(str, Separator) - 1)
dataList.Item(i) = LEFT$(str, RINSTR(str, Separator)) + a
END IF
END IF
WEND
END SUB
SUB LoadFromMaster (p AS STRING)
DIM masterFile AS QFILESTREAM
DIM i AS INTEGER, n AS INTEGER
DIM a AS STRING, a1 AS STRING, a2 AS STRING, b AS STRING
DIM f AS STRING, str AS STRING, mstr AS STRING
DIM p1 AS STRING, p2 AS STRING, s AS STRING
mstr = RIGHT$(p, LEN(p) - INSTR(INSTR(p, "-") + 1, p, "-"))
IF FILEEXISTS(mstr) THEN
IF masterFile.OPEN(mstr, fmOpenRead) THEN
keyMark(1)
mstr = masterFile.ReadLine
f = FIELD$(mstr, Separator, 11)
p1 = FIELD$(p, "-", 1)
p2 = FIELD$(p, "-", 2)
DO
mstr = masterFile.ReadLine
IF mstr <> "" THEN
a = FIELD$(mstr, Separator, 13)
IF f = "" THEN mstr = ConvertOldLineFormat(mstr, a)
a1 = FIELD$(a, "-", 1)
a2 = FIELD$(a, "-", 2)
IF Pin < a2 THEN Pin = a2
b = FIELD$(mstr, Separator, 11)
s = GetAlarmText(b)
IF s <> b THEN
i = RINSTR(LEFT$(mstr, RINSTR(mstr, Separator) - 1), Separator) - 1
mstr = LEFT$(mstr, i - LEN(b)) + s + RIGHT$(mstr, LEN(mstr) - i)
END IF
s = ""
i = dataList.ItemCount
WHILE 0 < i
i = i - 1
str = dataList.Item(i)
b = FIELD$(str, Separator, 14)
IF TALLY(b, "-") = 3 THEN
IF (FIELD$(b, "-", 1) = p1) AND (FIELD$(b, "-", 2) = a1) THEN
IF FIELD$(b, "-", 3) < a2 THEN
ShowChanges(msg14, RIGHT$(str, LEN(str) - INSTR(str, Separator)), mstr)
IF ChangesRC THEN
a = GetSortFieldContent(mstr) + Separator + mstr
ELSE
a = LEFT$(str, RINSTR(str, Separator) - 1)
END IF
s = LEFT$(a, RINSTR(a, Separator)) + p1 + "-" + FIELD$(mstr, Separator, 13) + Separator + FIELD$(str, Separator, 15)
dataList.Item(i) = s
ELSE
n = RINSTR(str, Separator)
s = LEFT$(str, n - 2) + RIGHT$(str, LEN(str) - n + 1)
dataList.Item(i) = s
END IF
a = ""
END IF
END IF
WEND
IF (a <> "") AND (p2 < a2) THEN
ShowChanges(msg13, "", mstr)
IF ChangesRC THEN
id = id + 1
n = RINSTR(mstr, Separator)
s = GetSortFieldContent(mstr) + Separator + LEFT$(mstr, n) + p1 + "-" + FIELD$(mstr, Separator, 13) + Separator + STR$(id)
dataList.AddItems(s)
END IF
END IF
IF s <> "" THEN
s = FIELD$(s, Separator, 13)
IF s <> "" THEN
IF GetCategoryIndex(s) < 0 THEN
ComboBoxCategory.AddItems s
ComboBoxFilter.AddItems s
END IF
END IF
END IF
END IF
LOOP UNTIL mstr = ""
masterFile.CLOSE
keyMark(0)
FillListBox("")
IF dataList.ItemCount THEN DateCurr.Enabled = 1
IF Edited = 0 THEN Pin = ""
END IF
END IF
END SUB
SUB Replication
DIM pinFile AS QFILESTREAM
DIM p AS STRING, s AS STRING, str AS STRING
s = GetFileName(".pin")
IF FILEEXISTS(s) THEN
IF pinFile.OPEN(s, fmOpenRead) THEN
str = pinFile.ReadLine
pinFile.CLOSE
Mode = "S"
IF FIELD$(str, "-", 2) = "" THEN
p = RIGHT$(str, LEN(str) - INSTR(INSTR(str, "-") + 1, str, "-"))
IF LCASE$(p) <> LCASE$(Pin) THEN
str = FIELD$(str, "-", 1) + "-" + ConvertDataList(FIELD$(str, "-", 1)) + "-" + p
IF pinFile.OPEN(s, fmCreate) THEN
pinFile.WriteLine(str)
pinFile.CLOSE
ELSE
DisplayMessage(msg10 + " " + s)
END IF
ELSE
Mode = "M"
str = ""
END IF
END IF
Pin = ""
IF str <> "" THEN LoadFromMaster(str)
ELSE
Pin = ""
END IF
ELSE
Pin = ""
END IF
END SUB
SUB DummyOnShow (Sender AS QFORM)
PostMessage(Dummy.Handle, WM_SYSCOMMAND, SC_CLOSE, 0)
END SUB
SUB CustomizeMenu (hwnd AS INTEGER)
DIM hmenu AS INTEGER
hmenu = GetSystemMenuAPI(hwnd, 0)
DeleteMenuAPI(hmenu, SC_MAXIMIZE, 0)
DeleteMenuAPI(hmenu, SC_SIZE, 0)
END SUB
SUB FormConfirmation
DisplayMessage("?")
IF MessageYes.Visible = 0 THEN SaveToFile
IF MessageNo.Visible = 0 THEN Edited = 0
END SUB
SUB RunCommand (str AS STRING)
IF FILEEXISTS(FileEXE) THEN
CHDIR HomeDir
RUN QUOTE + FileEXE + QUOTE + " " + QUOTE + Filename + QUOTE + IIF(str = "", "", " " + str)
ELSE
DisplayMessage(msg17 + " " + FileEXE)
END IF
END SUB
SUB WndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)
SELECT CASE uMsg
CASE WM_QUERYENDSESSION
IF TrayMode = 0 THEN
IF Edited THEN
IF IsIconicAPI(Form.Handle) THEN SendMessage(Form.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
FormConfirmation
END IF
IF Edited = 0 THEN Application.Terminate
ELSE
TrayClose
END IF
CASE WM_SYSCOMMAND
IF wParam = SC_MINIMIZE THEN PostMessage(hWnd, WM_USERMINIMIZE, 0, 0)
CASE WM_USERMINIMIZE
IF GetWindowLongAPI(hWnd, GWL_WNDPROC) <> DefaultWndProc THEN
AlternateWndProc = GetWindowLongAPI(hWnd, GWL_WNDPROC)
SetWindowLongAPI(hWnd, GWL_WNDPROC, DefaultWndProc)
PostMessage(hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0)
END IF
CASE WM_PAINT
IF TrayMode <> 0 THEN TrayForm.Visible = 0
CASE WM_USERTRAYMSG
SELECT CASE lParam AND &HFFFF
CASE WM_LBUTTONDBLCLK
RunCommand("")
CASE WM_LBUTTONDOWN, WM_RBUTTONDOWN
SetForegroundWindowAPI(TrayForm.Handle)
CASE WM_RBUTTONUP
TrayMenu.Popup(Screen.MOUSEX, Screen.MOUSEY)
END SELECT
END SELECT
END SUB
SUB TrayInterrupt
IF LastVisit <> DATE$ THEN
IF Check <> 0 THEN
LastVisit = DATE$
RunCommand("/check")
END IF
END IF
END SUB
SUB TrayOpen
RunCommand("")
END SUB
SUB TrayClose
Shell_NotifyIconAPI(NIM_DELETE, nid)
IF Message.Visible <> 0 THEN Message.CLOSE
TrayForm.CLOSE
END SUB
SUB TrayMain
DIM v AS OSVERSIONINFO
LastVisit = DATE$
TimerInterrupt.Enabled = Check
Application.Title = msg01
RunCommand("/check")
v.dwOSVersionInfoSize = SIZEOF(v)
GetVersionExAPI(v)
nid.hWnd = TrayForm.Handle
nid.uID = Application.hInstance
nid.uFlags = NIM_ICON OR NIM_MESSAGE OR NIM_TIP
nid.hIcon = Application.Icon
nid.uCallBackMessage = WM_USERTRAYMSG
nid.szTip = REPLACESUBSTR$(msg01, "&", IIF(v.dwMajorVersion = 4 AND v.dwMinorVersion <> 90, "&&", "&&&")) + NULL
Shell_NotifyIconAPI(NIM_ADD, nid)
SetWindowLongAPI(TrayForm.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, TrayForm.Handle)
TrayForm.SHOWMODAL
END SUB
FUNCTION ReadParams AS INTEGER
DIM str AS STRING
DIM i AS INTEGER
result = 0
FOR i = 1 TO COMMANDCOUNT
IF COMMAND$(i)[1] <> "/" THEN
Filename = COMMAND$(i)
result = 1
ELSE
str = LCASE$(COMMAND$(i))
IF str = "/check" THEN
Check = 1
ELSEIF str = "/pin" THEN
Pin = "?"
ELSEIF str = "/tray" THEN
TrayMode = 1
ELSE
DisplayMessage("Bad parameter: " + COMMAND$(i))
END IF
END IF
NEXT
str = SPACE$(260)
i = GetFullPathNameAPI(FileName, LEN(str), VARPTR(str), "")
IF 0 < i THEN
FileName = LEFT$(str, i)
FileDir = LEFT$(Filename, RINSTR(Filename, "\"))
END IF
END FUNCTION
IF FindWindowAPI("Shell_TrayWnd", "") <> 0 THEN
DIM i AS INTEGER, j AS INTEGER
DIM titel AS STRING
i = LoadLibraryAPI("stkit432")
IF i <> 0 THEN
FreeLibraryAPI(i)
CheckBoxLink.Checked = 1
CheckBoxLink.Visible = 1
LabelLink.Visible = 1
BreakItem5.Visible = 1
ShortcutItem.Visible = 1
END IF
j = LoadFromFiles(ReadParams)
IF Language <> "{E}" THEN
titel = LoadLanguage
ELSE
titel = "Alarms"
END IF
IF TrayMode <> 0 THEN
TrayMain
ELSE
CreatePin
CustomizeMenu(Form.Handle)
CustomizeMenu(Alarm.Handle)
CustomizeMenu(Changes.Handle)
FOR i = 0 TO 99
ComboBoxAlarm.AddItems(STR$(i))
NEXT
titel = msg01 + " - " + titel
i = FindWindowAPI("TForm", titel)
Application.Title = msg01
Alarm.CAPTION = titel
Alarm.OnResize = AlarmOnResize
IF ListOrder = "" THEN
ListOrder = "0"
dataListSave(GetFileName(".bak"))
j = 0
ELSE
IF j <> 0 THEN j = (j <> dataListSave(GetFileName(".bak")))
END IF
IF i <> 0 THEN
ShowWindowAPI(i, SW_SHOWNORMAL)
SetForegroundWindowAPI(i)
PostMessage(i, WM_SIZE, 0, 0)
ELSE
AlternateWndProc = 0
DefaultWndProc = GetWindowLongAPI(Dummy.Handle, GWL_WNDPROC)
SetWindowLongAPI(Dummy.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Dummy.Handle)
Dummy.WndProc = WndProc
Dummy.SHOWMODAL
SetWindowLongAPI(Dummy.Handle, GWL_WNDPROC, DefaultWndProc)
CreateAlarmList(1)
Alarm.CAPTION = ""
Replication
IF (Check = 0) OR (Pin <> "") THEN
IF Mode = "M" THEN Form.CAPTION = "<<< " + msg01 + " >>>"
IF Mode = "S" THEN Form.CAPTION = ">>> " + msg01 + " <<<"
IF j <> 0 THEN DisplayMessage(msg16)
SetFocusAPI(ListBox.Handle)
AlternateWndProc = 0
DefaultWndProc = GetWindowLongAPI(Form.Handle, GWL_WNDPROC)
SetWindowLongAPI(Form.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Form.Handle)
Form.WndProc = WndProc
Form.SHOWMODAL
SetWindowLongAPI(Form.Handle, GWL_WNDPROC, DefaultWndProc)
END IF
END IF
END IF
END IF
END
SUB RadioButtonClick (Sender AS QRADIOBUTTON)
DIM str AS STRING
DIM i AS INTEGER
IF RadioButtonCategory.Checked THEN ListOrder = "0"
IF RadioButtonName.Checked THEN ListOrder = "1"
IF RadioButtonDate.Checked THEN ListOrder = "9"
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
str = RIGHT$(str, LEN(str) - INSTR(str, Separator))
dataList.Item(i - 1) = GetSortFieldContent(str) + Separator + str
NEXT
FillListBox(ComboBoxFilter.Text)
ClearFields(1)
IF RadioButtonCategory.Checked THEN SetFocusAPI(RadioButtonCategory.Handle)
IF RadioButtonName.Checked THEN SetFocusAPI(RadioButtonName.Handle)
IF RadioButtonDate.Checked THEN SetFocusAPI(RadioButtonDate.Handle)
END SUB
SUB ComboBoxFilterChange (Sender AS QCOMBOBOX)
NoChange = 1
ListBox.ItemIndex = -1
NoChange = 0
FillListBox(ComboBoxFilter.Text)
ClearFields(1)
SetFocusAPI(ComboBoxFilter.Handle)
END SUB
FUNCTION GetIndex (n AS INTEGER) AS INTEGER
DIM i AS INTEGER
i = 0
WHILE 0 <= n
IF (FIELD$(dataList.item(i), Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN n = n - 1
i = i + 1
WEND
result = i - 1
END FUNCTION
SUB ListBoxItem
DIM str AS STRING, s AS STRING
DIM i AS INTEGER
ButtonEdit.Enabled = 0
str = dataList.Item(GetIndex(ListBox.ItemIndex))
s = FIELD$(str, Separator, 13)
ComboBoxCategory.ItemIndex = GetCategoryIndex(s)
EditName.Text = FIELD$(str, Separator, 2)
EditGivenname.Text = FIELD$(str, Separator, 3)
EditStreet.Text = FIELD$(str, Separator, 4)
EditZip.Text = FIELD$(str, Separator, 5)
EditCity.Text = FIELD$(str, Separator, 6)
EditPhone.Text = FIELD$(str, Separator, 7)
EditFax.Text = FIELD$(str, Separator, 8)
EditMail.Text = FIELD$(str, Separator, 9)
EditDate.Text = FIELD$(str, Separator, 10)
EditComment.Clear
s = FIELD$(str, Separator, 11)
IF s <> "" THEN
FOR i = 1 TO TALLY(s, LineBreak) + 1
EditComment.AddString(FIELD$(s, LineBreak, i))
NEXT
END IF
s = FIELD$(str, Separator, 12)
i = (s <> "")
IF i THEN
ComboBoxAlarm.ItemIndex = VAL(GetAlarmText(s)) + 1
ELSE
ComboBoxAlarm.Text = "-"
END IF
ButtonEdit.Enabled = 1
ButtonDelete.Enabled = 1
DatePrev.Enabled = i
DateNext.Enabled = i
LabelAlarmText.Enabled = i
ButtonAdd.CAPTION = CaptionCopy
ButtonEdit.CAPTION = CaptionEdit
ButtonClear.CAPTION = CaptionNew
FillOpenMenu(str, 1)
LabelNumber.CAPTION = STR$(ListBox.ItemIndex + 1) + " | " + STR$(ListBox.ItemCount) + " | " + STR$(dataList.ItemCount)
END SUB
SUB ListBoxClick (Sender AS QLISTBOX)
DIM i AS INTEGER
i = ListBox.SelCount
IF i = 1 THEN
ListBoxItem
ELSE
NoChange = 1
ClearFields(0)
NoChange = 0
IF i = 0 THEN ButtonDelete.Enabled = 0
END IF
END SUB
SUB ListBoxDblClick (Sender AS QLISTBOX)
IF ListBox.SelCount = 1 THEN
ListBoxItem
IF EditMail.Text <> "" THEN
IF OpenFlag = 1 THEN OpenURL(EditMail.Text)
END IF
END IF
END SUB
SUB ListBoxChange (Index AS SHORT, Change AS BYTE)
DIM i AS INTEGER
IF NoChange = 0 THEN
i = ListBox.SelCount
IF i = 1 THEN
IF (ListBox.ItemIndex <> -1) AND (Change <> 0) THEN ListBoxItem
ELSEIF i <> 0 THEN
NoChange = 1
ClearFields(0)
NoChange = 0
END IF
END IF
END SUB
SUB ListBoxKey (key AS BYTE)
IF ButtonDelete.Enabled THEN
IF key = 13 THEN SetFocusAPI(EditName.Handle)
END IF
END SUB
SUB AlarmDetail
DIM str AS STRING
DIM i AS INTEGER
i = ListView.ItemIndex
IF 0 <= i THEN
str = FIELD$(alarmList.Item(i), Separator, 6)
i = dataList.ItemCount
WHILE 0 < i
i = i - 1
IF FIELD$(dataList.Item(i), Separator, 15) = str THEN
str = dataList.Item(i)
i = -1
END IF
WEND
IF i = -1 THEN
ListView.Visible = 0
ButtonOk.Visible = 0
ButtonCancel.Visible = 0
ButtonClose.Visible = 1
Panel5.Visible = 1
AlarmEditName.Text = FIELD$(str, Separator, 2)
AlarmEditGivenname.Text = FIELD$(str, Separator, 3)
AlarmEditStreet.Text = FIELD$(str, Separator, 4)
AlarmEditZip.Text = FIELD$(str, Separator, 5)
AlarmEditCity.Text = FIELD$(str, Separator, 6)
AlarmEditPhone.Text = FIELD$(str, Separator, 7)
AlarmEditFax.Text = FIELD$(str, Separator, 8)
AlarmEditMail.Text = FIELD$(str, Separator, 9)
AlarmEditDate.Text = FIELD$(str, Separator, 10)
AlarmEditAlarm.Text = FIELD$(str, Separator, 12)
AlarmEditComment.Clear
str = FIELD$(str, Separator, 11)
IF str <> "" THEN
FOR i = 1 TO TALLY(str, LineBreak) + 1
AlarmEditComment.AddString(FIELD$(str, LineBreak, i))
NEXT
END IF
SetFocusAPI(ButtonClose.Handle)
END IF
END IF
END SUB
SUB ListViewDblClick (Sender AS QLISTBOX)
AlarmDetail
END SUB
SUB ListViewKey (key AS BYTE)
IF key = 13 THEN AlarmDetail
END SUB
SUB ButtonCloseClick (Sender AS QBUTTON)
ShowAlarmList
SetFocusAPI(ListView.Handle)
END SUB
SUB ListBoxIndex (position AS INTEGER)
DIM s AS INTEGER
IF (ListBox.ItemIndex < 0) OR (1 < ListBox.SelCount) THEN
SendMessage(ListBox.Handle, WM_KEYDOWN, VK_HOME, 0)
ELSE
position = position - ListBox.ItemIndex
END IF
s = SGN(position)
NoChange = 1
WHILE position <> 0
SendMessage(ListBox.Handle, WM_KEYDOWN, IIF(s < 0, VK_UP, VK_DOWN), 0)
position = position - s
WEND
IF 0 <= ListBox.ItemIndex THEN
IF 0 < ListBox.ItemIndex THEN
SendMessage(ListBox.Handle, WM_KEYDOWN, VK_UP, 0)
SendMessage(ListBox.Handle, WM_KEYDOWN, VK_DOWN, 0)
END IF
IF ListBox.ItemIndex < ListBox.ItemCount - 1 THEN
SendMessage(ListBox.Handle, WM_KEYDOWN, VK_DOWN, 0)
SendMessage(ListBox.Handle, WM_KEYDOWN, VK_UP, 0)
END IF
END IF
NoChange = 0
ListBoxItem
END SUB
FUNCTION DeleteItem (n AS INTEGER) AS STRING
n = GetIndex(n)
result = FIELD$(dataList.Item(n), Separator, 14)
dataList.DelItems(n)
ButtonAdd.CAPTION = CaptionAdd
END FUNCTION
FUNCTION GetTicket AS STRING
DO
result = DATE$
result = FIELD$(result, "-", 3) + FIELD$(result, "-", 1) + FIELD$(result, "-", 2) + REPLACESUBSTR$( TIME$, ":", "")
LOOP UNTIL result <> LastTicket
LastTicket = result
END FUNCTION
SUB UnLock (f AS INTEGER)
RadioButtonName.Enabled = f
RadioButtonDate.Enabled = f
RadioButtonCategory.Enabled = f
ComboBoxFilter.Enabled = f
ButtonDelete.Enabled = f
ListBox.Enabled = f
DateCurr.Enabled = f
END SUB
SUB AddItem (flag AS INTEGER)
DIM str AS STRING, s AS STRING, t AS STRING
DIM i AS INTEGER, j AS INTEGER
s = ComboBoxCategory.Text
str = REPLACESUBSTR$(EditComment.Text, CR + LF, LineBreak)
IF RIGHT$(str, 1) = LineBreak THEN str = LEFT$(str, LEN(str) - 1)
str = EditDate.Text + Separator + str
str = EditMail.Text + Separator + str
str = EditFax.Text + Separator + str
str = EditPhone.Text + Separator + str
str = EditCity.Text + Separator + str
str = EditZip.Text + Separator + str
str = EditStreet.Text + Separator + str
str = EditGivenname.Text + Separator + str
str = EditName.Text + Separator + str
str = str + Separator + GetAlarmText(ComboBoxAlarm.Text)
str = str + Separator + s
IF TALLY(str, Separator) = 11 THEN
IF flag = 2 THEN
t = ""
ELSE
i = ListBox.ItemIndex
t = DeleteItem(i)
ListBox.DelItems(i)
END IF
i = TALLY(t, "-")
IF i < 2 THEN
IF i = 1 THEN
t = FIELD$(t, "-", 1) + "-" + GetTicket
ELSE
t = GetTicket
t = t + "-" + t
END IF
END IF
IF s <> "" THEN
IF GetCategoryIndex(s) < 0 THEN
ComboBoxFilter.AddItems s
ComboBoxCategory.AddItems s
ComboBoxCategory.ItemIndex = GetCategoryIndex(s)
END IF
END IF
IF s <> ComboBoxFilter.Text THEN ComboBoxFilter.ItemIndex = 0
id = id + 1
str = GetSortFieldContent(str) + Separator + str + Separator + t + Separator + STR$(id)
dataList.AddItems(str)
FillListBox(ComboBoxFilter.Text)
i = dataList.ItemCount
j = ListBox.ItemCount
DO
i = i - 1
IF (FIELD$(str, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN j = j - 1
str = dataList.Item(i)
LOOP UNTIL VAL(FIELD$(str, Separator, 15)) = id
ListBoxIndex(j)
UnLock(1)
ButtonEdit.Enabled = 1
IF ABS(flag) <> 1 THEN Edited = 1
ELSE
DisplayMessage(msg03)
END IF
END SUB
SUB DisableListBox
IF ButtonEdit.Enabled THEN ButtonEdit.CAPTION = CaptionReplace
ButtonClear.CAPTION = CaptionClear
ButtonAdd.CAPTION = CaptionAdd
DatePrev.Enabled = 0
DateNext.Enabled = 0
UnLock(0)
END SUB
SUB ComboBoxChange (str AS STRING, n AS INTEGER)
DIM i AS INTEGER
IF ListBox.Enabled THEN
IF ButtonEdit.Enabled OR (ListBox.SelCount <> 1) THEN
i = GetIndex(ListBox.ItemIndex)
IF i < 0 THEN
IF str = "" THEN i = 0
ELSE
IF str <> FIELD$(dataList.Item(i), Separator, n) THEN i = -1
END IF
IF i < 0 THEN DisableListBox
END IF
END IF
END SUB
SUB ComboBoxAlarmChange (Sender AS QCOMBOBOX)
DIM str AS STRING
str = ComboBoxAlarm.Text
ComboBoxChange(str, 12)
IF ListBox.Enabled = 0 THEN LabelAlarmText.Enabled = (str <> "") AND (str <> "-")
END SUB
SUB ComboBoxCategoryChange (Sender AS QCOMBOBOX)
ComboBoxChange(ComboBoxCategory.Text, 13)
END SUB
SUB EditChange (Sender AS QEDIT)
IF NoChange = 0 THEN
IF ButtonEdit.Enabled OR (ListBox.SelCount <> 1) THEN DisableListBox
END IF
END SUB
SUB ButtonEditClick (Sender AS QBUTTON)
DIM f AS INTEGER
IF EditName.Text <> "" THEN
IF (GetAlarmText(ComboBoxAlarm.Text) = "") OR (ConvertDate(EditDate.Text) <> "") THEN
f = ListBox.Enabled
AddItem(f)
SetFocusAPI(IIF(f, EditName.Handle, ListBox.Handle))
ELSE
DisplayMessage(msg04)
END IF
ELSE
DisplayMessage(msg05)
END IF
END SUB
SUB ButtonAddClick (Sender AS QBUTTON)
IF EditName.Text <> "" THEN
IF (GetAlarmText(ComboBoxAlarm.Text) = "") OR (ConvertDate(EditDate.Text) <> "") THEN
AddItem(2)
ELSE
DisplayMessage(msg04)
END IF
ELSE
DisplayMessage(msg05)
END IF
END SUB
SUB ButtonDeleteClick (Sender AS QBUTTON)
DIM i AS INTEGER
IF 1 < ListBox.SelCount THEN
DisplayMessage("???")
IF MessageYes.Visible = 0 THEN
i = ListBox.ItemCount
WHILE 0 < i
i = i - 1
IF ListBox.Selected(i) THEN
DeleteItem(i)
Edited = 1
END IF
WEND
NoChange = 1
ListBox.ItemIndex = -1
FillListBox(ComboBoxFilter.Text)
NoChange = 0
ELSE
i = -1
END IF
ELSE
i = ListBox.ItemIndex
ListBox.DelItems(i)
DeleteItem(i)
Edited = 1
END IF
IF 0 <= i THEN
i = ListBox.ItemCount
LabelNumber.CAPTION = "- | " + STR$(i) + " | " + STR$(dataList.ItemCount)
ButtonEdit.Enabled = 0
DatePrev.Enabled = 0
IF i = 0 THEN DateCurr.Enabled = 0
DateNext.Enabled = 0
ButtonDelete.Enabled = 0
END IF
SetFocusAPI(ListBox.Handle)
END SUB
SUB ButtonClearClick (Sender AS QBUTTON)
NoChange = 1
ClearFields(1)
NoChange = 0
SetFocusAPI(EditName.Handle)
END SUB
SUB FormClose (Action AS INTEGER)
IF Edited THEN
IF IsIconicAPI(Form.Handle) THEN SendMessage(Form.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
FormConfirmation
IF Edited THEN Action = caNone
END IF
END SUB
SUB ButtonOkClick (Sender AS QBUTTON)
Alarm.CLOSE
Check = 0
END SUB
SUB ButtonCancelClick (Sender AS QBUTTON)
Alarm.CLOSE
Check = 1
END SUB
SUB ButtonGermanClick (Sender AS QBUTTON)
Intro.CLOSE
Language = "{D}"
END SUB
SUB ButtonEnglishClick (Sender AS QBUTTON)
Intro.CLOSE
END SUB
FUNCTION GetDateCurr AS INTEGER
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER, q AS INTEGER
DIM str AS STRING
result = -1
n = 0
q = 0
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
IF (FIELD$(str, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN
IF FIELD$(str, Separator, 12) <> "" THEN
j = DateCheck(FIELD$(str, Separator, 10), -3)
IF ((result < 0) OR (q < j)) AND (j <= 0) THEN
q = j
result = n
END IF
END IF
n = n + 1
END IF
NEXT
END FUNCTION
SUB DatePrevClick (Sender AS QBUTTON)
DIM c AS INTEGER, i AS INTEGER, j AS INTEGER, n AS INTEGER
DIM f AS INTEGER, p AS INTEGER, q AS INTEGER
DIM d AS INTEGER, m AS INTEGER, y AS INTEGER
DIM dmax AS INTEGER, mmax AS INTEGER, ymax AS INTEGER
DIM dnow AS INTEGER, mnow AS INTEGER, ynow AS INTEGER
DIM dmin AS INTEGER, mmin AS INTEGER, ymin AS INTEGER
DIM str AS STRING
str = DATE$
dnow = VAL(FIELD$(str, "-", 2))
mnow = VAL(FIELD$(str, "-", 1))
ynow = VAL(FIELD$(str, "-", 3))
i = GetIndex(ListBox.ItemIndex)
str = ConvertDate(FIELD$(dataList.Item(i), Separator, 10))
IF str <> "" THEN
dmax = VAL(FIELD$(str, "-", 2))
mmax = VAL(FIELD$(str, "-", 1))
ymax = VAL(FIELD$(str, "-", 3))
dmin = 0
mmin = 0
ymin = 0
c = GetDateCurr
q = IIF(i = c, -1, c)
j = ynow
IF q = -1 THEN
dmax = dnow
mmax = mnow
ymax = ynow
ELSEIF ymax < j THEN
IF (mnow < mmax) OR ((mnow = mmax) AND (dnow < dmax)) THEN j = j - 1
ymax = j
END IF
n = 0
p = -1
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
IF (FIELD$(str, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN
IF FIELD$(str, Separator, 12) <> "" THEN
str = ConvertDate(FIELD$(str, Separator, 10))
IF str <> "" THEN
d = VAL(FIELD$(str, "-", 2))
m = VAL(FIELD$(str, "-", 1))
y = VAL(FIELD$(str, "-", 3))
IF (y < j) OR (n = q) THEN
y = j
IF ymax <= ynow THEN
IF (mmax < m) OR ((mmax = m) AND (dmax < d)) THEN y = y - 1
END IF
ELSEIF y = ynow THEN
IF (m < mnow) OR ((m = mnow) AND (d <= dnow)) THEN y = j
END IF
f = (y < ymax)
IF NOT f THEN f = (y = ymax) AND (m < mmax)
IF NOT f THEN f = (y = ymax) AND (m = mmax) AND (d < dmax)
IF NOT f THEN f = (y = ymax) AND (m = mmax) AND (d = dmax) AND (n < ListBox.ItemIndex)
IF f THEN f = (ymin < y) OR ((ymin = y) AND (mmin < m)) OR ((ymin = y) AND (mmin = m) AND (dmin <= d))
IF f THEN
p = n
dmin = d
mmin = m
ymin = y
END IF
END IF
END IF
n = n + 1
END IF
NEXT
IF 0 <= p AND p <> c THEN
ListBoxIndex(p)
ELSE
DisplayMessage(msg11)
END IF
ELSE
DisplayMessage(msg04)
END IF
END SUB
SUB DateCurrClick (Sender AS QBUTTON)
DIM p AS INTEGER
p = GetDateCurr
IF 0 <= p THEN
ListBoxIndex(p)
ELSE
DisplayMessage(msg12)
END IF
END SUB
SUB DateNextClick (Sender AS QBUTTON)
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER
DIM a AS INTEGER, b AS INTEGER
DIM p AS INTEGER, q AS INTEGER
DIM str AS STRING
a = DateCheck(FIELD$(dataList.Item(GetIndex(ListBox.ItemIndex)), Separator, 10), -3)
IF a <= 0 THEN
b = a
n = 0
p = -1
q = ListBox.ItemIndex
FOR i = 1 TO dataList.ItemCount
str = dataList.Item(i - 1)
IF (FIELD$(str, Separator, 13) = ComboBoxFilter.Text) OR (ComboBoxFilter.Text = "") THEN
IF FIELD$(str, Separator, 12) <> "" THEN
j = DateCheck(FIELD$(str, Separator, 10), -3)
IF ((p = -1) AND (j < b)) OR ((a < j) AND (j < b)) OR ((j = b) AND ((a < b) OR (p < q)) AND (q < n)) THEN
a = j
p = n
END IF
END IF
n = n + 1
END IF
NEXT
IF 0 <= p THEN
ListBoxIndex(p)
ELSE
DisplayMessage(msg12)
END IF
ELSE
DisplayMessage(msg04)
END IF
END SUB
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2003-07-28 18:22:02
