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

Страница: « 1 … 9 10 11 12 13 14 15 »

Сообщений 301 страница 330 из 446

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

Нужно просто проинвертировать данные в структуре.
Это лучше делать в процедуре Draw_Image, поскольку инверсия нужна во многих эффектах.

Код:

pt.w = 2
tp.w
NOT_Flag.b = 0

Structure DrawInfo
  row.a[8]
EndStructure

CreateImage(0,148,148);

Procedure Draw_Image(*Infa.DrawInfo)
  Shared NOT_Flag
  
  If StartDrawing(ImageOutput(0))
    Box(83,0,148,148,0) ; Очистка рисунка
    For col = 0 To 7
      For row = 0 To 7
        x = 20 + col * 15
        y = 20 + row * 15
        
        Temp.a = *Infa\row[row]
        If NOT_Flag = 1
          Temp = ~ Temp
        EndIf
        
        If Temp << col & %10000000
          Color = RGB(255, 102, 00)
        Else
          Color = RGB(102, 102, 102)
        EndIf
        Circle(x, y, 5, Color)
      Next
    Next
    StopDrawing()
  EndIf
  SetGadgetState(0, ImageID(0))
EndProcedure

Procedure Timer1()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
    
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=0 To 7
      For x=1 To 8
        If Random(20) - (20-tp) >= 0
          Draw\row[i] | 1
        Else
          Draw\row[i] & %11111110
        EndIf
        If x<8 : Draw\row[i]<<1 : EndIf
      Next x
    Next i  
    Draw_Image(Draw)

  Else
    pt_counter - 1
  EndIf
EndProcedure

Procedure Timer2()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=6 To 0 Step -1
      Draw\row[i+1] = Draw\row[i]
    Next i
    
    For x=1 To 8
      If Random(20) - (20-tp) >= 0
        Draw\row[0] | 1
      Else
        Draw\row[0] & %11111110
      EndIf
      If x<8 : Draw\row[0]<<1 : EndIf
    Next x
    
    Draw_Image(Draw)
    
  Else
    pt_counter - 1
  EndIf
EndProcedure

OpenWindow(0, 0, 0, 535, 186, "МОДЖЕТ 8x8", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)


OptionGadget(14, 214, 23, 60, 20, "1")
OptionGadget(15, 214, 43, 60, 20, "2")
SetGadgetState(14, 1)
TrackBarGadget(19, 300, 57, 165, 35, 2, 100, #PB_TrackBar_Ticks)
TextGadget(23, 300, 90, 50 ,13,"Скорость")
TrackBarGadget(18, 300, 6, 165, 35, 0, 18, #PB_TrackBar_Ticks)
TextGadget(22, 300, 39, 50 ,18,"Пиксели")
ImageGadget(0,20,20,148,148, 0)
CheckBoxGadget(24, 214,70,80,16,"Инверсия")

Repeat
  Event = WaitWindowEvent()
  
  ;{----------События компонентов----------
  If Event=#PB_Event_Gadget
    
    Select EventGadget()
        
      Case 14
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),2,10, @Timer1())
        
      Case 15
        KillTimer_(WindowID(0),2)
        Timer2()
        SetTimer_(WindowID(0),2,10, @Timer2())    
        
      Case 18
        tp = GetGadgetState(18)
        
      Case 19
        pt = GetGadgetState(19)
        
      Case 24
        NOT_Flag = GetGadgetState(24) 
        
    EndSelect    
    
  EndIf 
  ;}-------------------------------------
  
Until Event = #PB_Event_CloseWindow

Поделиться30214.07.2011 22:22:39

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

Спасибо.

Поделиться30317.07.2011 19:52:36

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

Собрал в кучу:

Код:

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

;{---------Запрет на запуск программы более одного раза-----------  
a = CreateSemaphore_(#Null,0,1,"MODGET 8x8") 
If a<>0 And GetLastError_()= #ERROR_ALREADY_EXISTS 
  CloseHandle_(a) 
  End 
EndIf 
;}---------------------------------------------------------------

;{-----------------------Enumeration------------------------------
Enumeration 
  #Window_0 
  #Window_1
  #Window_2
  #Window_3
  #ButtonImage_3
EndEnumeration 
;}

;{ Images 
Enumeration
  #Image_Image_1
  #Image_ButtonImage_1
  #Image_ButtonImage_2
  #Image_ButtonImage_3
EndEnumeration
UsePNGImageDecoder()
;}

;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration

Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}----------------------------------------------------------------

;{----------------------Глобальные переменные---------------------
#Window_0=0
Global NO_Device.s="отключен"                            ;сообщения программы
Global YES_Device.s="подключен"                          ;сообщения программы
Global About.s="О программе МОДЖЕТ 8x8"
Global Mod.s="МОДЖЕТ 8x8"
Global Ver.s="Версия 1.0"
Global open.s="Открыть файл"
Global Maska.s="Текстовые файлы (*.txt)|*.txt"
Global Lib1.s="Файл отсутствует!"
Global Lib2.s="Для отображения времени"
Global Lib3.s="требуется файл"
#USB_PID=$5555                              ;идентификатор PID
#USB_VID=$FFFF                               ;идентификатор VID
Global R_DeviceHandle, W_DeviceHandle 
Global Text.s
Global Put.s ;абсолютный путь к файлу

#XML        = 0

SityNew$="29838"; - Барнаул

pt.w = 2
tp.w
NOT_Flag.b = 0

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

Structure ProgramItitThread
  meteo.b
  text.b
EndStructure

G_Meteo_Info.MeteoInfo
G_Meteo_Info\State = -1

ProgramItitThread.ProgramItitThread
;}

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$+"г., "+ #CRLF$+weekday$+","+ #CRLF$+"на " + 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 DateTime() 
  ; Эта процедура вызывается по таймеру два раза в секунду.
  Time.s = FormatDate("%hh:%ii:%ss", Date() ) ; Узнаём текущее время
  SetGadgetText(84,Time)
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)+#CRLF$+ *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

