2013-06-19 07:44

     $OPTIMIZE ON
     $OPTION icon "data\carnet.ico"
     $INCLUDE "rapidq.inc"

'----------- LANGUAGE
     $DEFINE FRANCAIS  'include this line for French; omit for English
     $INCLUDE "language.bas"  'text constants

     SUB debug(i AS DOUBLE)
      SHOWMESSAGE(STR$(i))
     END SUB

'------------ OTHER CONSTANTS
     CONST colorFond=&hbbeaea  'background color
     CONST colorHeader=&h66cae8 'alternate background color
     CONST separ=" ## "
     CONST crString=CHR$(13)+CHR$(10) 'carriage return
     CONST crSubst="<^p>" 'replacement string for carriage returns in text files

'------------- GLOBAL VARIABLES and INCLUDES
     DECLARE SUB SetFocus LIB "USER32" ALIAS "SetFocus" (HWnd AS LONG)
     DECLARE FUNCTION GetFocus LIB "user32" ALIAS "GetFocus" AS LONG
     DECLARE FUNCTION ShellExecute LIB "shell32.dll" 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 LoadCursor LIB "user32" ALIAS "LoadCursorA" (BYVAL hInstance AS LONG, BYVAL lpCursorName AS LONG) AS LONG
     DECLARE FUNCTION SetCursor LIB "user32" ALIAS "SetCursor" (BYVAL hCursor AS LONG) AS LONG
     CONST SW_SHOW = 5
     DIM lundi AS STRING 'first day of current week
     $RESOURCE im_flecheg AS "data\gauche.bmp" 'left arrow
     $RESOURCE im_fleched AS "data\droite.bmp" 'right arrow
     $INCLUDE "calendr.bas"
     DEFSTR appdir=CURDIR$
     DEFSTR icondir=CURDIR$
     DEFSTR myclipboard=""
     DEFINT runminimized=false
'----------- OPTIONS
     $INCLUDE "options.bas"

     $INCLUDE "fichiers.bas" 'file handling

'------------- EVENT HANDLING declarations
     DECLARE SUB handlekeydown(key AS WORD, shift AS INTEGER)
     DECLARE SUB menudelete : DECLARE SUB menunew
     DECLARE SUB selecticone
     DECLARE SUB menucut : DECLARE SUB menucopy : DECLARE SUB menupaste
     DECLARE SUB quit : DECLARE SUB printsub
     DECLARE SUB resizeform
     DECLARE SUB tabchange
     DECLARE SUB FormWndProc (Handle AS INTEGER, uMsg AS DWORD, wParam AS LONG, lParam AS LONG)
     DECLARE SUB systray
     DECLARE SUB menuuse
     DECLARE SUB formshow
     DECLARE SUB menuall
     DECLARE FUNCTION SetForegroundWindow LIB "USER32" ALIAS "SetForegroundWindow" (HWnd AS LONG) AS INTEGER
     DECLARE SUB menuprojectnew
     DECLARE SUB menuprojectmodify
     DECLARE SUB menuprojectdelete
     DECLARE SUB menuprojectinsert
     DECLARE SUB menuprojectoptimize
     DECLARE SUB menufind : DECLARE SUB menufindnext

