2003-10-07 22:18

'=======================================================
' Type Objet
' Classe QFormEx version 1.2
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     CONST WM_DROPFILES=&H233
     CONST GWL_HWNDPARENT=-8
     CONST GWL_WNDPROC=-4
     CONST HWND_DESKTOP=0

     CONST NIM_ADD=0
     CONST NIM_DELETE=2
     CONST NIM_MESSAGE=1
     CONST NIM_ICON=2
     CONST NIM_TIP=4
     CONST WM_TRAYICON=&H590
     CONST WM_LBUTTONDBLCLK=&H203
     CONST WM_RBUTTONUP=&H205
     CONST WM_SYSCOMMAND=&H112
     CONST SC_MINIMIZE=61472


     TYPE TPOINT
      X AS LONG
      Y AS LONG
     END TYPE


     DECLARE FUNCTION CallWindowProc LIB "user32.dll" ALIAS "CallWindowProcA" (lpPrevWndFunc AS LONG, hwnd AS LONG, Msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
     DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" (hwnd AS LONG,nIndex AS LONG,dwNewLong AS LONG) AS LONG
     DECLARE SUB DragAcceptFiles LIB "SHELL32" ALIAS "DragAcceptFiles" (hWnd AS LONG,Accept AS LONG)
     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 FUNCTION DragQueryPoint LIB "SHELL32" ALIAS "DragQueryPoint" (hDrop AS LONG,lppt AS TPOINT) AS LONG
     DECLARE SUB Shell_NotifyIcon LIB "shell32" ALIAS "Shell_NotifyIconA" (dwMessage AS LONG,niData AS QNOTIFYICONDATA)

     DECLARE SUB OnDrag_eventTemplate(file AS STRING)
     DECLARE SUB OnTrayClick_eventTemplate
     DECLARE SUB OnTrayDblClick_eventTemplate
     DECLARE SUB OnMinimise_eventTemplate

     TYPE QFormEx EXTENDS QFORM
PRIVATE:
      TrayIcon AS QNOTIFYICONDATA
      pOldProc AS LONG
      flagWinProc AS boolean
      flagTrayIcon AS boolean
      virtual AS QFORM
PUBLIC:
      DragZone AS QRECT
      DragEnable AS boolean PROPERTY SET SetDragEnable
      DeskBar AS boolean PROPERTY SET SetDeskBar
      FormStyle AS INTEGER PROPERTY SET SetFormStyle
      OnDrag AS EVENT(OnDrag_eventTemplate)
      OnTrayClick AS EVENT(OnTrayClick_eventTemplate)
      OnTrayDblClick AS EVENT(OnTrayDblClick_eventTemplate)
      OnMinimise AS EVENT(OnMinimise_eventTemplate)

PRIVATE:
  '============================================
  ' Procédure winproc de la fenetre
  '============================================
      FUNCTION WindowProc (hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
       DIM Point AS TPOINT
       DIM i AS INTEGER
       DIM File AS STRING
       DIM Count AS INTEGER
       DIM Length AS INTEGER

       SELECT CASE uMsg
       CASE WM_DROPFILES
        DragQueryPoint(wParam,Point)
        IF Point.X >= QFormEx.DragZone.Left AND Point.Y >= QFormEx.DragZone.Top AND _
         Point.X < QFormEx.DragZone.Right AND Point.Y < QFormEx.DragZone.Bottom THEN
         Count=DragQueryFile(wParam,&HFFFFFFFF,VARPTR(File),0)
         FOR i=0 TO Count-1
          Length=DragQueryFile(wParam,i,0,0)
          File=SPACE$(Length+1)
          DragQueryFile(wParam,i,VARPTR(File),Length+1)
          IF QFormEx.OnDrag<>0 THEN CALLFUNC(QFormEx.OnDrag,File)
         NEXT
        END IF
        DragFinish(wParam)
       CASE WM_SYSCOMMAND
        IF wParam=SC_MINIMIZE AND QFormEx.flagTrayIcon=true THEN
         IF QFormEx.OnMinimise<>0 THEN CALLFUNC QFormEx.OnMinimise
        ELSE
         QFormEx.WindowProc=CallWindowProc(QFormEx.pOldProc,hwnd,uMsg,wParam,lParam)
        END IF
       CASE WM_TRAYICON
        IF uMsg=WM_TRAYICON THEN
         IF (lParam AND &HFFFF)=WM_RBUTTONUP THEN
          IF QFormEx.OnTrayClick<>0 THEN CALLFUNC QFormEx.OnTrayClick
         ELSEIF (lParam AND &HFFFF)=WM_LBUTTONDBLCLK THEN
          IF QFormEx.OnTrayDblClick<>0 THEN CALLFUNC QFormEx.OnTrayDblClick
         END IF
        END IF
       CASE ELSE
        QFormEx.WindowProc=CallWindowProc(QFormEx.pOldProc,hwnd,uMsg,wParam,lParam)
       END SELECT
      END FUNCTION

PUBLIC:
  '============================================
  ' Proprieté style fenetre
  '============================================
      PROPERTY SET SetFormStyle(FormStyle AS INTEGER)
       IF FormStyle=3 THEN
        Super.formStyle=3
        QFormEx.formStyle=3
        QFormEx.PARENT=QFormEx.virtual
       ELSE
        Super.formStyle=formStyle
        QFormEx.formStyle=formStyle
       END IF
      END PROPERTY

  '============================================
  ' Proprieté Acceptation de dépose fichier
  '============================================
      PROPERTY SET SetDragEnable(flag AS boolean)
       DragAcceptFiles(QFormEx.Handle,flag)
       IF QFormEx.flagWinProc=false THEN
        QFormEx.pOldProc=SetWindowLong(QFormEx.handle,GWL_WNDPROC,CODEPTR(QFormEx.WindowProc))
        QFormEx.flagWinProc=true
       END IF
      END PROPERTY

  '=============================================================================
  ' Proprieté Application dans barre outil bureau lors de la reduction fenetre
  '=============================================================================
      PROPERTY SET SetDeskBar(flag AS boolean)
       IF flag THEN
        setwindowlong(QFormEx.handle,GWL_HWNDPARENT,HWND_DESKTOP)
        setwindowlong(application.handle,GWL_HWNDPARENT,QFormEx.handle)
       END IF
      END PROPERTY

  '=============================================
  ' Méthode AddTrayIcon
  '=============================================
      SUB AddTrayIcon
       QFormEx.TrayIcon.hWnd=QFormEx.Handle
       QFormEx.TrayIcon.uID=Application.hInstance
       QFormEx.TrayIcon.uFlags=NIM_MESSAGE OR NIM_ICON OR NIM_TIP
       QFormEx.TrayIcon.uCallBackMessage=WM_TRAYICON
       QFormEx.TrayIcon.hIcon=Application.Icon
       QFormEx.TrayIcon.szTip=Application.Title+CHR$(0)
       Shell_NotifyIcon(NIM_ADD,QFormEx.TrayIcon)
       IF QFormEx.flagWinProc=false THEN
        QFormEx.pOldProc=SetWindowLong(QFormEx.handle,GWL_WNDPROC,CODEPTR(QFormEx.WindowProc))
        QFormEx.flagWinProc=true
       END IF
       QFormEx.flagTrayIcon=true
      END SUB

  '=============================================
  ' Méthode DelTrayIcon
  '=============================================
      SUB DelTrayIcon
       Shell_NotifyIcon(NIM_DELETE,QFormEx.TrayIcon)
       QFormEx.flagTrayIcon=false
      END SUB
     END TYPE

2003-10-07 22:18