Первобытное / Primeval

Просмотров: 1222 | Дата: 25.04.2024 | Коментарии (0)

В страшном сне не представишь, что такое возможно — столкновение двух миров, современного и доисторического, которые смешивают судьбы людей современности с жуткими тварями, жившими сотни миллионов лет назад...

Продолжение предыдущей темы.

Описание серий и адреса находятся во внешнем файле, так удобней редактировать.
Приписал код, добавил:

Звездные врата Вселенная сезон 1
Звездные врата Вселенная сезон 2
--------------------------------
Звездные врата Атлантида сезон 1
Звездные врата Атлантида сезон 2
Звездные врата Атлантида сезон 3
--------------------------------
Первобытное все сезоны.

Для сериала Первобытное пришлось использовать не много другой подход, адреса постоянно меняются, в отличии от SG.

Сама программа весит мало, а картинки... Но это мелочи, если собираемся смотреть онлайн...

Скачать архив файлов.

Код реализации:

Enumeration 
 #Open=80
 #Spisok
 #Web
 #Container
 #Tex
 #tray
 
 #Window_0=100
 #img
 #img2
 #Link
 #descr
 #but
 #Find

EndEnumeration
UseJPEGImageDecoder()
UsePNGImageDecoder()

fon= RGB(10,10,10)

Global Dim Series.s(29)

