Une barre de lancement rapide

notepad.exe|Bloc note
calc.exe|Calculatrice

' Mise en place du Form 0
DIM SysH, SysW : SysH = 20 : SysW = 150 : ' dimensions des boutons
LABEL ErrProg: ON_ERROR_GOTO ErrProg
HIDE 0 : WIDTH 0, SysW+5 : TOP 0, 0 : LEFT 0, 0 : BORDER_HIDE 0
DIM retour : DLL_ON DIR_CURRENT$ + "\form.dll"
retour = DLL_CALL1("SetTopMost", HANDLE(0)) : ' La barre doit être toujours au 1er plan
DLL_OFF

DLL_ON DIR_CURRENT$ + "\mouse.dll"
DIM coord$, txt$ : coord$=STRING$(8," ")
DIM mx, my : ' coordonnées de la souris

DIM bStat, bMemStat : bStat = 0 : ' Etat de la barre (0 cachée, 1 visible)
DIM bExit : bExit = 1000
DIM bList : bList = 1001
DIM bTimer: bTimer= 1002

LABEL pEndProg  : ' on quitte le programme
LABEL pMouse    : ' routine executée par le timer (coordonnées de la souris)
LABEL pAction  : ' Evenement bouton
LABEL ShowBar, HideBar
' Bouton de fermeture du prog
BUTTON bExit : HEIGHT bExit, SysH : WIDTH bExit, SysW : LEFT bExit, 5
ON_CLICK bExit, pEndProg : CAPTION bExit, "Quitter"

' on charge la liste des utilitaires de la barre de lancement
DLIST 1001 : FILE_LOAD 1001, DIR_CURRENT$ + "\util.txt"

' initialisation des boutons
DIM i, a$,bouton(50), action$(50)
FOR i=1 TO COUNT(bList)
  BUTTON i: TOP i, i * (SysH + 5) : WIDTH i, SysW : HEIGHT i, SysH : LEFT i, 5
  a$ = ITEM_READ$(bList, i)
  action$(i) = LEFT$(a$, INSTR(a$, "|") - 1)
  CAPTION i, RIGHT$(a$, LEN(a$) - LEN(action$(i)) - 1)
  ON_CLICK i, pAction
NEXT i
' hauteur du formulaire
HEIGHT 0, i * (SysH + 5) : TOP 0, (SCREEN_Y + HEIGHT(0)) / 2

TIMER bTimer : TIMER_INTERVAL bTimer, 100 : ON_TIMER bTimer, pMouse
GOSUB HideBar : SHOW 0
END

pAction:
 EXECUTE action$(NUMBER_CLICK)
RETURN

pEndProg:
  DLL_OFF
  TERMINATE
RETURN

pMouse:
  retour = DLL_CALL1("GetMouseXY",ADR(coord$))
  mx = VAL(LEFT$(coord$,4)) : my = VAL(RIGHT$(coord$,4))
  bMemStat = bStat
  IF bStat = 1
    IF mx > WIDTH(0) THEN bStat = 0
  ELSE
    IF mx < 2 THEN bStat = 1
  END_IF
  IF bMemStat <> bStat
    SELECT bStat
      CASE 0: GOSUB HideBar
      CASE 1: GOSUB ShowBar
    END_SELECT
  END_IF
RETURN

ShowBar:
  TIMER_OFF bTimer
  WHILE LEFT(0)<0
  LEFT 0, LEFT(0) + 8 : PAUSE 1
  END_WHILE
  TIMER_ON bTimer
RETURN
HideBar:
  TIMER_OFF bTimer
  WHILE LEFT(0) > SysW*(-1)
    LEFT 0,LEFT(0) - 8 : PAUSE 1
  END_WHILE
  TIMER_ON bTimer
RETURN
ErrProg:
  MESSAGE "("+STR$(ERROR_NUMBER)+") "+ERROR_TYPE$+" line:"+STR$(ERROR_LINE)
  DLL_OFF
TERMINATE

notepad.exe|Bloc note|225|200|200
calc.exe|Calculatrice|200|225|200
C:\Progra~1\WinSCP\WinSCP.exe|WinSCP|200|200|225
explorer.exe|Explorer|225|200|200
http://panoramic.1fr1.net|Forum Panoramic|200|225|200