Procedure ProgramAtStartup(State, ProgName.s) ; Управление автозагрузкой программы
valueName$=ProgramFilename() 
 GetHandle = RegOpenKeyEx_(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, #KEY_ALL_ACCESS, @hKey)
 If GetHandle = #ERROR_SUCCESS
  If State=1
   RegSetValueEx_(hKey, @ProgName, 0, #REG_SZ, @valueName$, Len(valueName$))
  Else
   RegDeleteValue_(hKey, @ProgName)
  EndIf
  RegCloseKey_(hKey)
 EndIf
EndProcedure

Procedure FindDevice_Timer() ; таймер - процедура проверки подключения нашего устройства
Static Old_Test
Test=HID_Lib_DeviceTest(#USB_PID, #USB_VID)
 If Test<>Old_Test
  Old_Test=Test 
  If Test 
     HID_Lib_CloseDevice(R_DeviceHandle) : HID_Lib_CloseDevice(W_DeviceHandle)
     W_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
     R_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
      SetGadgetText(56, YES_Device)
      SetGadgetColor(56, #PB_Gadget_FrontColor, $00FF0F) 
    Else
     HID_Lib_CloseDevice(R_DeviceHandle) : HID_Lib_CloseDevice(W_DeviceHandle)
     R_DeviceHandle=0 : W_DeviceHandle=0
      SetGadgetText(56, NO_Device)
      SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)
    EndIf
  EndIf
  
EndProcedure

InitNetwork()

Structure DrawInfo
  row.c[8]
EndStructure

#xc = 20 ; начало по X
#yc = 20 ; начало по Y

CreateImage(80,148,148)

Procedure.s UTF2Ansi(str$) 
  str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
  CP_IN=65001; #CP_UTF8=65001
  CP_OUT=1251 
  MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
  WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
  ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 35
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)
          
          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" руб.;"
            EndIf
          EndIf
          
        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected ManyExpression.s, Temp.s
  Protected Pos, Pos1, Pos2
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        
        Pos = FindString(html, "<td>Офіційний курс</td>", 1)
        If Pos
          Pos1 = FindString(html, "</table>", Pos+Len("<td>Офіційний курс</td>"))
          If Pos1
            
            html=Mid(html, Pos, Pos1-Pos)
            
            Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
            Restore Many_uk
            For i=1 To 27
              Read.s Many
              Pos = FindString(Many, " ", 1)
              ManyExpression = Right(Many, Len(Many)-Pos)
              ManyExpression + "</td>"
              Pos1 = FindString(html, ManyExpression, 1)
              If Pos1>0
                Pos1+Len(ManyExpression)
                Pos2 = FindString(html,"</td>",Pos1)
                If Pos2>0
                  
                  Temp.s=Mid(html, Pos1, Pos2-Pos1)
                  Pos = FindString(ReverseString(Temp),">", 1)
                  If Pos>0
                    Result + " "+Many+" = "+Mid(Temp, Len(Temp)-Pos+2)+" грн.;"
                  EndIf
                  
                EndIf
              EndIf
            Next i
            
          EndIf
        EndIf
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure Draw_Image(*Infa.DrawInfo)
  Shared NOT_Flag
  
  If StartDrawing(ImageOutput(80))
    Box(83,0,148,148,0) ; Очистка рисунка
    For col = 0 To 7
      For row = 0 To 7
        x = 20 + col * 15
        y = 20 + row * 15
        
        Temp.a = *Infa\row[row]
        If NOT_Flag = 1
          Temp = ~ Temp
        EndIf
        
        If Temp << col & %10000000
          Color = RGB(255, 102, 00)
        Else
          Color = RGB(102, 102, 102)
        EndIf
        Circle(x, y, 5, Color)
      Next
    Next
    StopDrawing()
  EndIf
  SetGadgetState(82, ImageID(80))
EndProcedure

Procedure Timer1()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
    
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=0 To 7
      For x=1 To 8
        If Random(20) - (20-tp) >= 0
          Draw\row[i] | 1
        Else
          Draw\row[i] & %11111110
        EndIf
        If x<8 : Draw\row[i]<<1 : EndIf
      Next x
    Next i  
    Draw_Image(Draw)

  Else
    pt_counter - 1
  EndIf
EndProcedure

Procedure Timer2()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=6 To 0 Step -1
      Draw\row[i+1] = Draw\row[i]
    Next i
    
    For x=1 To 8
      If Random(20) - (20-tp) >= 0
        Draw\row[0] | 1
      Else
        Draw\row[0] & %11111110
      EndIf
      If x<8 : Draw\row[0]<<1 : EndIf
    Next x
    
    Draw_Image(Draw)
    
  Else
    pt_counter - 1
  EndIf
EndProcedure

Procedure StreamFileIn_Callback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1 
EndProcedure 

Procedure FileStreamIn(Gadget, Files.s) 
  
  
  ;Procedure zum streamen einer Datei in das RichEdit 
  ;Control 
  
  Protected StreamData.EDITSTREAM 
  
  ;Wenn die Datei geцffnet werden kann, fortfahren.  
  If ReadFile(10, Files)    
    
    ;Das Handle der Datei speichern 
    StreamData\dwCookie = FileID(10) 
    StreamData\dwError = #Null 
    
    ;Die Adresse der Callback Procedure speichern 
    StreamData\pfnCallback = @StreamFileIn_Callback() 
    
    ;Das RichEdit Control anweisen, den Stream zu aktivieren 
    SendMessage_(GadgetID(Gadget), #EM_STREAMIN, #SF_RTF, @StreamData) 
    
    ;Datei schliessen 
    CloseFile(10) 
    
  EndIf 
  
EndProcedure

Procedure Open_Window_1()
  
  OpenWindow(1, 0, 0, 277, 247, About, #PB_Window_ScreenCentered );| #PB_Window_SystemMenu)
  
  EditorGadget(72,2,2,496,370,#PB_Editor_ReadOnly)
  SendMessage_(GadgetID(72), #EM_SETTARGETDEVICE, #Null, 0) ; Перенос по словам
  
  ;If
  LoadImage(70, "LOGO.bmp")    ; change 2nd parameter to the path/filename of your image
  ImageGadget(70,  6, 6, 235, 78, ImageID(70))                      ; imagegadget standard
  EditorGadget(72,95,46,176,170,#PB_Editor_ReadOnly)
  SendMessage_(GadgetID(72), #EM_SETTARGETDEVICE, #Null, 0) ; Перенос по словам 
  FileStreamIn(72, "Авторы.rtf")
  
  TextGadget(62,95,6,100,18,Mod)
  TextGadget(63,95,26,100,18,Ver)
  ;TextGadget(64,102,58,150,18,"Copyright © Radan 2011")
  ;TextGadget(65,102,82,100,18,"Radan Studio")
  
    Lang.s="ru"
  If GetGadgetState(90)=1
    Lang.s="en"
  EndIf
  FileStreamIn(72, Left(Lang, 2)+"_avtori.rtf")
  
  ButtonGadget(66,185,222,75,20,"OK")
  ;EndIf
EndProcedure

Procedure LoadText(File.s)
  
  cb1 = GetGadgetState(30) ; Это чтобы восстановить активные кункты в выпадающих списках.
  cb2 = GetGadgetState(48)
  cb3 = GetGadgetState(#ComboBox_0)
    
  OpenPreferences(File)
  PreferenceGroup("MainWin")
  SetWindowTitle(0,ReadPreferenceString("ac","МОДЖЕТ 8x8") )
  ToolBarToolTip(0, 1, ReadPreferenceString("ac1","Добавить в автозагрузку") )
  ToolBarToolTip(0, 2, ReadPreferenceString("ac2","Удалить из автозагрузки") )
  ToolBarToolTip(0, 3, ReadPreferenceString("ac3","О программе") )
  GadgetToolTip(90, ReadPreferenceString("ac4","Язык"))
  ;CreatePopupMenu(68)
  ;MenuItem(5, ReadPreferenceString("ac5","Свернуть")) 
  ;MenuBar() 
  ;MenuItem(10, ReadPreferenceString("ac6","Выход"))
  SetGadgetItemText(0,0, ReadPreferenceString("ac7","Случайный"))
  SetGadgetText(22,ReadPreferenceString("ac8","Пиксели") )
  SetGadgetText(23,ReadPreferenceString("ac9","Скорость") )
  SetGadgetText(13,ReadPreferenceString("ac10","Случайно") )
  SetGadgetText(14,ReadPreferenceString("ac11","Матрица") )
  SetGadgetText(15,ReadPreferenceString("ac12","Калейдоскоп") )
  SetGadgetText(16,ReadPreferenceString("ac13","Инверсия") )
  SetGadgetText(17,ReadPreferenceString("ac14","Звук") )
  SetGadgetItemText(0,1, ReadPreferenceString("ac15","Время"))
  SetGadgetText(51,ReadPreferenceString("ac16","Скорость") )
  SetGadgetText(9,ReadPreferenceString("ac17","Вид 1") )
  SetGadgetText(10,ReadPreferenceString("ac18","Вид 2") )
  SetGadgetText(11,ReadPreferenceString("ac19","Вид 3") )
  SetGadgetText(12,ReadPreferenceString("ac20","Инверсия") )
  SetGadgetItemText(0,2, ReadPreferenceString("ac21","Курс валют") )
  SetGadgetText(25,ReadPreferenceString("ac22","Инверсия") )
  SetGadgetText(26,ReadPreferenceString("ac23","Регистр") )
  SetGadgetText(27,ReadPreferenceString("ac24","Горизонтально") )
  SetGadgetText(28,ReadPreferenceString("ac25","Вертикально") )
  SetGadgetText(52,ReadPreferenceString("ac26","Скорость") )
  SetGadgetItemText(30,0, ReadPreferenceString("ac27","Украина") )
  SetGadgetItemText(30,1, ReadPreferenceString("ac28","Россия") )
  SetGadgetItemText(0,3, ReadPreferenceString("ac29","Текст") )
  SetGadgetText(43,ReadPreferenceString("ac30","Инверсия") )
  SetGadgetText(44,ReadPreferenceString("ac31","Регистр") )
  SetGadgetText(45,ReadPreferenceString("ac32","Горизонтально") )
  SetGadgetText(46,ReadPreferenceString("ac33","Вертикально") )
  SetGadgetText(50,ReadPreferenceString("ac34","Загрузить текст") )
  SetGadgetItemText(0,4, ReadPreferenceString("ac35","Погода") )
  SetGadgetText(32,ReadPreferenceString("ac36","Инверсия") )
  SetGadgetText(33,ReadPreferenceString("ac37","Регистр") )
  SetGadgetText(34,ReadPreferenceString("ac38","Горизонтально") )
  SetGadgetText(35,ReadPreferenceString("ac39","Вертикально") )
  SetGadgetItemText(0,5, ReadPreferenceString("ac40","Спектр") )
  SetGadgetText(4,ReadPreferenceString("ac41","Линия 1") )
  SetGadgetText(5,ReadPreferenceString("ac42","Линия 2") )
  SetGadgetText(6,ReadPreferenceString("ac43","Точка") )
  SetGadgetText(24,ReadPreferenceString("ac44","Инверсия") )
  NO_Device = ReadPreferenceString("ac45","отключен")
  YES_Device = ReadPreferenceString("ac46","подключен")
  If HID_Lib_DeviceTest(#USB_PID, #USB_VID)
    SetGadgetText(56, YES_Device)
    SetGadgetColor(56, #PB_Gadget_FrontColor, $00FF0F) 
  Else
    SetGadgetText(56, NO_Device)
    SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)
  EndIf
 SysTrayIconToolTip(67, ReadPreferenceString("ac47","МОДЖЕТ 8x8") )
 SetGadgetText(55,ReadPreferenceString("ac48","МОДЖЕТ ") )
 About = ReadPreferenceString("ac49","О программе МОДЖЕТ 8x8")
 Mod = ReadPreferenceString("ac50","МОДЖЕТ 8x8")
 Ver = ReadPreferenceString("ac51","Версия 1.0")
 open = ReadPreferenceString("ac52","Открыть файл")
 Maska = ReadPreferenceString("ac53","Текстовые файлы (*.txt)|*.txt")
 GadgetToolTip(39, ReadPreferenceString("ac54","Прогноз на 6 часов"))
 GadgetToolTip(40, ReadPreferenceString("ac55","Прогноз на 12 часов"))
 GadgetToolTip(41, ReadPreferenceString("ac56","Прогноз на 18 часов"))
 GadgetToolTip(42, ReadPreferenceString("ac57","Прогноз на сутки"))
 SetGadgetText(85,ReadPreferenceString("ac58","Текущее время") )
 GadgetToolTip(37,ReadPreferenceString("ac59","Обновить данные") )
 SetGadgetText(75,ReadPreferenceString("ac60","Скорость") )
 Lib1 = ReadPreferenceString("ac61","Файл отсутствует!")
 Lib2 = ReadPreferenceString("ac62","Для отображения времени")
 Lib3 = ReadPreferenceString("ac63","требуется файл") 
 SetGadgetText(76,ReadPreferenceString("ac64","Уровень сигнала") )
 ClosePreferences()
 
  SetGadgetState(30,cb1) ; Это чтобы восстановить активные кункты в выпадающих списках.
  SetGadgetState(48,cb2)
  SetGadgetState(#ComboBox_0,cb3)
 
EndProcedure

Procedure.s ReadText(File$)
  Protected Text.s = ""
  If ReadFile(0, File$) 
    Size = Lof(0); размер файла в байтах
    If Size>0
      *String = AllocateMemory(Size+10); выделяем область памяти 
      If *String 
        FillMemory(*String, Size+10, 0)
        FormatFile=ReadStringFormat(0) ; Определение кодировки файла (Ascii, UTF8 или Unicode).
        ReadData(0, *String , Size); записываем строку в область памяти
        FillMemory(*String+Size+1, 8, 0)
        Text.s=PeekS(*String, -1, FormatFile)
        FreeMemory(*String)
      EndIf
    EndIf
    CloseFile(0)
  EndIf
  ProcedureReturn Text
EndProcedure

Procedure UnPak(*pak)
 ; Процедура UnPak() распаковывает данные, упакованные функцией PackMemory()
; Процедуре нужно передать указатель на первый байт упакованных данных, например из DataSection
; При успешной распаковке, процедура вернет указатель на место нахождения распакованных данных
; Не забывайте освобождать память функцией FreeMemory когда распакованные данные больше не нужны
  *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

Procedure ProgramItit_Thread(*x.ProgramItitThread)
  
  ;Получает полный путь запущенного приложения      
  Result$ = ProgramFilename()
  ;Извлекает путь из полного пути. Например, если полный путь "C:\PureBasic\PB.exe", результат будет "C:\PureBasic\". 
  Path$ = GetPathPart(Result$)
  ;Debug Path$
  ; Просмотр всех элементов директории запущенного приложения  (без поддиректорий)
  Directory$ = Path$   
  If ExamineDirectory(0, Directory$, "*.txt")  
    ;m=0
    While NextDirectoryEntry(0)
      
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        AddGadgetItem(48, -1, Left(DirectoryEntryName(0), Len(DirectoryEntryName(0))-4))
      EndIf
      
      ;txt.s=Text + ".txt"
      
;       If DirectoryEntryName(0) = txt
;         
;       EndIf
      ;m=m+1      ;Debug DirectoryEntryName(0) ;+ Type$ + "- Size in byte: " + Str(DirectoryEntrySize(0))
    Wend
    FinishDirectory(0)
  EndIf
  SetGadgetState(48, *x\text)
  
  If Put=""
  File$ = Path$ + GetGadgetText(48)+".txt"
;  Debug File$
Else
  File$ = Put
 ; Debug File$
EndIf

If FileSize(File$)>0
  Text=ReadText(File$)
  SetGadgetText(49,Text)
EndIf
  
  ;time=ElapsedMilliseconds()
  *mem = UnPak(?GismeteoCodSity_pak)
  If *mem
    Text.s = PeekS(*mem)
    FreeMemory(*mem)
    
    ReplaceString(Text,Chr(13),Chr(10), #PB_String_InPlace)
    Text=ReplaceString(Text,Chr(10)+Chr(10),Chr(10))
    
    PosOld = 0
    Pos = FindString(Text, Chr(10), 1)
    x=0
    *PointString = @Text
    While Pos
      String.s=PeekS(*PointString+PosOld, Pos-PosOld-1)
      AddGadgetItem(#ComboBox_0, x,String)
      PosOld=Pos
      x+1
      Pos = FindString(Text, Chr(10), PosOld+1)
      If Pos =< 0
        Break
      EndIf
    Wend
    SetGadgetState(#ComboBox_0,*x\meteo)
  EndIf
  
  SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
  If Len(SityNew$)
    GetMeteo(SityNew$)
  EndIf
  
  ;Debug ElapsedMilliseconds()-time
EndProcedure

Procedure Write_setting() ;Запись в файл настроек
 If OpenPreferences("setting.ini")
  WritePreferenceLong ("fr1", GetGadgetState (90))
  WritePreferenceLong ("fr2", GetGadgetState (0))
  WritePreferenceLong ("fr3", GetGadgetState (18))
  WritePreferenceLong ("fr4", GetGadgetState (19))
  WritePreferenceLong ("fr5", GetGadgetState (20))
  WritePreferenceLong ("fr6", GetGadgetState (13))
  WritePreferenceLong ("fr7", GetGadgetState (14))
  WritePreferenceLong ("fr8", GetGadgetState (15))
  WritePreferenceLong ("fr9", GetGadgetState (16))
  WritePreferenceLong ("fr10", GetGadgetState (17))
  WritePreferenceLong ("fr11", GetGadgetState (8))
  WritePreferenceLong ("fr12", GetGadgetState (9))
  WritePreferenceLong ("fr13", GetGadgetState (10))
  WritePreferenceLong ("fr14", GetGadgetState (11))
  WritePreferenceLong ("fr15", GetGadgetState (12))
  WritePreferenceLong ("fr16", GetGadgetState (25))
  WritePreferenceLong ("fr17", GetGadgetState (26))
  WritePreferenceLong ("fr18", GetGadgetState (27))
  WritePreferenceLong ("fr19", GetGadgetState (28))
  WritePreferenceLong ("fr20", GetGadgetState (29))
  WritePreferenceLong ("fr21", GetGadgetState (30))
  WritePreferenceLong ("fr22", GetGadgetState (43))
  WritePreferenceLong ("fr23", GetGadgetState (44))
  WritePreferenceLong ("fr24", GetGadgetState (45))
  WritePreferenceLong ("fr25", GetGadgetState (46))
  WritePreferenceLong ("fr26", GetGadgetState (47))
  WritePreferenceLong ("fr27", GetGadgetState (48))
  WritePreferenceLong ("fr28", GetGadgetState (32))
  WritePreferenceLong ("fr29", GetGadgetState (33))
  WritePreferenceLong ("fr30", GetGadgetState (34))
  WritePreferenceLong ("fr31", GetGadgetState (35))
  WritePreferenceLong ("fr32", GetGadgetState (36))
  WritePreferenceLong ("fr33", GetGadgetState (39))
  WritePreferenceLong ("fr34", GetGadgetState (40))
  WritePreferenceLong ("fr35", GetGadgetState (41))
  WritePreferenceLong ("fr36", GetGadgetState (42))
  WritePreferenceLong ("fr37", GetGadgetState (#ComboBox_0))
  WritePreferenceLong ("fr38", GetGadgetState (4))
  WritePreferenceLong ("fr39", GetGadgetState (5))
  WritePreferenceLong ("fr40", GetGadgetState (6))
  WritePreferenceLong ("fr41", GetGadgetState (7))
  WritePreferenceLong ("fr42", GetGadgetState (24))
  WritePreferenceString ("fr43", Put)
  ClosePreferences()
  EndIf
EndProcedure

Image.DrawInfo
;--------------------Окно программы---------------------
OpenWindow(0, 0, 0, 535, 186, "МОДЖЕТ 8x8", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
;--------------------Кнопки-------------------
ContainerGadget(95,0,0,97,30, #PB_Container_BorderLess)
  If CreateToolBar(0, GadgetID(95))
    ToolBarSeparator()
    ToolBarImageButton(1, CatchImage(1, ?ImageSave))
    ToolBarToolTip(0, 1, "Добавить в автозагрузку")
    ToolBarSeparator()
    ToolBarImageButton(2, CatchImage(2, ?ImageDelete))
    ToolBarToolTip(0, 2, "Удалить из автозагрузки")
    ToolBarSeparator()
    ToolBarImageButton(3, CatchImage(3, ?ImageInformation))
    ToolBarToolTip(0, 3, "О программе")
    ToolBarSeparator()
  EndIf
  CloseGadgetList()
;--------------------Язык-------------------
ComboBoxGadget(90,200,3,70,22)
GadgetToolTip(90, "")
AddGadgetItem(90,-1,"Русский")
AddGadgetItem(90,-1,"English")
SetGadgetState(90,0)


ImageGadget(82,6, 33,148,148,ImageID(80))
Draw_Image(@Image)
SetTimer_(WindowID(0),4,100, @Timer1() )

;-----------Системный трей----------- 
AddSysTrayIcon(67, WindowID(0), ExtractIcon_(0,ProgramFilename(),0))
SysTrayIconToolTip(67, "МОДЖЕТ 8x8") 
;Добавим к иконке меню
CreatePopupMenu(68) 
;MenuItem(4, "Развернуть") 
MenuItem(5, "") 
MenuBar() 
MenuItem(10, "")   

TextGadget(55, 387, 8, 120 ,15,"")

TextGadget(56, 440, 8, 120 ,15, NO_Device)
SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)

PanelGadget (0, 160, 33, 370, 150)
;--------------------Случайный-------------------
AddGadgetItem (0, -1, "Случайный")
TrackBarGadget(18, 17, 6, 165, 35, 0, 18, #PB_TrackBar_Ticks)
TrackBarGadget(19, 17, 57, 165, 35, 0, 100, #PB_TrackBar_Ticks)
TrackBarGadget(20, 214, 80, 99, 43, 0, 18, #PB_TrackBar_Ticks)
ButtonGadget(21,320,87,23,23,"")
TextGadget(22, 17, 39, 50 ,18,"")
TextGadget(23, 17, 90, 50 ,13,"")
OptionGadget(13, 214, 3, 80, 20, "")
OptionGadget(14, 214, 23, 60, 20, "")
OptionGadget(15, 214, 43, 90, 20, "")
CheckBoxGadget(16, 214, 63, 70, 20, ""): SetGadgetState(16, #PB_Checkbox_Checked) 
CheckBoxGadget(17, 304, 63, 70, 20, ""): SetGadgetState(17, #PB_Checkbox_Checked)
;--------------------Время-------------------
AddGadgetItem (0, -1,"Время")
TrackBarGadget(8, 50, 16, 165, 35, 0, 300, #PB_TrackBar_Ticks)
TextGadget(51, 50, 50, 50 ,13,"")
OptionGadget(9, 250, 10, 60, 20, "")
OptionGadget(10, 250, 32, 60, 20, "")
OptionGadget(11, 250, 54, 60, 20, "")
CheckBoxGadget(12, 250, 76, 70, 20, "")
TextGadget(85, 90, 76, 90 ,13,"")
TextGadget(84, 110, 90, 90 ,13,"")
SetGadgetState(12, #PB_Checkbox_Checked)  
;--------------------Курс валют-------------------
AddGadgetItem (0, -1,"Курс валют")
CheckBoxGadget(25, 11, 9, 70, 13, "")
SetGadgetState(25, #PB_Checkbox_Checked) 
CheckBoxGadget(26, 89, 9, 60, 13, "")
SetGadgetState(26, #PB_Checkbox_Checked) 
OptionGadget(27, 11, 99, 95, 20, "")
OptionGadget(28, 115, 99, 90, 20, "")
TrackBarGadget(29, 10, 52, 142, 35, 0, 300, #PB_TrackBar_Ticks)
TextGadget(52, 10, 86, 50 ,13,"")
ComboBoxGadget(30, 10, 28, 142, 21)
AddGadgetItem(30, -1, "")
AddGadgetItem(30, -1, "")
SetGadgetState(30,0)
EditorGadget(31,158,7,200,90) 
SendMessage_(GadgetID(31),#EM_SETTARGETDEVICE, #Null, 0)
SetGadgetText(31,Many_uk())
;--------------------Текст-------------------
AddGadgetItem (0, -1,"Текст")
CheckBoxGadget(43, 7, 35, 70, 13, "")
SetGadgetState(43, #PB_Checkbox_Checked) 
CheckBoxGadget(44, 85, 35, 60, 13, "")
SetGadgetState(44, #PB_Checkbox_Checked) 
OptionGadget(45, 11, 99, 95, 20, "")
OptionGadget(46, 115, 99, 90, 20, "")
TextGadget(75, 10, 86, 50 ,13,"")
TrackBarGadget(47, 6, 51, 142, 35, 0, 300, #PB_TrackBar_Ticks)
ComboBoxGadget(48, 205, 98, 153, 21)
EditorGadget(49,158,7,200,90,#PB_Editor_ReadOnly)
SendMessage_(GadgetID(49),#EM_SETTARGETDEVICE, #Null, 0)
ButtonGadget(50,6,6,144,23,"")
;Получает полный путь запущенного приложения      
Result$ = ProgramFilename()
;Извлекает путь из полного пути. 
;Например, если полный путь "C:\PureBasic\PB.exe", результат будет "C:\PureBasic\". 
Path$ = GetPathPart(Result$)
; Просмотр всех элементов директории запущенного приложения  (без поддиректорий)
Directory$ = Path$   
;--------------------Погода-------------------
AddGadgetItem (0, -1,"Погода")
CheckBoxGadget(32, 11, 9, 70, 13, "")
SetGadgetState(32, #PB_Checkbox_Checked) 
CheckBoxGadget(33, 89, 9, 60, 13, "")
SetGadgetState(33, #PB_Checkbox_Checked) 
OptionGadget(34, 11, 84, 94, 20, "")
OptionGadget(35, 11, 102, 85, 20, "")
TrackBarGadget(36, 10, 52, 142, 35, 0, 300, #PB_TrackBar_Ticks)
ComboBoxGadget(#ComboBox_0, 10, 28, 142, 21)
ButtonImageGadget(37,110,90,40,30, CatchImage(37, ?Image_ButtonImage_1))
GadgetToolTip(37, "")  
EditorGadget(38,158,7,200,90)
OptionGadget(39, 160, 102, 30, 20, "6"): SetGadgetState(39, 1)
GadgetToolTip(39, "Прогноз на 6 часов")
OptionGadget(40, 215, 102, 40, 20, "12")
GadgetToolTip(40, "Прогноз на 12 часов")
OptionGadget(41, 270, 102, 40, 20, "18")
GadgetToolTip(41, "Прогноз на 18 часов")
OptionGadget(42, 325, 102, 40, 20, "24")
GadgetToolTip(42, "Прогноз на сутки")
;--------------------Спектр-------------------
AddGadgetItem (0, -1,"Спектр")
TrackBarGadget(7, 27, 16, 165, 35, 0, 18, #PB_TrackBar_Ticks)
TextGadget(76, 27, 51, 100 ,13,"")
OptionGadget(4, 250, 10, 60, 20, "")
OptionGadget(5, 250, 32, 60, 20, "")
OptionGadget(6, 250, 54, 60, 20, "")
CheckBoxGadget(24, 250, 76, 70, 20, "")
SetGadgetState(24, #PB_Checkbox_Checked)  
CloseGadgetList()

SetTimer_(WindowID(0), 2, 800, @FindDevice_Timer() )

;--------------------Чтение настроек-------------------
 OpenPreferences("setting.ini")
 ; PreferenceGroup("Window")
 SetGadgetState(90, ReadPreferenceLong("fr1", 0))   
 SetGadgetState(0, ReadPreferenceLong("fr2", 0)) 
 SetGadgetState(18, ReadPreferenceLong("fr3", 0)) 
 SetGadgetState(19, ReadPreferenceLong("fr4", 0)) 
 SetGadgetState(20, ReadPreferenceLong("fr5", 0)) 
 SetGadgetState(13, ReadPreferenceLong("fr6", 0))   
 SetGadgetState(14, ReadPreferenceLong("fr7", 0)) 
 SetGadgetState(15, ReadPreferenceLong("fr8", 0)) 
 SetGadgetState(16, ReadPreferenceLong("fr9", 0)) 
 SetGadgetState(17, ReadPreferenceLong("fr10", 0))
 SetGadgetState(8, ReadPreferenceLong("fr11", 0))   
 SetGadgetState(9, ReadPreferenceLong("fr12", 0)) 
 SetGadgetState(10, ReadPreferenceLong("fr13", 0)) 
 SetGadgetState(11, ReadPreferenceLong("fr14", 0)) 
 SetGadgetState(12, ReadPreferenceLong("fr15", 0))
 SetGadgetState(25, ReadPreferenceLong("fr16", 0)) 
 SetGadgetState(26, ReadPreferenceLong("fr17", 0)) 
 SetGadgetState(27, ReadPreferenceLong("fr18", 0)) 
 SetGadgetState(28, ReadPreferenceLong("fr19", 0))
 SetGadgetState(29, ReadPreferenceLong("fr20", 0)) 
 SetGadgetState(30, ReadPreferenceLong("fr21", 0))
 SetGadgetState(43, ReadPreferenceLong("fr22", 0)) 
 SetGadgetState(44, ReadPreferenceLong("fr23", 0)) 
 SetGadgetState(45, ReadPreferenceLong("fr24", 0))
 SetGadgetState(46, ReadPreferenceLong("fr25", 0)) 
 SetGadgetState(47, ReadPreferenceLong("fr26", 0))
 ProgramItitThread\text = ReadPreferenceLong("fr27", 0)
 SetGadgetState(32, ReadPreferenceLong("fr28", 0)) 
 SetGadgetState(33, ReadPreferenceLong("fr29", 0))
 SetGadgetState(34, ReadPreferenceLong("fr30", 0)) 
 SetGadgetState(35, ReadPreferenceLong("fr31", 0))
 SetGadgetState(36, ReadPreferenceLong("fr32", 0)) 
 SetGadgetState(39, ReadPreferenceLong("fr33", 0)) 
 SetGadgetState(40, ReadPreferenceLong("fr34", 0))
 SetGadgetState(41, ReadPreferenceLong("fr35", 0)) 
 SetGadgetState(42, ReadPreferenceLong("fr36", 0))
 ProgramItitThread\meteo=ReadPreferenceLong("fr37", 0)
 SetGadgetState(4, ReadPreferenceLong("fr38", 0)) 
 SetGadgetState(5, ReadPreferenceLong("fr39", 0))
 SetGadgetState(6, ReadPreferenceLong("fr40", 0)) 
 SetGadgetState(7, ReadPreferenceLong("fr41", 0))
 SetGadgetState(24, ReadPreferenceLong("fr42", 0))
 Put=ReadPreferenceString("fr43", "")
 ClosePreferences()

CreateThread(@ProgramItit_Thread(),ProgramItitThread)

If GetGadgetState(90)=0
  LoadText("rus.lng") 
  Else
  LoadText("eng.lng")
EndIf

If GetGadgetState(16)=0
  NOT_Flag = 0 
  Else
  NOT_Flag = 1
EndIf

If GetGadgetState(30)=0
  SetGadgetText(31,Many_uk()) 
  Else
  SetGadgetText(31,Many_ru())
EndIf
               
If OpenLibrary(1,"user32.dll")=0 ; Открываем файл "user32.dll", для использования его функций 
  MessageRequester(Lib1, Lib2 +#CRLF$+Lib3+" user32.dll", #MB_OK|#MB_ICONWARNING)
  EndIf
    CallFunction(1,"SetTimer",WindowID(0), 1, 500, @DateTime() ) ; Вызываем функцию "SetTimer"

HideWindow(0,0)

;--------------------Главный цикл---------------------
Repeat 
  
  Event= WaitWindowEvent() 
  Window=EventWindow() 
  Gadget=EventGadget()
  
  If Event = #PB_Event_SysTray 
    
    If EventType() = #PB_EventType_RightClick ; Обработка правой кнопки мышки 
         Write_setting()        
         Break
  ;    DisplayPopupMenu(68, WindowID(0)) ; показ вспывающего меню 
    EndIf 
    
    If EventType() = #PB_EventType_LeftClick ; Обработка левой кнопки мышки     
      HideWindow(0, 0)
      SetWindowState(0, #PB_Window_Normal) 
    EndIf
    
       If EventType() = #PB_EventType_LeftDoubleClick  ; Обработка двойного нажатия левой кнопки мышки    
      HideWindow(0, 1)
    EndIf
    
  EndIf 
  
  If Event = #PB_Event_Menu 
    Select EventMenu() 
      Case 1 ;"Добавить в автозагрузку"  
        ProgramAtStartup(1, "MODGET 8x8")
      Case 2 ;"Удалить из автозагрузки"
        ProgramAtStartup(0, "MODGET 8x8")
      Case 3 ;"О программе"
        Open_Window_1()  
     ; Case 5 ;"Свернуть" 
     ;   HideWindow(0, 1) 
     ; Case 10 ;"Выход"
     ;   Write_setting()        
     ;   Break
        
    EndSelect 
  EndIf 
  
  If Event=#PB_Event_MinimizeWindow ;Событие при сворачивании окна
    HideWindow(0,1) ;свернуть окно
  EndIf
  
 ;{-------Событие при закрытии окна-------
If Event=#PB_Event_CloseWindow  ;
          Write_setting() 
EndIf 
;}-------------------------------------

  
  ;{----------События компонентов----------

  
If Event=#PB_Event_Gadget
    
    Select EventGadget()
          
      Case 13
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
        
      Case 14
        KillTimer_(WindowID(0),2)
        Timer2()
        SetTimer_(WindowID(0),4,10, @Timer2())    
                
      Case 16
        NOT_Flag = GetGadgetState(16) 
        
      Case 18
        tp = GetGadgetState(18)
        
      Case 19
        pt = GetGadgetState(19)
        
     Case 30
        If EventType()=1
          Select GetGadgetState(30)
            Case 0
              SetGadgetText(31,Many_uk())
            Case 1
              SetGadgetText(31,Many_ru())
          EndSelect
        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)    
        
      Case 48
        If EventType() = 1 ; Выпадающий список закрылся
          Put=""
          File$ = Path$ + GetGadgetText(48)+".txt"
          Text=ReadText(File$)
          SetGadgetText(49,Text)
          EndIf
        
      Case 50
        File$ = OpenFileRequester(open, "", Maska , 0)
        If File$
          Put=File$
          Text=ReadText(File$)
          SetGadgetText(49,Text)
        EndIf
        
         Case 90
        If EventType()=1
          Select GetGadgetState(90)
            Case 0
              LoadText("rus.lng")
            Case 1
              LoadText("eng.lng")
          EndSelect
          EndIf
        
      Case 66
        CloseWindow(#Window_1)
        
      Case 100
        ProgramAtStartup(1, "MODGET 8x8")
        
      Case 101
        ProgramAtStartup(0, "MODGET 8x8")
        
      Case 102
        Open_Window_1()
        
    EndSelect
    
    
    
  EndIf 
  ;}-------------------------------------
  
Until Event = #PB_Event_CloseWindow ;Конец главного цикла

; Вызываем функцию "KillTimer"
  CallFunction(1,"KillTimer",WindowID(0),1)
   ; Закрываем файл "user32.dll".
  CloseLibrary(1)

;{ Included Data
DataSection
  Image_ButtonImage_1:
  IncludeBinary "refresh.ico"
  
  ImageSave:
  IncludeBinary "accept.png"
  
  ImageDelete:
  IncludeBinary "delete.png"
  
  ImageInformation:
  IncludeBinary "information.png"
  
  GismeteoCodSity_pak:
  IncludeBinary "GismeteoCodSity.pak"
  
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
  
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

Инверсия считывается, а эффект нет.
И как сделать калейдоскоп?
У Василия:

Код:

'Массив значений для калейдоскопа
    Private Kaleydos As Integer() = {0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60, _
                                       6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52, _
                                       5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44, _
                                       4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36}

Код:

'Kaleydoskop
        If RadioButton3.Checked = True Then

            'Уровень в каналах
            'Dim RetVal
            'RetVal = Bass.BASS_ChannelGetLevel(recChannel)
            '' Update ProgressBars
            'On Error Resume Next
            'pbLeft.Value = (Un4seen.Bass.Utils.HighWord(RetVal) / 500) 
            'pbRight.Value = (Un4seen.Bass.Utils.LowWord(RetVal) / 500)


            Dim flg_bass As Boolean
            If CheckBox7.Checked = True Then
                Timer1.Interval = 30
                Bass.BASS_ChannelGetData(recChannel, fft, BASSData.BASS_DATA_FFT4096)
                Dim Xxx As Integer
                zzz = 0
                For Xxx = 1 To 200
                    zzz += fft(Xxx)
                Next

                'Если уровень сигнала очень мал - то это шум! 
                If zzz >= 0.01 Then
                    'bass_detector
                    'следующий момент срабатывания зависит от уровня громкости и движка регулятора (zzz и TrackBar6)
                    If zzz_new > zzz Then
                        zzz_new = zzz_new - (0.1 * TrackBar6.Value * zzz)
                        Button5.BackColor = Color.Transparent
                        flg_bass = False
                    Else
                        zzz_new = zzz
                        Button5.BackColor = Color.Red
                        flg_bass = True
                    End If
                Else
                    flg_bass = True
                End If
            Else
                Timer1.Interval = TrackBar2.Value * 10
                flg_bass = True
            End If

            If flg_bass = True Then
                For i As Integer = 0 To 15
                    'Масса заполнения матрицы в зависимости от громкости (zzz)
                    If CheckBox7.Checked = True Then
                        Dim k = (zzz * 1.5) + 1
                        'If k < 1 Then k = 1
                        'If k > 18 Then k = 18
                        If zzz < 0.01 Then k = 0
                        random = Int(Rnd() * k) '(21 - TrackBar1.Value))
                    Else
                        random = Int(Rnd() * (21 - TrackBar1.Value))
                    End If


                    For j As Integer = 0 To 3
                        If random <= 1 Then
                            buf_USB(Kaleydos(4 * i + j)) = 1
                        Else
                            buf_USB(Kaleydos(4 * i + j)) = 0
                        End If

                    Next
                Next
                Dim col, row
                For col = 0 To 7
                    For row = 0 To 7
                        st_led = (8 * col + row)
                        ellipseRect = New Rectangle(x(st_led), y(st_led), 13, 13)
                        If buf_USB(st_led) = 1 Then
                            If CheckBox2.Checked = False Then
                                myPath1.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 0
                            Else
                                myPath.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 1
                            End If
                        Else
                            If CheckBox2.Checked = False Then
                                myPath.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 1
                            Else
                                myPath1.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 0
                            End If
                        End If
                    Next
                Next
                'flg_bass = False
            End If

        End If

Поделиться30419.07.2011 20:32:10

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Инверсия считывается, а эффект нет.

У меня эффекты переключаются.

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

И как сделать калейдоскоп?

Этот массив как обычно помещаем а ДатаСекцию.

Поделиться30519.07.2011 21:29:58

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

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

У меня эффекты переключаются.

У меня тоже. Снова не так выразился. Эффекты не переключаются после закрытия и открытия програамы.
Думаю надо добавить это:

Код:

If GetGadgetState(13)=1
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

If GetGadgetState(14)=1
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

Поделиться30619.07.2011 21:32:37

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

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

Думаю надо добавить это:

Не помогло.

Поделиться30719.07.2011 21:32:46

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Эффекты не переключаются после закрытия и открытия програамы.

Это все нужно предусмотреть в коде.
В зависимости от предыдущего сохраненного эффекта, активировать его.

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

Не помогло.

Может быть потому что для второго эффекта нужно использовать процедуру Timer2()?
Создавать программу нужно аккуратно и внимательно, иначе ошибок будет вагон и маленькая тележка!

Поделиться30819.07.2011 21:34:58

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

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

Этот массив как обычно помещаем а ДатаСекцию.

Это не проблема, проблема в том, как ихоттуда вытащить?

Поделиться30919.07.2011 21:37:51

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Это не проблема, проблема в том, как ихоттуда вытащить?

Код:

Index = 0 ; Номер байта в ДатаСекции.
Byte.a = PeekA(?Kaleydos+Index)

Поделиться31019.07.2011 21:39:16

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

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

Может быть потому что для второго эффекта нужно использовать процедуру Timer2()?

Это да, но все равно не помогло.

Поделиться31119.07.2011 21:41:52

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

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

Код:

Index = 0 ; Номер байта в ДатаСекции.
Byte.a = PeekA(?Kaleydos+Index)

Спасибо. А это надо оформить в процедуру?

Поделиться31219.07.2011 21:46:10

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

А это надо оформить в процедуру?

Не думаю что стоит это делать.
Ведь по факту только одна строка кода.

Поделиться31319.07.2011 21:54:15

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

Вот:

Код:

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

;{---------Запрет на запуск программы более одного раза-----------  
a = CreateSemaphore_(#Null,0,1,"MODGET 8x8") 
If a<>0 And GetLastError_()= #ERROR_ALREADY_EXISTS 
  CloseHandle_(a) 
  End 
EndIf 
;}---------------------------------------------------------------

;{-----------------------Enumeration------------------------------
Enumeration 
  #Window_0 
  #Window_1
  #Window_2
  #Window_3
  #ButtonImage_3
EndEnumeration 
;}

;{ Images 
Enumeration
  #Image_Image_1
  #Image_ButtonImage_1
  #Image_ButtonImage_2
  #Image_ButtonImage_3
EndEnumeration
UsePNGImageDecoder()
;}

;{ Gadgets
Enumeration
  #Button_2
  #ComboBox_0
EndEnumeration

Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}----------------------------------------------------------------

;{----------------------Глобальные переменные---------------------
#Window_0=0
Global NO_Device.s="отключен"                            ;сообщения программы
Global YES_Device.s="подключен"                          ;сообщения программы
Global About.s="О программе МОДЖЕТ 8x8"
Global Mod.s="МОДЖЕТ 8x8"
Global Ver.s="Версия 1.0"
Global open.s="Открыть файл"
Global Maska.s="Текстовые файлы (*.txt)|*.txt"
Global Lib1.s="Файл отсутствует!"
Global Lib2.s="Для отображения времени"
Global Lib3.s="требуется файл"
#USB_PID=$5555                              ;идентификатор PID
#USB_VID=$FFFF                               ;идентификатор VID
Global R_DeviceHandle, W_DeviceHandle 
Global Text.s
Global Put.s ;абсолютный путь к файлу

#XML        = 0

SityNew$="29838"; - Барнаул

pt.w = 2
tp.w
NOT_Flag.b = 0

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

Structure ProgramItitThread
  meteo.b
  text.b
EndStructure

G_Meteo_Info.MeteoInfo
G_Meteo_Info\State = -1

ProgramItitThread.ProgramItitThread
;}

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$+"г., "+ #CRLF$+weekday$+","+ #CRLF$+"на " + 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 DateTime() 
  ; Эта процедура вызывается по таймеру два раза в секунду.
  Time.s = FormatDate("%hh:%ii:%ss", Date() ) ; Узнаём текущее время
  SetGadgetText(84,Time)
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)+#CRLF$+ *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

Procedure ProgramAtStartup(State, ProgName.s) ; Управление автозагрузкой программы
valueName$=ProgramFilename() 
 GetHandle = RegOpenKeyEx_(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, #KEY_ALL_ACCESS, @hKey)
 If GetHandle = #ERROR_SUCCESS
  If State=1
   RegSetValueEx_(hKey, @ProgName, 0, #REG_SZ, @valueName$, Len(valueName$))
  Else
   RegDeleteValue_(hKey, @ProgName)
  EndIf
  RegCloseKey_(hKey)
 EndIf
EndProcedure

Procedure FindDevice_Timer() ; таймер - процедура проверки подключения нашего устройства
Static Old_Test
Test=HID_Lib_DeviceTest(#USB_PID, #USB_VID)
 If Test<>Old_Test
  Old_Test=Test 
  If Test 
     HID_Lib_CloseDevice(R_DeviceHandle) : HID_Lib_CloseDevice(W_DeviceHandle)
     W_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
     R_DeviceHandle=HID_Lib_OpenDevice(#USB_PID, #USB_VID)
      SetGadgetText(56, YES_Device)
      SetGadgetColor(56, #PB_Gadget_FrontColor, $00FF0F) 
    Else
     HID_Lib_CloseDevice(R_DeviceHandle) : HID_Lib_CloseDevice(W_DeviceHandle)
     R_DeviceHandle=0 : W_DeviceHandle=0
      SetGadgetText(56, NO_Device)
      SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)
    EndIf
  EndIf
  
EndProcedure

InitNetwork()

Structure DrawInfo
  row.c[8]
EndStructure

#xc = 20 ; начало по X
#yc = 20 ; начало по Y

CreateImage(80,148,148)

Procedure.s UTF2Ansi(str$) 
  str_in$=str$: len=Len(str_in$)+5: str_tmp$=Space(len*4) 
  CP_IN=65001; #CP_UTF8=65001
  CP_OUT=1251 
  MultiByteToWideChar_(CP_IN,0,@str_in$,len,@str_tmp$,len) 
  WideCharToMultiByte_(CP_OUT,0,@str_tmp$,len,@str_in$,len,0,0) 
  ProcedureReturn str_in$ 
EndProcedure

Procedure.s Many_ru()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected Dim Result$(0), ManyExpression.s
  Protected Pos
  
  Result = "Ошибка"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://www.cbr.ru/currency_base/D_print.aspx?date_req="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        Result = "Центральный банк Российской Федерации установил следующие курсы иностранных валют к рублю Российской Федерации  на " + Datas + ":" + Chr(10)
        Restore Many_ru
        For i=1 To 35
          Read.s Many
          Pos = FindString(Many, " ", 1)
          ManyExpression = Right(Many, Len(Many)-Pos)
          
          ManyExpression+"</td>" + #CRLF$ + "<td align="+Chr(34)+"right"+Chr(34)+">"
          Pos1 = FindString(html, ManyExpression, 1)
          If Pos1>0
            Pos1+Len(ManyExpression)
            Pos2 = FindString(html,"</td>",Pos1)
            If Pos2>0
              Result + " "+Many+" = "+Mid(html, Pos1, Pos2-Pos1) +" руб.;"
            EndIf
          EndIf
          
        Next i
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.s Many_uk()
  Protected Result.s, *mem, Many.s
  Protected url.s, Bytes, Datas.s, html.s
  Protected ManyExpression.s, Temp.s
  Protected Pos, Pos1, Pos2
  
  Result = "Помилка при розшифровці файлу"
  Datas = FormatDate("%dd.%mm.%yyyy",Date())
  url = "http://bank.gov.ua/Fin_ryn/OF_KURS/Currency/FindByDate.aspx?__EVENTARGUMENT=&__EVENTTARGET=&Text1="+Datas
  
  *mem = AllocateMemory(200000)
  If *mem
    Bytes = DownloadToMem(url, *mem, 200000)
    If Bytes
      html = UTF2Ansi(PeekS(*mem))
      If html<>""
        
        Pos = FindString(html, "<td>Офіційний курс</td>", 1)
        If Pos
          Pos1 = FindString(html, "</table>", Pos+Len("<td>Офіційний курс</td>"))
          If Pos1
            
            html=Mid(html, Pos, Pos1-Pos)
            
            Result = "Національний банк України. Середній курс гривні до іноземних валют на " + Datas + " становить:" + Chr(10)
            Restore Many_uk
            For i=1 To 27
              Read.s Many
              Pos = FindString(Many, " ", 1)
              ManyExpression = Right(Many, Len(Many)-Pos)
              ManyExpression + "</td>"
              Pos1 = FindString(html, ManyExpression, 1)
              If Pos1>0
                Pos1+Len(ManyExpression)
                Pos2 = FindString(html,"</td>",Pos1)
                If Pos2>0
                  
                  Temp.s=Mid(html, Pos1, Pos2-Pos1)
                  Pos = FindString(ReverseString(Temp),">", 1)
                  If Pos>0
                    Result + " "+Many+" = "+Mid(Temp, Len(Temp)-Pos+2)+" грн.;"
                  EndIf
                  
                EndIf
              EndIf
            Next i
            
          EndIf
        EndIf
      EndIf
    EndIf
    FreeMemory(*mem)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure Draw_Image(*Infa.DrawInfo)
  Shared NOT_Flag
  
  If StartDrawing(ImageOutput(80))
    Box(83,0,148,148,0) ; Очистка рисунка
    For col = 0 To 7
      For row = 0 To 7
        x = 20 + col * 15
        y = 20 + row * 15
        
        Temp.a = *Infa\row[row]
        If NOT_Flag = 1
          Temp = ~ Temp
        EndIf
        
        If Temp << col & %10000000
          Color = RGB(255, 102, 00)
        Else
          Color = RGB(102, 102, 102)
        EndIf
        Circle(x, y, 5, Color)
      Next
    Next
    StopDrawing()
  EndIf
  SetGadgetState(82, ImageID(80))
EndProcedure

Procedure Timer1()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
    
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=0 To 7
      For x=1 To 8
        If Random(20) - (20-tp) >= 0
          Draw\row[i] | 1
        Else
          Draw\row[i] & %11111110
        EndIf
        If x<8 : Draw\row[i]<<1 : EndIf
      Next x
    Next i  
    Draw_Image(Draw)

  Else
    pt_counter - 1
  EndIf
EndProcedure

Procedure Timer2()
  Shared pt_counter.w, pt, tp
  Static Draw.DrawInfo, i
  If pt_counter<=0
    
    pt_counter = pt
    
    For i=6 To 0 Step -1
      Draw\row[i+1] = Draw\row[i]
    Next i
    
    For x=1 To 8
      If Random(20) - (20-tp) >= 0
        Draw\row[0] | 1
      Else
        Draw\row[0] & %11111110
      EndIf
      If x<8 : Draw\row[0]<<1 : EndIf
    Next x
    
    Draw_Image(Draw)
    
  Else
    pt_counter - 1
  EndIf
EndProcedure

Procedure StreamFileIn_Callback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1 
EndProcedure 

Procedure FileStreamIn(Gadget, Files.s) 
  
  
  ;Procedure zum streamen einer Datei in das RichEdit 
  ;Control 
  
  Protected StreamData.EDITSTREAM 
  
  ;Wenn die Datei geцffnet werden kann, fortfahren.  
  If ReadFile(10, Files)    
    
    ;Das Handle der Datei speichern 
    StreamData\dwCookie = FileID(10) 
    StreamData\dwError = #Null 
    
    ;Die Adresse der Callback Procedure speichern 
    StreamData\pfnCallback = @StreamFileIn_Callback() 
    
    ;Das RichEdit Control anweisen, den Stream zu aktivieren 
    SendMessage_(GadgetID(Gadget), #EM_STREAMIN, #SF_RTF, @StreamData) 
    
    ;Datei schliessen 
    CloseFile(10) 
    
  EndIf 
  
EndProcedure

Procedure Open_Window_1()
  
  OpenWindow(1, 0, 0, 277, 247, About, #PB_Window_ScreenCentered );| #PB_Window_SystemMenu)
  
  EditorGadget(72,2,2,496,370,#PB_Editor_ReadOnly)
  SendMessage_(GadgetID(72), #EM_SETTARGETDEVICE, #Null, 0) ; Перенос по словам
  
  ;If
  LoadImage(70, "LOGO.bmp")    ; change 2nd parameter to the path/filename of your image
  ImageGadget(70,  6, 6, 235, 78, ImageID(70))                      ; imagegadget standard
  EditorGadget(72,95,46,176,170,#PB_Editor_ReadOnly)
  SendMessage_(GadgetID(72), #EM_SETTARGETDEVICE, #Null, 0) ; Перенос по словам 
  FileStreamIn(72, "Авторы.rtf")
  
  TextGadget(62,95,6,100,18,Mod)
  TextGadget(63,95,26,100,18,Ver)
  ;TextGadget(64,102,58,150,18,"Copyright © Radan 2011")
  ;TextGadget(65,102,82,100,18,"Radan Studio")
  
    Lang.s="ru"
  If GetGadgetState(90)=1
    Lang.s="en"
  EndIf
  FileStreamIn(72, Left(Lang, 2)+"_avtori.rtf")
  
  ButtonGadget(66,185,222,75,20,"OK")
  ;EndIf
EndProcedure

Procedure LoadText(File.s)
  
  cb1 = GetGadgetState(30) ; Это чтобы восстановить активные кункты в выпадающих списках.
  cb2 = GetGadgetState(48)
  cb3 = GetGadgetState(#ComboBox_0)
    
  OpenPreferences(File)
  PreferenceGroup("MainWin")
  SetWindowTitle(0,ReadPreferenceString("ac","МОДЖЕТ 8x8") )
  ToolBarToolTip(0, 1, ReadPreferenceString("ac1","Добавить в автозагрузку") )
  ToolBarToolTip(0, 2, ReadPreferenceString("ac2","Удалить из автозагрузки") )
  ToolBarToolTip(0, 3, ReadPreferenceString("ac3","О программе") )
  GadgetToolTip(90, ReadPreferenceString("ac4","Язык"))
  ;CreatePopupMenu(68)
  ;MenuItem(5, ReadPreferenceString("ac5","Свернуть")) 
  ;MenuBar() 
  ;MenuItem(10, ReadPreferenceString("ac6","Выход"))
  SetGadgetItemText(0,0, ReadPreferenceString("ac7","Случайный"))
  SetGadgetText(22,ReadPreferenceString("ac8","Пиксели") )
  SetGadgetText(23,ReadPreferenceString("ac9","Скорость") )
  SetGadgetText(13,ReadPreferenceString("ac10","Случайно") )
  SetGadgetText(14,ReadPreferenceString("ac11","Матрица") )
  SetGadgetText(15,ReadPreferenceString("ac12","Калейдоскоп") )
  SetGadgetText(16,ReadPreferenceString("ac13","Инверсия") )
  SetGadgetText(17,ReadPreferenceString("ac14","Звук") )
  SetGadgetItemText(0,1, ReadPreferenceString("ac15","Время"))
  SetGadgetText(51,ReadPreferenceString("ac16","Скорость") )
  SetGadgetText(9,ReadPreferenceString("ac17","Вид 1") )
  SetGadgetText(10,ReadPreferenceString("ac18","Вид 2") )
  SetGadgetText(11,ReadPreferenceString("ac19","Вид 3") )
  SetGadgetText(12,ReadPreferenceString("ac20","Инверсия") )
  SetGadgetItemText(0,2, ReadPreferenceString("ac21","Курс валют") )
  SetGadgetText(25,ReadPreferenceString("ac22","Инверсия") )
  SetGadgetText(26,ReadPreferenceString("ac23","Регистр") )
  SetGadgetText(27,ReadPreferenceString("ac24","Горизонтально") )
  SetGadgetText(28,ReadPreferenceString("ac25","Вертикально") )
  SetGadgetText(52,ReadPreferenceString("ac26","Скорость") )
  SetGadgetItemText(30,0, ReadPreferenceString("ac27","Украина") )
  SetGadgetItemText(30,1, ReadPreferenceString("ac28","Россия") )
  SetGadgetItemText(0,3, ReadPreferenceString("ac29","Текст") )
  SetGadgetText(43,ReadPreferenceString("ac30","Инверсия") )
  SetGadgetText(44,ReadPreferenceString("ac31","Регистр") )
  SetGadgetText(45,ReadPreferenceString("ac32","Горизонтально") )
  SetGadgetText(46,ReadPreferenceString("ac33","Вертикально") )
  SetGadgetText(50,ReadPreferenceString("ac34","Загрузить текст") )
  SetGadgetItemText(0,4, ReadPreferenceString("ac35","Погода") )
  SetGadgetText(32,ReadPreferenceString("ac36","Инверсия") )
  SetGadgetText(33,ReadPreferenceString("ac37","Регистр") )
  SetGadgetText(34,ReadPreferenceString("ac38","Горизонтально") )
  SetGadgetText(35,ReadPreferenceString("ac39","Вертикально") )
  SetGadgetItemText(0,5, ReadPreferenceString("ac40","Спектр") )
  SetGadgetText(4,ReadPreferenceString("ac41","Линия 1") )
  SetGadgetText(5,ReadPreferenceString("ac42","Линия 2") )
  SetGadgetText(6,ReadPreferenceString("ac43","Точка") )
  SetGadgetText(24,ReadPreferenceString("ac44","Инверсия") )
  NO_Device = ReadPreferenceString("ac45","отключен")
  YES_Device = ReadPreferenceString("ac46","подключен")
  If HID_Lib_DeviceTest(#USB_PID, #USB_VID)
    SetGadgetText(56, YES_Device)
    SetGadgetColor(56, #PB_Gadget_FrontColor, $00FF0F) 
  Else
    SetGadgetText(56, NO_Device)
    SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)
  EndIf
 SysTrayIconToolTip(67, ReadPreferenceString("ac47","МОДЖЕТ 8x8") )
 SetGadgetText(55,ReadPreferenceString("ac48","МОДЖЕТ ") )
 About = ReadPreferenceString("ac49","О программе МОДЖЕТ 8x8")
 Mod = ReadPreferenceString("ac50","МОДЖЕТ 8x8")
 Ver = ReadPreferenceString("ac51","Версия 1.0")
 open = ReadPreferenceString("ac52","Открыть файл")
 Maska = ReadPreferenceString("ac53","Текстовые файлы (*.txt)|*.txt")
 GadgetToolTip(39, ReadPreferenceString("ac54","Прогноз на 6 часов"))
 GadgetToolTip(40, ReadPreferenceString("ac55","Прогноз на 12 часов"))
 GadgetToolTip(41, ReadPreferenceString("ac56","Прогноз на 18 часов"))
 GadgetToolTip(42, ReadPreferenceString("ac57","Прогноз на сутки"))
 SetGadgetText(85,ReadPreferenceString("ac58","Текущее время") )
 GadgetToolTip(37,ReadPreferenceString("ac59","Обновить данные") )
 SetGadgetText(75,ReadPreferenceString("ac60","Скорость") )
 Lib1 = ReadPreferenceString("ac61","Файл отсутствует!")
 Lib2 = ReadPreferenceString("ac62","Для отображения времени")
 Lib3 = ReadPreferenceString("ac63","требуется файл") 
 SetGadgetText(76,ReadPreferenceString("ac64","Уровень сигнала") )
 ClosePreferences()
 
  SetGadgetState(30,cb1) ; Это чтобы восстановить активные кункты в выпадающих списках.
  SetGadgetState(48,cb2)
  SetGadgetState(#ComboBox_0,cb3)
 
EndProcedure

Procedure.s ReadText(File$)
  Protected Text.s = ""
  If ReadFile(0, File$) 
    Size = Lof(0); размер файла в байтах
    If Size>0
      *String = AllocateMemory(Size+10); выделяем область памяти 
      If *String 
        FillMemory(*String, Size+10, 0)
        FormatFile=ReadStringFormat(0) ; Определение кодировки файла (Ascii, UTF8 или Unicode).
        ReadData(0, *String , Size); записываем строку в область памяти
        FillMemory(*String+Size+1, 8, 0)
        Text.s=PeekS(*String, -1, FormatFile)
        FreeMemory(*String)
      EndIf
    EndIf
    CloseFile(0)
  EndIf
  ProcedureReturn Text
EndProcedure

Procedure UnPak(*pak)
 ; Процедура UnPak() распаковывает данные, упакованные функцией PackMemory()
; Процедуре нужно передать указатель на первый байт упакованных данных, например из DataSection
; При успешной распаковке, процедура вернет указатель на место нахождения распакованных данных
; Не забывайте освобождать память функцией FreeMemory когда распакованные данные больше не нужны
  *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

Procedure ProgramItit_Thread(*x.ProgramItitThread)
  
  ;Получает полный путь запущенного приложения      
  Result$ = ProgramFilename()
  ;Извлекает путь из полного пути. Например, если полный путь "C:\PureBasic\PB.exe", результат будет "C:\PureBasic\". 
  Path$ = GetPathPart(Result$)
  ;Debug Path$
  ; Просмотр всех элементов директории запущенного приложения  (без поддиректорий)
  Directory$ = Path$   
  If ExamineDirectory(0, Directory$, "*.txt")  
    ;m=0
    While NextDirectoryEntry(0)
      
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        AddGadgetItem(48, -1, Left(DirectoryEntryName(0), Len(DirectoryEntryName(0))-4))
      EndIf
      
      ;txt.s=Text + ".txt"
      
;       If DirectoryEntryName(0) = txt
;         
;       EndIf
      ;m=m+1      ;Debug DirectoryEntryName(0) ;+ Type$ + "- Size in byte: " + Str(DirectoryEntrySize(0))
    Wend
    FinishDirectory(0)
  EndIf
  SetGadgetState(48, *x\text)
  
  If Put=""
  File$ = Path$ + GetGadgetText(48)+".txt"
;  Debug File$
Else
  File$ = Put
 ; Debug File$
EndIf

If FileSize(File$)>0
  Text=ReadText(File$)
  SetGadgetText(49,Text)
EndIf
  
  ;time=ElapsedMilliseconds()
  *mem = UnPak(?GismeteoCodSity_pak)
  If *mem
    Text.s = PeekS(*mem)
    FreeMemory(*mem)
    
    ReplaceString(Text,Chr(13),Chr(10), #PB_String_InPlace)
    Text=ReplaceString(Text,Chr(10)+Chr(10),Chr(10))
    
    PosOld = 0
    Pos = FindString(Text, Chr(10), 1)
    x=0
    *PointString = @Text
    While Pos
      String.s=PeekS(*PointString+PosOld, Pos-PosOld-1)
      AddGadgetItem(#ComboBox_0, x,String)
      PosOld=Pos
      x+1
      Pos = FindString(Text, Chr(10), PosOld+1)
      If Pos =< 0
        Break
      EndIf
    Wend
    SetGadgetState(#ComboBox_0,*x\meteo)
  EndIf
  
  SityNew$= Left(GetGadgetText(#ComboBox_0), 5)
  If Len(SityNew$)
    GetMeteo(SityNew$)
  EndIf
  
  ;Debug ElapsedMilliseconds()-time
EndProcedure

Procedure Write_setting() ;Запись в файл настроек
 If OpenPreferences("setting.ini")
  WritePreferenceLong ("fr1", GetGadgetState (90))
  WritePreferenceLong ("fr2", GetGadgetState (0))
  WritePreferenceLong ("fr3", GetGadgetState (18))
  WritePreferenceLong ("fr4", GetGadgetState (19))
  WritePreferenceLong ("fr5", GetGadgetState (20))
  WritePreferenceLong ("fr6", GetGadgetState (13))
  WritePreferenceLong ("fr7", GetGadgetState (14))
  WritePreferenceLong ("fr8", GetGadgetState (15))
  WritePreferenceLong ("fr9", GetGadgetState (16))
  WritePreferenceLong ("fr10", GetGadgetState (17))
  WritePreferenceLong ("fr11", GetGadgetState (8))
  WritePreferenceLong ("fr12", GetGadgetState (9))
  WritePreferenceLong ("fr13", GetGadgetState (10))
  WritePreferenceLong ("fr14", GetGadgetState (11))
  WritePreferenceLong ("fr15", GetGadgetState (12))
  WritePreferenceLong ("fr16", GetGadgetState (25))
  WritePreferenceLong ("fr17", GetGadgetState (26))
  WritePreferenceLong ("fr18", GetGadgetState (27))
  WritePreferenceLong ("fr19", GetGadgetState (28))
  WritePreferenceLong ("fr20", GetGadgetState (29))
  WritePreferenceLong ("fr21", GetGadgetState (30))
  WritePreferenceLong ("fr22", GetGadgetState (43))
  WritePreferenceLong ("fr23", GetGadgetState (44))
  WritePreferenceLong ("fr24", GetGadgetState (45))
  WritePreferenceLong ("fr25", GetGadgetState (46))
  WritePreferenceLong ("fr26", GetGadgetState (47))
  WritePreferenceLong ("fr27", GetGadgetState (48))
  WritePreferenceLong ("fr28", GetGadgetState (32))
  WritePreferenceLong ("fr29", GetGadgetState (33))
  WritePreferenceLong ("fr30", GetGadgetState (34))
  WritePreferenceLong ("fr31", GetGadgetState (35))
  WritePreferenceLong ("fr32", GetGadgetState (36))
  WritePreferenceLong ("fr33", GetGadgetState (39))
  WritePreferenceLong ("fr34", GetGadgetState (40))
  WritePreferenceLong ("fr35", GetGadgetState (41))
  WritePreferenceLong ("fr36", GetGadgetState (42))
  WritePreferenceLong ("fr37", GetGadgetState (#ComboBox_0))
  WritePreferenceLong ("fr38", GetGadgetState (4))
  WritePreferenceLong ("fr39", GetGadgetState (5))
  WritePreferenceLong ("fr40", GetGadgetState (6))
  WritePreferenceLong ("fr41", GetGadgetState (7))
  WritePreferenceLong ("fr42", GetGadgetState (24))
  WritePreferenceString ("fr43", Put)
  ClosePreferences()
  EndIf
EndProcedure

Image.DrawInfo
;--------------------Окно программы---------------------
OpenWindow(0, 0, 0, 535, 186, "МОДЖЕТ 8x8", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
;--------------------Кнопки-------------------
ContainerGadget(95,0,0,97,30, #PB_Container_BorderLess)
  If CreateToolBar(0, GadgetID(95))
    ToolBarSeparator()
    ToolBarImageButton(1, CatchImage(1, ?ImageSave))
    ToolBarToolTip(0, 1, "Добавить в автозагрузку")
    ToolBarSeparator()
    ToolBarImageButton(2, CatchImage(2, ?ImageDelete))
    ToolBarToolTip(0, 2, "Удалить из автозагрузки")
    ToolBarSeparator()
    ToolBarImageButton(3, CatchImage(3, ?ImageInformation))
    ToolBarToolTip(0, 3, "О программе")
    ToolBarSeparator()
  EndIf
  CloseGadgetList()
;--------------------Язык-------------------
ComboBoxGadget(90,200,3,70,22)
GadgetToolTip(90, "")
AddGadgetItem(90,-1,"Русский")
AddGadgetItem(90,-1,"English")
SetGadgetState(90,0)


ImageGadget(82,6, 33,148,148,ImageID(80))
Draw_Image(@Image)
SetTimer_(WindowID(0),4,100, @Timer1() )

;-----------Системный трей----------- 
AddSysTrayIcon(67, WindowID(0), ExtractIcon_(0,ProgramFilename(),0))
SysTrayIconToolTip(67, "МОДЖЕТ 8x8") 
;Добавим к иконке меню
CreatePopupMenu(68) 
;MenuItem(4, "Развернуть") 
MenuItem(5, "") 
MenuBar() 
MenuItem(10, "")   

TextGadget(55, 387, 8, 120 ,15,"")

TextGadget(56, 440, 8, 120 ,15, NO_Device)
SetGadgetColor(56, #PB_Gadget_FrontColor, $0000FF)

PanelGadget (0, 160, 33, 370, 150)
;--------------------Случайный-------------------
AddGadgetItem (0, -1, "Случайный")
TrackBarGadget(18, 17, 6, 165, 35, 0, 18, #PB_TrackBar_Ticks)
TrackBarGadget(19, 17, 57, 165, 35, 0, 100, #PB_TrackBar_Ticks)
TrackBarGadget(20, 214, 80, 99, 43, 0, 18, #PB_TrackBar_Ticks)
ButtonGadget(21,320,87,23,23,"")
TextGadget(22, 17, 39, 50 ,18,"")
TextGadget(23, 17, 90, 50 ,13,"")
OptionGadget(13, 214, 3, 80, 20, "")
OptionGadget(14, 214, 23, 60, 20, "")
OptionGadget(15, 214, 43, 90, 20, "")
CheckBoxGadget(16, 214, 63, 70, 20, ""): SetGadgetState(16, #PB_Checkbox_Checked) 
CheckBoxGadget(17, 304, 63, 70, 20, ""): SetGadgetState(17, #PB_Checkbox_Checked)
;--------------------Время-------------------
AddGadgetItem (0, -1,"Время")
TrackBarGadget(8, 50, 16, 165, 35, 0, 300, #PB_TrackBar_Ticks)
TextGadget(51, 50, 50, 50 ,13,"")
OptionGadget(9, 250, 10, 60, 20, "")
OptionGadget(10, 250, 32, 60, 20, "")
OptionGadget(11, 250, 54, 60, 20, "")
CheckBoxGadget(12, 250, 76, 70, 20, "")
TextGadget(85, 90, 76, 90 ,13,"")
TextGadget(84, 110, 90, 90 ,13,"")
SetGadgetState(12, #PB_Checkbox_Checked)  
;--------------------Курс валют-------------------
AddGadgetItem (0, -1,"Курс валют")
CheckBoxGadget(25, 11, 9, 70, 13, "")
SetGadgetState(25, #PB_Checkbox_Checked) 
CheckBoxGadget(26, 89, 9, 60, 13, "")
SetGadgetState(26, #PB_Checkbox_Checked) 
OptionGadget(27, 11, 99, 95, 20, "")
OptionGadget(28, 115, 99, 90, 20, "")
TrackBarGadget(29, 10, 52, 142, 35, 0, 300, #PB_TrackBar_Ticks)
TextGadget(52, 10, 86, 50 ,13,"")
ComboBoxGadget(30, 10, 28, 142, 21)
AddGadgetItem(30, -1, "")
AddGadgetItem(30, -1, "")
SetGadgetState(30,0)
EditorGadget(31,158,7,200,90) 
SendMessage_(GadgetID(31),#EM_SETTARGETDEVICE, #Null, 0)
SetGadgetText(31,Many_uk())
;--------------------Текст-------------------
AddGadgetItem (0, -1,"Текст")
CheckBoxGadget(43, 7, 35, 70, 13, "")
SetGadgetState(43, #PB_Checkbox_Checked) 
CheckBoxGadget(44, 85, 35, 60, 13, "")
SetGadgetState(44, #PB_Checkbox_Checked) 
OptionGadget(45, 11, 99, 95, 20, "")
OptionGadget(46, 115, 99, 90, 20, "")
TextGadget(75, 10, 86, 50 ,13,"")
TrackBarGadget(47, 6, 51, 142, 35, 0, 300, #PB_TrackBar_Ticks)
ComboBoxGadget(48, 205, 98, 153, 21)
EditorGadget(49,158,7,200,90,#PB_Editor_ReadOnly)
SendMessage_(GadgetID(49),#EM_SETTARGETDEVICE, #Null, 0)
ButtonGadget(50,6,6,144,23,"")
;Получает полный путь запущенного приложения      
Result$ = ProgramFilename()
;Извлекает путь из полного пути. 
;Например, если полный путь "C:\PureBasic\PB.exe", результат будет "C:\PureBasic\". 
Path$ = GetPathPart(Result$)
; Просмотр всех элементов директории запущенного приложения  (без поддиректорий)
Directory$ = Path$   
;--------------------Погода-------------------
AddGadgetItem (0, -1,"Погода")
CheckBoxGadget(32, 11, 9, 70, 13, "")
SetGadgetState(32, #PB_Checkbox_Checked) 
CheckBoxGadget(33, 89, 9, 60, 13, "")
SetGadgetState(33, #PB_Checkbox_Checked) 
OptionGadget(34, 11, 84, 94, 20, "")
OptionGadget(35, 11, 102, 85, 20, "")
TrackBarGadget(36, 10, 52, 142, 35, 0, 300, #PB_TrackBar_Ticks)
ComboBoxGadget(#ComboBox_0, 10, 28, 142, 21)
ButtonImageGadget(37,110,90,40,30, CatchImage(37, ?Image_ButtonImage_1))
GadgetToolTip(37, "")  
EditorGadget(38,158,7,200,90)
OptionGadget(39, 160, 102, 30, 20, "6"): SetGadgetState(39, 1)
GadgetToolTip(39, "Прогноз на 6 часов")
OptionGadget(40, 215, 102, 40, 20, "12")
GadgetToolTip(40, "Прогноз на 12 часов")
OptionGadget(41, 270, 102, 40, 20, "18")
GadgetToolTip(41, "Прогноз на 18 часов")
OptionGadget(42, 325, 102, 40, 20, "24")
GadgetToolTip(42, "Прогноз на сутки")
;--------------------Спектр-------------------
AddGadgetItem (0, -1,"Спектр")
TrackBarGadget(7, 27, 16, 165, 35, 0, 18, #PB_TrackBar_Ticks)
TextGadget(76, 27, 51, 100 ,13,"")
OptionGadget(4, 250, 10, 60, 20, "")
OptionGadget(5, 250, 32, 60, 20, "")
OptionGadget(6, 250, 54, 60, 20, "")
CheckBoxGadget(24, 250, 76, 70, 20, "")
SetGadgetState(24, #PB_Checkbox_Checked)  
CloseGadgetList()

SetTimer_(WindowID(0), 2, 800, @FindDevice_Timer() )

;--------------------Чтение настроек-------------------
 OpenPreferences("setting.ini")
 ; PreferenceGroup("Window")
 SetGadgetState(90, ReadPreferenceLong("fr1", 0))   
 SetGadgetState(0, ReadPreferenceLong("fr2", 0)) 
 SetGadgetState(18, ReadPreferenceLong("fr3", 0)) 
 SetGadgetState(19, ReadPreferenceLong("fr4", 0)) 
 SetGadgetState(20, ReadPreferenceLong("fr5", 0)) 
 SetGadgetState(13, ReadPreferenceLong("fr6", 0))   
 SetGadgetState(14, ReadPreferenceLong("fr7", 0)) 
 SetGadgetState(15, ReadPreferenceLong("fr8", 0)) 
 SetGadgetState(16, ReadPreferenceLong("fr9", 0)) 
 SetGadgetState(17, ReadPreferenceLong("fr10", 0))
 SetGadgetState(8, ReadPreferenceLong("fr11", 0))   
 SetGadgetState(9, ReadPreferenceLong("fr12", 0)) 
 SetGadgetState(10, ReadPreferenceLong("fr13", 0)) 
 SetGadgetState(11, ReadPreferenceLong("fr14", 0)) 
 SetGadgetState(12, ReadPreferenceLong("fr15", 0))
 SetGadgetState(25, ReadPreferenceLong("fr16", 0)) 
 SetGadgetState(26, ReadPreferenceLong("fr17", 0)) 
 SetGadgetState(27, ReadPreferenceLong("fr18", 0)) 
 SetGadgetState(28, ReadPreferenceLong("fr19", 0))
 SetGadgetState(29, ReadPreferenceLong("fr20", 0)) 
 SetGadgetState(30, ReadPreferenceLong("fr21", 0))
 SetGadgetState(43, ReadPreferenceLong("fr22", 0)) 
 SetGadgetState(44, ReadPreferenceLong("fr23", 0)) 
 SetGadgetState(45, ReadPreferenceLong("fr24", 0))
 SetGadgetState(46, ReadPreferenceLong("fr25", 0)) 
 SetGadgetState(47, ReadPreferenceLong("fr26", 0))
 ProgramItitThread\text = ReadPreferenceLong("fr27", 0)
 SetGadgetState(32, ReadPreferenceLong("fr28", 0)) 
 SetGadgetState(33, ReadPreferenceLong("fr29", 0))
 SetGadgetState(34, ReadPreferenceLong("fr30", 0)) 
 SetGadgetState(35, ReadPreferenceLong("fr31", 0))
 SetGadgetState(36, ReadPreferenceLong("fr32", 0)) 
 SetGadgetState(39, ReadPreferenceLong("fr33", 0)) 
 SetGadgetState(40, ReadPreferenceLong("fr34", 0))
 SetGadgetState(41, ReadPreferenceLong("fr35", 0)) 
 SetGadgetState(42, ReadPreferenceLong("fr36", 0))
 ProgramItitThread\meteo=ReadPreferenceLong("fr37", 0)
 SetGadgetState(4, ReadPreferenceLong("fr38", 0)) 
 SetGadgetState(5, ReadPreferenceLong("fr39", 0))
 SetGadgetState(6, ReadPreferenceLong("fr40", 0)) 
 SetGadgetState(7, ReadPreferenceLong("fr41", 0))
 SetGadgetState(24, ReadPreferenceLong("fr42", 0))
 Put=ReadPreferenceString("fr43", "")
 ClosePreferences()

CreateThread(@ProgramItit_Thread(),ProgramItitThread)

If GetGadgetState(90)=0
  LoadText("rus.lng") 
  Else
  LoadText("eng.lng")
EndIf

If GetGadgetState(16)=0
  NOT_Flag = 0 
  Else
  NOT_Flag = 1
EndIf

If GetGadgetState(13)=1
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

If GetGadgetState(14)=0
        KillTimer_(WindowID(0),2)
        Timer2()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

If GetGadgetState(30)=0
  SetGadgetText(31,Many_uk()) 
  Else
  SetGadgetText(31,Many_ru())
EndIf
               
If OpenLibrary(1,"user32.dll")=0 ; Открываем файл "user32.dll", для использования его функций 
  MessageRequester(Lib1, Lib2 +#CRLF$+Lib3+" user32.dll", #MB_OK|#MB_ICONWARNING)
  EndIf
    CallFunction(1,"SetTimer",WindowID(0), 1, 500, @DateTime() ) ; Вызываем функцию "SetTimer"

HideWindow(0,0)

;--------------------Главный цикл---------------------
Repeat 
  
  Event= WaitWindowEvent() 
  Window=EventWindow() 
  Gadget=EventGadget()
  
  If Event = #PB_Event_SysTray 
    
    If EventType() = #PB_EventType_RightClick ; Обработка правой кнопки мышки 
         Write_setting()        
         Break
  ;    DisplayPopupMenu(68, WindowID(0)) ; показ вспывающего меню 
    EndIf 
    
    If EventType() = #PB_EventType_LeftClick ; Обработка левой кнопки мышки     
      HideWindow(0, 0)
      SetWindowState(0, #PB_Window_Normal) 
    EndIf
    
       If EventType() = #PB_EventType_LeftDoubleClick  ; Обработка двойного нажатия левой кнопки мышки    
      HideWindow(0, 1)
    EndIf
    
  EndIf 
  
  If Event = #PB_Event_Menu 
    Select EventMenu() 
      Case 1 ;"Добавить в автозагрузку"  
        ProgramAtStartup(1, "MODGET 8x8")
      Case 2 ;"Удалить из автозагрузки"
        ProgramAtStartup(0, "MODGET 8x8")
      Case 3 ;"О программе"
        Open_Window_1()  
     ; Case 5 ;"Свернуть" 
     ;   HideWindow(0, 1) 
     ; Case 10 ;"Выход"
     ;   Write_setting()        
     ;   Break
        
    EndSelect 
  EndIf 
  
  If Event=#PB_Event_MinimizeWindow ;Событие при сворачивании окна
    HideWindow(0,1) ;свернуть окно
  EndIf
  
 ;{-------Событие при закрытии окна-------
If Event=#PB_Event_CloseWindow  ;
          Write_setting() 
EndIf 
;}-------------------------------------

  
  ;{----------События компонентов----------

  
If Event=#PB_Event_Gadget
    
    Select EventGadget()
          
      Case 13
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
        
      Case 14
        KillTimer_(WindowID(0),2)
        Timer2()
        SetTimer_(WindowID(0),4,10, @Timer2())  
        
      Case 15
        KillTimer_(WindowID(0),2)
        For z=0 To 63
        ;Index = 0 ; Номер байта в ДатаСекции.
;Byte.a = PeekA(?Kaleydos+Index)
Byte.a = PeekA(?Kaleydos+z)
    Next z            
      Case 16
        NOT_Flag = GetGadgetState(16) 
        
      Case 18
        tp = GetGadgetState(18)
        
      Case 19
        pt = GetGadgetState(19)
        
     Case 30
        If EventType()=1
          Select GetGadgetState(30)
            Case 0
              SetGadgetText(31,Many_uk())
            Case 1
              SetGadgetText(31,Many_ru())
          EndSelect
        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)    
        
      Case 48
        If EventType() = 1 ; Выпадающий список закрылся
          Put=""
          File$ = Path$ + GetGadgetText(48)+".txt"
          Text=ReadText(File$)
          SetGadgetText(49,Text)
          EndIf
        
      Case 50
        File$ = OpenFileRequester(open, "", Maska , 0)
        If File$
          Put=File$
          Text=ReadText(File$)
          SetGadgetText(49,Text)
        EndIf
        
         Case 90
        If EventType()=1
          Select GetGadgetState(90)
            Case 0
              LoadText("rus.lng")
            Case 1
              LoadText("eng.lng")
          EndSelect
          EndIf
        
      Case 66
        CloseWindow(#Window_1)
        
      Case 100
        ProgramAtStartup(1, "MODGET 8x8")
        
      Case 101
        ProgramAtStartup(0, "MODGET 8x8")
        
      Case 102
        Open_Window_1()
        
    EndSelect
    
    
    
  EndIf 
  ;}-------------------------------------
  
Until Event = #PB_Event_CloseWindow ;Конец главного цикла

; Вызываем функцию "KillTimer"
  CallFunction(1,"KillTimer",WindowID(0),1)
   ; Закрываем файл "user32.dll".
  CloseLibrary(1)

;{ Included Data
DataSection
  Image_ButtonImage_1:
  IncludeBinary "refresh.ico"
  
  ImageSave:
  IncludeBinary "accept.png"
  
  ImageDelete:
  IncludeBinary "delete.png"
  
  ImageInformation:
  IncludeBinary "information.png"
  
  GismeteoCodSity_pak:
  IncludeBinary "GismeteoCodSity.pak"
  
  Kaleydos:
  Data.l 0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60
  Data.l 6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52
  Data.l 5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44
  Data.l 4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36
   
  Many_ru:
  Data.s "1 Австралийский доллар", "1 Азербайджанский манат", "1000 Армянских драмов", "10000 Белорусских рублей"
  Data.s "1 Болгарский лев", "1 Бразильский реал", "100 Венгерских форинтов ", "1000 Вон Республики Корея"
  Data.s "10 Датских крон", "1 Доллар США", "1 Евро", "100 Индийских рупий", "100 Казахских тенге"
  Data.s "1 Канадский доллар", "100 Киргизских сомов", "10 Китайских юаней", "1 Латвийский лат"
  Data.s "1 Литовский лит", "10 Молдавских леев", "10 Новых румынских леев", "10 Новых туркменских манатов"
  Data.s "10 Норвежских крон", "1 Польский злотый", "1 СДР (специальные права заимствования)", "1 Сингапурский доллар"
  Data.s "10 Таджикских сомони", "1 Турецкая лира", "1000 Узбекских сумов", "10 Украинских гривен"
  Data.s "1 Фунт стерлингов Соединенного королевства", "10 Чешских крон", "10 Шведских крон", "1 Швейцарский франк"
  Data.s "10 Южноафриканских рэндов", "100 Японских иен"
  
  Many_uk:
  Data.s "100 австралійських доларів", "100 азербайджанських манатів", "100 англійських фунтів стерлінгів", "10 білоруських рублів"
  Data.s "100 датських крон", "100 доларів США", "100 ЄВРО ", "100 ісландських крон"
  Data.s "100 казахстанських тенге", "100 канадських доларів", "100 латвійських латів", "100 литовських літів", "100 молдовських леїв"
  Data.s "100 норвезьких крон", "100 польських злотих", "10 російських рублів", "100 сінгапурських доларів"
  Data.s "100 СПЗ", "100 турецьких лір", "100 туркменських манатів", "1000 угорських форинтів"
  Data.s "100 узбецьких сумів", "100 чеських крон", "100 шведських крон", "100 швейцарських франків"
  Data.s "100 юанів женьміньбі (Китай)", "1000 японських єн"
EndDataSection

Я что-то опять не допонял? :dontknow:

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Я что-то опять не допонял?

А можно уточнять что именно не допонял и желательно в мельчайший подробностях.
Это позволит сократить время поиска причины.

Поделиться31520.07.2011 19:16:10

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

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

А можно уточнять что именно не допонял

Первое.

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

Пётр написал(а):
Может быть потому что для второго эффекта нужно использовать процедуру Timer2()?
Это да, но все равно не помогло.

Сделал так перед главным циклом:

Код:

If GetGadgetState(13)=1
        KillTimer_(WindowID(0),2)
        Timer1()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

If GetGadgetState(14)=1
        KillTimer_(WindowID(0),2)
        Timer2()
        SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

Запоминается еффект "матрица", а отображается все равно случайный. В чем может быть пробдема?
Второе.

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

max написал(а):
Это не проблема, проблема в том, как ихоттуда вытащить?
Код:Index = 0 ; Номер байта в ДатаСекции.
Byte.a = PeekA(?Kaleydos+Index)

Вот что я сделал, а оно не работает:

Код:

      Case 15
        KillTimer_(WindowID(0),2)
        For z=0 To 63
        ;Index = 0 ; Номер байта в ДатаСекции.
;Byte.a = PeekA(?Kaleydos+Index)
Byte.a = PeekA(?Kaleydos+z)
    Next z

Код:

  Kaleydos:
  Data.l 0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60
  Data.l 6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52
  Data.l 5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44
  Data.l 4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36

Не работает, как мне кажется, потому, что я не использую Byte.a. А как это сделать, я не понял.

Отредактировано max (20.07.2011 19:16:38)

Поделиться31620.07.2011 19:30:17

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Сделал так перед главным циклом:

Извини конечно, но ты ничего не сделал.
Выделил красным ошибку

If GetGadgetState(13)=1
KillTimer_(WindowID(0),2)
Timer1()
SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

If GetGadgetState(14)=1
KillTimer_(WindowID(0),2)
Timer2()
SetTimer_(WindowID(0),4,10, @Timer1())
EndIf

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

Не работает, как мне кажется, потому, что я не использую Byte.a. А как это сделать, я не понял.

А как нужно использовать?

Поделиться31720.07.2011 19:41:49

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

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

Выделил красным ошибку

Поменял Timer1() на Timer2(), а @Timer2() забыл. Сейчас работает. Спасибо.

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

А как нужно использовать?

В том то и дело, что это только мое предположение.

Отредактировано max (20.07.2011 19:43:39)

Поделиться31822.07.2011 22:52:05

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

Всем привет!
Исправил данные:

Код:

  Kaleydos:
  Data.a 0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60
  Data.a 6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52
  Data.a 5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44
  Data.a 4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36

Байта достаточно.

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

А как нужно использовать?

Думаю в процедуре, наподобии Timer1() и Timer2().

Поделиться31923.07.2011 12:22:05

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

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

Думаю в процедуре, наподобии Timer1() и Timer2().

Это понятно.
Алгоритм работы нужен.

Поделиться32024.07.2011 19:16:04

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

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

Алгоритм работы нужен.

Могу предложить только этот:

Код:

'Kaleydoskop
        If RadioButton3.Checked = True Then

            'Уровень в каналах
            'Dim RetVal
            'RetVal = Bass.BASS_ChannelGetLevel(recChannel)
            '' Update ProgressBars
            'On Error Resume Next
            'pbLeft.Value = (Un4seen.Bass.Utils.HighWord(RetVal) / 500) 
            'pbRight.Value = (Un4seen.Bass.Utils.LowWord(RetVal) / 500)


            Dim flg_bass As Boolean
            If CheckBox7.Checked = True Then
                Timer1.Interval = 30
                Bass.BASS_ChannelGetData(recChannel, fft, BASSData.BASS_DATA_FFT4096)
                Dim Xxx As Integer
                zzz = 0
                For Xxx = 1 To 200
                    zzz += fft(Xxx)
                Next

                'Если уровень сигнала очень мал - то это шум! 
                If zzz >= 0.01 Then
                    'bass_detector
                    'следующий момент срабатывания зависит от уровня громкости и движка регулятора (zzz и TrackBar6)
                    If zzz_new > zzz Then
                        zzz_new = zzz_new - (0.1 * TrackBar6.Value * zzz)
                        Button5.BackColor = Color.Transparent
                        flg_bass = False
                    Else
                        zzz_new = zzz
                        Button5.BackColor = Color.Red
                        flg_bass = True
                    End If
                Else
                    flg_bass = True
                End If
            Else
                Timer1.Interval = TrackBar2.Value * 10
                flg_bass = True
            End If

            If flg_bass = True Then
                For i As Integer = 0 To 15
                    'Масса заполнения матрицы в зависимости от громкости (zzz)
                    If CheckBox7.Checked = True Then
                        Dim k = (zzz * 1.5) + 1
                        'If k < 1 Then k = 1
                        'If k > 18 Then k = 18
                        If zzz < 0.01 Then k = 0
                        random = Int(Rnd() * k) '(21 - TrackBar1.Value))
                    Else
                        random = Int(Rnd() * (21 - TrackBar1.Value))
                    End If


                    For j As Integer = 0 To 3
                        If random <= 1 Then
                            buf_USB(Kaleydos(4 * i + j)) = 1
                        Else
                            buf_USB(Kaleydos(4 * i + j)) = 0
                        End If

                    Next
                Next
                Dim col, row
                For col = 0 To 7
                    For row = 0 To 7
                        st_led = (8 * col + row)
                        ellipseRect = New Rectangle(x(st_led), y(st_led), 13, 13)
                        If buf_USB(st_led) = 1 Then
                            If CheckBox2.Checked = False Then
                                myPath1.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 0
                            Else
                                myPath.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 1
                            End If
                        Else
                            If CheckBox2.Checked = False Then
                                myPath.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 1
                            Else
                                myPath1.AddEllipse(ellipseRect)
                                buf_USB(st_led) = 0
                            End If
                        End If
                    Next
                Next
                'flg_bass = False
            End If

        End If

Поделиться32125.07.2011 17:59:44

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

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

Алгоритм работы нужен

Написал Василию, жду ответа.

Поделиться32225.07.2011 20:27:04

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

Василий написал(а):

Там ничего сложного нет. Делим матрицу 8х8 на 4 квадрата размером 4х4. Далее получаем 16 случайных чисел - 1 и 0. От регулятора зависит, сколько в этом массиве из 16 чисел будет выпадать нулей или единиц - от этого зависит заполнение матрицы. Далее этот массив (квадрат) вращаем вокруг центра матрицы 8х8 - переносим данные на следующие 3 квадрата.

Как это реализовать? :dontknow:

Отредактировано max (25.07.2011 20:29:04)

Поделиться32325.07.2011 20:38:54

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

Не понятно как с этим связать массив.

Код:

  Kaleydos:
  Data.a 0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60
  Data.a 6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52
  Data.a 5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44
  Data.a 4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36

Поделиться32425.07.2011 21:50:49

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

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

Не понятно как с этим связать массив.

Судя по коду это все-таки данные для отправки в USB:

Код:

For j As Integer = 0 To 3
                        If random <= 1 Then
                            buf_USB(Kaleydos(4 * i + j)) = 1
                        Else
                            buf_USB(Kaleydos(4 * i + j)) = 0
                        End If

Отредактировано max (25.07.2011 21:51:39)

Поделиться32527.07.2011 20:19:55

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

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

Привет.
В коде есть строчки:

Код:

'Массив значений для калейдоскопа 
  Private Kaleydos As Integer() = {0, 7, 56, 63, 1, 15, 48, 62, 2, 23, 40, 61, 3, 31, 32, 60, _ 
                                                    6, 8, 55, 57, 9, 14, 49, 54, 10, 22, 41, 53, 11, 30, 33, 52, _ 
                                                    5, 16, 47, 58, 13, 17, 46, 50, 18, 21, 42, 45, 19, 29, 34, 44, _ 
                                                    4, 24, 39, 59, 12, 25, 38, 51, 20, 26, 37, 43, 27, 28, 35, 36}

Это данные для отправки в USB или что-то другое?

Василий написал(а):

Как раз этот массив и определяет симметрию из 16 в 64. Т.е. если первый бит в квадрате 4х4 нужно зажигать, зажигаем 0, 7, 56, 63 - угловые светодиоды. Если второй нужно зажигать, зажигаем 1, 15, 48, 62 и т.д. Чтобы каждый раз не считать, разрисовал в тетрадке в клетку и составил этот массив. Получается 16 четверостиший

Поделиться32628.07.2011 18:45:03

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

Привет..
Судя по всему массив надо переделывать, только не могу понять как данные сформировать. Подскажите куда копать? :dontknow:

Поделиться32729.07.2011 18:24:03

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

Есть какие-нибудь идеи?

Поделиться32829.07.2011 21:19:06

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

Лично я сейчас занят и свободного времени очень мало.
Странно что больше никто не помогает.

Поделиться32930.07.2011 00:34:10

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2944
Уважение: [+96/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 9 дней
Последний визит:
18.04.2024 17:14:34

Калейдоскоп это один из эффектов, а не обязательная часть программы, поэтому, думаю что стоит пока что продолжить добавлять остальные функции, а потом, когда немного освобожусь - добьем этот калейдоскоп.

Поделиться33030.07.2011 09:52:08

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

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

думаю что стоит пока что продолжить добавлять остальные функции, а потом

Я этим сейчас и занимаюсь.

Страница: « 1 … 9 10 11 12 13 14 15 »

PureBasic - форум

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

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

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

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

Сообщений 301 страница 330 из 446

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

Поделиться30214.07.2011 22:22:39

Поделиться30317.07.2011 19:52:36

Поделиться30419.07.2011 20:32:10

Поделиться30519.07.2011 21:29:58

Поделиться30619.07.2011 21:32:37

Поделиться30719.07.2011 21:32:46

Поделиться30819.07.2011 21:34:58

Поделиться30919.07.2011 21:37:51

Поделиться31019.07.2011 21:39:16

Поделиться31119.07.2011 21:41:52

Поделиться31219.07.2011 21:46:10

Поделиться31319.07.2011 21:54:15

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

Поделиться31520.07.2011 19:16:10

Поделиться31620.07.2011 19:30:17

Поделиться31720.07.2011 19:41:49

Поделиться31822.07.2011 22:52:05

Поделиться31923.07.2011 12:22:05

Поделиться32024.07.2011 19:16:04

Поделиться32125.07.2011 17:59:44

Поделиться32225.07.2011 20:27:04

Поделиться32325.07.2011 20:38:54

Поделиться32425.07.2011 21:50:49

Поделиться32527.07.2011 20:19:55

Поделиться32628.07.2011 18:45:03

Поделиться32729.07.2011 18:24:03

Поделиться32829.07.2011 21:19:06

Поделиться32930.07.2011 00:34:10

Поделиться33030.07.2011 09:52:08

Похожие темы