'------------- MAIN FORM
     DEFINT ActiveTab=-1 'Active page: -1=none (startup), 0=week organizer
     DIM panelwidth AS INTEGER, panelheight AS INTEGER 'width and height of pages
     CREATE Form AS QFORM
      font=appQfont
      CAPTION = s_Organizer
      Width = defaultformwidth
      Height = defaultformheight
      Center
      COLOR=colorFond
      keypreview=true
      onkeydown=handlekeydown
      wndproc=FormWndProc
      onpaint=formshow
      onresize=resizeform
      autoscroll=false
      CREATE Tab AS QTABCONTROL
       COLOR=colorfond : tabinactivecolor=colorheader
       addtabs s_Week, s_Addresses, s_Lists, s_Links, s_Projects
       onchange=TabChange
      END CREATE 'TAB (Main QTabControl)
      CREATE menu AS QMAINMENU 'Main form MENU
       CREATE menufile AS QMENUITEM  'FILE menu
        CAPTION=s_File
        CREATE fileprint AS QMENUITEM
         CAPTION=s_Print
         shortcut="CTRL+P"
         onclick=printsub
        END CREATE
        CREATE filequit AS QMENUITEM
         CAPTION=s_Quit
         shortcut="CTRL+Q"
         onclick=quit
        END CREATE
       END CREATE '(menufile)
       CREATE menuedit AS QMENUITEM  'EDIT menu
        CAPTION=s_Edit
        CREATE editcut AS QMENUITEM
         CAPTION=s_Cut
         shortcut="CTRL+X"
         onclick=menucut
        END CREATE
        CREATE editcopy AS QMENUITEM
         CAPTION=s_Copy
         shortcut="CTRL+C"
         onclick=menucopy
        END CREATE
        CREATE editpaste AS QMENUITEM
         CAPTION=s_Paste
         shortcut="CTRL+V"
         onclick=menupaste
        END CREATE
        CREATE editsepar AS QMENUITEM
         CAPTION="-"
         enabled=false
        END CREATE
        CREATE editnew AS QMENUITEM
         CAPTION=s_New
         shortcut="CTRL+N"
         onclick=menunew
        END CREATE
        CREATE editdelete AS QMENUITEM
         CAPTION=s_Delete
         shortcut="CTRL+D"
         onclick=menudelete
        END CREATE
        CREATE edituse AS QMENUITEM
         CAPTION=s_Use
         shortcut="CTRL+U"
         onclick=menuuse
        END CREATE
        CREATE menuicon AS QMENUITEM
         CAPTION=s_Icon
         shortcut="CTRL+I"
         onclick=selecticone
        END CREATE
        CREATE editall AS QMENUITEM
         CAPTION=s_Selectall
         shortcut="CTRL+A"
         onclick=menuall
        END CREATE
        CREATE editsepar2 AS QMENUITEM
         CAPTION="-"
         enabled=false
        END CREATE
        CREATE editfind AS QMENUITEM
         CAPTION=s_Find
         shortcut="CTRL+F"
         onclick=menufind
        END CREATE
        CREATE editfindnext AS QMENUITEM
         CAPTION=s_Findnext
         shortcut="CTRL+G"
         onclick=menufindnext
        END CREATE
       END CREATE '(editmenu)
       CREATE menuproject AS QMENUITEM  'PROJECT menu
        CAPTION=s_Project
        visible=false
        CREATE projectnew AS QMENUITEM
         CAPTION=s_Projectnew
         shortcut="CTRL+SHIFT+N"
         onclick=menuprojectnew
        END CREATE
        CREATE projectmodify AS QMENUITEM
         CAPTION=s_projectmodify
         shortcut="CTRL+SHIFT+M"
         onclick=menuprojectmodify
        END CREATE
        CREATE projectdelete AS QMENUITEM
         CAPTION=s_projectdelete
         shortcut="SHIFT+CTRL+D"
         onclick=menuprojectdelete
        END CREATE
        CREATE projectsepar AS QMENUITEM
         CAPTION="-"
         enabled=false
        END CREATE
        CREATE projectinsert AS QMENUITEM
         CAPTION=s_projectinsert
         shortcut="CTRL+shift+I"
         onclick=menuprojectinsert
        END CREATE
        CREATE projectoptimize AS QMENUITEM
         CAPTION=s_projectoptimize
         shortcut="CTRL+O"
         onclick=menuprojectoptimize
        END CREATE
       END CREATE '(menuproject)
      END CREATE '(Menu)
     END CREATE 'Main form (FORM)

'--------- Find dialog
     DECLARE SUB findclickcancel
     DECLARE SUB findclickOK
     DECLARE SUB finddialogkey(key AS WORD, shift AS INTEGER)
     CREATE finddialog AS QFORM
      CAPTION = s_Find
      Width = 317
      Height = 126
      Center
      visible=false
      keypreview=true
      onkeydown=finddialogkey
      onclose=findclickcancel
      CREATE finddialogLabel AS QLABEL
       CAPTION = s_Find
       Left = 12
       Top = 20
       Width = 90
      END CREATE
      CREATE findtext AS QEDIT
       Text = ""
       Left = 105 : width=184
       Top = 18
       taborder=0
      END CREATE
      CREATE findButton1 AS QBUTTON
       CAPTION = "OK"
       Left = 105
       Top = 60
       TabOrder = 4
       onclick=findclickOK
      END CREATE
      CREATE findButton2 AS QBUTTON
       CAPTION = s_Cancel
       Left = 216
       Top = 60
       TabOrder = 5
       onclick=findclickcancel
      END CREATE
     END CREATE
     SUB findclickcancel
      findtext.text=""
      finddialog.visible=false
     END SUB
     SUB findclickOK
      finddialog.visible=false
     END SUB
     SUB finddialogkey(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 27 : findclickcancel
      CASE 13 : findclickOK
      END SELECT
     END SUB

'----------  Panels routines
     $INCLUDE "use.bas"
     $INCLUDE "week.bas"
     $INCLUDE "addresses.bas"
     $INCLUDE "p:\documents\fun\carnet\source\tree.bas"
     $INCLUDE "p:\documents\fun\carnet\source\links.bas"
     $INCLUDE "projets.bas"
     $INCLUDE "demo.bas"

'---------- initialization
     SUB TabInit  '--TABINIT: initializes form when changing tab index
'page dimensions
      panelwidth=form.width-20
      panelheight=form.height-76
      Tab.width=panelwidth+9 : Tab.height=panelheight+30
      SELECT CASE ActiveTab
      CASE 0 : weekinit 'Week organizer
      CASE 1 : adinit 'Address book
      CASE 2 : trinit 'Lists
      CASE 3 : lkinit 'Links
      CASE 4 : prinit 'Projects
      END SELECT
     END SUB

     SUB GlobalInit '--GLOBALINIT on startup
      DIM madate AS STRING
      madate=todaystr
      theweekday=weekday(madate)
      IF (theweekday=7) AND (firstdayofweek=0) THEN theweekday=0
      lundi=advancedays(madate,firstdaydisplayed-theweekday)  '1st day of current week
      demo
      activetab=0
      buildadfields  'build fields of address book from field description file
      opentree
      openlinks
      openprojects
      TabInit
     END SUB

     SUB TabClose '--TABCLOSE: housework on leaving a page
      SELECT CASE ActiveTab
      CASE 0 'Week organizer
       hideallevents
       savecarnet
      CASE 1 : adsave 'Address book
      CASE 2 : trsave 'Tree
      CASE 3 : lksave 'Links
      CASE 4 : prsave 'Projects
      END SELECT
     END SUB

     SUB TabChange '--TABCHANGE: change page
      WeekPanel.visible=false
      AdPanel.visible=false
      TrPanel.visible=false
      Lkpanel.visible=false
      Prpanel.visible=false
      menuproject.visible=false
      TabClose
      SELECT CASE Tab.Tabindex
      CASE 0 : WeekPanel.visible=true
      CASE 1 : AdPanel.visible=true
      CASE 2 : TrPanel.visible=true
      CASE 3 : Lkpanel.visible=true 'Links
      CASE 4 : Prpanel.visible=true : menuproject.visible=true
      END SELECT
      ActiveTab=Tab.Tabindex
      TabInit
     END SUB

     DEFINT ignorefirstresize=true
     SUB resizeForm '--RESIZEFORM: resize event
      IF ignorefirstresize THEN ignorefirstresize=false : EXIT SUB
      TabClose
      TabInit
     END SUB

'------------- PRINTING ROUTINES
     $INCLUDE "print.bas"
'$include "pprint.bas"


'-- MENU Commands
     SUB printsub
      SELECT CASE ActiveTab
      CASE 0 : printweek
      CASE 1 : adprint
      CASE 2 : trprint
      CASE 3 : lkprint
      CASE 4 : prprint
      END SELECT
     END SUB

     SUB handlekeydown(key AS WORD, shift AS INTEGER)    'keydown
      IF key=27 THEN systray : EXIT SUB 'minimize to system tray
      IF key=9 THEN
       IF shift=1 THEN 'ctrl+tab
        IF activetab<4 THEN
         tab.tabindex=activetab+1
        ELSE
         tab.tabindex=0
        END IF
        tabchange
       ELSEIF shift=257 THEN 'ctrl+shift+tab
        IF activetab>0 THEN
         tab.tabindex=activetab-1
        ELSE
         tab.tabindex=4
        END IF
        tabchange
       END IF
      END IF
      SELECT CASE ActiveTab
      CASE 0 : weekkeydown(key,shift)
      CASE 1 : adkeydown(key,shift)
      CASE 2 : trkeydown(key,shift)
      CASE 3 : lkkeydown(key,shift)
      CASE 4 : prkeydown(key,shift)
      END SELECT
     END SUB

     SUB menunew
      SELECT CASE ActiveTab
      CASE 0 :
      CASE 1 : adnewclic
      CASE 2 : trnewclic
      CASE 3 : lknewclic
      END SELECT
     END SUB

     SUB menuall
      SELECT CASE ActiveTab
      CASE 0 :
      CASE 1 :
      CASE 2 : trselectall
      CASE 3 :
      END SELECT
     END SUB

     SUB menudelete
      SELECT CASE ActiveTab
      CASE 0 : weekdelete
      CASE 1 : addelete
      CASE 2 : trdelete
      CASE 3 : lkdelete
      CASE 4 : prdelete
      END SELECT
     END SUB

     SUB quit    'quit
      form.CLOSE
     END SUB

     SUB menucut
      SELECT CASE ActiveTab
      CASE 0 : weekcut
      CASE 1 : adcut
      CASE 2 : trcut
      CASE 3 : lkcut
      CASE 4 : prcut
      END SELECT
     END SUB

     SUB menucopy
      SELECT CASE ActiveTab
      CASE 0 : weekcopy
      CASE 1 : adcopy
      CASE 2 : trcopy
      CASE 3 : lkcopy
      CASE 4 : prcopy
      END SELECT
     END SUB

     SUB menupaste
      SELECT CASE ActiveTab
      CASE 0 : weekpaste
      CASE 1 : adpaste
      CASE 2 : trpaste
      CASE 3 : lkpaste
      CASE 4 : prpaste
      END SELECT
     END SUB

     SUB menuuse
      SELECT CASE ActiveTab
      CASE 1 : aduse
      CASE 2 : truse
      END SELECT
     END SUB

     SUB menufind
      finddialog.visible=true
      WHILE finddialog.visible
       DOEVENTS
      WEND
      IF findtext.text="" THEN EXIT SUB
      SELECT CASE ActiveTab
      CASE 0 : wkmenufind
      CASE 2 : trmenufind
      END SELECT
     END SUB

     SUB menufindnext
      SELECT CASE ActiveTab
      CASE 0 : wkfindnext
      CASE 2 : trfindnext
      END SELECT
     END SUB

'-------------  System Tray
' How to put your application icon into the system tray area.
' Double click your icon to "re-display" the application.
' Written in Rapid-Q by William Yu
     TYPE TNOTIFYICONDATA
      cbSize AS DWORD
      hWnd AS LONG
      uID AS LONG
      uFlags AS LONG
      uCallbackMessage AS LONG
      hIcon AS LONG
      szTip AS STRING*64
     END TYPE

     DECLARE SUB Shell_NotifyIcon LIB "SHELL32" ALIAS "Shell_NotifyIconA" _
      (dwMessage AS LONG, NIDATA AS TNOTIFYICONDATA)

     CONST NIM_ADD = 0
     CONST NIM_MODIFY = 1
     CONST NIM_DELETE = 2
     CONST NIM_MESSAGE = 1
     CONST NIM_ICON = 2
     CONST NIM_TIP = 4
     CONST WM_USER = &H400
     CONST WM_TRAYICON = WM_USER + 400
     CONST WM_COMMAND = &H111
     CONST WM_SYSCOMMAND = &H112
     CONST WM_LBUTTONDOWN = &H201
     CONST WM_LBUTTONDBLCLK = &H203
     CONST WM_RBUTTONDOWN = &H204
     CONST WM_RBUTTONDBLCLK = &H206
     CONST WM_DROPFILES = &H233
     CONST WM_MOUSEWHEEL = &H20A
     CONST WM_GETMINMAXINFO= &h24
     CONST SC_MINIMIZE = 61472
     CONST SC_CLOSE = 61536
     CONST SC_RESTORE = &HF120

     DIM NI AS TNotifyIconData
     DEFINT AlreadyTrayed = FALSE

     SUB Systray 'minimize app to system tray
      IF NOT AlreadyTrayed THEN
       NI.cbSize = SIZEOF(NI)
       NI.hWnd = Form.Handle
       NI.uID = Application.hInstance
       NI.uFlags = NIM_ICON OR NIM_MESSAGE OR NIM_TIP
       'NI.hIcon=Application.Icon
       today=VAL(MID$(DATE$,4,2))
       NI.hIcon = ExtractIcon(application.handle,"data\days.icl",today-1)
       NI.uCallBackMessage = WM_TRAYICON
       NI.szTip = s_Carnet+CHR$(0)
       Shell_NotifyIcon(NIM_ADD, NI)
       AlreadyTrayed = TRUE
       Form.Visible = FALSE
'      form.formstyle=0
      END IF
     END SUB

     DECLARE SUB DragFinish LIB "SHELL32" ALIAS "DragFinish" (hDrop AS LONG)
     DECLARE FUNCTION DragQueryFile LIB "SHELL32" ALIAS "DragQueryFileA" _
      (hDrop AS LONG, iFile AS LONG, lpszFile AS LONG, cch AS LONG) AS LONG
     DECLARE SUB CopyMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory" (BYVAL dest AS LONG, BYVAL source AS LONG, BYVAL numBytes AS LONG)
     DIM minmaxinfo(9) AS LONG
     SUB FormWndProc (Handle AS INTEGER, uMsg AS DWORD, wParam AS LONG, lParam AS LONG)
      DIM s AS STRING
      SELECT CASE uMsg
      CASE WM_SYSCOMMAND
       SELECT CASE wParam
       CASE SC_MINIMIZE
        SysTray  '-- Minimize to system tray
       CASE SC_RESTORE
        form.width=defaultformwidth
        form.height=defaultformheight
       CASE SC_CLOSE
        form.CLOSE
       END SELECT
      CASE WM_TRAYICON
       IF (lParam AND &HFFFF) = WM_LBUTTONDOWN THEN   '-- Respond on click
        Form.Visible = TRUE                           '-- Bring back our form
        Form.WindowState = 0
        Shell_NotifyIcon(NIM_DELETE, NI)   '-- Remove our tray icon
        SetForegroundWindow (form.handle)
        AlreadyTrayed=false
       END IF
      CASE WM_DROPFILES         'drag and drop
       IF activetab=3 THEN    'accept on Links panel
        Count = DragQueryFile(wParam, &HFFFFFFFF, VARPTR(S), 0)
        FOR I = 0 TO Count-1
         Length = DragQueryFile(wParam, I, 0, 0)
         S = SPACE$(Length+1)
         DragQueryFile(wParam, I, VARPTR(S), Length+1)
         lkAddlink(s)
        NEXT
       END IF
       DragFinish(wParam)
      CASE WM_MOUSEWHEEL  'roulette
       IF wparam<0 THEN
        handlekeydown(34,0) 'process as pagedown
       ELSE
        handlekeydown(33,0) 'pageup
       END IF
      CASE WM_GETMINMAXINFO 'resize : set minimum window size
       copymemory(VARPTR(minmaxinfo(0)),lparam,32) 'copy size info into array minmaxinfo
       minmaxinfo(6)=400 :  minmaxinfo(7)=270      'set my minimum values
       copymemory(lparam,VARPTR(minmaxinfo(0)),32) 'copy back to parameter
      END SELECT
     END SUB
'------------- (end systray)

     SUB formshow
      IF runminimized THEN systray
      runminimized=false
     END SUB

'MAIN PROGRAM
     GlobalInit
     IF COMMAND$(1)="-m" THEN runminimized=true
     Form.SHOWMODAL
     TabClose
     IF AlreadyTrayed THEN
      Shell_NotifyIcon(NIM_DELETE, NI)   '-- Remove our tray icon
     END IF

2013-06-19 07:44