' Mise en place du Form 0
DIM SysH, SysW : SysH = 40 : SysW = 150 : ' dimensions des boutons
LABEL ErrProg: ON_ERROR_GOTO ErrProg
HIDE 0 : WIDTH 0, SysW+5 : TOP 0, 0 : LEFT 0, 0 : BORDER_HIDE 0
DIM retour : DLL_ON DIR_CURRENT$ + "\form.dll"
retour = DLL_CALL1("SetTopMost", HANDLE(0)) : ' La barre doit être toujours au 1er plan
DLL_OFF

DLL_ON DIR_CURRENT$ + "\mouse.dll"
DIM coord$, txt$ : coord$=STRING$(8," ")
DIM mx, my : ' coordonnées de la souris

DIM bStat, bMemStat : bStat = 0 : ' Etat de la barre (0 cachée, 1 visible)
DIM bExit : bExit = 1000
DIM bList : bList = 1001
DIM bTimer: bTimer= 1002

LABEL pEndProg  : ' on quitte le programme
LABEL pMouse    : ' routine executée par le timer (coordonnées de la souris)
LABEL pAction  : ' Evenement bouton
LABEL ShowBar, HideBar
LABEL CreateButton
' Bouton de fermeture du prog
BUTTON bExit : HEIGHT bExit, SysH : WIDTH bExit, SysW : LEFT bExit, 5
ON_CLICK bExit, pEndProg : CAPTION bExit, "Quitter"

' on charge la liste des utilitaires de la barre de lancement
DLIST 1001 : FILE_LOAD 1001, DIR_CURRENT$ + "\PanoDock.txt"

' initialisation des boutons
DIM N,j,k, Obj$,Obj_param$
DIM Obj_action$(50)
DIM Obj_caption$(50)
DIM Obj_red(50),Obj_green(50),Obj_blue(50)
FOR N=1 TO COUNT(bList)
  Obj$ = ITEM_READ$(bList, N)
  k=0:Obj_param$=""
  FOR j=1 TO LEN(Obj$)
    IF MID$(Obj$,j,1)="|" OR j=LEN(Obj$)
      IF j=LEN(Obj$) THEN Obj_param$=Obj_param$+MID$(Obj$,j,1)
      SELECT k
        CASE 0:Obj_action$(N)=Obj_param$
        CASE 1:Obj_caption$(N)=Obj_param$
        CASE 2:Obj_red(N)=VAL(Obj_param$)
        CASE 3:Obj_green(N)=VAL(Obj_param$)
        CASE 4:Obj_blue(N)=VAL(Obj_param$)
      END_SELECT
      k=k+1
      Obj_param$=""
    ELSE
      Obj_param$=Obj_param$+MID$(Obj$,j,1)
    END_IF
  NEXT j
  GOSUB CreateButton
NEXT N
DIM nObj,nOldObj

' hauteur du formulaire
HEIGHT 0, N * (SysH + 5) : TOP 0, (SCREEN_Y - HEIGHT(0)) / 2
TIMER bTimer : TIMER_INTERVAL bTimer, 100 : ON_TIMER bTimer, pMouse
GOSUB HideBar : SHOW 0
END


CreateButton:
  PICTURE N : WIDTH N, SysW : HEIGHT N, SysH
  TOP N, N * (SysH + 5) : LEFT N, 5
  2D_TARGET_IS N
  2D_PEN_COLOR Obj_red(N)-50,Obj_green(N)-50,Obj_blue(N)-50
  2D_FILL_COLOR Obj_red(N),Obj_green(N),Obj_blue(N)
  2D_RECTANGLE 0, 0, SysW, SysH
  2D_PEN_COLOR 255,255,255: 2D_LINE 0,0,SysW,0: 2D_LINE 0,0,0,SysH
  PRINT_TARGET_IS N: FONT_NAME N, "Arial": FONT_SIZE N, 10
  PRINT_LOCATE (SysW-TEXT_WIDTH(Obj_caption$(N),N))/2,(SysH-TEXT_HEIGHT(Obj_caption$(N),N))/2:print Obj_caption$(N)
  ON_CLICK N,pAction
RETURN

