purebasic.info

PureBasic forum
Текущее время: Пн июл 13, 2020 4:53 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 8 ] 
Автор Сообщение
 Заголовок сообщения: Диафильм для рабочего стола
СообщениеДобавлено: Вс дек 25, 2011 1:49 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб май 21, 2011 10:27 pm
Сообщений: 246
Откуда: Брест , Беларусь
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Enumeration 
   #image
   #Ima
EndEnumeration
 
 UsePNGImageDecoder()
 UseJPEGImageDecoder()
   
Procedure SetScreenImage(FileName$)
 ExamineDesktops()
 W=DesktopWidth(0)
 H=DesktopHeight(0)
 If CreateImage(#image, W, H)
 
  LoadImage(#Ima, FileName$)
 
  StartDrawing(ImageOutput(#image))
    DrawImage(ImageID(#ima), 0, 0, w, h)
  StopDrawing()
 
   file.s = GetHomeDirectory()+"image.bmp"
   SaveImage(#image, file, #PB_ImagePlugin_BMP)
  SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, file.s, #SPIF_UPDATEINIFILE)
 EndIf
EndProcedure
Procedure RedrawImageToList(FileName$)
 Dir$=GetHomeDirectory()+"VisualFones\"
 If FileSize(Dir$)=-1
    CreateDirectory(Dir$)
 EndIf
 ExamineDesktops()
 W=DesktopWidth(0)
 H=DesktopHeight(0)
 If CreateImage(#image,w, h)
 
  If LoadImage(#Ima, FileName$)
 
  StartDrawing(ImageOutput(#image))
    DrawImage(ImageID(#ima), 0, 0, w, h)
  StopDrawing()
  i=0
  Repeat:i=i+1
  Until FileSize(Dir$+Str(i)+".bmp")=-1
 
  file.s = Dir$+Str(i)+".bmp"
  SaveImage(#image, file, #PB_ImagePlugin_BMP)
  ;SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, file.s, #SPIF_UPDATEINIFILE)
  EndIf
 EndIf
EndProcedure
Procedure ShowScreenList()
 
Repeat
 
Dir$=GetHomeDirectory()+"VisualFones\"
ExamineDirectory(0,Dir$,"*.bmp")
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        file$=Dir$+DirectoryEntryName(0)
        SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, file$, #SPIF_UPDATEINIFILE)
      EndIf
      Delay(3000)
    Wend
    FinishDirectory(0)
ForEver
EndProcedure
Procedure RedrawFullDirectory(Directory$)
ExamineDirectory(0,Directory$,"")
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        file$=Directory$+DirectoryEntryName(0)
        If redrawImageToList(file$)
        EndIf
      EndIf
    Wend
    FinishDirectory(0)
EndProcedure
Procedure ClearScreenDirectory()
  ProcedureReturn DeleteDirectory(GetHomeDirectory()+"VisualFones\","")
EndProcedure
 
ClearScreenDirectory()
RedrawFullDirectory("C:\Documents and Settings\All Users\Документы\Мои рисунки\Образцы рисунков\")
ShowScreenList()


_________________
Выпьем ещё раз - чтобы выпить в следущий раз! (С) Иван Пашкевич


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс дек 25, 2011 7:33 pm 
Не в сети
PureBasic Coder
Аватар пользователя

Зарегистрирован: Чт ноя 10, 2011 10:50 am
Сообщений: 4049
Откуда: Ростов-на-Дону
Благодарил (а): 71 раз.
Поблагодарили: 81 раз.
Пункты репутации: 24
у меня ошибка на 69 строке


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс дек 25, 2011 8:27 pm 
Не в сети
профессор

Зарегистрирован: Вс окт 25, 2009 5:48 pm
Сообщений: 263
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Никита Однороб писал(а):
у меня ошибка на 69 строке


У тебя просто нет директории:

"C:\Documents and Settings\All Users\Документы\Мои рисунки\Образцы рисунков"

Поставь путь к папке с рисунками.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс дек 25, 2011 8:45 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6651
Благодарил (а): 36 раз.
Поблагодарили: 234 раз.
Пункты репутации: 65
Во избежании неприятностей системные папки лучше искать программно:

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
Procedure.s GetPath(Type); 
        *itemid.Long = #Null
        If SHGetSpecialFolderLocation_ (0, Type, @*itemid) = #NOERROR
        location$ = Space (#MAX_PATH+1)
        If SHGetPathFromIDList_ (*itemid, @location$)
        If Right(location$,1)<>"\" : location$+"\" : EndIf
        ProcedureReturn location$
        EndIf
        EndIf
EndProcedure
 
Debug GetPath(#CSIDL_COMMON_PICTURES)+"Образцы рисунков\"
 


Хотя если Винда не русская, то в этом случае не спасает.

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн дек 26, 2011 5:42 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Чт июн 25, 2009 1:02 pm
Сообщений: 2328
Откуда: Russia — Belarus
Благодарил (а): 7 раз.
Поблагодарили: 75 раз.
Пункты репутации: 11
Без подробного описания даже нет желания смотреть код :(.

_________________
EnableExplicit User


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн дек 26, 2011 1:51 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб май 21, 2011 10:27 pm
Сообщений: 246
Откуда: Брест , Беларусь
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Вот немного переделал код, теперь можно делать все внутренней папке
В папку Images\ скидываем нужные изображения


Вложения:
VisualFones_pb.rar [84.04 KiB]
Скачиваний: 236

_________________
Выпьем ещё раз - чтобы выпить в следущий раз! (С) Иван Пашкевич
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пт дек 30, 2011 10:30 am 
Не в сети
доцент
Аватар пользователя

Зарегистрирован: Вс июн 05, 2011 5:56 pm
Сообщений: 72
Откуда: Бендеры
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
qpAHToMAS писал(а):
Без подробного описания даже нет желания смотреть код :(.

согласен


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Сб дек 31, 2011 12:01 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб май 21, 2011 10:27 pm
Сообщений: 246
Откуда: Брест , Беларусь
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Программа меняет каждые 5 секунд картинку на рабочем столе из папки (который а архиве) или с папки "Образцы рисунков" который дан в начале темы . Вот и все :wink:

_________________
Выпьем ещё раз - чтобы выпить в следущий раз! (С) Иван Пашкевич


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 8 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB