Светодиодная матрица - МОДЖЕТ (антигаджет) на Пурике

Страница: « 1 2 3 4 5 6 7 … 15 »

Сообщений 121 страница 150 из 446

Поделиться12120.06.2011 19:30:34

Автор: ВиниПур
Активный участник
Зарегистрирован: 11.11.2010
Приглашений: 0
Сообщений: 271
Уважение: [+8/-0]
Позитив: [+1/-0]
Провел на форуме:
1 день 22 часа
Последний визит:
12.03.2022 21:07:46

max написал(а):

Возможно-ли сделать так, чтобы строчка
Код:

OpenFileRequester("Открыть файл", "", "Текстовые файлы (*.txt)|*.txt" , 0)

так же переводилась при выборе языка?

Рецепт тот же - хранить текст("Открыть файл" и "Текстовые файлы (*.txt)|*.txt") в переменной (как в случае с YES_Device и NO_Device)

Код:

; = rus
;open$ = "Открыть файл"
;Maska$ = "Текстовые файлы (*.txt)|*.txt"
; = En
open$ = "Open file "
Maska$ = "Text file (*.txt)|*.txt"

OpenFileRequester(open$, "", Maska$ , 0)

Отредактировано ВиниПур (20.06.2011 19:36:05)

Поделиться12220.06.2011 20:29:07

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Спасибо. Я вчера пробовал так, но забыл убрать кавычки, поэтому ни чего не получалось. Сейчас работает как надо.

Поделиться12320.06.2011 21:28:50

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

В место первого аргумента можно указать пустую строку и тогда система сама подставит текст а радном для неё языке.

Код:

OpenFileRequester("", "", "Text file (*.txt)|*.txt" , 0)

Поделиться12421.06.2011 18:12:39

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Привет.
Вернулся к вопросу о погоде. Добавил EditorGadget и код из 86 поста. Прога стала тормозить. Гляньте, что не так.

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Text_0
  #Image_1
  #Text_2
  #Text_3
  #Text_4
  #Text_5
  #Text_6
  #Text_7
  #Text_8
  #ComboBox_0
  #ButtonImage_1
  #ButtonImage_2
  #ButtonImage_3
EndEnumeration
;}
UsePNGImageDecoder()
#XML        = 0
Global Sity$
Global SityNew$
Global N=0
Global G=1
Global Dim DataDay.s(4)
Global Dim cloudiness.s(4)
Global Dim precipitation.s(4)
Global Dim rpower.s(4)
Global Dim spower.s(4)
Global Dim PRESSUREmin.s(4)
Global Dim PRESSUREmax.s(4)
Global Dim TEMPERATUREmin.s(4)
Global Dim TEMPERATUREmax.s(4)
Global Dim HEATmin.s(4)
Global Dim HEATmax.s(4)
Global Dim WINDmin.s(4)
Global Dim WINDmax.s(4)
Global Dim RELWETmin.s(4)
Global Dim RELWETmax.s(4)
Global Dim direction.s(4)

;{ Fonts
Enumeration
  #Font_Text_0
  #Font_Text_6
  #Font_Text_8
EndEnumeration
;}
;{ Images
Enumeration
  #Image_Image_1
  #Image_ButtonImage_1
  #Image_ButtonImage_2
  #Image_ButtonImage_3
EndEnumeration
;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel)
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
      
    If  GetXMLNodeName(*CurrentNode) = "FORECAST": N+1:EndIf
         
    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
           Select XMLAttributeName(*CurrentNode)
           Case "sname"
             Sity$=XMLAttributeValue(*CurrentNode)
              
           Case "day"
               day$=XMLAttributeValue(*CurrentNode)
           Case "month"
                month$=XMLAttributeValue(*CurrentNode)
           Case "year"
                year$=XMLAttributeValue(*CurrentNode)
           Case "hour"
                hour$=XMLAttributeValue(*CurrentNode)
                
           Case "weekday"
              Select XMLAttributeValue(*CurrentNode)
                              
                 Case "1"
                  weekday$= "в воскресенье"
                 Case "2"
                  weekday$= "в понедельник"
                 Case "3"
                 weekday$= "во вторник"
                 Case "4" 
                 weekday$= "в среду"
                 Case "5"
                 weekday$= "в четверг"
                 Case "6"
                 weekday$= "в пятницу"
                 Case "7"
                 weekday$= "в субботу"
             EndSelect
              dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
                DataDay(N)=dataProg$
                
                
           Case "cloudiness"; Облачность
             Select XMLAttributeValue(*CurrentNode)
                Case "0"
                cloudiness(N)= "ясно"
                Case "1"
                cloudiness(N)= "малооблачно"
                Case "2"
                cloudiness(N)= "облачно"
                Case "3"
                cloudiness(N)= "пасмурно"
              EndSelect
                                  
            Case "precipitation" ; Осадки
               Select XMLAttributeValue(*CurrentNode)
                Case "4"
                precipitation(N)= "дождь"
                Case "5"
                precipitation(N)= "ливень"
                Case "6","7"
                precipitation(N)= "снег"
                Case "8"
                precipitation(N)= "гроза"
                Case "9"
                precipitation(N)= "нет данных"
                Case "10" 
                precipitation(N)= "без осадков"
               EndSelect  
               ;Debug cloudiness(N) + ", " + precipitation(N)
               
             Case "rpower" ; интенсивность осадков
               Select XMLAttributeValue(*CurrentNode)
                Case "0"
                rpower(N)= "возможен дождь/снег"
                Case "1"
                rpower(N)= "дождь/снег"
               EndSelect   
            
             Case "spower" ; вероятность грозы
               Select XMLAttributeValue(*CurrentNode)
                Case "0"
                spower(N)= "возможна гроза"
                Case "1"
                spower(N)= "гроза"
               EndSelect            
               
             Case "min"
               Select GetXMLNodeName(*CurrentNode) 
                Case "PRESSURE"
                PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
                Case "TEMPERATURE"
                TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
                Case "HEAT"
                HEATmin(N) = XMLAttributeValue(*CurrentNode)
                Case "WIND"
                WINDmin(N) = XMLAttributeValue(*CurrentNode)
                Case "RELWET"
                RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
                EndSelect
              Case "max"
               Select GetXMLNodeName(*CurrentNode) 
                Case "PRESSURE"
                PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
                Case "TEMPERATURE"
                TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
                Case "HEAT"
                HEATmax(N) = XMLAttributeValue(*CurrentNode)
                Case "WIND"
                WINDmax(N) = XMLAttributeValue(*CurrentNode)
                Case "RELWET"
                RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
                EndSelect
                                
              Case "direction"
                Select XMLAttributeValue(*CurrentNode)
                 Case "0"
                 direction(N) = "северный"
                 Case "1"
                 direction(N) = "северо-восточный"
                 Case "2"
                 direction(N) = "восточный"
                 Case "3"
                 direction(N) = "юго-восточный"
                 Case "4"
                 direction(N) = "южный"
                 Case "5"
                 direction(N) = "юго-западный"
                 Case "6"
                 direction(N) = "западный"
                 Case "7"
                 direction(N) = "северо-западный"
                EndSelect

           EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
         GisMet_XML_Data(*ChildNode, CurrentSublevel+1)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
  
  EndIf

 
EndProcedure

