Собственно написал ,только порою тормоза случаются ,в чём причина не понимаю ? Вот код :
ExamineDesktops()
Width = DesktopWidth(0); ширина экрана
Height= DesktopHeight(0); высота экрана
cursor=LoadCursor_(0,#IDC_HAND);загружаем курсор "рука"
Structure DirList ;создаём список
FileN.s ; получили имя сылоки
GadgetID.l ; идентиф. полученных сылок
EndStructure
Global NewList Dirs.DirList(),a ;глобальные переменные
Procedure Direct(ProgPath.s);извлекаем url из пути и добавляем в список
a=1
If ExamineDirectory(0, Directory$, "*.*")
While NextDirectoryEntry(0)
FileName.s = DirectoryEntryName(0)
Ext$ = LCase(Right(FileName.s,5))
Extt$ = LCase(Right(FileName.s,4))
If Ext$ = ".html" Or Ext$ = ".html"
AddElement(Dirs())
Dirs()\FileN=FileName.s
Dirs()\GadgetID=HyperLinkGadget(#PB_Any, 5, 30+ 15*(a-1), 70, 15,FileName.s, RGB(255, 250, 200))
SetGadgetColor(Dirs()\GadgetID, #PB_Gadget_BackColor , $999966)
SetGadgetColor(Dirs()\GadgetID, #PB_Gadget_FrontColor , $330000)
a=a+1
EndIf
If Extt$ = ".htm" Or Extt$ = ".htm"
AddElement(Dirs())
Dirs()\FileN=FileName.s
Dirs()\GadgetID=HyperLinkGadget(#PB_Any, 5, 30+ 15*(a-1), 500, 15,FileName.s, RGB(255, 250, 200))
SetGadgetColor(Dirs()\GadgetID, #PB_Gadget_BackColor , $999966)
SetGadgetColor(Dirs()\GadgetID, #PB_Gadget_FrontColor , $330000)
a=a+1
EndIf
Wend
FinishDirectory(0)
EndIf
EndProcedure
Procedure IsMouseOver(wnd) ; Определяем находится ли курсор мышки в пределах данного окна (гаджета)
Protected Result, re.RECT, pt.POINT
GetWindowRect_(wnd, @re)
GetCursorPos_(@pt)
Result = PtInRect_(@re, pt\x | (pt\y<<32) )
ProcedureReturn Result
EndProcedure
OpenWindow(0, 100, 0, Width, Height, "Просмотр .Html и .Htm файлов из дирректории : Слева отображаются ссылки на файлы ...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget)
DeleteMenu_(GetSystemMenu_(WindowID(0),#False),1,#MF_BYPOSITION);блокирум пемещение окна
WebGadget(0, 102, 0, Width-110, Height-54,"")
ScrollAreaGadget(3, 15, 0, 100, Height-52, 800, Height-82, #PB_ScrollArea_Single )
TextGadget(4,0, 5, 100, 20, "Ссылки :",#PB_Text_Center)
SetGadgetColor(4, #PB_Gadget_BackColor , $999966)
SetGadgetColor(4, #PB_Gadget_FrontColor , RGB(255, 255, 255))
ProgPath.s= GetPathPart(ProgramFilename())
ProgPath.s=ProgPath.s
CreateDirectory(ProgPath.s)
Direct(ProgPath.s)
CloseGadgetList()
SetGadgetColor(3, #PB_Gadget_BackColor , $999966)
SetGadgetColor(3, #PB_Gadget_FrontColor , $660000)
TextGadget(2,0, Height-50, Width, 24, "",#PB_Text_Border |#PB_Text_Center)
SetGadgetColor(2, #PB_Gadget_BackColor , $999966)
SetGadgetColor(2, #PB_Gadget_FrontColor , RGB(255, 255, 0))
Repeat
event=WaitWindowEvent()
;-------------- изменяем размеры когда мышь находится над списком -----------------
If Event=#WM_MOUSEMOVE
If IsMouseOver(GadgetID(3))
ResizeGadget(3,0,#PB_Ignore,600,#PB_Ignore)
ResizeGadget(0,602,#PB_Ignore,#PB_Ignore,#PB_Ignore)
Else
ResizeGadget(3,0,#PB_Ignore,100,#PB_Ignore)
ResizeGadget(0,102,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndIf
EndIf
;-------------- проходимся по списку при клике по ссылке -----------------
Gadget=EventGadget()
ForEach Dirs()
If Dirs()\GadgetID=Gadget
FileName.s=Dirs()\FileN
ID=Dirs()\GadgetID
SetGadgetColor(ID, #PB_Gadget_FrontColor, RGB(0, 0, 155))
SetGadgetText(0, "file://"+GetPathPart(ProgramFilename())+ FileName.s)
SetWindowTitle(0, "Просмотр .Html и .Htm файлов из дирректории : "+ ProgPath.s + FileName.s )
SetCursor_(cursor)
EndIf
Next
Until event=#WM_CLOSE
;-------------- удаляем гаджеты и освобождаем память ,плавно закрываем окно -----------------
ForEach Dirs()
If Dirs()\GadgetID=Gadget
ID=Dirs()\GadgetID
FreeGadget(ID)
EndIf
Next
For s=2 To 4
FreeGadget(s)
Next
FreeGadget(0)
AnimateWindow_(WindowID(0),500,#AW_BLEND|#AW_HIDE)
End