' TODO: ' X- fix focus of OneNote (under 2nd visible window) e.g. when showing Domains List ' X- add label "Hit enter to create new contact" when user types new "Name, Surname" '------------------------------------------------------------------------------ ' ** Includes ** '------------------------------------------------------------------------------ #INCLUDE ONCE "WIN32API.INC" #INCLUDE ONCE "INC\CLIPBOARDHTML.INC" #INCLUDE ONCE "INC\UTF8.INC" '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Constants ** '------------------------------------------------------------------------------ %IDC_COMBOBOX1 = 1001 '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Globals ** '------------------------------------------------------------------------------ GLOBAL OldCBBProc AS LONG GLOBAL hComboEdit AS DWORD GLOBAL contacts() AS STRING GLOBAL emails() AS STRING GLOBAL domains_a() AS STRING ' domain acronyms (RNA) GLOBAL domains_c() AS STRING ' domain companies (Renault) GLOBAL domains_e() AS STRING ' domain extensions (@renault.com) '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Functions / Subs ** '------------------------------------------------------------------------------ SUB AddContact(contact AS STRING, email AS STRING) WritePrivateProfileString "contact_book", (contact), "mailto:"+email, INIFILE END SUB '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ SUB AddDomain(acronym AS STRING, company AS STRING, mailext AS STRING) LOCAL n AS LONG n = UBOUND(domains_a) + 1 REDIM PRESERVE domains_a(n) REDIM PRESERVE domains_c(n) REDIM PRESERVE domains_e(n) domains_a(n) = acronym domains_c(n) = company domains_e(n) = mailext WritePrivateProfileString "domains", (acronym), company + mailext, INIFILE END SUB '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ SUB PasteContact(hD AS DWORD, contact AS STRING, email AS STRING) LOCAL i AS LONG LOCAL e, r AS STRING i = INSTR(email, "@") e = MID$(email, i) ' extension ARRAY SCAN domains_e(), = e, TO i : DECR i e = "" IF i >= 0 THEN IF domains_a(i) <> "default" THEN e = domains_a(i) + "\" END IF r = "" r += "@" + e + TRIM$(RTRIM$(contact, ",")) r += "" ClipBoardHtmlSet hD, TRIM$(r) DIALOG END hD, -1 END SUB '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** CallBacks ** '------------------------------------------------------------------------------ MACRO FLASH_DLG(ctlId) ' BEEP CONTROL SET FOCUS CB.HNDL, ctlId flashInfo.cbSize = SIZEOF(flashInfo) flashInfo.hwnd = CB.HNDL flashInfo.dwflags = %FLASHW_CAPTION flashInfo.ucount = 2 flashInfo.dwTimeout = 100 ' flashing rate in ms FlashWindowEx(flashInfo) EXIT FUNCTION END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ TYPE FLASHWINDOWAPI cbSize AS DWORD hwnd AS DWORD dwFlags AS DWORD uCount AS DWORD dwTimeout AS DWORD END TYPE '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ CALLBACK FUNCTION ProcNewDomain() LOCAL flashInfo AS FlashWindowAPI SELECT CASE AS LONG CB.MSG CASE %WM_INITDIALOG ' Initialization handler CASE %WM_COMMAND ' Process control notifications IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL, 0 ELSEIF CB.CTL = %IDOK THEN LOCAL acronym, company, mailext AS STRING CONTROL GET TEXT CB.HNDL, 201 TO acronym : acronym = TRIM$(acronym) IF acronym = "" THEN FLASH_DLG(201) END IF CONTROL GET TEXT CB.HNDL, 202 TO company : company = TRIM$(company) IF company = "" THEN FLASH_DLG(202) END IF CONTROL GET TEXT CB.HNDL, 203 TO mailext : mailext = TRIM$(mailext) mailext = LTRIM$(mailext, "@") IF INSTR(mailext, ".") <= 1 OR INSTR(mailext, ".") = LEN(mailext) THEN FLASH_DLG(203) END IF IF LEFT$(mailext, 1) <> "@" THEN mailext = "@" + mailext AddDomain acronym, company, mailext DIALOG END CB.HNDL, (UBOUND(domains_a) + 1) END IF END IF END SELECT END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO FOCUS_NEXT_CTL KeyBd_Event(%VK_TAB, 0, 0, 0) KeyBd_Event(%VK_TAB, 0, %KEYEVENTF_KEYUP, 0) END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO FOCUS_PREV_CTL KeyBd_Event(%VK_SHIFT, 0, 0, 0) KeyBd_Event(%VK_TAB, 0, 0, 0) KeyBd_Event(%VK_TAB, 0, %KEYEVENTF_KEYUP, 0) KeyBd_Event(%VK_SHIFT, 0, %KEYEVENTF_KEYUP, 0) END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO FOCUS_BUTTON (bid) CONTROL SET FOCUS CB.HNDL, bid IF bid = 103 THEN FOCUS_NEXT_CTL FOCUS_PREV_CTL ELSE FOCUS_PREV_CTL FOCUS_NEXT_CTL END IF END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ CALLBACK FUNCTION ProcDomainsList() STATIC lbid AS LONG ' last button Id LOCAL i AS LONG SELECT CASE AS LONG CB.MSG CASE %WM_INITDIALOG ' Initialization handler FOCUS_BUTTON(103) lbid = 103 CASE %WM_COMMAND ' Process control notifications IF (CB.CTL - %WM_USER) = %VK_HOME THEN ' keyboard trap via accelerator table.. FOR i = lbid - 1 TO 103 STEP -1 KeyBd_Event(%VK_UP, 0, 0, 0) KeyBd_Event(%VK_UP, 0, %KEYEVENTF_KEYUP, 0) NEXT EXIT FUNCTION ELSEIF (CB.CTL - %WM_USER) = %VK_END THEN FOR i = lbid + 1 TO 103 + UBOUND(domains_a) + 1 KeyBd_Event(%VK_DOWN, 0, 0, 0) KeyBd_Event(%VK_DOWN, 0, %KEYEVENTF_KEYUP, 0) NEXT EXIT FUNCTION ELSEIF (CB.CTL - %WM_USER) = %VK_PRIOR THEN ' PG-UP FOR i = lbid - 1 TO MAX(lbid - 7, 103) STEP -1 KeyBd_Event(%VK_UP, 0, 0, 0) KeyBd_Event(%VK_UP, 0, %KEYEVENTF_KEYUP, 0) NEXT EXIT FUNCTION ELSEIF (CB.CTL - %WM_USER) = %VK_NEXT THEN ' PG-DOWN FOR i = lbid + 1 TO MIN(103 + UBOUND(domains_a) + 1, lbid + 7) KeyBd_Event(%VK_DOWN, 0, 0, 0) KeyBd_Event(%VK_DOWN, 0, %KEYEVENTF_KEYUP, 0) NEXT EXIT FUNCTION END IF IF CB.CTLMSG = %BN_SETFOCUS THEN lbid = CB.CTL IF CB.CTL = %IDCANCEL THEN FOCUS_BUTTON(103) END IF ELSEIF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL, 0 ELSE DIALOG END CB.HNDL, CB.CTL - 103 + 1 END IF END IF END SELECT END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ CALLBACK FUNCTION ProcContactBook() LOCAL hCombo AS DWORD LOCAL ComboInfo AS COMBOBOXINFO SELECT CASE AS LONG CB.MSG CASE %WM_INITDIALOG ' Initialization handler CONTROL HANDLE CB.HNDL, %IDC_COMBOBOX1 TO hCombo ComboInfo.cbSize = SIZEOF(COMBOBOXINFO) GETCOMBOBOXINFO(hCombo, BYVAL VARPTR(ComboInfo)) ' get data about combobox hComboEdit = ComboInfo.hwndItem ' handle to edit control of combobox OldCBBProc = SETWINDOWLONG(hComboEdit, %GWL_WNDPROC, CODEPTR(CBBProc)) ' subclass CASE %WM_COMMAND ' Process control notifications IF CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL, 0 END SELECT END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO UPDATE_HINT IF nn = 0 THEN ' new contact -> display hints IF INSTR(s, ",") > 0 THEN CONTROL SET TEXT hDlg, 102, "Hit enter to create new contact" ELSE CONTROL SET TEXT hDlg, 102, "For a new contact: type ""Name, Surname""" END IF CONTROL SHOW STATE hDlg, 102, %SW_SHOW ELSE ' existing contact(s) -> hide hint CONTROL SHOW STATE hDlg, 102, %SW_HIDE END IF END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ FUNCTION CBBProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG LOCAL hDlg AS DWORD LOCAL s, e AS STRING LOCAL i, n, nn, k AS LONG SELECT CASE Msg CASE %WM_KEYUP WINDOW GET PARENT hWnd TO hDlg : hDlg = GetParent(hDlg) COMBOBOX GET COUNT hDlg, %IDC_COMBOBOX1 TO n : nn = n IF wParam >= ASC("A") AND wParam <= ASC("Z") THEN ' Typing name... CONTROL GET TEXT hDlg, %IDC_COMBOBOX1 TO s ' get search string FOR i = n TO 1 STEP -1 ' search each entry COMBOBOX GET TEXT hDlg, %IDC_COMBOBOX1, i TO e IF INSTR(NoAccent(LCASE$(e)), _ NoAccent(LCASE$(s))) = 0 THEN COMBOBOX DELETE hDlg, %IDC_COMBOBOX1, i : DECR nn ' restrict list END IF NEXT UPDATE_HINT ELSEIF wParam = 8 OR wParam = 46 THEN ' Backspace/Del keys CONTROL GET TEXT hDlg, %IDC_COMBOBOX1 TO s ' get search string FOR i = LBOUND(contacts) TO UBOUND(contacts) ' search initial contact book IF INSTR(NoAccent(LCASE$(contacts(i))), _ NoAccent(LCASE$(s))) > 0 THEN COMBOBOX FIND EXACT hDlg, %IDC_COMBOBOX1, 1, _ Utf8ToAnsi(contacts(i)) TO k IF k = 0 THEN COMBOBOX ADD hDlg, %IDC_COMBOBOX1, _ ' populate list Utf8ToAnsi(contacts(i)) : INCR nn END IF END IF NEXT UPDATE_HINT ELSEIF wParam = 36 THEN ' Home key COMBOBOX SELECT hDlg, %IDC_COMBOBOX1, 1 ' select first entry ELSEIF wParam = 35 THEN ' End key COMBOBOX SELECT hDlg, %IDC_COMBOBOX1, n ' select last entry ELSEIF wParam = 13 THEN ' Return key CONTROL GET TEXT hDlg, %IDC_COMBOBOX1 TO s IF s = "" THEN EXIT FUNCTION ' (ignore empty name) ARRAY SCAN contacts(), = AnsiToUtf8(s), TO k : DECR k IF k >= 0 THEN ' Existing contact DIALOG SHOW STATE hDlg, %SW_HIDE DIALOG SEND GetParent(hWnd), %WM_SETFOCUS, 0, 0 ' put OneNote on top PasteContact hDlg, contacts(k), emails(k) ' paste contact ELSE ' New contact i = INSTR(s, ",") IF i = 0 THEN ' do not save it until EXIT FUNCTION ' it's "Name, Surname" ELSE DIALOG SHOW STATE hDlg, %SW_HIDE ' valid format DIALOG SEND GetParent(hWnd), %WM_SETFOCUS, 0, 0 ' put OneNote on top e = TRIM$( MID$(NoAccent(s), i+1)) + "." _ + TRIM$(LEFT$(NoAccent(s), i-1)) i = ShowDomainsList(hWnd, s) IF i = 0 THEN ' cancelled by user e = "" ELSEIF i - 1 > UBOUND(domains_a) THEN ' New company i = ShowNewDomain(hWnd) IF i = 0 THEN ' cancelled by user e = "" ELSE ' new email extension e += domains_e(i - 1) END IF ELSEIF i > 0 THEN ' Existing company e += domains_e(i-1) ' add email extension ELSE ' (e.g. @renault.com) END IF IF e = "" THEN DIALOG END hDlg, 0 EXIT FUNCTION END IF s = AnsiToUtf8(s) ' switch from Win-display world to UTF8 encoding world AddContact s, e PasteContact hDlg, s, e END IF END IF END IF END SELECT FUNCTION = CallWindowProc(OldCBBProc, hWnd, Msg, wParam, lParam) END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Fill ComboBox ** '------------------------------------------------------------------------------ FUNCTION FillContactBook(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG LOCAL i, k, n, ff AS LONG LOCAL e AS STRING CONTROL SEND hDlg, lID, %CB_SETEXTENDEDUI, %TRUE, 0 ' Read favorite domain names & extensions from ini file ff = FREEFILE OPEN INIFILE FOR INPUT ACCESS READ LOCK SHARED AS #ff DO LINE INPUT #ff, e LOOP UNTIL "[domains]" = LCASE$(TRIM$(e)) OR ISTRUE EOF(#ff) IF ISFALSE EOF(#ff) THEN DO LINE INPUT #ff, e k = INSTR(e, "=") IF k > 0 AND INSTR(e, "@") > 0 THEN n = UBOUND(domains_a) IF n < 0 THEN n = 0 REDIM domains_a(n) REDIM domains_c(n) REDIM domains_e(n) ELSE INCR n REDIM PRESERVE domains_a(n) REDIM PRESERVE domains_c(n) REDIM PRESERVE domains_e(n) END IF domains_a(n) = TRIM$(LEFT$(e, k-1)) ' domain acronym (RNA) e = TRIM$(MID$(e, k+1)) k = INSTR(e, "@") domains_c(n) = TRIM$(LEFT$(e, k-1)) ' domain company (Renault) domains_e(n) = TRIM$(MID$ (e, k)) ' domain extension (@renault.com) END IF LOOP UNTIL EOF(#ff) OR (INSTR(e, "[") > 0 AND INSTR(e, "]") > 0) END IF CLOSE #ff ' Sanity check n = UBOUND(domains_a) IF n < 0 THEN n = 0 REDIM domains_a(n) REDIM domains_c(n) REDIM domains_e(n) domains_a(n) = "default" ' domain acronym domains_c(n) = "Microsoft" ' domain company domains_e(n) = "@microsoft.com" ' domain extension END IF ' Populate contact book from ini file ff = FREEFILE OPEN INIFILE FOR INPUT ACCESS READ LOCK SHARED AS #ff DO LINE INPUT #ff, e LOOP UNTIL "[contact_book]" = LCASE$(TRIM$(e)) OR ISTRUE EOF(#ff) IF ISFALSE EOF(#ff) THEN DO LINE INPUT #ff, e k = INSTR(e, "=") IF k > 0 AND INSTR(e, ",") > 0 AND INSTR(e, "@") > 0 THEN n = UBOUND(contacts) IF n < 0 THEN n = 0 REDIM contacts(n) REDIM emails(n) ELSE INCR n REDIM PRESERVE contacts(n) REDIM PRESERVE emails(n) END IF contacts(n) = TRIM$(LEFT$(e, k-1)) emails(n) = TRIM$( MID$(e, k+1)) END IF LOOP UNTIL EOF(#ff) OR (INSTR(e, "[") > 0 AND INSTR(e, "]") > 0) END IF CLOSE #ff ' Fill ComboBox with contact names FOR i = LBOUND(contacts) TO UBOUND(contacts) COMBOBOX ADD hDlg, %IDC_COMBOBOX1, Utf8ToAnsi(contacts(i)) NEXT END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Dialogs ** '------------------------------------------------------------------------------ FUNCTION ShowContactBook(BYVAL hParent AS DWORD) AS LONG LOCAL lRes AS LONG LOCAL hDlg AS DWORD LOCAL hIco AS DWORD DIALOG NEW PIXELS, hParent, "Contact Book", 310, 210, 297, 201, _ %WS_POPUP OR%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_VISIBLE OR _ %WS_CLIPSIBLINGS OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg hIco = ExtractIcon(GetModuleHandle(""), "shell32.dll", 160) SetClassLong(hDlg, %GCL_HICONSM, hIco) SetClassLong(hDlg, %GCL_HICON, hIco) DeleteObject(hIco) ERASE contacts(), emails(), domains_a(), domains_c(), domains_e() ClipBoardHtmlSet hDlg, "" CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX1, , 8, 8, 280, 152, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_SIMPLE OR %CBS_SORT _ OR %WS_VSCROLL, %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR FillContactBook hDlg, %IDC_COMBOBOX1 CONTROL ADD LABEL, hDlg, 102, "--hint--", 6, 154, 280, 16 CONTROL SHOW STATE hDlg, 102, %SW_HIDE CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 224, 172, 64, 24 CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 144, 172, 64, 24 DIALOG SHOW MODAL hDlg, CALL ProcContactBook TO lRes FUNCTION = lRes END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ MACRO REGISTER_ACCEL (aclId, keyVal) ac(aclId).fvirt = %FVIRTKEY ac(aclId).key = keyVal ac(aclId).cmd = keyVal + %WM_USER END MACRO '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ %dlg_dw = 280 '------------------------------------------------------------------------------ FUNCTION ShowDomainsList(BYVAL hParent AS DWORD, contact AS STRING) AS LONG LOCAL i AS LONG LOCAL lRes AS LONG LOCAL hDlg AS DWORD LOCAL hIco AS DWORD LOCAL e AS STRING DIALOG NEW PIXELS, hParent, "New contact", 0, 0, 2, 2, _ %WS_POPUP OR%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_VISIBLE OR _ %WS_CLIPSIBLINGS OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg hIco = ExtractIcon(GetModuleHandle(""), "shell32.dll", 158) SetClassLong(hDlg, %GCL_HICONSM, hIco) SetClassLong(hDlg, %GCL_HICON, hIco) DeleteObject(hIco) CONTROL ADD BUTTON, hDlg, %IDCANCEL, "", -2, -2, 0, 0, %BS_NOTIFY CONTROL ADD LABEL, hDlg, 102, "What company does "+contact+" belong to ?" _ , 6, 6, %dlg_dw - 6, 20 FOR i = LBOUND(domains_c) TO UBOUND(domains_c) ' domain companies e = domains_c(i) IF domains_a(i) = "default" THEN e = domains_a(i) + " (" + e + ")" CONTROL ADD BUTTON, hDlg, 103 + i, e, 40, 25 * (i + 1), %dlg_dw - 85, 24, %BS_NOTIFY NEXT CONTROL ADD BUTTON, hDlg, 103 + i, "< New company >", _ 40, 25 * (i + 1), %dlg_dw - 85, 24, %BS_NOTIFY DIM ac(0 TO 3) AS ACCELAPI REGISTER_ACCEL (0, %VK_HOME) REGISTER_ACCEL (1, %VK_END) REGISTER_ACCEL (2, %VK_PRIOR) ' PG-UP REGISTER_ACCEL (3, %VK_NEXT) ' PG-DOWN ACCEL ATTACH hDlg, ac() TO lRes DIALOG SET SIZE hDlg, %dlg_dw, 25 * (i + 3) + 15 DIALOG SHOW MODAL hDlg, CALL ProcDomainsList TO lRes FUNCTION = lRes END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ FUNCTION ShowNewDomain(BYVAL hParent AS DWORD) AS LONG LOCAL lRes AS LONG LOCAL hDlg AS DWORD LOCAL hIco AS DWORD DIALOG NEW PIXELS, hParent, "New company", 0, 0, 300, 155, _ %WS_POPUP OR%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_VISIBLE OR _ %WS_CLIPSIBLINGS OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg hIco = ExtractIcon(GetModuleHandle(""), "shell32.dll", 57) SetClassLong(hDlg, %GCL_HICONSM, hIco) SetClassLong(hDlg, %GCL_HICON, hIco) DeleteObject(hIco) CONTROL ADD LABEL, hDlg, 101, "Company Acronym (e.g. MS, Y!) :", 8, 16, 208, 16 CONTROL ADD TEXTBOX, hDlg, 201, "", 224, 12, 64, 20 CONTROL ADD LABEL, hDlg, 102, "Company Name (Microsoft, Yahoo) :", 8, 48, 184, 16 CONTROL ADD TEXTBOX, hDlg, 202, "", 192, 44, 96, 20 CONTROL ADD LABEL, hDlg, 103, "Email extension (""@microsoft.com"") :", 8, 80, 184, 16 CONTROL ADD TEXTBOX, hDlg, 203, "@", 192, 76, 96, 20 CONTROL ADD BUTTON, hDlg, %IDCANCEL, "Cancel", 120, 120, 72, 24 CONTROL ADD BUTTON, hDlg, %IDOK, "OK", 216, 120, 72, 24 DIALOG SHOW MODAL hDlg, CALL ProcNewDomain TO lRes FUNCTION = lRes END FUNCTION '------------------------------------------------------------------------------