2013-06-19 07:44

' LINKS PANEL


     $IFDEF FRANCAIS
      CONST lkfile="data\Liens.txt" 'tree data file
     $ELSE
      CONST lkfile="data\Links.txt" 'tree data file
     $ENDIF

     DECLARE SUB lkinit
     DECLARE SUB lknewclic
     DECLARE SUB linksclic
     DECLARE SUB lkkeydown(key AS WORD, shift AS INTEGER)
     DECLARE SUB DragAcceptFiles LIB "SHELL32" ALIAS "DragAcceptFiles" (hWnd AS LONG, Accept AS LONG)

'------------ CONTROLS
     CONST lkmarginW=0.04 'percentage of panel width for left+right margin (1/2 each)
     CONST lkVunit=20    'line height


     CREATE largeimageslist AS QIMAGELIST
      width=32 : height=32
      clear
     END CREATE
     CREATE paths AS QSTRINGLIST 'list of file names
      duplicates=dupAccept
      clear
     END CREATE
     CREATE LkPanel AS QPANEL
      PARENT=Tab
      left=4 : top=28
      COLOR=colorfond
      visible=false
      borderstyle=0 : bevelouter=0 : bevelinner=0
      CREATE links AS QLISTVIEW 'links zone
       viewstyle=vsIcon
       ondblclick=linksclic
       COLOR=&hffffff
       borderstyle=1
       font=appsmallfont
       largeimages=largeimageslist
      END CREATE
      CREATE lknew AS QBUTTON
       CAPTION=s_New
       onclick=lknewclic
      END CREATE
     END CREATE '-- (LkPanel)

'-- LKINIT: show controls
     SUB lkinit
'Redimension controls according to window size
      lkpanel.width=panelwidth: lkpanel.height=panelheight
      WITH links
       .left=panelwidth*lkmarginW/2
       .top=lkVunit*3
       .width=panelwidth*(1-lkmarginW)
       .height=panelheight-links.top-lkVunit
      END WITH
      WITH lknew
       .left=links.left : .top=lkVunit
       .width=links.width * 0.1 : .height=lkVunit
      END WITH
'allow drag and drop of files
      DragAcceptFiles(Form.Handle, 1)
'menu enables
      fileprint.enabled=false
      editnew.enabled=true
      edituse.enabled=false
      menuicon.enabled=false
      editall.enabled=false
      editfind.enabled=false
      editfindnext.enabled=false
      setfocus(links.handle)
     END SUB   '--(LKinit)

'-- GETDISPLAYNAME: get display name of file
     CONST MAX_PATH = 260
     CONST SHGFI_DISPLAYNAME = &H200
     TYPE SHFILEINFO
      hIcon AS LONG ' : icon
      iIcon AS LONG ' : icondex
      dwAttributes AS LONG ' : SFGAO_ flags
      szDisplayName AS STRING * MAX_PATH  ' : display name (or path) length max_path
      szTypeName AS STRING * 80 ' : type name length 80
     END TYPE
     DECLARE FUNCTION SHGetFileInfo LIB "shell32.dll" ALIAS "SHGetFileInfoA" (BYVAL pszPath AS STRING, BYVAL dwFileAttributes AS LONG, psfi AS SHFILEINFO, BYVAL cbFileInfo AS LONG, BYVAL uFlags AS LONG) AS LONG
     FUNCTION getdisplayname(s AS STRING) AS STRING
      DIM myfi AS shfileinfo
      l=SHGetFileInfo(s,0,myfi,SIZEOF(myfi),SHGFI_DISPLAYNAME)
      getdisplayname=IIF(l=0,"Nom non trouvé",myfi.szDisplayName)
     END FUNCTION

'-- LKADDLINK: create a new item
     DECLARE FUNCTION ExtractAssociatedIcon LIB "shell32.dll" ALIAS "ExtractAssociatedIconA" (BYVAL hInst AS LONG, byref lpIconPath AS STRING, byref lpiIcon AS WORD) AS LONG
     DECLARE FUNCTION ImageList_AddIcon LIB "comctl32.dll" ALIAS "ImageList_AddIcon" (BYVAL himl AS LONG, BYVAL hIcon AS LONG) AS INTEGER
     SUB lkaddlink(ss AS STRING)
      DIM s AS STRING, iconh AS LONG, lpiIcon AS WORD, iconstr AS STRING
      IF (FILEEXISTS(ss)=false)AND(DIREXISTS(ss)=false) THEN
       SHOWMESSAGE(s_filenotfound)
       EXIT SUB
      END IF
'get file name
      s=getdisplayname(ss)
      links.additems(s)
      paths.additems(ss)
'get icon
      iconstr=ss
      iconh=ExtractAssociatedIcon(application.handle,iconstr,lpiIcon)
      IF iconh=0 THEN
       SHOWMESSAGE("Icône non trouvée")
      ELSE
       myimageindex=ImageList_AddIcon(largeimageslist.handle, iconh)
       links.item(links.itemcount-1).imageindex=myimageindex
      END IF
     END SUB

'-- OPENLINKS: get links from file, called once in Globalinit
     SUB openlinks
      DIM loadedlinks AS QSTRINGLIST
      DIM s AS STRING
      IF FILEEXISTS(lkfile)=false THEN EXIT SUB
      CHDIR appdir
      loadedlinks.loadfromfile(lkfile)
      nblinks=loadedlinks.itemcount
      FOR i=0 TO nblinks-1
       s=loadedlinks.item(i)
       lkaddlink(s)
      NEXT
     END SUB

'-- LINKSdbCLIC: select item
     SUB linksclic
      DIM ss AS STRING
      i=links.itemindex
      IF i<0 THEN EXIT SUB
      ss=paths.item(i)
      IF ss="" THEN EXIT SUB
      IF shellexecute(form.handle,"",ss,"","",SW_SHOW) <=32 THEN SHOWMESSAGE(s_filenotfound)
     END SUB

'-- LKNEWCLIC: create new item
     SUB lknewclic
      DIM OpenDialog AS QOPENDIALOG
      IF OpenDialog.EXECUTE THEN
       lkaddlink(opendialog.filename)
      END IF
     END SUB

'-- LKSAVE: save links
     SUB lksave
      DIM file AS QFILESTREAM
      CHDIR appdir
      paths.savetofile(lkfile)
'disable drag and drop
      DragAcceptFiles(Form.Handle, 0)
     END SUB

'-- LKDELETE: delete item
     SUB LKdelete
      i=links.itemindex
      IF i<0 THEN EXIT SUB
      paths.delitems(i)
      links.delitems(i)
     END SUB

'-- LKCUT: cut
     SUB lkcut
      clipboard.text=paths.item(links.itemindex)
      lkdelete
     END SUB

'-- LKCOPY: copy
     SUB lkcopy
      clipboard.text=paths.item(links.itemindex)
     END SUB

'-- LKPASTE: paste
     SUB lkpaste
      lkaddlink(clipboard.text)
     END SUB

'-- LKpageup: move up 1 item (doesn't work)
     SUB lkpageup
     END SUB

'-- LKpagedown: move down 1 item (doesn't work)
     SUB lkpagedown
     END SUB

'-- lkkeydown: handle keydown : check for carriage returns, tabs, escape
     SUB lkkeydown(key AS WORD, shift AS INTEGER)
      SELECT CASE key
      CASE 33 : lkpageup 'PageUp
      CASE 34 : lkpagedown 'PageDown
      END SELECT
     END SUB

'-- lkprint
     SUB lkprint
      SHOWMESSAGE(s_addontprint)
     END SUB

2013-06-19 07:44