purebasic.info

PureBasic forum
Текущее время: Пн июл 16, 2018 9:49 am

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




Начать новую тему Ответить на тему  [ Сообщений: 95 ]  На страницу Пред.  1 ... 3, 4, 5, 6, 7  След.
Автор Сообщение
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 10:13 am 
Не в сети
профессор

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 420
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Да, верно, видел. Пытался так разделить события
Код:
1
If Temp = #PB_EventType_Change And Temp = #PB_EventType_RightClick


но вообще перестаёт работать.

Ага... вон оказывается как надо. Спасибо, а то пытался объеденить эти два события.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 10:28 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11204
Благодарил (а): 4 раз.
Поблагодарили: 421 раз.
Переменная одновременно не может быть равна двум разным значениям...

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 10:58 am 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 261
Благодарил (а): 14 раз.
Поблагодарили: 30 раз.
Пункты репутации: 0
А так?
Код:
1
2
3
4
5
6
7
x.w 
 
PokeB(@x, 1)
PokeB(@x+1, 2)
 
Debug PeekB(@x)
Debug PeekB(@x+1)


но я ничего не утверждаю просто спрашиваю :?


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 12:00 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11204
Благодарил (а): 4 раз.
Поблагодарили: 421 раз.
Можно еще на биты поделить переменную...

Код:
1
2
3
4
5
6
7
8
9
10
11
x.w 
 
PokeB(@x, 1)
PokeB(@x+1, 2)
 
Debug PeekB(@x)
Debug PeekB(@x+1)
 
If x=1 And x=2
  Debug "Переменная x равна 1 и 2"
EndIf


_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 12:30 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 261
Благодарил (а): 14 раз.
Поблагодарили: 30 раз.
Пункты репутации: 0
Вот вот, никакой экономии памяти :D


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 5:15 pm 
Не в сети
профессор

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 420
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Есть ещё вопрос по этому гаджету. Как можно укрупнить иконки в нём? Пытался адаптировать под код Петра следующий код:
Код:
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
#TVM_GETITEMHEIGHT = #TV_FIRST + 28
 