Procedure Pervobytnoe()
DeleteFile("111.htm")
URLDownloadToFile_(0,"http://www.filin.tv/fantastika/251-pervobytnoe-primeval-123-sezon-onlajn.html", "Text.txt",0,0)
 If ReadFile(0, "Text.txt")
 While Eof(0) = 0
 string.s= ReadString(0)
 Find.s="(file=http://filin.tv/)(.*?)(/play/pervobitnoe.xml)"
 CreateRegularExpression(#Find,Find,#PB_RegularExpression_DotAll)
 Dim Matched.s(10)
 Matching.i = ExtractRegularExpression(#Find,String,Matched())
 For i = 0 To (Matching - 1) 
 kod.s= Matched(i)
 kod.s = RemoveString(kod.s,"file=http://filin.tv/")
 kod.s = RemoveString(kod.s,"/play/pervobitnoe.xml")
 Debug kod
 Next 
 FreeRegularExpression(#Find)
 Wend 
 CloseFile(0)
 EndIf
Htm.s=""
Htm + ""
;----------------------------------------
OpenFile(1, "111.htm") 
 WriteStringN(1, Htm)
CloseFile(1)
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"111.htm" )
DeleteFile("Text.txt") 
EndProcedure

Procedure Spisok() ;создаем список фильмов
If OpenPreferences("film/список_фильмов.txt")
 x=0
 If PreferenceGroup("список фильмов")
 Repeat
 text.s= ReadPreferenceString("Название "+Str(x), "") 
 If text="" 
 Break
 EndIf
 AddGadgetItem(#Spisok,-1,text,0)
 x=x+1
 ForEver 
 EndIf
 ClosePreferences() 
EndIf
EndProcedure

Procedure Film(grup.s)
If OpenPreferences("film/"+grup+"/"+grup+".txt")
 x=0
 If PreferenceGroup(grup)
 Repeat
 text.s= ReadPreferenceString(Str(x), "") 
 If text="" 
 Break
 EndIf
 SetGadgetText(x, text)
 x=x+1
 ForEver 
 EndIf
 a=0 
 If PreferenceGroup("Series")
 Repeat
 text.s= ReadPreferenceString(Str(a), "") 
 If text="" 
 Break
 EndIf
 Series(a)=text ; записываем в масив адреса
 a=a+1
 ForEver 
 EndIf
ClosePreferences() 
EndIf 
EndProcedure

Procedure Logo(img.s) ; перезаписываем код видео файла 
DeleteFile("111.htm") 
Htm.s=""
;----------------------------------------
OpenFile(1, "111.htm") 
 WriteStringN(1, Htm)
CloseFile(1)
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"111.htm" )
EndProcedure

Procedure JS_PB(ret.s) ; перезаписываем код видео файла 
DeleteFile("111.htm")
Htm.s=""
Htm + ""
Htm + ""
;----------------------------------------
OpenFile(1, "111.htm") 
 WriteStringN(1, Htm)
CloseFile(1)
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"111.htm" )
EndProcedure

Procedure Animate_Winodw(State)
 If State=1 ; Развернуть окно
 For i=570 To 850 Step 4
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,i,#PB_Ignore)
 For x=1 To 10
 WindowEvent()
 Next x
 Delay(8)
 Next i
 Else ; Свернуть окно
 For i=850 To 570 Step -4
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,i,#PB_Ignore)
 For x=1 To 10
 WindowEvent()
 Next x
 Delay(8) 
 Next i
 EndIf
EndProcedure

grup.s="Звездные врата Вселенная сезон 1"

OpenWindow(#Window_0,0,0,570,580,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)

 SetWindowColor(#Window_0,fon)
 
 TextGadget(#Tex,10,5,500,17,"Звездные врата: Вселенная сезон 1",#PB_Text_Center)
 SetGadgetColor(#Tex, #PB_Gadget_BackColor, fon) 
 SetGadgetColor(#Tex, #PB_Gadget_FrontColor, RGB(137, 127, 98))
 
 ContainerGadget(#Container,40,20,480,280, #PB_Container_BorderLess) ;убираем прокрутку
 WebGadget(#Web,0,0,600,280,"")
 CloseGadgetList()
 
 Logo("Звездные врата Вселенная сезон 1")
 
 HyperLinkGadget(#Open,460,562,100,15,"Список фильмов",RGB(255, 255, 255)) ; показать/скрыть список
 SetGadgetColor(#Open, #PB_Gadget_BackColor, fon) 
 SetGadgetColor(#Open, #PB_Gadget_FrontColor, RGB(137, 127, 98))
 

 HyperLinkGadget(0, 10,310+(16*0), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(1, 10,310+(16*1), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(2, 10,310+(16*2), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(3, 10,310+(16*3), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(4, 10,310+(16*4), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(5, 10,310+(16*5), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(6, 10,310+(16*6), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(7, 10,310+(16*7), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(8, 10,310+(16*8), 170,15,"",RGB(255, 255, 255))
 HyperLinkGadget(9, 10,310+(16*9), 170,15,"",RGB(255, 255, 255))
 
 HyperLinkGadget(10,185,310+(16*0),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(11,185,310+(16*1),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(12,185,310+(16*2),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(13,185,310+(16*3),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(14,185,310+(16*4),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(15,185,310+(16*5),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(16,185,310+(16*6),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(17,185,310+(16*7),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(18,185,310+(16*8),160,15,"",RGB(255, 255, 255))
 HyperLinkGadget(19,185,310+(16*9),160,15,"",RGB(255, 255, 255))
 
ButtonGadget(#but,0,0,0,0,"Убираем дурацкий фокус")
 
 For f=0 To 19
 SetGadgetColor(f, #PB_Gadget_BackColor, fon) 
 SetGadgetColor(f, #PB_Gadget_FrontColor, RGB(137, 127, 98)) 
 Next


 ImageGadget(#img,344,310,0,0,LoadImage(#img2, "film/"+grup.s+"/"+grup.s+"/1.jpg")) 
 HyperLinkGadget(#Link,360,450,180,15,"",RGB(255, 255, 255),#PB_HyperLink_Underline)
 SetGadgetColor(#Link, #PB_Gadget_BackColor, fon) 
 SetGadgetColor(#Link, #PB_Gadget_FrontColor, RGB(137, 127, 98)) 


 TextGadget(#descr,10,480,550,80,"Во время официального визита сенатора Армстронга, на совершенно секретную базу Икар было совершено нападение, вынуждая персонал эвакуироваться. Прежде, чем они покидают внеземную базу, доктор Николас Раш набирает девятый шеврон, посылая команду на Судьбу, Древний корабль бороздящий просторы Вселенной на миллиардах световых лет от Земли.")
 SetGadgetColor(#descr, #PB_Gadget_BackColor, fon) 
 SetGadgetColor(#descr, #PB_Gadget_FrontColor, RGB(137, 127, 98)) 
 
 
 
 ListIconGadget(#Spisok,575,10,0,0,"--------",350,#PB_ListIcon_DisplayMode|#PB_ListIcon_GridLines|#LVS_NOCOLUMNHEADER) ;|#LVS_NOSCROLL
 SetGadgetColor(#Spisok, #PB_Gadget_BackColor, RGB(21, 21, 21)) ;стиль списка
 SetGadgetColor(#Spisok, #PB_Gadget_FrontColor, RGB(137, 127, 98)) ;стиль списка
 SetGadgetColor(#Spisok, #PB_Gadget_LineColor, RGB(35, 35, 35)) ;стиль списка
 SetWindowLongPtr_(GadgetID(#Spisok),#GWL_EXSTYLE,0) ;убираем рамку
 ResizeGadget(#Spisok,#PB_Ignore,#PB_Ignore,270,560) ;убираем рамку 
 
 AddSysTrayIcon(#tray, WindowID(#Window_0),ExtractIcon_(0,"netshell.dll",8)) ; Добавляет значок в Systray из библиокеки 

 ;******************************* 
 CreatePopupMenu(0) ; Контекстное меню для трея 
 MenuItem(1,"Инфо.") 
 MenuBar() 
 MenuItem(2,"Выход") 
 
 
 Spisok() ;создаем список фильмов
 Film(grup.s)
 
 
StickyWindow(#Window_0, 1) 
HideWindow(#Window_0, 0)
Repeat
Event = WaitWindowEvent() 
Window = EventWindow() 
Gadget = EventGadget()
 Select Event
 Case #PB_Event_Gadget
 Select EventGadget()
 Case 0 To 19
 If EventType()= #PB_EventType_LeftClick 
 SetGadgetState(#img,LoadImage(#img2, "film/"+grup.s+"/"+grup.s+"/"+Str(Gadget+1)+".jpg"))
 SetGadgetText(#Link,GetGadgetText(Gadget))
 If OpenPreferences("film/"+grup.s+"/"+grup.s+".txt")
 PreferenceGroup("описание") 
 text.s= ReadPreferenceString(Str(Gadget+1), "") 
 SetGadgetText(#descr,text)
 EndIf 
 EndIf
 Case #Link
 SetWindowTitle(#Window_0, GetGadgetText(#Link)) 
 namber.s=Series(Val(Left(GetGadgetText(#Link),2))-1)
 JS_PB(namber)
 Case #Open
 If EventType()=#PB_EventType_LeftClick ; раскрыть по левому клику 
 klic=klic ! 1
 If klic
 Animate_Winodw(1)
 Else
 Animate_Winodw(0)
 EndIf
 EndIf
 Case #Spisok
 If EventType()=#PB_EventType_LeftClick
 rez = GetGadgetState(#Spisok)
 grup.s= GetGadgetItemText(#Spisok,rez)
 If grup.s= "Первобытное"
 Pervobytnoe()
 For g=0 To 19
 HideGadget(g, 1)
 Next
 HideGadget(#img, 1)
 HideGadget(#Link, 1)
 HideGadget(#descr, 1)
 ResizeGadget(#Container,5,5,565,550)
 ResizeGadget(#Web,0,0,600,590) 
 SetWindowTitle(#Window_0, "Первобытное") 
 Else
 For g=0 To 19
 HideGadget(g,0)
 Next
 HideGadget(#img, 0)
 HideGadget(#Link, 0)
 HideGadget(#descr, 0)
 ResizeGadget(#Container,40,20,480,280)
 ResizeGadget(#Web,0,0,600,280) 
 Logo(grup)
 SetGadgetText(#Tex, grup)
 Film(grup)
 EndIf
 EndIf
 EndSelect 
 Case #PB_Event_SysTray 
 If EventType() = #PB_EventType_RightClick ; Обработка правый клик мышки 
 DisplayPopupMenu(0, WindowID(#Window_0)) ; показ вспывающего меню 
 EndIf 
 Case #PB_Event_Menu 
 Select EventMenu() 
 Case 1 
 ;код 
 Case 2
 DeleteFile("111.htm") 
 Break 
 EndSelect 
 EndSelect 
If Event = #PB_Event_CloseWindow
ShowWindow_(WindowID(#Window_0),#SW_MINIMIZE) 
EndIf
ForEver

www.purebasic.info/

www.purebasic.com

www.purebasic.mybb.ru

www.www.purebasic.fr/english

www.www.purebasic.fr/german

Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.