pAction:
  TIMER_OFF bTimer
  DIM r,g,b
  ' Dessine l'enfoncement du bouton
  PRINT_TARGET_IS NUMBER_CLICK
  r=Obj_red(NUMBER_CLICK):g=Obj_green(NUMBER_CLICK):b=Obj_blue(NUMBER_CLICK)
  2D_TARGET_IS NUMBER_CLICK
  2D_PEN_COLOR r-150,g-150,b-150: 2D_FILL_COLOR r,g,b
  2D_RECTANGLE 0, 0, SysW, SysH
  2D_PEN_COLOR 255,255,255: 2D_LINE 0,SysH-1,SysW-1,SysH-1: 2D_LINE SysW-1,SysH-1,SysW-1,0
  PRINT_LOCATE 1+(SysW-TEXT_WIDTH(Obj_caption$(NUMBER_CLICK),NUMBER_CLICK))/2,1+(SysH-TEXT_HEIGHT(Obj_caption$(NUMBER_CLICK),NUMBER_CLICK))/2:print Obj_caption$(NUMBER_CLICK)
  PAUSE 500
  ' retour du bouton dans son état normal
  2D_TARGET_IS NUMBER_CLICK: 2D_PEN_COLOR r-150,g-150,b-150: 2D_FILL_COLOR r,g,b
  2D_RECTANGLE 0, 0, SysW, SysH
  2D_PEN_COLOR 255,255,255: 2D_LINE 0,0,SysW,0: 2D_LINE 0,0,0,SysH
  PRINT_LOCATE (SysW-TEXT_WIDTH(Obj_caption$(NUMBER_CLICK),NUMBER_CLICK))/2,(SysH-TEXT_HEIGHT(Obj_caption$(NUMBER_CLICK),NUMBER_CLICK))/2:print Obj_caption$(NUMBER_CLICK)
  EXECUTE Obj_action$(NUMBER_CLICK)
  TIMER_ON bTimer
  FREE r:FREE g:FREE b
RETURN

pEndProg:
  DLL_OFF
  TERMINATE
RETURN

pMouse:
  retour = DLL_CALL1("GetMouseXY",ADR(coord$))
  mx = VAL(LEFT$(coord$,4)) : my = VAL(RIGHT$(coord$,4))
  ' Etat de la barre
  bMemStat = bStat
  IF bStat = 1
    IF mx > WIDTH(0) THEN bStat = 0
  ELSE
    IF mx < 2 THEN bStat = 1
  END_IF
  IF bMemStat <> bStat
    SELECT bStat
      CASE 0: GOSUB HideBar
      CASE 1: GOSUB ShowBar
    END_SELECT
  END_IF
  ' Gestion du MouseOver des boutons
  my = my-TOP(0)
  nObj = INT(my/(SysH+5))
  if OBJECT_EXISTS(nObj)=1
    if (mx < (LEFT(0)+LEFT(nObj))) OR (mx>(LEFT(0)+LEFT(nObj)+WIDTH(nObj)))
      nObj = 0
    END_IF
  ELSE
    nObj = 0
  END_IF
  if (nOldObj <> nObj) AND nOldObj<>0
    IF OBJECT_EXISTS(nOldObj)=1
      2D_TARGET_IS nOldObj
      PRINT_TARGET_IS nOldObj
      2D_PEN_COLOR Obj_red(nOldObj)-150,Obj_green(nOldObj)-150,Obj_blue(nOldObj)-150
      2D_FILL_COLOR Obj_red(nOldObj),Obj_green(nOldObj),Obj_blue(nOldObj)
      2D_RECTANGLE 0, 0, SysW, SysH
      2D_PEN_COLOR 255,255,255: 2D_LINE 0,0,SysW,0: 2D_LINE 0,0,0,SysH
      PRINT_LOCATE (SysW-TEXT_WIDTH(Obj_caption$(nOldObj),nOldObj))/2,(SysH-TEXT_HEIGHT(Obj_caption$(nOldObj),nOldObj))/2:print Obj_caption$(nOldObj)
      nOldObj=0
    END_IF
  END_IF
  if nObj <> 0 AND nOldObj=0
    contrast nObj,80
    nOldObj=nObj
  END_IF

RETURN

ShowBar:
  TIMER_OFF bTimer
  WHILE LEFT(0)<0
  LEFT 0, LEFT(0) + 8 : PAUSE 1
  END_WHILE
  TIMER_ON bTimer
RETURN
HideBar:
  TIMER_OFF bTimer
  WHILE LEFT(0) > SysW*(-1)
    LEFT 0,LEFT(0) - 8 : PAUSE 1
  END_WHILE
  TIMER_ON bTimer
RETURN
ErrProg:
  MESSAGE "("+STR$(ERROR_NUMBER)+") "+ERROR_TYPE$+" line:"+STR$(ERROR_LINE)
  DLL_OFF
TERMINATE