LoadFont(1, "Courier New", 24, #PB_Font_Bold)
 
If OpenWindow(0, 0, 0, 455, 440, "TreeGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  TreeGadget(0, 10, 10, 440, 420, #PB_Tree_CheckBoxes)      
  SetGadgetFont(0, FontID(1))
  itemHeight = SendMessage_(GadgetID(0), #TVM_GETITEMHEIGHT, 0, 0)
 
  normalImgList = ImageList_Create_(itemHeight, itemHeight, #ILC_COLOR32, 0, 2)
  ImageList_SetBkColor_(normalImgList, #White)
  SendMessage_(GadgetID(0), #TVM_SETIMAGELIST, #TVSIL_NORMAL, normalImgList)
 
  ico0 = ExtractIcon_(0, "shell32.dll", 23)
  ico1 = ExtractIcon_(0, "shell32.dll", 3)
  ico2 = ExtractIcon_(0, "shell32.dll", 13)
  ico3 = ExtractIcon_(0, "shell32.dll", 43)
 
  ImageList_AddIcon_(normalImgList, ico0)
  ImageList_AddIcon_(normalImgList, ico1)
  ImageList_AddIcon_(normalImgList, ico2)
  ImageList_AddIcon_(normalImgList, ico3)
 
  DestroyIcon_(ico0)
  DestroyIcon_(ico1)
  DestroyIcon_(ico2)
  DestroyIcon_(ico3)
 
  tvi.TV_ITEM
  tvi\mask = #TVIF_HANDLE | #TVIF_IMAGE | #TVIF_SELECTEDIMAGE
 
  For a = 0 To 10
    tvi\hItem = AddGadgetItem (0, -1, "Normal Item "+Str(a), 0, 0)
    tvi\iImage = 2
    tvi\iSelectedImage = 2
    SendMessage_(GadgetID(0), #TVM_SETITEM, 0, tvi)
   
    tvi\hItem = AddGadgetItem (0, -1, "Node "+Str(a), 0, 0)
    tvi\iImage = 0
    tvi\iSelectedImage = 0
    SendMessage_(GadgetID(0), #TVM_SETITEM, 0, tvi)
   
    tvi\hItem = AddGadgetItem(0, -1, "Sub-Item 1", 0, 1)
    tvi\iImage = 3
    tvi\iSelectedImage = 3
    SendMessage_(GadgetID(0), #TVM_SETITEM, 0, tvi)
   
    tvi\hItem = AddGadgetItem (0, -1, "File "+Str(a), 0, 0)
    tvi\iImage = 1
    tvi\iSelectedImage = 1
    SendMessage_(GadgetID(0), #TVM_SETITEM, 0, tvi)
  Next
 
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  ImageList_Destroy_(normalImgList)
 
EndIf


Не увеличивает. Кому не сложно, помогите пожалуйста.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 14, 2017 6:55 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 261
Благодарил (а): 14 раз.
Поблагодарили: 30 раз.
Пункты репутации: 0
Ну не знаю, по-моему, это и есть большие. Пробовал подключать .ico 50X50 ничего не увеличивает, да и help пишет 16x16 :roll:
Код:
1
2
3
4
5
6
7
8
9
10
  ;-----------------------------------------------------------------------------------------------
   IconNum = ExtractIconEx_("shell32.dll", -1, #Null, #Null, #Null)
  Dim hIcon_Small(IconNum)
  Dim hIcon_Large(IconNum)
  ExtractIconEx_("shell32.dll", 0, hIcon_Large(), hIcon_Small(), IconNum)
  ico0 = hIcon_Large(23)
  ico1 = hIcon_Large(3)
  ico2 = hIcon_Large(13)
  ico3 = hIcon_Large(43)
  ;-----------------------------------------------------------------------------------------------



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Ср мар 15, 2017 5:49 am 
Не в сети
профессор

Зарегистрирован: Вт май 13, 2014 4:12 am
Сообщений: 629
Благодарил (а): 66 раз.
Поблагодарили: 20 раз.
Пункты репутации: 5
да быть такого не могЁт!!! в чём прикол?
Код:
1
If x=1 And x=2


может OR?


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Ср мар 15, 2017 12:06 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11204
Благодарил (а): 4 раз.
Поблагодарили: 421 раз.
newJS писал(а):
да быть такого не могЁт!!! в чём прикол?
Вот и я пишу о том же.
Пётр писал(а):
Переменная одновременно не может быть равна двум разным значениям

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Ср мар 15, 2017 7:47 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 261
Благодарил (а): 14 раз.
Поблагодарили: 30 раз.
Пункты репутации: 0
newJS писал(а):
да быть такого не могЁт!!!
Не, ну я даже не знаю :)
Код:
1
2
3
4
5
6
7
8
x.w 
 
PokeB(@x, 1)
PokeB(@x+1, 2)
 
If x>>9 = 1 And x>>8 = 2
   Debug "Переменная x равна 1 и 2"
EndIf



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Пт мар 17, 2017 4:58 pm 
Не в сети
профессор

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 420
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Люди, вы отошли от темы. Вопрос про размер иконок в TreeGadget'e актуален!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Пт мар 17, 2017 5:09 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11204
Благодарил (а): 4 раз.
Поблагодарили: 421 раз.
Не проще отобразить не дерево, а как в проводнике (папки и файлы текущей папки)? Тогда можно использовать ListIconGadget который поддерживает большие картинки.
Иначе придется создать Image_List для картинок нужного размера.

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Пт мар 17, 2017 5:31 pm 
Не в сети
профессор

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 420
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Пётр, ведь изначально под дерево затачивалось, а теперь... отказаться? жаль :(
Вот попался ещё один код:
Код:
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
 
;...New icon size
iconW = 32
iconH = 32
 
;...Create some images for this example
zeroImg = CreateImage(0, iconW, iconH)
StartDrawing(ImageOutput(0))
Box(0, 0, iconW, iconH, RGB(0, 0, 0))
StopDrawing()
 
greenImg = CreateImage(1, iconW, iconH)
StartDrawing(ImageOutput(1))
Box(0, 0, iconW, iconH, RGB(0, 255, 0))
StopDrawing()
 
blueImg = CreateImage(2, iconW, iconH)
StartDrawing(ImageOutput(2))
Box(0, 0, iconW, iconH, RGB(0, 0, 255))
StopDrawing()
 
redImg = CreateImage(3, iconW, iconH)
StartDrawing(ImageOutput(3))
Box(0, 0, iconW, iconH, RGB(255, 0, 0))
StopDrawing()
 
IconImg = LoadImage(4, #PB_Compiler_Home + "Examples\Sources\Data\CDPlayer.Ico")
 
;...Create our newly sized image list
newIL = ImageList_Create_(iconW, iconH, #ILC_COLOR32|#ILC_MASK, 0, 10)
 
;...Add our images
ImageList_Add_(newIL, ImageID(0), 0)
ImageList_Add_(newIL, ImageID(1), 0)
ImageList_Add_(newIL, ImageID(2), 0)
ImageList_Add_(newIL, ImageID(3), 0)
ImageList_ReplaceIcon_(newIL, -1, ImageID(4))
 
If OpenWindow(0, 0, 0, 700, 500, "TreeGadget mit großen Icons",  #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  TreeGadget(0, 10, 10, 680, 480)
 
  AddGadgetItem (0, -1, "Node 1", greenImg, 0)
  FreeImage(1)
  AddGadgetItem (0, -1, "Node 2", blueImg, 0)
  FreeImage(2)
  AddGadgetItem(0, -1, "Sub-Item 1", redImg, 1)
  FreeImage(3)
  AddGadgetItem(0, -1, "Sub-Item 2", IconImg, 1)
  FreeImage(0)
 
  SetGadgetItemState(0, 1, #PB_Tree_Expanded)
       
  ;...Get handle to current TreeGadget normal image list
  oldIL = SendMessage_(GadgetID(0), #TVM_GETIMAGELIST, #TVSIL_NORMAL, 0)
  ;...Replace the old image list with our new one
  SendMessage_(GadgetID(0), #TVM_SETIMAGELIST, #TVSIL_NORMAL, newIL)
  ;...Destroy the old image list
  ImageList_Destroy_(oldIL)
 
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
End
; IDE Options = PureBasic 5.31 (Windows - x86)
; CursorPosition = 60
; EnableUnicode
; EnableXP
 


Он почти нормально отображает большие значки с твоим кодом, только вот незадача: как мне этот вновь созданный список грамотно разрушить (ImageList_Destroy_(newIL)) и затем снова воссоздать? Это нужно для того чтобы обновить дерево, то есть я его удаляю путём ClearGadgetItems(0) и затем по новой строю AddGadgetItem(). Только после таких манипуляций все значки ломаются :( Как быть? Пётр, подскажи.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Чт мар 23, 2017 9:17 am 
Не в сети
профессор

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 420
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Кому не сложно, поправьте пожалуйста код:
Код:
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
Structure TreeInfo
  *P.TreeFiles
  N.s                ; Имя файла или папки.
EndStructure
 
Structure FileList Extends TreeInfo
  S.q ; Размер файла
  E.s ; Расширение
EndStructure
 
Structure TreeFiles Extends TreeInfo
  List D.TreeFiles() ; Список вложенных папок текущей папки.
  List F.FileList()  ; Список файлов текущей папки.
EndStructure
 
Structure FileInfo
  Path.s
  Size.q
  Ex_.s       ; Расширение
EndStructure
 
;EnableExplicit
 
#desc = "description"
#db = 1
 
 
Procedure ScanDisk(*Tree.TreeFiles, Dir.s) ; Сохранение структуры указаной папки
  Protected ID, Name.s, Ext.s, Size
 
  If *Tree
    ID = ExamineDirectory(#PB_Any, Dir, "*.*")
    If ID
      While NextDirectoryEntry(ID)
        Name = DirectoryEntryName(ID)
        If DirectoryEntryType(ID) = #PB_DirectoryEntry_File ; Файл
          Ext = LCase(GetExtensionPart(Name))
          If AddElement(*Tree\F())
            *Tree\F()\N = DirectoryEntryName(ID)
            *Tree\F()\S = DirectoryEntrySize(ID)
            *Tree\F()\E = Ext
          EndIf
        Else ; Папка
          If Name<>"." And Name<>".."
            If AddElement(*Tree\D())
              *Tree\D()\N = Name
              *Tree\D()\P = *Tree
              ScanDisk(*Tree\D(), Dir+Name+"\") ; Рекурсивный вызов процедуры
            EndIf
          EndIf
        EndIf
      Wend
      FinishDirectory(ID)
    EndIf
  EndIf
EndProcedure
 
Procedure DelDir(*Tree.TreeFiles) ; Удаление пустых папок.
  Protected DelState = #False
  If *Tree
   
    ForEach *Tree\D()
      If DelDir(*Tree\D()) = #True
        DeleteElement(*Tree\D())
      EndIf
    Next
   
    If *Tree\N="" Or (ListSize(*Tree\D())=0 And ListSize(*Tree\F())=0)
      DelState = #True
    EndIf
   
  EndIf
 
  ProcedureReturn DelState
EndProcedure
 
Procedure SetTreeGadget(Gadget, *Tree.TreeFiles, Depth, *Pos.Integer)
  Protected filename$, LenExt
 
  If *Tree
    If *Tree\N<>""
      AddGadgetItem(Gadget, *Pos\i, *Tree\N, 0, Depth)
      SetGadgetItemData(Gadget, *Pos\i, 0)
      *Pos\i+1
      Depth+1
    EndIf
   
    ForEach *Tree\D()
      SetTreeGadget(Gadget, *Tree\D(), Depth, *Pos)
    Next
   
    ForEach *Tree\F()
      filename$ = *Tree\F()\N
      LenExt = Len(*Tree\F()\E)
      If LenExt
        filename$ = Left(filename$, Len(filename$) - LenExt - 1)
      EndIf
 
      AddGadgetItem(Gadget, -1, filename$, 0, Depth)
      SetGadgetItemData(Gadget, *Pos\i, *Tree\F())
      *Pos\i+1
    Next
;    
  EndIf
EndProcedure
 
Procedure TreeParentRefresh(*Tree.TreeFiles) ; Обновление ссылок на на родительские узлы дерева.
  If *Tree
   
    ForEach *Tree\D()
      *Tree\D()\P = *Tree
      TreeParentRefresh(*Tree\D())
    Next
   
    ForEach *Tree\F()
      *Tree\F()\P = *Tree
    Next
   
  EndIf
EndProcedure
 
Procedure TreeParentNull(*Tree.TreeFiles) ; Обнуление ссылок на на родительские узлы дерева.
  If *Tree
   
    ForEach *Tree\D()
      *Tree\D()\P = 0
      TreeParentNull(*Tree\D())
    Next
   
    ForEach *Tree\F()
      *Tree\F()\P = 0
    Next
   
  EndIf
EndProcedure
 
Procedure Path(*Tree.TreeInfo, *Path.FileInfo)
  If *Tree And *Tree\N<>"" And *Path
   
    If *Path\Path<>"" And *Tree\P<>0
      *Path\Path = *Tree\N+"\"+*Path\Path
    Else
      If *Path\Path=""
        Protected *File.FileList = *Tree
        *Path\Size = *File\S
        *Path\Ex_ = *File\E
      EndIf
      *Path\Path + *Tree\N
    EndIf
       
    Path(*Tree\P, *Path)
  EndIf
EndProcedure
 
Procedure SaveFile(*Tree.TreeFiles)
  Protected Temp.TreeFiles
 
  CopyStructure(*Tree, Temp, TreeFiles)
  TreeParentNull(Temp) ; Обнуление ссылок на на родительские узлы дерева.
 
  If CreateJSON(0)
    InsertJSONStructure(JSONValue(0), @Temp, TreeFiles)
    SaveJSON(0, #desc)
    FreeJSON(0)
  EndIf
EndProcedure
 
 
 
Define Tree.TreeFiles, Temp, Event, Gadget, Path.FileInfo
Root.s = "d:\-----2017\"
 
 
If LoadJSON(0, #desc)
  ExtractJSONStructure(JSONValue(0), Tree, TreeFiles)
  FreeJSON(0)
EndIf
 
TreeParentRefresh(Tree)
 
If OpenWindow(0, 0, 0, 500, 350, "TreeGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  TreeGadget(0, 0, 50, 500, 300)
  ButtonGadget(1, 10, 10, 120, 28, "Сканировать папку")
  Temp=0
  SetTreeGadget(0, Tree, 0, @Temp)
  Repeat
    Event = WaitWindowEvent()
    Gadget = EventGadget()
   
    If Event = #PB_Event_Gadget
      If Gadget = 0
       
        Temp=EventType()
        If Temp = #PB_EventType_Change
          Temp = GetGadgetState(0)
          If Temp>=0 And GetGadgetItemData(0, Temp)<>0
            Path\Path=""
            Path\Size=0
            Path\Ex_=""
            Path(GetGadgetItemData(0, Temp), Path)
           
            ClearDebugOutput()
 
            Debug Path\Path+"    Size "+Path\Size+"    Ext: "+Path\Ex_
            ;Debug ReadTXT(Path\Bias, Path\SizePacked, Path\Size)
           
          EndIf
        EndIf
       
      ElseIf Gadget = 1 ; Сканирование папки
       
        ClearGadgetItems(0)
        ClearStructure(Tree, TreeFiles)
        InitializeStructure(Tree, TreeFiles)
       
        If Not CreateFile(#db, "database")
          MessageRequester("Error", "ошибка создания файла-базы")
          End
        EndIf
       
        ScanDisk(Tree, Root)
        DelDir(Tree) ; Удаление пустых папок.
        Temp=0
        SetTreeGadget(0, Tree, 0, @Temp)
       
        CloseFile(#db)
        SaveFile(Tree)
 
      EndIf
    EndIf
   
  Until Event = #PB_Event_CloseWindow
EndIf


чтобы он сохранял не один общий, а несколько json-файлов списков. Нужна выборка по расширению перед сохранением, например файлы с расширением "txt" сохранить в файл-список json1, "doc" в json2. Чтобы потом эти списки можно было загружать LoadJSON() по отдельности.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Вт мар 28, 2017 10:02 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11204
Благодарил (а): 4 раз.
Поблагодарили: 421 раз.
Код:
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
Procedure CopyTree(*Src.TreeFiles, *Dest.TreeFiles, List Ext.s())
  Protected s.s, x
 
  If *Src And *Dest
   
    ForEach *Src\D()
      If AddElement(*Dest\D())
        CopyTree(*Src\D(), *Dest\D(), Ext())
      EndIf
    Next
   
    ForEach *Src\F()
      s = LCase(GetExtensionPart(*Src\F()\N))
      x = #False
     
      ForEach Ext()
        If s = Ext()
          x=#True
          Break
        EndIf
      Next
     
      If x=#True
        If AddElement(*Dest\F())
          CopyStructure(*Src\F(), *Dest\F(), FileList)
        EndIf
      EndIf
     
    Next
   
  EndIf
EndProcedure
 
Procedure SaveFile(*Tree.TreeFiles, File.s, Extensions.s)
  Protected Temp.TreeFiles, Count, i, s.s
  Protected NewList Ext.s()
 
  Count = CountString(Extensions, ",")+1
  For i=1 To Count
    s=Trim(StringField(Extensions, i, ","))
    If s<>""
      If AddElement(Ext())
        Ext() = LCase(s)
      EndIf
    EndIf
  Next
 
  CopyTree(*Tree, @Temp, Ext())
  TreeParentNull(Temp) ; Обнуление ссылок на на родительские узлы дерева.
 
  If CreateJSON(0)
    InsertJSONStructure(JSONValue(0), @Temp, TreeFiles)
    SaveJSON(0, File)
    FreeJSON(0)
  EndIf
EndProcedure



Нужно вызвать SaveFile для каждого списка в отдельности. Примерно так
Код:
1
2
SaveFile(Tree, "1.json", "pb,pbi")
SaveFile(Tree, "2.json", "txt,rtf")


_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 95 ]  На страницу Пред.  1 ... 3, 4, 5, 6, 7  След.

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


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

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


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

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