PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » Вопросы по PureBasic » Просмотщик html и htm файлов в дирректории :


Просмотщик html и htm файлов в дирректории :

Сообщений 1 страница 2 из 2

1

Собственно написал ,только порою тормоза случаются ,в чём причина не понимаю ? Вот код :

Код:
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

0

2

Проверил на одной папке - работает.

В коде есть элементы непонятного назначения.

If Ext$ = ".html" Or Ext$ = ".html"

If Extt$ = ".htm" Or Extt$ = ".htm"

   ProgPath.s= GetPathPart(ProgramFilename())
   ProgPath.s=ProgPath.s
   CreateDirectory(ProgPath.s)
Создает папку которая уже есть

В Procedure Direct(ProgPath.s) параметр ProgPath нигде не используется
Зато используется неинициализированная переменная Directory$
Что удивительно (не описано в документации) ExamineDirectory(0, Directory$, "*.*") с пустым Directory$ обрабатывает текущий каталог.

Очевидно что это все - рудименты разработки

пожелание для корректности алгоритма - отсеивать папки с расширением htm/html

0


Вы здесь » PureBasic - форум » Вопросы по PureBasic » Просмотщик html и htm файлов в дирректории :