PureBasic - форум |
Привет, Гость! Войдите или зарегистрируйтесь.
Вы здесь » PureBasic - форум » Вопросы по PureBasic » Вопросы новичка
Правильней организовать цикл так.
ForEach zapisi()
If zapisi()=""
Break ; Прерывание цикла
EndIf
AddGadgetItem(#ListIcon_1,1,zapisi())
NextНе подскажете как открыв файл командой OpenFile удалить все его содержимое?
Используй в место OpenFile, функцию, CreateFile.
Это полностью очистит существующий файл.
Есть такой вопрос: почему при проигрывании звука (mp3 песни) не получается воспользоваться командой LoadSound? Все работает только с использованием LoadMovie 
почему при проигрывании звука (mp3 песни) не получается воспользоваться командой LoadSound
Потому что не поддерживается MP3 формат.
Подскажите пожалуйста, в проектах часто вижу незнакомые коды, внизу они отображаются в виде подсказки, но при нажатии F1 ничего не происходит. Поэтому не могу понять смысл тех или иных участков. Например в ниже написанной процедуре переменной присваивается непонятная мне команда:
Procedure OGG_Load(Nb,file.s)
;i=mciSendString_("open Sequencer!"+Chr(34)+file+Chr(34)+" alias mid"+Str(Nb),0,0,0)
i=mciSendString_("OPEN "+Chr(34)+file+Chr(34)+" Type MPEGVIDEO ALIAS OGG"+Str(Nb),0,0,0)
If i=0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedureОтредактировано daiomik (11.04.2010 13:05:20)
mciSendString_ все функции, заканчивающиеся знаком _ это API и в справке их нет, пока по крайней мере
Спасибо. Из предыдущего вопроса вытекает следующий. Во всех найденных мной примерах по использованию трек бара для плеера используется API огромным кодом. Может есть пример в котором просто показано, как прикрутить полосу прокрутка к проигрыванию песни
Вот хелп по API функциям http://pure-basic.narod.ru/miscfiles/API_Help.rar
Чтобы он вызывался по F1, содержимое архива нужно извлечь в папку с PureBasic
Может есть пример в котором просто показано, как прикрутить полосу прокрутки к проигрыванию песни
Ползунок "Position"
Enumeration 0
#MP3_Unknown
#MP3_Stopped
#MP3_Playing
#MP3_Paused
EndEnumeration
Procedure MP3_GetStatus(Nb)
Result=#MP3_Unknown
a$=Space(#MAX_PATH)
i=mciSendString_("status MP3_"+Str(Nb)+" mode",@a$,#MAX_PATH,0)
If i=0
Debug a$
Select a$
Case "stopped":Result=#MP3_Stopped
Case "playing":Result=#MP3_Playing
Case "paused":Result=#MP3_Paused
EndSelect
EndIf
ProcedureReturn Result
EndProcedure
Procedure MP3_Load(Nb,file.s)
;i=mciSendString_("open Sequencer!"+Chr(34)+file+Chr(34)+" alias mid"+Str(Nb),0,0,0)
i=mciSendString_("OPEN "+Chr(34)+file+Chr(34)+" Type MPEGVIDEO ALIAS MP3_"+Str(Nb),0,0,0)
If i=0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure MP3_Play(Nb)
i=mciSendString_("play MP3_"+Str(Nb),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_PlayStart(Nb)
i=mciSendString_("play MP3_"+Str(Nb)+" from "+Str(0),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_PlayPart(Nb,Start,endPos)
i=mciSendString_("play MP3_"+Str(Nb)+" from "+Str(Start)+" to "+Str(endPos),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_Pause(Nb)
i=mciSendString_("pause MP3_"+Str(Nb),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_Resume(Nb)
i=mciSendString_("resume MP3_"+Str(Nb),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_Stop(Nb)
i=mciSendString_("stop MP3_"+Str(Nb),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_Free(Nb)
i=mciSendString_("close MP3_"+Str(Nb),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_SetVolume(Nb,volume)
i=mciSendString_("SetAudio MP3_"+Str(Nb)+" volume to "+Str(volume),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_GetVolume(Nb)
a$=Space(#MAX_PATH)
i=mciSendString_("status MP3_"+Str(Nb)+" volume",@a$,#MAX_PATH,0)
ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_SetSpeed(Nb,Tempo)
i=mciSendString_("set MP3_"+Str(Nb)+" Speed "+Str(Tempo),0,0,0)
ProcedureReturn i
EndProcedure
Procedure MP3_GetSpeed(Nb)
a$=Space(#MAX_PATH)
i=mciSendString_("status MP3_"+Str(Nb)+" Speed",@a$,#MAX_PATH,0)
ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_GetLength(Nb)
a$=Space(#MAX_PATH)
i=mciSendString_("status MP3_"+Str(Nb)+" length",@a$,#MAX_PATH,0)
ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_GetPosition(Nb)
a$=Space(#MAX_PATH)
i=mciSendString_("status MP3_"+Str(Nb)+" position",@a$,#MAX_PATH,0)
ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_Seek(Nb,pos)
i=mciSendString_("Seek MP3_"+Str(Nb)+" to "+Str(pos),0,0,0)
ProcedureReturn i
EndProcedure
Procedure.s MP3_TimeString(Time)
Time/1000
sek=Time%60:Time/60
min=Time%60:Time/60
ProcedureReturn RSet(Str(Time),2,"0")+":"+RSet(Str(min),2,"0")+":"+RSet(Str(sek),2,"0")
EndProcedure
;Example
Enumeration 1
#gadget_File
#Gadget_VolumeTxt
#Gadget_Volume
#Gadget_SpeedTxt
#Gadget_Speed
#Gadget_PositionTxt
#Gadget_Position
#Gadget_Load
#Gadget_Play
#Gadget_Stop
#Gadget_Pause
#Gadget_Resume
EndEnumeration
Procedure SetVol(x)
SetGadgetText(#Gadget_VolumeTxt,"Volume:"+Str(x))
SetGadgetState(#Gadget_Volume,x)
EndProcedure
Procedure SetSpeed(x)
SetGadgetText(#Gadget_SpeedTxt,"Speed:"+Str(x))
SetGadgetState(#Gadget_Speed,x)
EndProcedure
Procedure SetPosition(x,max)
SetGadgetText(#Gadget_PositionTxt,"Position:"+MP3_TimeString(x)+" : "+MP3_TimeString(max))
If max>0
SetGadgetState(#Gadget_Position,x*1000/max)
Else
SetGadgetState(#Gadget_Position,0)
EndIf
EndProcedure
If OpenWindow(0, 100, 200, 310,310, "Simple MP3-Player", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(0))
top=5
TextGadget (#gadget_File ,5,top,300,20,"File:"):top+25
TextGadget (#Gadget_VolumeTxt, 5,top,300,20,"Volume"):top+20
TrackBarGadget(#Gadget_Volume ,5,top,300,25,0,100):top+30
TextGadget (#Gadget_SpeedTxt ,5,top,300,20,"Speed"):top+20
TrackBarGadget(#Gadget_Speed ,5,top,300,25,0,200):top+30
TextGadget (#Gadget_PositionTxt,5,top,300,20,"Position"):top+20
TrackBarGadget(#Gadget_Position ,5,top,300,25,0,1000):top+30
ButtonGadget (#Gadget_Load ,5,top,300,20,"Load"):top+25
ButtonGadget (#Gadget_Play ,5,top,300,20,"Play"):top+25
ButtonGadget (#Gadget_Pause ,5,top,300,20,"Pause"):top+25
ButtonGadget (#Gadget_Resume ,5,top,300,20,"Resume"):top+25
ButtonGadget (#Gadget_Stop ,5,top,300,20,"Stop"):top+25
loaded=#False
Quit=#False
Repeat
EventID.l = WindowEvent()
Select EventID
Case 0
If loaded And max>0
x=MP3_GetPosition(1)
If GetGadgetState(#Gadget_Position)<>x*1000/max
SetPosition(x,max)
EndIf
EndIf
Delay(100)
Case #PB_Event_CloseWindow ; If the user has pressed on the close button
Quit=#True
Case #PB_Event_Gadget
Select EventGadget()
Case #Gadget_Load
File$=OpenFileRequester("","","Media (Wave,MP3,OGG)|*.wav;*.ogg;*.mp3|Wave|*.wav|mp3|*.mp3|OGG|*.OGG|ALL|*.*",0)
If File$<>""
If loaded
MP3_Free(1)
loaded=#False
EndIf
If MP3_Load(1,File$)
max=MP3_GetLength(1)
SetVol(MP3_GetVolume(1)/10)
SetSpeed(MP3_GetSpeed(1)/10)
SetPosition(0,max)
loaded=#True
SetGadgetText(#gadget_File,"File:"+File$)
Else
SetGadgetText(#gadget_File,"File")
EndIf
EndIf
Case #Gadget_Resume
If loaded
MP3_Resume(1)
EndIf
Case #Gadget_Pause
If loaded
MP3_Pause(1)
EndIf
Case #Gadget_Play
If loaded
MP3_Play(1)
EndIf
Case #Gadget_Stop
If loaded
MP3_Stop(1)
EndIf
Case #Gadget_Position
If loaded And max>0
x=GetGadgetState(#Gadget_Position)*max/1000
SetPosition(x,max)
MP3_Seek(1,x)
MP3_Resume(1)
EndIf
Case #Gadget_Volume
If loaded
x=GetGadgetState(#Gadget_Volume)
SetVol(x)
MP3_SetVolume(1,x*10)
EndIf
Case #Gadget_Speed
If loaded
x=GetGadgetState(#Gadget_Speed)
SetSpeed(x)
MP3_SetSpeed(1,x*10)
EndIf
EndSelect
EndSelect
Until Quit
If loaded
MP3_Stop(1)
MP3_Free(1)
EndIf
EndIf
EndIf
EndСтранно, но во всех справочниках которые у меня были и который скинул выше мне Петр я не нашел команды mciSendString_. Может ни так ищу?
То, чего нет в справичниках, есть в гугле
Вот здесь есть немного инфы на русском http://pure-basic.narod.ru/miscfiles/API.rar
Ищи функцию mciSendString
Спасибо огромное
Всю справку по ButtonImageGadget перерыл вроде, неужели нельзя узнать номер изображения, которое туда загружено? То есть загрузил LoadImage(0,"фото") послал в гаджет, а как потом узнать какой номер в этом гаджете. GadgetId() не подходит цифра шестизначная. А у меня загружены два фото под номерами 0 и 1. По усмотрению их надо менять. Мне бы хотелось без извратов таким образом: a ! 1
Можно хранить номер изображения в переменной, а можно в самой кнопке, используя функции GetGadgetData и SetGadgetData
Можно хранить номер изображения в переменной, а можно в самой кнопке, используя функции GetGadgetData и SetGadgetData
Об этом я думал, просто мне казалось, что возможно выуживать номер фото. Ну что же придется добавить немного лишнего кода.
Ну как можно выудить номер, если кнопке передаётся не он, а SysID рисунка?
Здравствуйте. Подскажите как правильно освободить массив. ИМЯ_МАССИВА() не получается.
Здравствуйте. Подскажите как правильно освободить массив. ИМЯ_МАССИВА() не получается.
Dim ИМЯ_МАССИВА()
Пример:
Dim tt.b(22) For q=0 To 22 tt(q)=55 Next Dim tt.b(22) For q=0 To 22 Debug tt(q) Next
Подскажите как правильно освободить массив
Что-то не понял вопроса.
Как в Пурике пользоваться таймером(секундомером), верней как его создать и проверять его события? Или API снова использовать нужно?
Функция AddWindowTimer()
Спасибо
Как в Пурике пользоваться таймером(секундомером), верней как его создать и проверять его события?
Создаём таймер с помощью строки AddWindowTimer(#Window, Timer, Timeout)
Потом, отслеживаем событие в таймере #PB_Event_Timer и узнаём в какой таймере произошло событие с помощью EventTimer()
Когда таймер больше не нужен, то уничтожаем его с помощью строки
RemoveWindowTimer(#Window, Timer)
Вот пример использования таймера - отображается текущее время в окне
OpenWindow(0,20,20,100,50,"Таймер",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
TextGadget(0,30,16,50,16,FormatDate("%hh:%ii:%ss", Date() ))
AddWindowTimer(0,1,1000) ; Создание таймера
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_Timer
If EventTimer()=1
SetGadgetText(0, FormatDate("%hh:%ii:%ss", Date() ) )
EndIf
EndIf
Until Event=#PB_Event_CloseWindow
RemoveWindowTimer(0, 1)Но при необходимости, всё это можно сделать с помощью API.
Но при необходимости, всё это можно сделать с помощью API.
не в коем случае)) так намного легче, спасибо
на этой строчки ошибка вылетает:
AddWindowTimer(0,1,1000) ; Создание таймера
Что-то не понял вопроса.
Пётр я всё мучаюсь с той прогой по которой задавал вопрос здесь. Не придумав, ни чего лучшего чем пересылать папку предварительно сжав её в один файл (код подсмотрел в код архиве), проблема в следующем : когда запускаеш прогу она пересылает пакпку как положено, а последующие папки пересылает добавляя к ней предыдущие, я так понимаю что адреса этих папок хранятся в массиве но как его освободить я не пойму.
Enumeration
#Window
#Menu_Nad_Ikonkoi
#Kartinka
#Ikonka
#Gad_Kart
#Monitor
#Okno_Vibora
#ProgressBar
#Panel_Gadget
#IP_Add_Gad_1
#IP_Add_Gad_2
#Port_Gad_1
#Port_Gad_2
#Imia_Gad_1
#Imia_Gad_2
#Knopka_Sohranit_1
#Knopka_Vpered_2
#Knopka_Otpravit_1
#Knopka_Otpravit_2
#Knopka_Otmena_1
#Knopka_Otmena_2
#Knopka_Otmena_3
#Knopka_Otmena_4
#Knopka_Udalit_1
#Knopka_Udalit_2
#Knopka_Nazad_2
#List_Icon_Gadget
#Editor_Gadget
#Explorer_List_Gadget
#Menu_Skrit
#Menu_Poluchatel
#Menu_Soobshenia
#Menu_Faili
#Menu_Nastr
#Menu_Vihod
EndEnumeration
Port = 6000
Structure Dannie
DliaProgressa.l
Vkladka.l
Port.u
IP_Klienta.s
Filename.s
Directory.s
EndStructure
V_Proceduru.Dannie
ExamineDesktops()
Shirina_Monitora = DesktopWidth(0)
Visota_Monitora = DesktopHeight(0)
W_X = Shirina_Monitora - 130
W_Y = Visota_Monitora - 170
Skr_Otob.a = 0
Nazvanie_Papki_Sohranenia.s = "Папка для сохранения\"
Imia_Faila_Nastroek.s = "Настройки.ini"
Global NewList Soobshenia.s()
AddElement(Soobshenia())
Soobshenia() = "ПРИВЕТ"
Global Tekushaia_Direktoria.s = GetCurrentDirectory()
ID_Tekushei_Papki = ExamineDirectory(#PB_Any, Tekushaia_Direktoria, "")
If ID_Tekushei_Papki > 0
While NextDirectoryEntry(ID_Tekushei_Papki)
Imia_Proverka$ = DirectoryEntryName(ID_Tekushei_Papki)
If Imia_Proverka$ = "Папка для сохранения"
Proverka_Papki_Dlia_Sohranenia = 1
EndIf
Wend
If Proverka_Papki_Dlia_Sohranenia <> 1
CreateDirectory("Папка для сохранения")
EndIf
; FinishDirectory(ID_Tekushei_Papki)
EndIf
Global Papka_Dlia_Sohranenia.s = GetCurrentDirectory() + Nazvanie_Papki_Sohranenia
Global Imia_Faila_Poluchatelei.s = "Контакты.ini"
Global Dim Dirlist$(10000)
Global Dim Filelist$(10000)
Global Dim Filecnt(10000)
Global curfile$
Global prog.f
Global Stepnum
Global filenum
Global gesFiles.l
Global dirnum
Global fsz.f
Global comp
Global runone
Global rootlen
Global Compl=0 ;коэфициент сжатия
Procedure GetList(root$, Start)
If runone = 0
filenum = 0
dirnum = 0
rootlen = Len(root$)
runone = 1
EndIf
If Right(root$,1)<>"\" : root$+"\" : EndIf
If ExamineDirectory(Start, root$, "")
While NextDirectoryEntry(Start)
Type=FileSize(root$+ DirectoryEntryName(Start))
If Type = -2 ;Directory
If DirectoryEntryName(Start) <> "." And DirectoryEntryName(Start) <> ".."
dirnum = dirnum + 1
If root$ = ""
Dirlist$(dirnum) = DirectoryEntryName(Start) + "\"
GetList(Dirlist$(dirnum), Start+1)
Else
Dirlist$(dirnum) = root$ + DirectoryEntryName(Start) + "\"
GetList(Dirlist$(dirnum), Start+1)
EndIf
EndIf
ElseIf Type >0 ;File
Filecnt(Start) = Filecnt(Start) + 1
gesFiles + 1
Filelist$(gesFiles) = root$ + DirectoryEntryName(Start)
EndIf
Wend
EndIf
; Dim Dirlist$(10000)
; Dim Filelist$(10000)
; Dim Filecnt(10000)
EndProcedure
Procedure makepack(packname$, folder$)
curfile$ = packname$
If Right(folder$, 1) <> "\"
folder$ = folder$ + "\"
EndIf
GetList(folder$, 1)
b = CreateFile(1,"index.dir")
WriteStringN(1,Str(dirnum))
For a = 1 To dirnum
WriteStringN(1,Right(Dirlist$(a),Len(Dirlist$(a)) - rootlen))
WriteStringN(1,Str(Filecnt(a)))
Next
CloseFile(1)
b = CreateFile(1,"index.fil")
WriteStringN(1,Str(gesFiles))
For a = 1 To gesFiles
WriteStringN(1,Right(Filelist$(a),Len(Filelist$(a)) - rootlen))
Next
CloseFile(1)
b = CreatePack(packname$)
b = AddPackFile("index.dir", Compl)
b = AddPackFile("index.fil", Compl)
b = DeleteFile("index.dir")
b = DeleteFile("index.fil")
For filenum = 1 To gesFiles
fsz = FileSize(Filelist$(filenum ))
b = AddPackFile(Filelist$(filenum ),Compl)
Next
b = ClosePack()
; Dim Dirlist$(dirnum)
; Dim Filelist$(gesFiles)
; Dim Filecnt(dirnum)
EndProcedure
Procedure UnPack(packname$, dest$)
If Right(dest$,1) <> "\"
dest$ = dest$ + "\"
EndIf
If dest$ = "\"
dest$ = ""
EndIf
c = OpenPack(packname$)
memloca = NextPackFile()
FileLength = PackFileSize()
b = CreateFile(1,"index.dir")
WriteData(1,memloca,FileLength)
CloseFile(1)
memloca = NextPackFile()
FileLength = PackFileSize()
b = CreateFile(1,"index.fil")
WriteData(1,memloca,FileLength)
CloseFile(1)
b = OpenFile(1,"index.dir")
dirnum = Val(ReadString(1))
For a = 1 To dirnum
Dirlist$(a) = ReadString(1)
Filecnt(a) = Val(ReadString(1))
Next a
CloseFile(1)
b = DeleteFile("index.dir")
b = OpenFile(1,"index.fil")
filenum = Val(ReadString(1))
For a = 1 To filenum
Filelist$(a) = ReadString(1)
Next a
CloseFile(1)
b = DeleteFile("index.fil")
b = CreateDirectory(dest$)
For a = 1 To dirnum
b = CreateDirectory(dest$ + Dirlist$(a))
Next a
For a = 1 To filenum
memloca = NextPackFile()
FileLength = PackFileSize()
If CreateFile(1,dest$ + Filelist$(a))
WriteData(1,memloca,FileLength)
CloseFile(1)
EndIf
Next a
b = ClosePack()
; Dim Dirlist$(dirnum)
; Dim Filelist$(filenum)
; Dim Filecnt(dirnum)
EndProcedure
Procedure Zapolnenie_Lista_poluchatelei()
If OpenPreferences(Tekushaia_Direktoria + Imia_Faila_Poluchatelei) = 0
If CreatePreferences(Tekushaia_Direktoria+Imia_Faila_Poluchatelei) = 0
MessageRequester("СООБЩЕНИЕ!", "Не удалось создать файл"+Chr(10)+"для сохранения записей!", #MB_OK)
ProcedureReturn
EndIf
Else
ExaminePreferenceGroups()
While NextPreferenceGroup() <> 0
Group$ = PreferenceGroupName()
ExaminePreferenceKeys()
While NextPreferenceKey() <> 0
Key$ = PreferenceKeyName()
Value$ = PreferenceKeyValue()
AddGadgetItem(#List_Icon_Gadget, -1, Value$+Chr(10)+Group$+Chr(10)+Key$)
AddGadgetItem(#Imia_Gad_2, -1, Value$)
Wend
Wend
ClosePreferences()
EndIf
EndProcedure
Procedure Otpravka_faila (*V_Procedure.Dannie)
IP_Klienta2$ = *V_Procedure\IP_Klienta
Port2 = *V_Procedure\Port
Directory$ = *V_Procedure\Directory
Filename$ = "2?" + *V_Procedure\Filename
ConnectionID = OpenNetworkConnection(IP_Klienta2$, Port2)
If ConnectionID
Debug ConnectionID
SendNetworkString(ConnectionID, Filename$)
Delay (50)
info=SendNetworkFile(ConnectionID, Directory$)
Select info
Case 0
MessageRequester("Внимане!", "Не удалось отправить файл!", 0)
Case 1
Debug "Файл отправлен !"
EndSelect
CloseNetworkConnection(ConnectionID)
Else
MessageRequester("Внимане!", "Не удалось подключиться к клиенту!", 0)
EndIf
Delay (300)
EndProcedure
Procedure Otpravka_papki (*V_Procedure.Dannie)
IP_Klienta2$ = *V_Procedure\IP_Klienta
Port2 = *V_Procedure\Port
Filename$ = "3?" + *V_Procedure\Filename
ConnectionID = OpenNetworkConnection(IP_Klienta2$, Port2)
If ConnectionID
Debug ConnectionID
SendNetworkString(ConnectionID, Filename$)
Delay (50)
info=SendNetworkFile(ConnectionID, Tekushaia_Direktoria + *V_Procedure\Filename)
Select info
Case 0
MessageRequester("Внимане!", "Не удалось отправить файл!", 0)
Case 1
Debug "Файл отправлен !"
EndSelect
CloseNetworkConnection(ConnectionID)
Else
MessageRequester("Внимане!", "Не удалось подключиться к клиенту!", 0)
EndIf
EndProcedure
Procedure Otpravka_soobshenia (*V_Procedure.Dannie)
IP_Klienta2$ = *V_Procedure\IP_Klienta
Port2 = *V_Procedure\Port
Filename$ = "1?" + *V_Procedure\Filename
ConnectionID = OpenNetworkConnection(IP_Klienta2$, Port2)
If ConnectionID
Debug ConnectionID
SendNetworkString(ConnectionID, Filename$)
CloseNetworkConnection(ConnectionID)
Else
MessageRequester("Внимане!", "Не удалось подключиться к клиенту!", 0)
EndIf
EndProcedure
Procedure SET()
;обработка событий сети
Static Postupivshaia_Stroka.s , Opredelenie.s , ImiaFaila.s, Fail_Ili_Papka.l
SEvent = NetworkServerEvent()
If SEvent
ClientID = EventClient()
Select SEvent
Case #PB_NetworkEvent_Connect
Debug "новый клиент подключился !"
Case #PB_NetworkEvent_Data
*Buffer = AllocateMemory(1000)
Begun = 1
ReceiveNetworkData(ClientID, *Buffer, 1000)
Postupivshaia_Stroka = PeekS(*Buffer)
FreeMemory(*Buffer)
Opredelenie = StringField(Postupivshaia_Stroka, 1, "?")
ImiaFaila = StringField(Postupivshaia_Stroka, 2, "?")
Debug Opredelenie
Debug ImiaFaila
Select Opredelenie
Case "1"
AddElement(Soobshenia())
Soobshenia() = ImiaFaila
Case "2"
Fail_Ili_Papka = 1
Case "3"
Fail_Ili_Papka = 2
EndSelect
Case #PB_NetworkEvent_File
Debug ImiaFaila
ReceiveNetworkFile(ClientID, Papka_Dlia_Sohranenia + ImiaFaila)
Begun = 1
Select Fail_Ili_Papka
Case 2
UnPack(Papka_Dlia_Sohranenia + ImiaFaila, Papka_Dlia_Sohranenia + StringField(ImiaFaila, 1, "."))
DeleteFile(Papka_Dlia_Sohranenia + ImiaFaila)
; Case 1
; CopyFile(Tekushaia_Direktoria + ImiaFaila, Papka_Dlia_Sohranenia + ImiaFaila)
EndSelect
; DeleteFile(Tekushaia_Direktoria + ImiaFaila)
Fail_Ili_Papka = 0
Postupivshaia_Stroka = ""
Case #PB_NetworkEvent_Disconnect
Debug "Client "+Str(ClientID)+" выкючен"
Debug StringField(ImiaFaila, 1, ".")
EndSelect
EndIf
ProcedureReturn Begun
EndProcedure
Procedure Okno_Vibora (*V_Procedure.Dannie)
*V_Procedure\DliaProgressa = 0
SetGadgetState (#ProgressBar, 0)
Vkladka = *V_Procedure\Vkladka
If OpenWindow(#Okno_Vibora, 0, 0, 390, 390, "СЕТЕВОЕ ОБЩЕНИЕ", #PB_Window_ScreenCentered)
StickyWindow(#Okno_Vibora, 1)
FontID1 = LoadFont(#PB_Any, "Arial", 10, #PB_Font_Bold)
PanelGadget (#Panel_Gadget, 1, 1, 390, 390)
AddGadgetItem (#Panel_Gadget, -1, " ПОЛУЧАТЕЛЬ ")
IPAddressGadget(#IP_Add_Gad_1, 163, 2, 147, 25)
SetGadgetFont(#IP_Add_Gad_1, FontID1)
StringGadget(#Port_Gad_1, 311, 2, 70, 25, "6000", #PB_String_Numeric)
SetGadgetFont(#Port_Gad_1, FontID1)
StringGadget(#Imia_Gad_1, 2, 2, 160, 25, "")
SetGadgetFont(#Imia_Gad_1, FontID1)
ButtonGadget(#Knopka_Udalit_1, 2, 339, 94, 25, "Удалить")
ButtonGadget(#Knopka_Sohranit_1, 97, 339, 94, 25, "Сохранить")
ButtonGadget(#Knopka_Otpravit_1, 192, 339, 94, 25, "Отправить")
ButtonGadget(#Knopka_Otmena_1, 287, 339, 94, 25, "Выход")
ListIconGadget(#List_Icon_Gadget, 2, 28, 379, 310, "ИМЯ", 159, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
SetGadgetFont(#List_Icon_Gadget, FontID1)
AddGadgetColumn(#List_Icon_Gadget, 2, "Порт", 69)
AddGadgetColumn(#List_Icon_Gadget, 1, "IP Адрес", 148)
;-
AddGadgetItem (#Panel_Gadget, -1, " СООБЩЕНИЯ ")
IPAddressGadget(#IP_Add_Gad_2, 163, 2, 147, 25)
SetGadgetFont(#IP_Add_Gad_2, FontID1)
StringGadget(#Port_Gad_2, 311, 2, 70, 25, "6000", #PB_String_Numeric)
SetGadgetFont(#Port_Gad_2, FontID1)
ComboBoxGadget(#Imia_Gad_2, 2, 2, 160, 25)
SetGadgetFont(#Imia_Gad_2, FontID1)
ButtonGadget(#Knopka_Nazad_2, 1, 339, 62, 25, "Назад")
ButtonGadget(#Knopka_Vpered_2, 64, 339, 62, 25, "Вперёд")
ButtonGadget(#Knopka_Udalit_2, 127, 339, 64, 25, "Удалить")
ButtonGadget(#Knopka_Otpravit_2, 192, 339, 94, 25, "Отправить")
ButtonGadget(#Knopka_Otmena_2, 287, 339, 94, 25, "Выход")
EditorGadget(#Editor_Gadget, 2, 28, 379, 310)
SetGadgetFont(#Editor_Gadget, FontID1)
SetGadgetText(#Editor_Gadget, Soobshenia())
;-
AddGadgetItem (#Panel_Gadget, -1, " ФАЙЛЫ И ПАПКИ ")
ExplorerListGadget(#Explorer_List_Gadget, 1, 1, 380, 337, Papka_Dlia_Sohranenia, #PB_Explorer_List | #PB_Explorer_NoParentFolder | #PB_Explorer_MultiSelect)
RemoveGadgetColumn(#Explorer_List_Gadget, 2)
RemoveGadgetColumn(#Explorer_List_Gadget, 3)
SetGadgetItemAttribute(#Explorer_List_Gadget, 0, #PB_Explorer_ColumnWidth, 310 , 0 )
SetGadgetItemAttribute(#Explorer_List_Gadget, 1, #PB_Explorer_ColumnWidth, 70 , 1 )
EnableGadgetDrop(#Explorer_List_Gadget, #PB_Drop_Files, #PB_Drag_Move)
ButtonGadget(#Knopka_Otmena_3, 287, 339, 94, 25, "Выход")
;-
AddGadgetItem (#Panel_Gadget, -1, " НАСТРОЙКИ ")
ButtonGadget(#Knopka_Otmena_4, 287, 339, 94, 25, "Выход")
;-
Zapolnenie_Lista_poluchatelei()
CloseGadgetList()
SetGadgetState(#Panel_Gadget, Vkladka)
Repeat
Event = WindowEvent()
Delay (1)
If Event = #PB_Event_Gadget
Gadget = EventGadget()
Select Gadget
Case #Knopka_Otmena_1
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 0
Case #Knopka_Otmena_2
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 0
Case #Knopka_Otmena_3
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 0
Case #Knopka_Otmena_4
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 0
Case #Knopka_Udalit_1
Imia_Poluchatelia.s = GetGadgetText(#Imia_Gad_1)
IP_Klienta.s = GetGadgetText(#IP_Add_Gad_1)
Nomer_Porta.s = GetGadgetText(#Port_Gad_1)
Port = Val(Nomer_Porta)
If OpenPreferences(Tekushaia_Direktoria+Imia_Faila_Poluchatelei)
Nomer_vibranoi_stroki = GetGadgetState(#List_Icon_Gadget)
If Nomer_vibranoi_stroki <> -1
PreferenceGroup(IP_Klienta)
RemovePreferenceKey(Nomer_Porta)
If NextPreferenceKey() = 0
RemovePreferenceGroup(IP_Klienta)
EndIf
ClosePreferences()
ClearGadgetItems(#List_Icon_Gadget)
ClearGadgetItems(#Imia_Gad_2)
Zapolnenie_Lista_poluchatelei()
EndIf
SetGadgetText(#Imia_Gad_1, "")
SetGadgetText(#IP_Add_Gad_1, "")
SetGadgetText(#Port_Gad_1, "")
EndIf
Case #Knopka_Sohranit_1
Imia_Poluchatelia.s = GetGadgetText(#Imia_Gad_1)
IP_Klienta.s = GetGadgetText(#IP_Add_Gad_1)
Nomer_Porta.s = GetGadgetText(#Port_Gad_1)
Port = Val(Nomer_Porta)
If Imia_Poluchatelia <>"" And IP_Klienta <> "0.0.0.0" And Nomer_Porta <>""
If OpenPreferences(Tekushaia_Direktoria+Imia_Faila_Poluchatelei)
PreferenceGroup(IP_Klienta)
WritePreferenceString(Nomer_Porta, Imia_Poluchatelia)
ClosePreferences()
ClearGadgetItems(#List_Icon_Gadget)
ClearGadgetItems(#Imia_Gad_2)
Zapolnenie_Lista_poluchatelei()
EndIf
EndIf
Case #Knopka_Otpravit_1
Nomer_Porta.s = GetGadgetText(#Port_Gad_1)
IPAddress = GetGadgetState(#IP_Add_Gad_1)
*V_Procedure\Port = Val(Nomer_Porta)
*V_Procedure\IP_Klienta = IPString(IPAddress)
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 2
QQ = 1
Case #Knopka_Otpravit_2
Nomer_Porta.s = GetGadgetText(#Port_Gad_2)
IPAddress = GetGadgetState(#IP_Add_Gad_2)
*V_Procedure\Port = Val(Nomer_Porta)
*V_Procedure\IP_Klienta = IPString(IPAddress)
*V_Procedure\Filename = GetGadgetText(#Editor_Gadget)
CloseWindow (#Okno_Vibora)
HideWindow(#Window, 0)
ProcedureReturn 1
QQ = 1
Case #Knopka_Nazad_2
If PreviousElement(Soobshenia()) = 0
LastElement(Soobshenia())
EndIf
SetGadgetText(#Editor_Gadget, Soobshenia())
Case #Knopka_Vpered_2
If NextElement(Soobshenia()) = 0
FirstElement(Soobshenia())
EndIf
SetGadgetText(#Editor_Gadget, Soobshenia())
Case #Knopka_Udalit_2
DeleteElement(Soobshenia(), 1)
If ListSize(Soobshenia()) = 0
AddElement(Soobshenia())
EndIf
SetGadgetText(#Editor_Gadget, Soobshenia())
Case #List_Icon_Gadget
Nomer_vibranoi_stroki = GetGadgetState(#List_Icon_Gadget)
If Nomer_vibranoi_stroki <> -1
Field$ = GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,1 )
Field0 = Val(StringField(Field$, 1, "."))
Field1 = Val(StringField(Field$, 2, "."))
Field2 = Val(StringField(Field$, 3, "."))
Field3 = Val(StringField(Field$, 4, "."))
SetGadgetText(#Imia_Gad_1, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,0 ))
SetGadgetState(#IP_Add_Gad_1, MakeIPAddress(Field0, Field1, Field2, Field3))
SetGadgetText(#Port_Gad_1, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,2 ))
SetGadgetText(#Imia_Gad_2, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,0 ))
SetGadgetState(#IP_Add_Gad_2, MakeIPAddress(Field0, Field1, Field2, Field3))
SetGadgetText(#Port_Gad_2, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,2 ))
EndIf
Case #Imia_Gad_2
Nomer_vibranoi_stroki = GetGadgetState(#Imia_Gad_2)
If Nomer_vibranoi_stroki <> -1
Field$ = GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,1 )
Field0 = Val(StringField(Field$, 1, "."))
Field1 = Val(StringField(Field$, 2, "."))
Field2 = Val(StringField(Field$, 3, "."))
Field3 = Val(StringField(Field$, 4, "."))
SetGadgetText(#Imia_Gad_1, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,0 ))
SetGadgetState(#IP_Add_Gad_1, MakeIPAddress(Field0, Field1, Field2, Field3))
SetGadgetText(#Port_Gad_1, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,2 ))
SetGadgetText(#Imia_Gad_2, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,0 ))
SetGadgetState(#IP_Add_Gad_2, MakeIPAddress(Field0, Field1, Field2, Field3))
SetGadgetText(#Port_Gad_2, GetGadgetItemText(#List_Icon_Gadget, Nomer_vibranoi_stroki ,2 ))
EndIf
Case #Explorer_List_Gadget
If EventType() = #PB_EventType_DragStart
Priniatie_Fail$ = ""
For i = 0 To CountGadgetItems(#Explorer_List_Gadget)-1
If GetGadgetItemState(#Explorer_List_Gadget, i) & #PB_Explorer_Selected
Priniatie_Fail$ + GetGadgetText(#Explorer_List_Gadget) + GetGadgetItemText(#Explorer_List_Gadget, i) + Chr(10)
Debug Priniatie_Fail$
EndIf
Debug Priniatie_Fail$
Next i
If Priniatie_Fail$ <> ""
DragFiles(Priniatie_Fail$, #PB_Drag_Move)
EndIf
EndIf
EndSelect
EndIf
SET()
Until QQ = 1
EndIf
ProcedureReturn 0
EndProcedure
;активируем нетворк
If InitNetwork() = 0
MessageRequester("СООБЩЕНИЕ", "Не удалось активировать Network!!!", 0)
EndIf
;создаём сервер
SERVER = CreateNetworkServer(#PB_Any, Port)
Debug SERVER
If SERVER = 0
MessageRequester("СООБЩЕНИЕ", "Не удалось создать Сервер!!!", 0)
End
EndIf
;открываем окно
If OpenWindow(#Window, W_X, W_Y, 123, 103, "Окно Для Отправки", #PB_Window_BorderLess)
ImageGadget(#Gad_Kart, 0, 0, 123, 103, CatchImage(#Kartinka,?Kartinka_Okna_File))
ProgressBarGadget(#ProgressBar, 36, 50, 70, 18, 0, 15)
AddSysTrayIcon(1, WindowID(#Window), CatchImage(#Ikonka,?Trei_Icon_File));выводим иконку в СисТрей
CreatePopupMenu(#Menu_Nad_Ikonkoi) ;создаем меню для иконки при нажатии левой кнопкой мыши
MenuItem(#Menu_Skrit, "скрыть")
MenuBar()
MenuItem(#Menu_Poluchatel, "получатель")
MenuItem(#Menu_Soobshenia, "сообщения")
MenuItem(#Menu_Faili, "файлы")
MenuItem(#Menu_Nastr, "настройки")
MenuBar()
MenuItem(#Menu_Vihod, "выход")
;активируем драг-дроп
EnableWindowDrop(#Window, #PB_Drop_Files, #PB_Drag_Copy)
StickyWindow(#Window, 1)
;главный цикл
Progresi = 0
Repeat
;определяем событие окна
Event = WindowEvent()
Delay (1)
Time1 = ElapsedMilliseconds()
If (Time1 - Time2) > 100 And V_Proceduru\DliaProgressa = 1
Time2 = Time1
Progresi + 1
SetGadgetState (#ProgressBar, Progresi)
If Progresi > 14
Progresi = 0
EndIf
EndIf
;если событие на нашем окне
If EventWindow() = #Window
Select Event
;если сбросили объект
Case #PB_Event_WindowDrop
Files$ = EventDropFiles() ;получаем адреса сброшеных объектов
Count = CountString(Files$, Chr(10)) + 1 ;определяем количество объектов
V_Proceduru\Vkladka = 0
If Okno_Vibora (@V_Proceduru) = 2
For i = 1 To Count
Directory$ = StringField(Files$, i, Chr(10)) ;отделяем элемент, если несколько
RashirenieFaila$ = GetExtensionPart(Directory$);отделяем расширение файла
Filename$ = GetFilePart(Directory$)
If RashirenieFaila$ = ""
Filename$ + ".pack"
Debug "Это папка"
Debug Filename$
Debug Directory$
makepack(Filename$,Directory$)
runone = 0
V_Proceduru\Filename = Filename$
Otpravka_papki (@V_Proceduru)
DeleteFile(Tekushaia_Direktoria + Filename$)
Filename$ = ""
Directory$ = ""
Else
HideWindow(#Window, 1)
V_Proceduru\Filename = Filename$
V_Proceduru\Directory = Directory$
Otpravka_faila (@V_Proceduru)
Filename$ = ""
Directory$ = ""
EndIf
Next i
EndIf
HideWindow(#Window, 0)
;если событие на окне отправки
Case #PB_Event_Gadget
Select EventType()
Case #PB_EventType_RightClick ;нажали правой кнопкой
DisplayPopupMenu(#Menu_Nad_Ikonkoi, WindowID(#Window)) ;отбражаем меню выбора действий или выход
Case #PB_EventType_LeftDoubleClick ;двойной клик левой кнопки мыши
HideWindow(#Window, 1) ;скрываем окно отправки
V_Proceduru\Vkladka = 2 ;выбираем вкладку просмотра принятых файлов
If Okno_Vibora (@V_Proceduru) = 1 ;переходим в процедуру выбора
Otpravka_soobshenia (@V_Proceduru)
EndIf
EndSelect
;если событие в системном трее
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_RightClick ;и нажали левую кнопку мыши
DisplayPopupMenu(#Menu_Nad_Ikonkoi, WindowID(#Window)) ;отбражаем меню выбора действий или выход
Case #PB_EventType_LeftClick ;двойной клик левой кнопки мыши
If Skr_Otob = 0
Skr_Otob = 1
SetMenuItemText(#Menu_Nad_Ikonkoi, #Menu_Skrit, "показать")
HideWindow(#Window, 1)
Else
Skr_Otob = 0
SetMenuItemText(#Menu_Nad_Ikonkoi, #Menu_Skrit, "скрыть")
HideWindow(#Window, 0)
; ImageGadget(#Gad_Kart, 0, 0, 123, 103, CatchImage(0,?Kartinka_Okna_File))
EndIf
EndSelect
;если выбрали пункт в меню выбора или выход
Case #PB_Event_Menu
Select EventMenu()
Case #Menu_Skrit
If Skr_Otob = 0
Skr_Otob = 1
SetMenuItemText(#Menu_Nad_Ikonkoi, #Menu_Skrit, "показать")
HideWindow(#Window, 1)
Else
Skr_Otob = 0
SetMenuItemText(#Menu_Nad_Ikonkoi, #Menu_Skrit, "скрыть")
HideWindow(#Window, 0)
; ImageGadget(#Gad_Kart, 0, 0, 123, 103, CatchImage(0,?Kartinka_Okna_File))
EndIf
Case #Menu_Poluchatel ;если выбрали пункт настройки
HideWindow(#Window, 1) ;скрываем окно отправки
V_Proceduru\Vkladka = 0 ;выбираем вкладку пнастроек
If Okno_Vibora (@V_Proceduru) = 1 ;переходим в процедуру выбора
Otpravka_soobshenia (@V_Proceduru)
EndIf
Case #Menu_Soobshenia ;если выбрали пункт настройки
HideWindow(#Window, 1) ;скрываем окно отправки
V_Proceduru\Vkladka = 1 ;выбираем вкладку пнастроек
If Okno_Vibora (@V_Proceduru) = 1 ;переходим в процедуру выбора
Otpravka_soobshenia (@V_Proceduru)
EndIf
Case #Menu_Faili ;если выбрали пункт настройки
HideWindow(#Window, 1) ;скрываем окно отправки
V_Proceduru\Vkladka = 2 ;выбираем вкладку пнастроек
If Okno_Vibora (@V_Proceduru) = 1 ;переходим в процедуру выбора
Otpravka_soobshenia (@V_Proceduru)
EndIf
Case #Menu_Nastr ;если выбрали пункт настройки
HideWindow(#Window, 1) ;скрываем окно отправки
V_Proceduru\Vkladka = 3 ;выбираем вкладку пнастроек
If Okno_Vibora (@V_Proceduru) = 1 ;переходим в процедуру выбора
Otpravka_soobshenia (@V_Proceduru)
EndIf ;переходим в процедуру выбора
Case #Menu_Vihod ;если выбрали пункт выход
End ;выходим из программы
EndSelect
EndSelect
EndIf
If SET() = 1
V_Proceduru\DliaProgressa = 1
EndIf
ForEver
EndIf
DataSection
Trei_Icon_File:
IncludeBinary "C:\Значок.ico"
Trei_Icon_FileEnd:
Kartinka_Okna_File:
IncludeBinary "C:\mail.bmp"
Kartinka_Okna_FileEnd:
EndDataSectionОтредактировано lakomet (13.04.2010 20:06:00)
на этой строчки ошибка вылетает:
Это для новых версий компилятора, а для старых используй API SetTimer_()
не в коем случае)) так намного легче, спасибо
А что сложного?
Вот тот же пример, но на API
Procedure Tim()
SetGadgetText(0, FormatDate("%hh:%ii:%ss", Date() ) )
EndProcedure
OpenWindow(0,20,20,100,50,"Таймер",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
TextGadget(0,30,16,50,16,FormatDate("%hh:%ii:%ss", Date() ))
SetTimer_(WindowID(0),1,1000, @Tim()) ; Создание таймера
Repeat
Event=WaitWindowEvent()
Until Event=#PB_Event_CloseWindowего освободить я не пойму
Его нужно просто "почистить" - в цикле записать нули или пустые строки (в записимости от типа массива), примерно так
Dim Proba.l(10) For i=0 To 10 Proba(i)=0 Next i
А разве такая запись не очищает? Зачем вообще цикл? Я же написал ответ выше
Dim Proba.l(10)
А что сложного?
просто для моего примера требуется по "Тику" секундомера выполнять определенные действия, а по примеру со временем малец не понятно. СТранно, что в стандартном наборе PB нет нормального таймера.
| Вопросы новичка (продолжение…) | Вопросы по PureBasic | 26.02.2024 |
| Скорее, это теоретический вопрос о правах в директории. | OffTop | 16.09.2022 |
| Вопрос по отладке | Вопросы по PureBasic | 26.01.2017 |
| Три вопроса по созданию браузера. | Вопросы по PureBasic | 01.11.2010 |
| вопрос о точности типов данных | Вопросы по PureBasic | 20.05.2021 |
Вы здесь » PureBasic - форум » Вопросы по PureBasic » Вопросы новичка