;Procedure FileGis(Ind.i)
;    If CreateFile(1, "Прогноз.txt")         ; we create a new text file...
;
;      WriteStringN(1, "В городе " + URLDecoder(Sity$)+" "+ DataDay(Ind)+ "прогнозируется:") 
;      WriteStringN(1, "давление " + PRESSUREmin(Ind) + "-"+ PRESSUREmax(Ind) +" мм.рт.ст.,")
;      WriteStringN(1, "ветер "+direction(Ind)+","+" "+WINDmin(Ind)+"-"+WINDmax(Ind) +"m\c,") 
;      WriteStringN(1, "относительная влажность воздуха " + RELWETmin(Ind) + "-"+ RELWETmax(Ind) +" %")
;      WriteStringN(1, "температура "+TEMPERATUREmin(Ind)+"-"+ TEMPERATUREmax(Ind) +"°C, " + cloudiness(Ind) + ", " + precipitation(Ind)) 
;      WriteStringN(1, "комфортность " + HEATmin(Ind)+"-"+ HEATmax(Ind) +"°C") 
;      
;    CloseFile(1)                       ; close the previously opened file and store the written data this way
;  Else
;    MessageRequester("Информация","Невозможно создать файл!", #PB_MessageRequester_Ok)
;  EndIf
;EndProcedure

Procedure ShowGis(Ind.i)
      ;- вывод на печать
;  Debug "Комфортность: " + HEATmin(i)+"-"+ HEATmax(i) +"°C"
      
      SetGadgetText(#Text_0,URLDecoder(Sity$))
      SetGadgetText(#Text_2,"Давление: "     + PRESSUREmin(Ind) + "..."+ PRESSUREmax(Ind) +" мм.рт.ст.")
      SetGadgetText(#Text_3,"Ветер "+direction(Ind))
      SetGadgetText(#Text_4,WINDmin(Ind)+"..."+WINDmax(Ind) +"m\c")
      SetGadgetText(#Text_5,"Влажность: "    + RELWETmin(Ind) + "..."+ RELWETmax(Ind) +" %")
      SetGadgetText(#Text_6,TEMPERATUREmin(Ind)+"..."+ TEMPERATUREmax(Ind) +"°C")
      SetGadgetText(#Text_8,DataDay(Ind))
      SetGadgetText(#Text_7,cloudiness(Ind) + ", " + precipitation(Ind))
      EditorGadget(38,400,7,163,90,#PB_Editor_ReadOnly)
    SetGadgetText(38, "В городе " + URLDecoder(Sity$)+" "+ DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + PRESSUREmin(Ind) + "-"+ PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+direction(Ind)+","+" "+WINDmin(Ind)+"-"+WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + RELWETmin(Ind) + "-"+ RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+TEMPERATUREmin(Ind)+"-"+ TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + cloudiness(Ind) + ", " + precipitation(Ind) )            
    
      Select precipitation(Ind)
       Case "без осадков"
        Select cloudiness(Ind)
         Case "ясно":
         LoadImage(0, "Pogoda\pogoda20.png")
         Case "малооблачно":
         LoadImage(0, "Pogoda\pogoda9.png")
         Case "облачно":
         LoadImage(0, "Pogoda\pogoda2.png")
         Case "пасмурно":
         LoadImage(0, "Pogoda\pogoda24.png")
        EndSelect
       Case "дождь"
       LoadImage(0, "Pogoda\pogoda14.png")
       Case "ливень"
       LoadImage(0, "Pogoda\pogoda13.png")
       Case "снег"
       LoadImage(0, "Pogoda\pogoda19.png")
       Case "гроза"
       LoadImage(0, "Pogoda\pogoda23.png")
       EndSelect
       SetGadgetState(#Image_1, ImageID(0)) 
    
EndProcedure
     
InitNetwork()
SityNew$="27612"; "29838"; - Барнаул
newSity:
  Filename$ = "gis.xml";
  
  If ReceiveHTTPFile("http://informer.gismeteo.ru/xml/"+SityNew$+"_1.xml", Filename$)
    ;Debug "Прогноз загружен"
  
If FileSize(FileName$) > 0 

  If LoadXML(#XML, FileName$)

    If XMLStatus(#XML) <> #PB_XML_Success
      Message$ = "Error in the XML file:" + Chr(13)
      Message$ + "Message: " + XMLError(#XML) + Chr(13)
      Message$ + "Line: " + Str(XMLErrorLine(#XML)) + "   Character: " + Str(XMLErrorPosition(#XML))
      MessageRequester("Error", Message$)
    EndIf
     *MainNode = MainXMLNode(#XML)      
      If *MainNode
        GisMet_XML_Data(*MainNode, 0)
      EndIf
      



  If OpenWindow(#Window_0, 436, 47, 600, 400, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar)

      TextGadget(#Text_0, 40, 5, 250, 30, "", #PB_Text_Center)
      ImageGadget(#Image_1, 5, 95, 155, 160, 0)
      TextGadget(#Text_2, 190, 210, 200, 25, "Давление", #PB_Text_Center)
      TextGadget(#Text_3, 185, 105, 200, 25, "направление ветра", #PB_Text_Center)
      TextGadget(#Text_4, 185, 135, 200, 25, "Скорость", #PB_Text_Center)
      TextGadget(#Text_5, 185, 165, 200, 25, "Влажность", #PB_Text_Center)
      TextGadget(#Text_6, 85, 265, 210, 50, "Температура", #PB_Text_Center)
      TextGadget(#Text_7, 85, 315, 210, 50, "атмосфера", #PB_Text_Center)
      TextGadget(#Text_8, 5, 40, 250, 30, "число", #PB_Text_Center)
      ComboBoxGadget(#ComboBox_0, 85, 370, 210, 20): HideGadget(#ComboBox_0,1)
      ButtonImageGadget(#ButtonImage_1, 10, 360, 45, 30, CatchImage(#Image_ButtonImage_1, ?Image_ButtonImage_1))
      ButtonImageGadget(#ButtonImage_2, 340, 360, 45, 30, CatchImage(#Image_ButtonImage_2, ?Image_ButtonImage_2))
      ButtonImageGadget(#ButtonImage_3, 360, 10, 35, 35, CatchImage(#Image_ButtonImage_3, ?Image_ButtonImage_3))
      ; Gadget Fonts
      SetGadgetFont(#Text_0, LoadFont(#Font_Text_0, "Microsoft Sans Serif", 14, 272))
      SetGadgetFont(#Text_6, LoadFont(#Font_Text_6, "Microsoft Sans Serif", 20, 272))
      SetGadgetFont(#Text_8, LoadFont(#Font_Text_8, "Microsoft Sans Serif", 12, 784))
      SetGadgetFont(#Text_7, LoadFont(#Font_Text_8, "Microsoft Sans Serif", 12, 784))
      GadgetToolTip(#ButtonImage_1, "Обновить данные")
      GadgetToolTip(#ButtonImage_2, "Дальше...")
      GadgetToolTip(#ButtonImage_3, "Найти другой город")
    
  EndIf
  ShowGis(1)
  ;FileGis(1)
  
  
If ReadFile(0, "GismeteoCodSity.txt")   
    While Eof(0) = 0           
         AddGadgetItem(#ComboBox_0, -1,ReadString(0))
    Wend
    CloseFile(0)               
  Else
    MessageRequester("Information","Нет файла - справочника")
  EndIf  
  

      
;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
    ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #Text_0
      ElseIf EventGadget = #ButtonImage_3
       HideGadget(#ComboBox_0,0)
      ElseIf EventGadget = #ComboBox_0
      SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
      If Len(SityNew$)
        HideGadget(#ComboBox_0,1)
        N=0
        Goto newSity
      EndIf
        
      ElseIf EventGadget = #ButtonImage_1
      N=0
      Goto newSity
      ElseIf EventGadget = #ButtonImage_2
         If G<=3
           G+1
           ShowGis(G)
           ;FileGis(G)
         Else
           G=1
           ShowGis(G)
           ;FileGis(G)
         EndIf
      
      EndIf
      
      
    ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver
Else
    MessageRequester("Error", "The file cannot be opened.")
  EndIf
 EndIf
  
 ;Else
     ;Debug "Не загружен"
     MessageRequester("Information","Нет возможности загрузить данные из Интернет!")
   EndIf

;{ Included Images
DataSection
  Image_ButtonImage_1:
  IncludeBinary "Pogoda\refresh.ico"
  Image_ButtonImage_2:
  IncludeBinary "Pogoda\right.ico"
  Image_ButtonImage_3:
  IncludeBinary "Pogoda\0031 - Start Find.ico"
EndDataSection
;}


;}

Поделиться12521.06.2011 18:39:39

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

Выход из Select/Case с помощью Goto предварительно не почистив стек?
Это же приведет к появлению лишнего адреса в стеке при каждом переходе! :tired: В асм. отладчике это хорошо видно.

Поделиться12621.06.2011 18:47:02

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

А как его почистить?

Поделиться12721.06.2011 19:05:39

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

А как его почистить?

Надо добавить оператор FakeReturn.
И вообще, данная программа не лучший пример, многое сделано через....
Должно быть так как минимум.

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Text_0
  #Image_1
  #Text_2
  #Text_3
  #Text_4
  #Text_5
  #Text_6
  #Text_7
  #Text_8
  #ComboBox_0
  #ButtonImage_1
  #ButtonImage_2
  #ButtonImage_3
EndEnumeration
;}
UsePNGImageDecoder()
#XML        = 0
Global Sity$
Global SityNew$
Global N=0
Global G=1
Global Dim DataDay.s(4)
Global Dim cloudiness.s(4)
Global Dim precipitation.s(4)
Global Dim rpower.s(4)
Global Dim spower.s(4)
Global Dim PRESSUREmin.s(4)
Global Dim PRESSUREmax.s(4)
Global Dim TEMPERATUREmin.s(4)
Global Dim TEMPERATUREmax.s(4)
Global Dim HEATmin.s(4)
Global Dim HEATmax.s(4)
Global Dim WINDmin.s(4)
Global Dim WINDmax.s(4)
Global Dim RELWETmin.s(4)
Global Dim RELWETmax.s(4)
Global Dim direction.s(4)

;{ Fonts
Enumeration
  #Font_Text_0
  #Font_Text_6
  #Font_Text_8
EndEnumeration
;}
;{ Images
Enumeration
  #Image_Image_1
  #Image_ButtonImage_1
  #Image_ButtonImage_2
  #Image_ButtonImage_3
EndEnumeration
;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel)
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
    
    If  GetXMLNodeName(*CurrentNode) = "FORECAST": N+1:EndIf
    
    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
        Select XMLAttributeName(*CurrentNode)
          Case "sname"
            Sity$=XMLAttributeValue(*CurrentNode)
            
          Case "day"
            day$=XMLAttributeValue(*CurrentNode)
          Case "month"
            month$=XMLAttributeValue(*CurrentNode)
          Case "year"
            year$=XMLAttributeValue(*CurrentNode)
          Case "hour"
            hour$=XMLAttributeValue(*CurrentNode)
            
          Case "weekday"
            Select XMLAttributeValue(*CurrentNode)
                
              Case "1"
                weekday$= "в воскресенье"
              Case "2"
                weekday$= "в понедельник"
              Case "3"
                weekday$= "во вторник"
              Case "4" 
                weekday$= "в среду"
              Case "5"
                weekday$= "в четверг"
              Case "6"
                weekday$= "в пятницу"
              Case "7"
                weekday$= "в субботу"
            EndSelect
            dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
            DataDay(N)=dataProg$
            
            
          Case "cloudiness"; Облачность
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                cloudiness(N)= "ясно"
              Case "1"
                cloudiness(N)= "малооблачно"
              Case "2"
                cloudiness(N)= "облачно"
              Case "3"
                cloudiness(N)= "пасмурно"
            EndSelect
            
          Case "precipitation" ; Осадки
            Select XMLAttributeValue(*CurrentNode)
              Case "4"
                precipitation(N)= "дождь"
              Case "5"
                precipitation(N)= "ливень"
              Case "6","7"
                precipitation(N)= "снег"
              Case "8"
                precipitation(N)= "гроза"
              Case "9"
                precipitation(N)= "нет данных"
              Case "10" 
                precipitation(N)= "без осадков"
            EndSelect  
            ;Debug cloudiness(N) + ", " + precipitation(N)
            
          Case "rpower" ; интенсивность осадков
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                rpower(N)= "возможен дождь/снег"
              Case "1"
                rpower(N)= "дождь/снег"
            EndSelect   
            
          Case "spower" ; вероятность грозы
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                spower(N)= "возможна гроза"
              Case "1"
                spower(N)= "гроза"
            EndSelect            
            
          Case "min"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                HEATmin(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                WINDmin(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
          Case "max"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                HEATmax(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                WINDmax(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
            
          Case "direction"
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                direction(N) = "северный"
              Case "1"
                direction(N) = "северо-восточный"
              Case "2"
                direction(N) = "восточный"
              Case "3"
                direction(N) = "юго-восточный"
              Case "4"
                direction(N) = "южный"
              Case "5"
                direction(N) = "юго-западный"
              Case "6"
                direction(N) = "западный"
              Case "7"
                direction(N) = "северо-западный"
            EndSelect
            
        EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
      GisMet_XML_Data(*ChildNode, CurrentSublevel+1)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
    
  EndIf
  
  
EndProcedure

;Procedure FileGis(Ind.i)
;    If CreateFile(1, "Прогноз.txt")         ; we create a new text file...
;
;      WriteStringN(1, "В городе " + URLDecoder(Sity$)+" "+ DataDay(Ind)+ "прогнозируется:") 
;      WriteStringN(1, "давление " + PRESSUREmin(Ind) + "-"+ PRESSUREmax(Ind) +" мм.рт.ст.,")
;      WriteStringN(1, "ветер "+direction(Ind)+","+" "+WINDmin(Ind)+"-"+WINDmax(Ind) +"m\c,") 
;      WriteStringN(1, "относительная влажность воздуха " + RELWETmin(Ind) + "-"+ RELWETmax(Ind) +" %")
;      WriteStringN(1, "температура "+TEMPERATUREmin(Ind)+"-"+ TEMPERATUREmax(Ind) +"°C, " + cloudiness(Ind) + ", " + precipitation(Ind)) 
;      WriteStringN(1, "комфортность " + HEATmin(Ind)+"-"+ HEATmax(Ind) +"°C") 
;      
;    CloseFile(1)                       ; close the previously opened file and store the written data this way
;  Else
;    MessageRequester("Информация","Невозможно создать файл!", #PB_MessageRequester_Ok)
;  EndIf
;EndProcedure

Procedure ShowGis(Ind.i)
  ;- вывод на печать
  ;  Debug "Комфортность: " + HEATmin(i)+"-"+ HEATmax(i) +"°C"
  
  SetGadgetText(#Text_0,URLDecoder(Sity$))
  SetGadgetText(#Text_2,"Давление: "     + PRESSUREmin(Ind) + "..."+ PRESSUREmax(Ind) +" мм.рт.ст.")
  SetGadgetText(#Text_3,"Ветер "+direction(Ind))
  SetGadgetText(#Text_4,WINDmin(Ind)+"..."+WINDmax(Ind) +"m\c")
  SetGadgetText(#Text_5,"Влажность: "    + RELWETmin(Ind) + "..."+ RELWETmax(Ind) +" %")
  SetGadgetText(#Text_6,TEMPERATUREmin(Ind)+"..."+ TEMPERATUREmax(Ind) +"°C")
  SetGadgetText(#Text_8,DataDay(Ind))
  SetGadgetText(#Text_7,cloudiness(Ind) + ", " + precipitation(Ind))
  SetGadgetText(38, "В городе " + URLDecoder(Sity$)+" "+ DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + PRESSUREmin(Ind) + "-"+ PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+direction(Ind)+","+" "+WINDmin(Ind)+"-"+WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + RELWETmin(Ind) + "-"+ RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+TEMPERATUREmin(Ind)+"-"+ TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + cloudiness(Ind) + ", " + precipitation(Ind) )            
  
  Select precipitation(Ind)
    Case "без осадков"
      Select cloudiness(Ind)
        Case "ясно":
          LoadImage(0, "Pogoda\pogoda20.png")
        Case "малооблачно":
          LoadImage(0, "Pogoda\pogoda9.png")
        Case "облачно":
          LoadImage(0, "Pogoda\pogoda2.png")
        Case "пасмурно":
          LoadImage(0, "Pogoda\pogoda24.png")
      EndSelect
    Case "дождь"
      LoadImage(0, "Pogoda\pogoda14.png")
    Case "ливень"
      LoadImage(0, "Pogoda\pogoda13.png")
    Case "снег"
      LoadImage(0, "Pogoda\pogoda19.png")
    Case "гроза"
      LoadImage(0, "Pogoda\pogoda23.png")
  EndSelect
  ;SetGadgetState(#Image_1, ImageID(0)) 
  
EndProcedure

Procedure.l DownloadToMem ( URL.s, *lpRam, ramsize.l ) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

InitNetwork()
SityNew$="27612"; "29838"; - Барнаул



If OpenWindow(#Window_0, 436, 47, 600, 400, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  
  TextGadget(#Text_0, 40, 5, 250, 30, "", #PB_Text_Center)
  ImageGadget(#Image_1, 5, 95, 155, 160, 0)
  TextGadget(#Text_2, 190, 210, 200, 25, "Давление", #PB_Text_Center)
  TextGadget(#Text_3, 185, 105, 200, 25, "направление ветра", #PB_Text_Center)
  TextGadget(#Text_4, 185, 135, 200, 25, "Скорость", #PB_Text_Center)
  TextGadget(#Text_5, 185, 165, 200, 25, "Влажность", #PB_Text_Center)
  TextGadget(#Text_6, 85, 265, 210, 50, "Температура", #PB_Text_Center)
  TextGadget(#Text_7, 85, 315, 210, 50, "атмосфера", #PB_Text_Center)
  TextGadget(#Text_8, 5, 40, 250, 30, "число", #PB_Text_Center)
  ComboBoxGadget(#ComboBox_0, 85, 370, 210, 20): HideGadget(#ComboBox_0,1)
  ButtonImageGadget(#ButtonImage_1, 10, 360, 45, 30, CatchImage(#Image_ButtonImage_1, ?Image_ButtonImage_1))
  ButtonImageGadget(#ButtonImage_2, 340, 360, 45, 30, CatchImage(#Image_ButtonImage_2, ?Image_ButtonImage_2))
  ButtonImageGadget(#ButtonImage_3, 360, 10, 35, 35, CatchImage(#Image_ButtonImage_3, ?Image_ButtonImage_3))
  ; Gadget Fonts
  SetGadgetFont(#Text_0, LoadFont(#Font_Text_0, "Microsoft Sans Serif", 14, 272))
  SetGadgetFont(#Text_6, LoadFont(#Font_Text_6, "Microsoft Sans Serif", 20, 272))
  SetGadgetFont(#Text_8, LoadFont(#Font_Text_8, "Microsoft Sans Serif", 12, 784))
  SetGadgetFont(#Text_7, LoadFont(#Font_Text_8, "Microsoft Sans Serif", 12, 784))
  GadgetToolTip(#ButtonImage_1, "Обновить данные")
  GadgetToolTip(#ButtonImage_2, "Дальше...")
  GadgetToolTip(#ButtonImage_3, "Найти другой город")
  
  EditorGadget(38,400,7,163,90,#PB_Editor_ReadOnly)
  
EndIf

If ReadFile(0, "GismeteoCodSity.txt")   
  While Eof(0) = 0           
    AddGadgetItem(#ComboBox_0, -1,ReadString(0))
  Wend
  CloseFile(0)               
Else
  MessageRequester("Information","Нет файла - справочника")
EndIf  



*Mem_XML = AllocateMemory(100000)

newSity:
;Filename$ = "gis.xml";

FillMemory(*Mem_XML, 100000, 0)
Bytes=DownloadToMem ("http://informer.gismeteo.ru/xml/"+SityNew$+"_1.xml", *Mem_XML, 100000)

If Bytes>0 ;ReceiveHTTPFile("http://informer.gismeteo.ru/xml/"+SityNew$+"_1.xml", Filename$)
  ;Debug "Прогноз загружен"
  
  ;If FileSize(FileName$) > 0 
  
  If CatchXML(#XML,*Mem_XML,Bytes)  ;LoadXML(#XML, FileName$)
    
    If XMLStatus(#XML) <> #PB_XML_Success
      Message$ = "Error in the XML file:" + Chr(13)
      Message$ + "Message: " + XMLError(#XML) + Chr(13)
      Message$ + "Line: " + Str(XMLErrorLine(#XML)) + "   Character: " + Str(XMLErrorPosition(#XML))
      MessageRequester("Error", Message$)
    EndIf
    *MainNode = MainXMLNode(#XML)      
    If *MainNode
      GisMet_XML_Data(*MainNode, 0)
    EndIf
    
    
    
    
    ShowGis(1)
    ;FileGis(1)
    
    
    
    
    
    ;{- Event loop
    Repeat
      Event = WaitWindowEvent()
      Select Event
          ; ///////////////////
        Case #PB_Event_Gadget
          EventGadget = EventGadget()
          EventType = EventType()
          If EventGadget = #Text_0
          ElseIf EventGadget = #ButtonImage_3
            HideGadget(#ComboBox_0,0)
          ElseIf EventGadget = #ComboBox_0
            SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
            If Len(SityNew$)
              HideGadget(#ComboBox_0,1)
              N=0
              FakeReturn
              Goto newSity
            EndIf
            
          ElseIf EventGadget = #ButtonImage_1
            N=0
            FakeReturn
            Goto newSity
          ElseIf EventGadget = #ButtonImage_2
            If G<=3
              G+1
              ShowGis(G)
              ;FileGis(G)
            Else
              G=1
              ShowGis(G)
              ;FileGis(G)
            EndIf
            
          EndIf
          
          
          ; ////////////////////////
        Case #PB_Event_CloseWindow
          EventWindow = EventWindow()
          If EventWindow = #Window_0
            CloseWindow(#Window_0)
            Break
          EndIf
      EndSelect
    ForEver
  Else
    MessageRequester("Error", "The file cannot be opened.")
  EndIf
  ;EndIf
  
Else
  ;Debug "Не загружен"
  MessageRequester("Information","Нет возможности загрузить данные из Интернет!")
EndIf

;{ Included Images
 DataSection
   Image_ButtonImage_1:
   IncludeBinary "Pogoda\refresh.ico"
   Image_ButtonImage_2:
   IncludeBinary "Pogoda\right.ico"
   Image_ButtonImage_3:
   IncludeBinary "Pogoda\0031 - Start Find.ico"
 EndDataSection
;}


;}

Поделиться12821.06.2011 19:17:22

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Спасибо.

Поделиться12921.06.2011 19:38:00

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

Вот так будет проще перенести, правда, глобальные переменные типа N и G могут привести к глюкам, если такие же используются в программе, скажем, в процедуре.

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration
;}
UsePNGImageDecoder()
#XML        = 0
 Global Sity$
 Global SityNew$
 Global N=0
 Global G=1
 Global Dim DataDay.s(4)
 Global Dim cloudiness.s(4)
 Global Dim precipitation.s(4)
 Global Dim rpower.s(4)
 Global Dim spower.s(4)
 Global Dim PRESSUREmin.s(4)
 Global Dim PRESSUREmax.s(4)
 Global Dim TEMPERATUREmin.s(4)
 Global Dim TEMPERATUREmax.s(4)
 Global Dim HEATmin.s(4)
 Global Dim HEATmax.s(4)
 Global Dim WINDmin.s(4)
 Global Dim WINDmax.s(4)
 Global Dim RELWETmin.s(4)
 Global Dim RELWETmax.s(4)
 Global Dim direction.s(4)

;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel)
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
    
    If  GetXMLNodeName(*CurrentNode) = "FORECAST": N+1:EndIf
    
    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
        Select XMLAttributeName(*CurrentNode)
          Case "sname"
            Sity$=XMLAttributeValue(*CurrentNode)
            
          Case "day"
            day$=XMLAttributeValue(*CurrentNode)
          Case "month"
            month$=XMLAttributeValue(*CurrentNode)
          Case "year"
            year$=XMLAttributeValue(*CurrentNode)
          Case "hour"
            hour$=XMLAttributeValue(*CurrentNode)
            
          Case "weekday"
            Select XMLAttributeValue(*CurrentNode)
                
              Case "1"
                weekday$= "в воскресенье"
              Case "2"
                weekday$= "в понедельник"
              Case "3"
                weekday$= "во вторник"
              Case "4" 
                weekday$= "в среду"
              Case "5"
                weekday$= "в четверг"
              Case "6"
                weekday$= "в пятницу"
              Case "7"
                weekday$= "в субботу"
            EndSelect
            dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
            DataDay(N)=dataProg$
            
            
          Case "cloudiness"; Облачность
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                cloudiness(N)= "ясно"
              Case "1"
                cloudiness(N)= "малооблачно"
              Case "2"
                cloudiness(N)= "облачно"
              Case "3"
                cloudiness(N)= "пасмурно"
            EndSelect
            
          Case "precipitation" ; Осадки
            Select XMLAttributeValue(*CurrentNode)
              Case "4"
                precipitation(N)= "дождь"
              Case "5"
                precipitation(N)= "ливень"
              Case "6","7"
                precipitation(N)= "снег"
              Case "8"
                precipitation(N)= "гроза"
              Case "9"
                precipitation(N)= "нет данных"
              Case "10" 
                precipitation(N)= "без осадков"
            EndSelect  
            ;Debug cloudiness(N) + ", " + precipitation(N)
            
          Case "rpower" ; интенсивность осадков
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                rpower(N)= "возможен дождь/снег"
              Case "1"
                rpower(N)= "дождь/снег"
            EndSelect   
            
          Case "spower" ; вероятность грозы
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                spower(N)= "возможна гроза"
              Case "1"
                spower(N)= "гроза"
            EndSelect            
            
          Case "min"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                HEATmin(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                WINDmin(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
          Case "max"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                HEATmax(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                WINDmax(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
            
          Case "direction"
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                direction(N) = "северный"
              Case "1"
                direction(N) = "северо-восточный"
              Case "2"
                direction(N) = "восточный"
              Case "3"
                direction(N) = "юго-восточный"
              Case "4"
                direction(N) = "южный"
              Case "5"
                direction(N) = "юго-западный"
              Case "6"
                direction(N) = "западный"
              Case "7"
                direction(N) = "северо-западный"
            EndSelect
            
        EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
      GisMet_XML_Data(*ChildNode, CurrentSublevel+1)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
    
  EndIf
  
  
EndProcedure


Procedure.l DownloadToMem ( URL.s, *lpRam, ramsize.l ) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure GetMeteo()
  *Mem_XML = AllocateMemory(100000)
  If *Mem_XML
    FillMemory(*Mem_XML, 100000, 0)
    Bytes=DownloadToMem ("http://informer.gismeteo.ru/xml/"+SityNew$+"_1.xml", *Mem_XML, 100000)
    If Bytes>0  
      If CatchXML(#XML,*Mem_XML,Bytes)  ;LoadXML(#XML, FileName$)
        *MainNode = MainXMLNode(#XML)      
        If *MainNode
          GisMet_XML_Data(*MainNode, 0)
        EndIf
        SetGadgetText(38, "В городе " + URLDecoder(Sity$)+" "+ DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + PRESSUREmin(Ind) + "-"+ PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+direction(Ind)+","+" "+WINDmin(Ind)+"-"+WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + RELWETmin(Ind) + "-"+ RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+TEMPERATUREmin(Ind)+"-"+ TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + cloudiness(Ind) + ", " + precipitation(Ind) )            
      EndIf
    EndIf
    FreeMemory(*Mem_XML)
  EndIf
EndProcedure

InitNetwork()
SityNew$="27612"; "29838"; - Барнаул



If OpenWindow(#Window_0, 436, 47, 600, 100, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  ComboBoxGadget(#ComboBox_0, 105, 10, 210, 20)
  ButtonGadget(#Button_2, 10, 10, 80, 30, "Обновить")
  
  EditorGadget(38,350,7,200,90,#PB_Editor_ReadOnly)
  
EndIf

If ReadFile(0, "GismeteoCodSity.txt")   
  While Eof(0) = 0           
    AddGadgetItem(#ComboBox_0, -1,ReadString(0))
  Wend
  CloseFile(0)               
Else
  MessageRequester("Information","Нет файла - справочника")
EndIf  

;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
      ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #Button_2
        GetMeteo()
      ElseIf EventGadget = #ComboBox_0 And EventType = 1
        SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
        If Len(SityNew$)
          GetMeteo()
        EndIf
      EndIf
      
      ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver



;}

Поделиться13022.06.2011 15:46:00

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Спасибо.
Только прога вылетает на 88-ой строчке:
"Указатель массива больше допустимого диапазона".
Что-бы это значило? :dontknow:

Поделиться13122.06.2011 15:51:01

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

Только прога вылетает на 88-ой строчке:"Указатель массива больше допустимого диапазона".

О какой именно программе идет речь?
В последних двух кодах что я выложил, на 88 строке нет массива.

Поделиться13222.06.2011 16:09:56

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

В самой последней программе на строке

Код:

DataDay(N)=dataProg$

.
Ошибка вылетает после нажатия на кнопку.

Отредактировано max (22.06.2011 16:27:10)

Поделиться13322.06.2011 17:57:08

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

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

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration
;}
#XML        = 0

SityNew$="27612"; "29838"; - Барнаул
 
Structure MeteoInfo
  Sity.s
  Array DataDay.s(4)
  Array cloudiness.s(4)
  Array precipitation.s(4)
  Array rpower.s(4)
  Array spower.s(4)
  Array PRESSUREmin.s(4)
  Array PRESSUREmax.s(4)
  Array TEMPERATUREmin.s(4)
  Array TEMPERATUREmax.s(4)
  Array HEATmin.s(4)
  Array HEATmax.s(4)
  Array WINDmin.s(4)
  Array WINDmax.s(4)
  Array RELWETmin.s(4)
  Array RELWETmax.s(4)
  Array direction.s(4)
EndStructure
  

;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel, *Info.MeteoInfo)
  Protected N
  N=0
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
    
    If  GetXMLNodeName(*CurrentNode) = "FORECAST": N+1:EndIf
    
    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
        Select XMLAttributeName(*CurrentNode)
          Case "sname"
            *Info\Sity=XMLAttributeValue(*CurrentNode)
            
          Case "day"
            day$=XMLAttributeValue(*CurrentNode)
          Case "month"
            month$=XMLAttributeValue(*CurrentNode)
          Case "year"
            year$=XMLAttributeValue(*CurrentNode)
          Case "hour"
            hour$=XMLAttributeValue(*CurrentNode)
            
          Case "weekday"
            Select XMLAttributeValue(*CurrentNode)
                
              Case "1"
                weekday$= "в воскресенье"
              Case "2"
                weekday$= "в понедельник"
              Case "3"
                weekday$= "во вторник"
              Case "4" 
                weekday$= "в среду"
              Case "5"
                weekday$= "в четверг"
              Case "6"
                weekday$= "в пятницу"
              Case "7"
                weekday$= "в субботу"
            EndSelect
            dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
            *Info\DataDay(N)=dataProg$
            
            
          Case "cloudiness"; Облачность
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\cloudiness(N)= "ясно"
              Case "1"
                *Info\cloudiness(N)= "малооблачно"
              Case "2"
                *Info\cloudiness(N)= "облачно"
              Case "3"
                *Info\cloudiness(N)= "пасмурно"
            EndSelect
            
          Case "precipitation" ; Осадки
            Select XMLAttributeValue(*CurrentNode)
              Case "4"
                *Info\precipitation(N)= "дождь"
              Case "5"
                *Info\precipitation(N)= "ливень"
              Case "6","7"
                *Info\precipitation(N)= "снег"
              Case "8"
                *Info\precipitation(N)= "гроза"
              Case "9"
                *Info\precipitation(N)= "нет данных"
              Case "10" 
                *Info\precipitation(N)= "без осадков"
            EndSelect  
            ;Debug cloudiness(N) + ", " + precipitation(N)
            
          Case "rpower" ; интенсивность осадков
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\rpower(N)= "возможен дождь/снег"
              Case "1"
                *Info\rpower(N)= "дождь/снег"
            EndSelect   
            
          Case "spower" ; вероятность грозы
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\spower(N)= "возможна гроза"
              Case "1"
                *Info\spower(N)= "гроза"
            EndSelect            
            
          Case "min"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmin(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmin(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
          Case "max"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmax(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmax(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
            
          Case "direction"
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\direction(N) = "северный"
              Case "1"
                *Info\direction(N) = "северо-восточный"
              Case "2"
                *Info\direction(N) = "восточный"
              Case "3"
                *Info\direction(N) = "юго-восточный"
              Case "4"
                *Info\direction(N) = "южный"
              Case "5"
                *Info\direction(N) = "юго-западный"
              Case "6"
                *Info\direction(N) = "западный"
              Case "7"
                *Info\direction(N) = "северо-западный"
            EndSelect
            
        EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
      GisMet_XML_Data(*ChildNode, CurrentSublevel+1, *Info)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
    
  EndIf
  
  
EndProcedure


Procedure.l DownloadToMem ( URL.s, *lpRam, ramsize.l ) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure GetMeteo(SityNew.s)
  Protected Info.MeteoInfo
  
  *Mem_XML = AllocateMemory(100000)
  If *Mem_XML
    FillMemory(*Mem_XML, 100000, 0)
    Bytes=DownloadToMem ("http://informer.gismeteo.ru/xml/"+SityNew+"_1.xml", *Mem_XML, 100000)
    If Bytes>0  
      If CatchXML(#XML,*Mem_XML,Bytes)  ;LoadXML(#XML, FileName$)
        *MainNode = MainXMLNode(#XML)      
        If *MainNode
          GisMet_XML_Data(*MainNode, 0, @Info)
        EndIf
        SetGadgetText(38, "В городе " + URLDecoder(Info\Sity)+" "+ Info\DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + Info\PRESSUREmin(Ind) + "-"+ Info\PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+Info\direction(Ind)+","+" "+Info\WINDmin(Ind)+"-"+Info\WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + Info\RELWETmin(Ind) + "-"+ Info\RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+Info\TEMPERATUREmin(Ind)+"-"+ Info\TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + Info\cloudiness(Ind) + ", " + Info\precipitation(Ind) )
        EndIf
    EndIf
    FreeMemory(*Mem_XML)
  EndIf
EndProcedure

InitNetwork()




If OpenWindow(#Window_0, 436, 47, 600, 100, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  ComboBoxGadget(#ComboBox_0, 105, 10, 210, 20)
  ButtonGadget(#Button_2, 10, 10, 80, 30, "Обновить")
  
  EditorGadget(38,350,7,200,90,#PB_Editor_ReadOnly)
  
EndIf

If ReadFile(0, "GismeteoCodSity.txt")   
  While Eof(0) = 0           
    AddGadgetItem(#ComboBox_0, -1,ReadString(0))
  Wend
  CloseFile(0)               
Else
  MessageRequester("Information","Нет файла - справочника")
EndIf  

;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
      ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #Button_2
        GetMeteo(SityNew$)
      ElseIf EventGadget = #ComboBox_0 And EventType = 1
        SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
        If Len(SityNew$)
          GetMeteo(SityNew$)
        EndIf
      EndIf
      
      ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver



;}

Поделиться13422.06.2011 18:50:35

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Странно, :dontknow: но теперь DataDay не выводится.

Поделиться13522.06.2011 19:50:27

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

Должно быть так:

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration
;}
#XML        = 0

SityNew$="27612"; "29838"; - Барнаул
 
Structure MeteoInfo
  Sity.s
  Array DataDay.s(4)
  Array cloudiness.s(4)
  Array precipitation.s(4)
  Array rpower.s(4)
  Array spower.s(4)
  Array PRESSUREmin.s(4)
  Array PRESSUREmax.s(4)
  Array TEMPERATUREmin.s(4)
  Array TEMPERATUREmax.s(4)
  Array HEATmin.s(4)
  Array HEATmax.s(4)
  Array WINDmin.s(4)
  Array WINDmax.s(4)
  Array RELWETmin.s(4)
  Array RELWETmax.s(4)
  Array direction.s(4)
EndStructure
  

;}

Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel, *Info.MeteoInfo)
  Static N
  
  If CurrentSublevel=0
    N=0
  EndIf
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
    
    If  GetXMLNodeName(*CurrentNode) = "FORECAST" : N+1 : EndIf
     

    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
        Select XMLAttributeName(*CurrentNode)
          Case "sname"
            *Info\Sity=XMLAttributeValue(*CurrentNode)
            
          Case "day"
            day$=XMLAttributeValue(*CurrentNode)
          Case "month"
            month$=XMLAttributeValue(*CurrentNode)
          Case "year"
            year$=XMLAttributeValue(*CurrentNode)
          Case "hour"
            hour$=XMLAttributeValue(*CurrentNode)
            
          Case "weekday"
            Select XMLAttributeValue(*CurrentNode)
                
              Case "1"
                weekday$= "в воскресенье"
              Case "2"
                weekday$= "в понедельник"
              Case "3"
                weekday$= "во вторник"
              Case "4" 
                weekday$= "в среду"
              Case "5"
                weekday$= "в четверг"
              Case "6"
                weekday$= "в пятницу"
              Case "7"
                weekday$= "в субботу"
            EndSelect
            dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
            *Info\DataDay(N)=dataProg$
            Debug dataProg$ +"      "+Str(N)
            
            
          Case "cloudiness"; Облачность
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\cloudiness(N)= "ясно"
              Case "1"
                *Info\cloudiness(N)= "малооблачно"
              Case "2"
                *Info\cloudiness(N)= "облачно"
              Case "3"
                *Info\cloudiness(N)= "пасмурно"
            EndSelect
            
          Case "precipitation" ; Осадки
            Select XMLAttributeValue(*CurrentNode)
              Case "4"
                *Info\precipitation(N)= "дождь"
              Case "5"
                *Info\precipitation(N)= "ливень"
              Case "6","7"
                *Info\precipitation(N)= "снег"
              Case "8"
                *Info\precipitation(N)= "гроза"
              Case "9"
                *Info\precipitation(N)= "нет данных"
              Case "10" 
                *Info\precipitation(N)= "без осадков"
            EndSelect  
            ;Debug cloudiness(N) + ", " + precipitation(N)
            
          Case "rpower" ; интенсивность осадков
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\rpower(N)= "возможен дождь/снег"
              Case "1"
                *Info\rpower(N)= "дождь/снег"
            EndSelect   
            
          Case "spower" ; вероятность грозы
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\spower(N)= "возможна гроза"
              Case "1"
                *Info\spower(N)= "гроза"
            EndSelect            
            
          Case "min"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmin(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmin(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
          Case "max"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmax(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmax(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
            
          Case "direction"
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\direction(N) = "северный"
              Case "1"
                *Info\direction(N) = "северо-восточный"
              Case "2"
                *Info\direction(N) = "восточный"
              Case "3"
                *Info\direction(N) = "юго-восточный"
              Case "4"
                *Info\direction(N) = "южный"
              Case "5"
                *Info\direction(N) = "юго-западный"
              Case "6"
                *Info\direction(N) = "западный"
              Case "7"
                *Info\direction(N) = "северо-западный"
            EndSelect
            
        EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
      GisMet_XML_Data(*ChildNode, CurrentSublevel+1, *Info)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
    
  EndIf
  
  
EndProcedure


Procedure.l DownloadToMem ( URL.s, *lpRam, ramsize.l ) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure GetMeteo(SityNew.s, Ind)
  Protected Info.MeteoInfo
  
  *Mem_XML = AllocateMemory(100000)
  If *Mem_XML
    FillMemory(*Mem_XML, 100000, 0)
    Bytes=DownloadToMem ("http://informer.gismeteo.ru/xml/"+SityNew+"_1.xml", *Mem_XML, 100000)
    If Bytes>0  
      If CatchXML(#XML,*Mem_XML,Bytes)  ;LoadXML(#XML, FileName$)
        *MainNode = MainXMLNode(#XML)      
        If *MainNode
          GisMet_XML_Data(*MainNode, 0, @Info)
        EndIf
        SetGadgetText(38, "В городе " + URLDecoder(Info\Sity)+" "+ Info\DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + Info\PRESSUREmin(Ind) + "-"+ Info\PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+Info\direction(Ind)+","+" "+Info\WINDmin(Ind)+"-"+Info\WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + Info\RELWETmin(Ind) + "-"+ Info\RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+Info\TEMPERATUREmin(Ind)+"-"+ Info\TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + Info\cloudiness(Ind) + ", " + Info\precipitation(Ind) )
        EndIf
    EndIf
    FreeMemory(*Mem_XML)
  EndIf
EndProcedure

InitNetwork()




If OpenWindow(#Window_0, 436, 47, 600, 100, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  ComboBoxGadget(#ComboBox_0, 105, 10, 210, 20)
  ButtonGadget(#Button_2, 10, 10, 80, 30, "Обновить")
  
  EditorGadget(38,350,7,200,90,#PB_Editor_ReadOnly)
  
EndIf

If ReadFile(0, "GismeteoCodSity.txt")   
  While Eof(0) = 0           
    AddGadgetItem(#ComboBox_0, -1,ReadString(0))
  Wend
  CloseFile(0)               
Else
  MessageRequester("Information","Нет файла - справочника")
EndIf  

;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
      ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #Button_2
        GetMeteo(SityNew$, 1)
      ElseIf EventGadget = #ComboBox_0 And EventType = 1
        SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
        If Len(SityNew$)
          GetMeteo(SityNew$, 1)
        EndIf
      EndIf
      
      ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver



;}

Поделиться13622.06.2011 20:00:50

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Теперь нормально. Спасибо.

Поделиться13722.06.2011 20:35:53

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Добавил это

Код:

OptionGadget(39, 10, 50, 30, 20, "6")
GadgetToolTip(39, "Прогноз на 6 часов")
OptionGadget(40, 54, 50, 40, 20, "12")
GadgetToolTip(40, "Прогноз на 12 часов")
OptionGadget(41, 98, 50, 40, 20, "18")
GadgetToolTip(41, "Прогноз на 18 часов")
OptionGadget(42, 142, 50, 40, 20, "24")
GadgetToolTip(42, "Прогноз на сутки")

для выбора времени прогноза. Застопорился на опросе OptionGadget. Глядя на первоисточник, смена времени производится изменением N?

Поделиться13822.06.2011 21:08:14

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

Глядя на первоисточник, смена времени производится изменением N?

Нет.
Теперь эта переменная уже не глобальная.

Код:

;
; ------------------------------------------------------------
;     Парсинг XML кода возвращаемого с ресурса Gismeteo.ru
;  
;
;    (c) 2009 - kvitaliy
;
; ------------------------------------------------------------

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration
;}
#XML        = 0

SityNew$="27612"; "29838"; - Барнаул
 
Structure MeteoInfo
  State.b
  Sity.s
  Array DataDay.s(4)
  Array cloudiness.s(4)
  Array precipitation.s(4)
  Array rpower.s(4)
  Array spower.s(4)
  Array PRESSUREmin.s(4)
  Array PRESSUREmax.s(4)
  Array TEMPERATUREmin.s(4)
  Array TEMPERATUREmax.s(4)
  Array HEATmin.s(4)
  Array HEATmax.s(4)
  Array WINDmin.s(4)
  Array WINDmax.s(4)
  Array RELWETmin.s(4)
  Array RELWETmax.s(4)
  Array direction.s(4)
EndStructure

G_Meteo_Info.MeteoInfo
G_Meteo_Info\State = -1

;}

Procedure GisMet_XML_Data(*CurrentNode, CurrentSublevel, *Info.MeteoInfo)
  Static N
  
  If CurrentSublevel=0
    N=0
  EndIf
  
  If XMLNodeType(*CurrentNode) = #PB_XML_Normal
    
    If  GetXMLNodeName(*CurrentNode) = "FORECAST" : N+1 : EndIf
     

    If ExamineXMLAttributes(*CurrentNode)
      While NextXMLAttribute(*CurrentNode)
        Select XMLAttributeName(*CurrentNode)
          Case "sname"
            *Info\Sity=XMLAttributeValue(*CurrentNode)
            
          Case "day"
            day$=XMLAttributeValue(*CurrentNode)
          Case "month"
            month$=XMLAttributeValue(*CurrentNode)
          Case "year"
            year$=XMLAttributeValue(*CurrentNode)
          Case "hour"
            hour$=XMLAttributeValue(*CurrentNode)
            
          Case "weekday"
            Select XMLAttributeValue(*CurrentNode)
                
              Case "1"
                weekday$= "в воскресенье"
              Case "2"
                weekday$= "в понедельник"
              Case "3"
                weekday$= "во вторник"
              Case "4" 
                weekday$= "в среду"
              Case "5"
                weekday$= "в четверг"
              Case "6"
                weekday$= "в пятницу"
              Case "7"
                weekday$= "в субботу"
            EndSelect
            dataProg$= day$ + "." + month$ +"." + year$+"г., "+weekday$+", на " + hour$
            *Info\DataDay(N)=dataProg$
            Debug dataProg$ +"      "+Str(N)
            
            
          Case "cloudiness"; Облачность
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\cloudiness(N)= "ясно"
              Case "1"
                *Info\cloudiness(N)= "малооблачно"
              Case "2"
                *Info\cloudiness(N)= "облачно"
              Case "3"
                *Info\cloudiness(N)= "пасмурно"
            EndSelect
            
          Case "precipitation" ; Осадки
            Select XMLAttributeValue(*CurrentNode)
              Case "4"
                *Info\precipitation(N)= "дождь"
              Case "5"
                *Info\precipitation(N)= "ливень"
              Case "6","7"
                *Info\precipitation(N)= "снег"
              Case "8"
                *Info\precipitation(N)= "гроза"
              Case "9"
                *Info\precipitation(N)= "нет данных"
              Case "10" 
                *Info\precipitation(N)= "без осадков"
            EndSelect  
            ;Debug cloudiness(N) + ", " + precipitation(N)
            
          Case "rpower" ; интенсивность осадков
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\rpower(N)= "возможен дождь/снег"
              Case "1"
                *Info\rpower(N)= "дождь/снег"
            EndSelect   
            
          Case "spower" ; вероятность грозы
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\spower(N)= "возможна гроза"
              Case "1"
                *Info\spower(N)= "гроза"
            EndSelect            
            
          Case "min"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmin(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmin(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmin(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmin(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
          Case "max"
            Select GetXMLNodeName(*CurrentNode) 
              Case "PRESSURE"
                *Info\PRESSUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "TEMPERATURE"
                *Info\TEMPERATUREmax(N) = XMLAttributeValue(*CurrentNode)
              Case "HEAT"
                *Info\HEATmax(N) = XMLAttributeValue(*CurrentNode)
              Case "WIND"
                *Info\WINDmax(N) = XMLAttributeValue(*CurrentNode)
              Case "RELWET"
                *Info\RELWETmax(N) = XMLAttributeValue(*CurrentNode)
                
            EndSelect
            
          Case "direction"
            Select XMLAttributeValue(*CurrentNode)
              Case "0"
                *Info\direction(N) = "северный"
              Case "1"
                *Info\direction(N) = "северо-восточный"
              Case "2"
                *Info\direction(N) = "восточный"
              Case "3"
                *Info\direction(N) = "юго-восточный"
              Case "4"
                *Info\direction(N) = "южный"
              Case "5"
                *Info\direction(N) = "юго-западный"
              Case "6"
                *Info\direction(N) = "западный"
              Case "7"
                *Info\direction(N) = "северо-западный"
            EndSelect
            
        EndSelect
        
      Wend
    EndIf
    ;    
    *ChildNode = ChildXMLNode(*CurrentNode)
    
    While *ChildNode <> 0
      GisMet_XML_Data(*ChildNode, CurrentSublevel+1, *Info)      
      *ChildNode = NextXMLNode(*ChildNode)
    Wend        
    
  EndIf
  
  
EndProcedure


Procedure.l DownloadToMem ( URL.s, *lpRam, ramsize.l ) 
  Protected agent.s, hInet.l, hData.l, Bytes.l 
  
  agent.s = "IE 6.0" 
  hInet.l = InternetOpen_ ( @agent.s,0,0,0,0 ) 
  hData.l = InternetOpenUrl_ ( hInet, @URL.s, "", 0, $8000000, 0 ) 
  
  If hData > 0 : InternetReadFile_ ( hData, *lpRam, ramsize.l, @Bytes.l ) : Else : Bytes = -1 : EndIf 
  
  InternetCloseHandle_ (hInet) 
  InternetCloseHandle_ (hFile) 
  InternetCloseHandle_ (hData) 
  
  ProcedureReturn Bytes.l 
EndProcedure 

Procedure SetEditorMemeo(*Info.MeteoInfo)
  If *Info\State = 1
    
    If GetGadgetState(40) = 1
      Ind = 2
    ElseIf GetGadgetState(41) = 1
      Ind = 3
    ElseIf GetGadgetState(42) = 1
      Ind = 4
    Else
      Ind = 1
    EndIf
    
    SetGadgetText(38, "В городе " + URLDecoder(*Info\Sity)+" "+ *Info\DataDay(Ind)+ "ч. прогнозируется:" + #CRLF$ + "давление " + *Info\PRESSUREmin(Ind) + "-"+ *Info\PRESSUREmax(Ind) +" мм.рт.ст.," + #CRLF$ + "ветер "+*Info\direction(Ind)+","+" "+*Info\WINDmin(Ind)+"-"+*Info\WINDmax(Ind) +" m\c,"+ #CRLF$ +"относительная влажность" + #CRLF$ + "воздуха " + *Info\RELWETmin(Ind) + "-"+ *Info\RELWETmax(Ind) +" %"+ #CRLF$ +"температура "+*Info\TEMPERATUREmin(Ind)+"-"+ *Info\TEMPERATUREmax(Ind) +"°C, "+ #CRLF$ + *Info\cloudiness(Ind) + ", " + *Info\precipitation(Ind) )

  ElseIf *Info\State = 0
    SetGadgetText(38, "Внутеняя ошибка программы") ; Не удалось выделить память под XML
  ElseIf *Info\State = 2
    SetGadgetText(38, "Нет связи с сервером погоды")
  ElseIf *Info\State = 3
    SetGadgetText(38, "Ошибка расшифровки данных")
  EndIf
EndProcedure

Procedure GetMeteo(SityNew.s)
  Shared G_Meteo_Info
  
  *Mem_XML = AllocateMemory(100000)
  If *Mem_XML
    FillMemory(*Mem_XML, 100000, 0)
    Bytes=DownloadToMem ("http://informer.gismeteo.ru/xml/"+SityNew+"_1.xml", *Mem_XML, 100000)
    If Bytes>0  
      If CatchXML(#XML,*Mem_XML,Bytes)  ;LoadXML(#XML, FileName$)
        *MainNode = MainXMLNode(#XML)      
        If *MainNode
          G_Meteo_Info\State = 1
          GisMet_XML_Data(*MainNode, 0, @G_Meteo_Info)
          SetEditorMemeo(@G_Meteo_Info)
        Else
          G_Meteo_Info\State = 3
        EndIf
      Else
        G_Meteo_Info\State = 3
      EndIf
    Else
       G_Meteo_Info\State = 2
    EndIf
    FreeMemory(*Mem_XML) 
  Else
    G_Meteo_Info\State = 0
  EndIf
EndProcedure



InitNetwork()




If OpenWindow(#Window_0, 436, 47, 600, 100, "Прогноз погоды на сутки", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  ComboBoxGadget(#ComboBox_0, 105, 10, 210, 20)
  ButtonGadget(#Button_2, 10, 10, 80, 30, "Обновить")
  
  EditorGadget(38,350,7,200,90,#PB_Editor_ReadOnly)
  
  OptionGadget(39, 10, 50, 30, 20, "6") : SetGadgetState(39, 1)
  GadgetToolTip(39, "Прогноз на 6 часов")
  OptionGadget(40, 54, 50, 40, 20, "12")
  GadgetToolTip(40, "Прогноз на 12 часов")
  OptionGadget(41, 98, 50, 40, 20, "18")
  GadgetToolTip(41, "Прогноз на 18 часов")
  OptionGadget(42, 142, 50, 40, 20, "24")
  GadgetToolTip(42, "Прогноз на сутки")
  
EndIf

If ReadFile(0, "GismeteoCodSity.txt")   
  While Eof(0) = 0           
    AddGadgetItem(#ComboBox_0, -1,ReadString(0))
  Wend
  CloseFile(0)               
Else
  MessageRequester("Information","Нет файла - справочника")
EndIf  

;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
      ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      
      If EventGadget = #Button_2
        GetMeteo(SityNew$)
      ElseIf EventGadget = #ComboBox_0 And EventType = 1
        SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
        If Len(SityNew$)
          GetMeteo(SityNew$)
        EndIf
        
        
      ElseIf EventGadget>=39 And EventGadget<=42 ; Выбор времени
         SetEditorMemeo(@G_Meteo_Info)    
      EndIf
      
      ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver



;}

Поделиться13922.06.2011 21:11:39

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Понятно. Спасибо.

Поделиться14023.06.2011 18:15:19

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Привет.
Слил две проги. Город выбирается, но в EditorGadget пусто.
Кнопка работает. Скажите, что не так делаю?
Код.

Поделиться14123.06.2011 18:26:02

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

Город выбирается, но в EditorGadget пусто.

У меня не пусто.

Поделиться14223.06.2011 18:31:12

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

В том-то и дело, что работает только кнопка обновления данных.
На выбор города и времени прогноза ни каких реакций.

Отредактировано max (23.06.2011 18:32:00)

Поделиться14323.06.2011 18:43:27

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

На выбор города ни каких реакций.

Потому что обработчик событий от выпадающего списка находится в обработчике событий кнопки и естественно события списка не обрабатываются.

Нужно этот участок кода

Код:

     Case 37
        
     If EventGadget() = 37
       GetMeteo(SityNew$)
     ElseIf EventGadget = #ComboBox_0 And EventType = 1
       SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
       If Len(SityNew$)
         GetMeteo(SityNew$)
       EndIf
      
      ElseIf EventGadget>=39 And EventGadget<=42 ; Выбор времени
         SetEditorMemeo(@G_Meteo_Info)    
      EndIf

заменить на этот

Код:

      Case 37
 
       GetMeteo(SityNew$)       
     
     Case #ComboBox_0
       
       If EventType() = 1
         SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
         If Len(SityNew$)
           GetMeteo(SityNew$)
         EndIf
       EndIf
      
      Case  39 To 42 ; Выбор времени
         SetEditorMemeo(@G_Meteo_Info)

Поделиться14423.06.2011 18:45:54

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

То, что надо.

Поделиться14523.06.2011 19:03:32

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

С погодой разобрались. Теперь курс валют.

Дмитрий написал(а):

Код:

POST$ + "POST /DailyInfoWebServ/DailyInfo.asmx HTTP/1.1" + Chr(13) + Chr(10)
POST$ + "Host: www.cbr.ru" + Chr(13) + Chr(10)
POST$ + "Content-Type: text/xml; charset=utf-8" + Chr(13) + Chr(10)
POST$ + "Content-Length: "+"256"+ Chr(13) + Chr(10)
POST$ + "SOAPAction: "+Chr(34)+"http://web.cbr.ru/GetCursDynamic"+Chr(34) + Chr(13) + Chr(10)

Procedure.s PostToHost(Host$, POST$,Port) 
  ConnectionID = OpenNetworkConnection(Host$, Port) 
  If ConnectionID 
    SendNetworkString(ConnectionID,POST$) 
      Repeat : Until NetworkClientEvent(ConnectionID) = 2 
      Buffer = AllocateMemory(10000) 
      ReceiveNetworkData(ConnectionID, Buffer, 10000) 
      CloseNetworkConnection(ConnectionID) 
      ProcedureReturn PeekS(Buffer) 
      CloseNetworkConnection(ConnectionID)
    EndIf 
EndProcedure
InitNetwork()
  ServerName$ = "http://www.cbr.ru"
  Port = 80
Debug PostToHost(ServerName$, POST$,Port)

в ответ присылают XML документ! От туда вытаскивай курсы.

Дмитрий написал(а):

Илья написал(а):
...а куда сохраняется этот XML документ
в переменную String$ = PostToHost(ServerName$, POST$,Port)

Как работать с этой переменной?

Поделиться14623.06.2011 19:43:04

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

Как работать с этой переменной?

Поскольку это XML документ, то переменную нужно передать функции CatchXML

Код:

CatchXML(0, @String$, Len(String$))

а дальше нужно разобрать XML документ и выделить из него данные.
Это примерно так же как и с расшифровкой XML документа прогноза погоды.

Поделиться14723.06.2011 20:14:18

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

И лучше загружать значки не с диска а внедрить их в программу и грузить из памяти.
Для этого в конец исходника, в DataSection нужно добавить такие строки:

Код:

  ImageSave:
  IncludeBinary "Save.ico"
  
  ImageStop:
  IncludeBinary "Stop.ico"
  
  ImageHelp:
  IncludeBinary "Help32.ico"

А эти строки:

Код:

         ToolBarImageButton(1, LoadImage(0, "Save.ico"))
    ToolBarToolTip(0, 1, "Добавить в автозагрузку")
    ToolBarSeparator()
    ToolBarImageButton(2, LoadImage(0, "stop.ico"))
    ToolBarToolTip(0, 2, "Удалить из автозагрузки")
    ToolBarSeparator()
    ToolBarImageButton(3, LoadImage(0, "help32.ico"))

нужно заменить на эти:

Код:

        ToolBarImageButton(1, CatchImage(1, ?ImageSave))
    ToolBarToolTip(0, 1, "Добавить в автозагрузку")
    ToolBarSeparator()
    ToolBarImageButton(2, CatchImage(2, ?ImageStop))
    ToolBarToolTip(0, 2, "Удалить из автозагрузки")
    ToolBarSeparator()
    ToolBarImageButton(3, CatchImage(3, ?ImageHelp))

Туда (в ДатаСекцию) можно запихнуть так же файл GismeteoCodSity.txt предварительно сжав его для уменьшения размера.
Тогда программа будет состоять из одного исполняемого файла и не тянуть за собой кучу других.

Поделиться14823.06.2011 20:26:27

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Код:

POST$ + "POST /DailyInfoWebServ/DailyInfo.asmx HTTP/1.1" + Chr(13) + Chr(10)
POST$ + "Host: www.cbr.ru" + Chr(13) + Chr(10)
POST$ + "Content-Type: text/xml; charset=utf-8" + Chr(13) + Chr(10)
POST$ + "Content-Length: "+"256"+ Chr(13) + Chr(10)
POST$ + "SOAPAction: "+Chr(34)+"http://web.cbr.ru/GetCursDynamic"+Chr(34) + Chr(13) + Chr(10)

Procedure.s PostToHost(Host$, POST$,Port) 
  ConnectionID = OpenNetworkConnection(Host$, Port) 
  If ConnectionID 
    SendNetworkString(ConnectionID,POST$) 
      Repeat : Until NetworkClientEvent(ConnectionID) = 2 
      Buffer = AllocateMemory(10000) 
      ReceiveNetworkData(ConnectionID, Buffer, 10000) 
      CloseNetworkConnection(ConnectionID) 
      ProcedureReturn PeekS(Buffer) 
      CloseNetworkConnection(ConnectionID)
    EndIf 
EndProcedure
InitNetwork()
  ServerName$ = "http://www.cbr.ru"
  Port = 80
  String$ = PostToHost(ServerName$, POST$,Port)
  CatchXML(0, @String$, Len(String$))

На функции CatchXML выскакивает ошибка:

Отредактировано max (23.06.2011 20:38:49)

Поделиться14923.06.2011 20:31:47

Автор: max
Активный участник
Зарегистрирован: 24.11.2010
Приглашений: 0
Сообщений: 571
Уважение: [+1/-0]
Позитив: [+40/-0]
Пол: Мужской
Возраст: 39 [1985-03-29]
Провел на форуме:
1 месяц 14 дней
Последний визит:
19.10.2023 06:50:33

Пётр написал(а):

И лучше загружать значки не с диска а внедрить их в программу и грузить из памяти.

Сейчас исправлю. Спасибо.

Пётр написал(а):

Туда (в ДатаСекцию) можно запихнуть так же файл GismeteoCodSity.txt предварительно сжав его для уменьшения размера.

Как-бы два вопроса.
1. Чем лучше сжать файл.
2. Как в ДатаСекцию запихнуть текстовый файл(в справке не увидел)?

Отредактировано max (23.06.2011 20:47:06)

Поделиться15023.06.2011 22:42:08

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

max написал(а):

в ответ присылают XML документ!

Не присылает!

Код:

POST$ + "POST /DailyInfoWebServ/DailyInfo.asmx HTTP/1.1" + Chr(13) + Chr(10)
POST$ + "Host: www.cbr.ru" + Chr(13) + Chr(10)
POST$ + "Content-Type: text/xml; charset=utf-8" + Chr(13) + Chr(10)
POST$ + "Content-Length: "+"256"+ Chr(13) + Chr(10)
POST$ + "SOAPAction: "+Chr(34)+"http://web.cbr.ru/GetCursDynamic"+Chr(34) + Chr(13) + Chr(10)

Procedure.s PostToHost(Host$, POST$,Port) 
  ConnectionID = OpenNetworkConnection(Host$, Port) 
  If ConnectionID 
    SendNetworkString(ConnectionID,POST$) 
    x=0
    Repeat 
      If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data 
        Buffer = AllocateMemory(10000) 
        ReceiveNetworkData(ConnectionID, Buffer, 10000) 
        CloseNetworkConnection(ConnectionID) 
        ProcedureReturn PeekS(Buffer) 
      EndIf
      Delay(10)
      x+1
    Until x>100
    CloseNetworkConnection(ConnectionID)
  EndIf 
  ProcedureReturn ""
EndProcedure
InitNetwork()
String$ = PostToHost("www.cbr.ru", POST$,80)
Debug String$
If String$
  CatchXML(0, @String$, Len(String$))
EndIf

max написал(а):

1. Чем лучше сжать файл.

Сжатие.

Код:

InputFile$ = OpenFileRequester("", "", "Все файлы|*.*", 0)
If InputFile$
  
  If ReadFile(0,InputFile$)
    Filesize=Lof(0)
    If Filesize>0
      *file=AllocateMemory(Filesize+1)
      *pak=AllocateMemory(Filesize+8)
      If *file And *pak
        ReadData(0, *file, Filesize)
        CloseFile(0)
        
        PakSize=PackMemory(*file, *pak, Filesize, 9)
        
        If PakSize>0
          
          OutputFile$ = SaveFileRequester("", Left(InputFile$, Len(InputFile$)-Len(GetExtensionPart(InputFile$)))+"pak", "pak файлы|*.pak|All Files|*.*", 0)
          If OutputFile$
            If CreateFile(1,OutputFile$)
              WriteData(1,*pak,PakSize)
              CloseFile(1)
              MessageRequester("", "ОК", #MB_OK|#MB_ICONINFORMATION)
            Else
              MessageRequester("", "Не удалось создать файл", #MB_OK|#MB_ICONWARNING)
            EndIf
          EndIf 
        Else
          MessageRequester("", "Проблема при упаковке", #MB_OK|#MB_ICONERROR)
        EndIf
      Else
        MessageRequester("", "Проблема с памятью", #MB_OK|#MB_ICONERROR)
      EndIf
    Else
      MessageRequester("", "Файл пустой", #MB_OK|#MB_ICONERROR)
    EndIf
  Else
    MessageRequester("", "Нет файла", #MB_OK|#MB_ICONERROR)
  EndIf
  
EndIf

Запускаем.
Выбираем файл, который надо упаковать и выбираем место сохранения упакованого файла с расширением PAK.
Этот PAK файл добавляем в ДатаСекцию, например так:

Код:

DataSection
  TextPak:
  IncludeBinary "GismeteoCodSity.pak"
EndDataSection

Далее распаковываем текст:

Код:

; Процедура UnPak() распаковывает данные, упакованные функцией PackMemory()
; Процедуре нужно передать указатель на первый байт упакованных данных, например из DataSection
; При успешной распаковке, процедура вернет указатель на место нахождения распакованных данных
; Не забывайте освобождать память функцией FreeMemory когда распакованные данные больше не нужны

Procedure UnPak(*pak)
  *Unpak_mem = 0
  RealSize = PeekL(*pak+2)
  If RealSize>0 And RealSize<10000000
    *mem = AllocateMemory(RealSize+10)
    If *mem
      If UnpackMemory(*pak, *mem) = RealSize
        *Unpak_mem = *mem
      Else
        FreeMemory(*mem)
      EndIf
    EndIf
  EndIf
  ProcedureReturn *Unpak_mem
EndProcedure

*mem = UnPak(?TextPak)
If *mem
  Text.s = PeekS(*mem)
  FreeMemory(*mem)
endif

Страница: « 1 2 3 4 5 6 7 … 15 »

PureBasic - форум

Меню навигации

Пользовательские ссылки

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

Светодиодная матрица - МОДЖЕТ (антигаджет) на Пурике

Сообщений 121 страница 150 из 446

Поделиться12120.06.2011 19:30:34

Поделиться12220.06.2011 20:29:07

Поделиться12320.06.2011 21:28:50

Поделиться12421.06.2011 18:12:39

Поделиться12521.06.2011 18:39:39

Поделиться12621.06.2011 18:47:02

Поделиться12721.06.2011 19:05:39

Поделиться12821.06.2011 19:17:22

Поделиться12921.06.2011 19:38:00

Поделиться13022.06.2011 15:46:00

Поделиться13122.06.2011 15:51:01

Поделиться13222.06.2011 16:09:56

Поделиться13322.06.2011 17:57:08

Поделиться13422.06.2011 18:50:35

Поделиться13522.06.2011 19:50:27

Поделиться13622.06.2011 20:00:50

Поделиться13722.06.2011 20:35:53

Поделиться13822.06.2011 21:08:14

Поделиться13922.06.2011 21:11:39

Поделиться14023.06.2011 18:15:19

Поделиться14123.06.2011 18:26:02

Поделиться14223.06.2011 18:31:12

Поделиться14323.06.2011 18:43:27

Поделиться14423.06.2011 18:45:54

Поделиться14523.06.2011 19:03:32

Поделиться14623.06.2011 19:43:04

Поделиться14723.06.2011 20:14:18

Поделиться14823.06.2011 20:26:27

Поделиться14923.06.2011 20:31:47

Поделиться15023.06.2011 22:42:08

Похожие темы