Собственно написал ,только порою тормоза случаются ,в чём причина не понимаю ? Вот код :
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