purebasic.info

PureBasic forum
Текущее время: Ср сен 19, 2018 4:36 am

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




Начать новую тему Ответить на тему  [ Сообщений: 95 ]  На страницу Пред.  1, 2, 3, 4, 5, 6, 7  След.
Автор Сообщение
 Заголовок сообщения: Re: TreeGadget
СообщениеДобавлено: Пт мар 10, 2017 8:11 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

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

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
У меня Debug Compress всегда равен нулю (то есть размер упакованного блока памяти) и соответственно до записи из него дело не доходит. Естественно файл database также равен нулю.


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

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

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Пётр - гений!
Действительно файл был слишком мал. Вручную создал текстовый файл с содержимым "12345", то есть размер был всего 5! Байт. Увеличил до несколький Килобайт и всё упаковалось. Что ж будем смотреть дальше. Спасибо!

За предыдущий пост с исправлением процедуры Path() также спасибо!

офтоп:
на сегодня пока всё. по мере появления вопросов думаю что отмечусь ещё в этой теме :D


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 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
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
Structure TreeInfo
  *P.TreeFiles
  N.s                ; Имя файла или папки.
EndStructure
 
Structure FileList Extends TreeInfo
  S.q ; Размер файла
  B.q ; Смещение
  SP.q ; Размер упакованного файла
EndStructure
 
Structure TreeFiles Extends TreeInfo
  List D.TreeFiles() ; Список вложенных папок текущей папки.
  List F.FileList()  ; Список файлов текущей папки.
EndStructure
 
Structure FileInfo
  Path.s
  Size.q
  Bias.q       ; Смещение
  SizePacked.q ; Размер упакованного файла
EndStructure
 
;EnableExplicit
 
UseZipPacker()
#desc = "description"
#temp = "Temp\"
#db = 1
#file = 2
 
Global Position.q = 0
 
Procedure ScanDisk(*Tree.TreeFiles, Dir.s) ; Сохранение структуры указаной папки
  Protected ID, Name.s, Ext.s, size.i
 
  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 Ext="pb" Or Ext="exe"
          If Ext="txt"
            size = DirectoryEntrySize(ID)
            If size >=8
              If ReadFile(#file, Dir + Name)
                If AddElement(*Tree\F())
                  *Tree\F()\N = Name
                  *Tree\F()\S = size
                  *Tree\F()\P = *Tree
                  *Tree\F()\B = Position
                 
                  *input = AllocateMemory(size)
                  *packed = AllocateMemory(size * 2)
                 
                  If *input And *packed
                    If ReadData(#file, *input, size)
                      SizeCompressed = CompressMemory(*input, size, *packed, size * 2, #PB_PackerPlugin_Zip)
                      If SizeCompressed > 0
                        WriteData(#db, *packed, SizeCompressed)
                      EndIf
                    EndIf
                    FreeMemory(*input)
                    FreeMemory(*packed)
                  EndIf
                 
                  Position + SizeCompressed
                  *Tree\F()\SP = SizeCompressed
                EndIf
                CloseFile(#file)
              EndIf
            EndIf
          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)
 
  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()
      AddGadgetItem(Gadget, -1, *Tree\F()\N+"    ("+*Tree\F()\S+")", 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\Bias = *File\B
        *Path\SizePacked = *File\SP
      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
 
Procedure.s ReadTXT(move.q, sizepacked.q, sizeunpacked.q)
  Protected content$
  If ReadFile(#db, "database")
    FileSeek(#db, move)
    *input = AllocateMemory(sizepacked)
    *unpacked = AllocateMemory(sizeunpacked)
   
    If *input And *unpacked
      ReadData(#db, *input, sizepacked)
      If UncompressMemory(*input, sizepacked, *unpacked, sizeunpacked, #PB_PackerPlugin_Zip) <> -1
        content$ = PeekS(*unpacked, sizeunpacked, #PB_Ascii)
      EndIf
      FreeMemory(*input)
      FreeMemory(*unpacked)
    EndIf
    CloseFile(#db)
  EndIf
  ProcedureReturn content$  
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\Bias=0
            Path\SizePacked=0
            Path(GetGadgetItemData(0, Temp), Path)
           
            ClearDebugOutput()
 
            Debug Path\Path+"    Size "+Path\Size+"    Bias "+Path\Bias+"    SizePacked "+Path\SizePacked
            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



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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11255
Благодарил (а): 4 раз.
Поблагодарили: 429 раз.
Примерно. Только лучше эти строки (процедура SkanDisk)
Код:
1
2
Position + SizeCompressed
*Tree\F()\SP = SizeCompressed

разместить после
Код:
1
WriteData(#db, *packed, SizeCompressed)

на тот случай если не получится сжать файл.

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Понятно. Пётр, как бы ещё иконки возле каталогов в дереве нарисовать? Для пущего сходства с chm :mrgreen:

добавлено:
тогда и эти строки:
Код:
1
2
3
4
*Tree\F()\N = Name
*Tree\F()\S = size
*Tree\F()\P = *Tree
*Tree\F()\B = Position


тоже надо поместить после WriteData ?


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11255
Благодарил (а): 4 раз.
Поблагодарили: 429 раз.
knower писал(а):
как бы ещё иконки возле каталогов в дереве нарисовать?
Код:
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
Structure GetIcon_Extension
  Part.s    ; Расширение файла
  IconID.i  ; Идентификатор иконки, связанной с расширением
EndStructure
 
Procedure GetIcon_Extension(Part.s) ; Идентификатор иконки (16x16), связанной с расширением в переменной Part
  Static NewList Part_IconID.GetIcon_Extension()
  Protected Info.SHFILEINFO, IconID
   
  Part=LCase(Part)
   
  ForEach Part_IconID()
    If Part=Part_IconID()\Part ; Данные о расширении найдены
     ProcedureReturn Part_IconID()\IconID
    EndIf
  Next
   
  ; Данных о расширении нет, поэтому загружаем иконку
 
  IconID = 0
  If SHGetFileInfo_("." + Part, #FILE_ATTRIBUTE_NORMAL, @Info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_USEFILEATTRIBUTES | #SHGFI_ICON | #SHGFI_SMALLICON)
    IconID  = Info\hIcon
  Else
    ExtractIconEx_("shell32.dll", 0, 0, @IconID , 1)
  EndIf
 
  If IconID
   If AddElement(Part_IconID())
     Part_IconID()\Part=Part
     Part_IconID()\IconID=IconID
   EndIf
  EndIf
 
 ProcedureReturn IconID
 
EndProcedure



knower писал(а):
тоже надо поместить после WriteData ?
Принципиально это ничего не изменит. Правильнее было бы при ошибке сжатия, записать файл как есть и пометить его что он не сжат.

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 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
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
Structure TreeInfo
  *P.TreeFiles
  N.s                ; Имя файла или папки.
EndStructure
 
Structure FileList Extends TreeInfo
  S.q ; Размер файла
  B.q ; Смещение
  SP.q; Размер упакованного файла
EndStructure
 
Structure TreeFiles Extends TreeInfo
  List D.TreeFiles() ; Список вложенных папок текущей папки.
  List F.FileList()  ; Список файлов текущей папки.
EndStructure
 
Structure FileInfo
  Path.s
  Size.q
  Bias.q       ; Смещение
  SizePacked.q ; Размер упакованного файла
EndStructure
 
;EnableExplicit
 
UseZipPacker()
#desc = "description"
#temp = "Temp\"
#db = 1
#file = 2
 
Global Position.q = 0
 
Procedure ScanDisk(*Tree.TreeFiles, Dir.s) ; Сохранение структуры указаной папки
  Protected ID, Name.s, Ext.s, size.i
 
  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 Ext="pb" Or Ext="exe"
          If Ext="txt"
            size = DirectoryEntrySize(ID)
            If size >=8
              If ReadFile(#file, Dir + Name)
                If AddElement(*Tree\F())
                  *Tree\F()\N = Name
                  *Tree\F()\S = size
                  *Tree\F()\P = *Tree
                  *Tree\F()\B = Position
                 
                  *input = AllocateMemory(size)
                  *packed = AllocateMemory(size * 2)
                 
                  If *input And *packed
                    If ReadData(#file, *input, size)
                      SizeCompressed = CompressMemory(*input, size, *packed, size * 2, #PB_PackerPlugin_Zip)
                      If SizeCompressed
                        WriteData(#db, *packed, SizeCompressed)
                        Position + SizeCompressed
                      Else
                        WriteData(#db, *input, size)
                        Position + size
                      EndIf
                      *Tree\F()\SP = SizeCompressed
                    EndIf
                    FreeMemory(*input)
                    FreeMemory(*packed)
                  EndIf
 
                EndIf
                CloseFile(#file)
              EndIf
            EndIf
          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)
 
  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()
      AddGadgetItem(Gadget, -1, *Tree\F()\N+"    ("+*Tree\F()\S+")", 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\Bias = *File\B
        *Path\SizePacked = *File\SP
      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
 
Procedure.s ReadTXT(move.q, sizepacked.q, sizeunpacked.q)
  Protected content$
 
  If ReadFile(#db, "database")
    FileSeek(#db, move)
    If sizepacked
      *input = AllocateMemory(sizepacked)
      *unpacked = AllocateMemory(sizeunpacked)
   
      If *input And *unpacked
        ReadData(#db, *input, sizepacked)
        If UncompressMemory(*input, sizepacked, *unpacked, sizeunpacked, #PB_PackerPlugin_Zip) <> -1
          content$ = PeekS(*unpacked, sizeunpacked, #PB_Ascii)
        EndIf
        FreeMemory(*input)
        FreeMemory(*unpacked)
      EndIf
    Else
      *input = AllocateMemory(sizeunpacked)
      If *input
        ReadData(#db, *input, sizeunpacked)
        content$ = PeekS(*input, sizeunpacked, #PB_Ascii)
      EndIf
    EndIf
    CloseFile(#db)
  EndIf
  ProcedureReturn content$  
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)
  SetGadgetFont(0, FontID(0))
  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\Bias=0
            Path\SizePacked=0
            Path(GetGadgetItemData(0, Temp), Path)
           
            ClearDebugOutput()
 
            Debug Path\Path+"    Size "+Path\Size+"    Bias "+Path\Bias+"    SizePacked "+Path\SizePacked
            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



только как проверить работает оно или нет, тое сть как преднамеренно сосздать ошибку при сжатии памяти?

добавлено:
вопрос снимается. всё работает.


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Пётр, добавил пока что так (для файлов понятно, но не знаю какое расширение задать для папки, чтобы получить ID системной иконки)
Код:
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
Global img0 = LoadImage(0, "c:\LR.ico")
Global img1 = LoadImage(1, "c:\LG.ico")
 
Procedure SetTreeGadget(Gadget, *Tree.TreeFiles, Depth, *Pos.Integer)
 
  If *Tree
   
    If *Tree\N<>""
      AddGadgetItem(Gadget, *Pos\i, *Tree\N, img0, 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()
      AddGadgetItem(Gadget, -1, *Tree\F()\N+"    ("+*Tree\F()\S+")", img1, Depth)
      SetGadgetItemData(Gadget, *Pos\i, *Tree\F())
      *Pos\i+1
    Next
;    
  EndIf
EndProcedure



а как бы еще изменять иконку папки при её раскрытии (нажатии на "+")? Не сломав дерева!
То есть нужно при событии ЛКМ на папке считывать её состояние (свёрнута-развёрнута) и в зависимости от этого изменять иконку на ту или иную.


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11255
Благодарил (а): 4 раз.
Поблагодарили: 429 раз.
Иконку папки можно добавить в прогу через IncludeBinary и загрузить функцией CatchImage.
Узнать раскрыта или закрыта папка можно функцией GetGadgetItemState.

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Пётр писал(а):
Иконку папки можно добавить в прогу через IncludeBinary и загрузить функцией CatchImage.

Да, я в курсе. Но ведь вопрос не о том был. Хотел сделать примерно как в этой теме (второй код srod).


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11255
Благодарил (а): 4 раз.
Поблагодарили: 429 раз.
Для этого есть функция SetGadgetItemImage.

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


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

Зарегистрирован: Вс авг 31, 2014 12:11 am
Сообщений: 433
Благодарил (а): 50 раз.
Поблагодарили: 20 раз.
Пункты репутации: 10
Добрый день, всем.
Возник вопрос по коду Петра на участке:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
 
Temp=EventType()
If Temp = #PB_EventType_Change
  Temp = GetGadgetState(0)
  If Temp>=0 And GetGadgetItemData(0, Temp)<>0
    Path\Path=""
    Path\Size=0
    Path(GetGadgetItemData(0, Temp), Path)
    Debug Path\Path+"    Size "+Path\Size
  EndIf
EndIf
 


Код уже неоднократно пОстился в теме, поэтому только интересующий участок.
Здесь происходит реагирование на изменение в TreeGadget'е. Причём только на item'e, но не на узле/ноде (о чём свидетельствует If Temp>=0) И не важно какой кнопкой мышки нажимать, что ЛКМ что ПКМ код одинаково выведет в Debug информацию. Вопрос в том как можно отличать/отлавливать отдельно события ПКМ на item'е в TreeGadget'e от ЛКМ. Чтобы иметь возможность выполнять различные действия по нажатию.
P.S. В связи с этим (#PB_EventType_Change) также происходит следующая вещь: если однажды вызвав определенный item из дерева после этого ткнуться в него же, то ничего не произойдет. Собственно так и должно быть. Вполне закономерно.


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11255
Благодарил (а): 4 раз.
Поблагодарили: 429 раз.
Ответ находится в справке https://www.purebasic.com/documentation ... adget.html
Типы событий TreeGadget
Цитата:
#PB_EventType_LeftClick: left click on an item, or a checkbox was checked/unchecked
#PB_EventType_LeftDoubleClick
#PB_EventType_RightClick
#PB_EventType_RightDoubleClick
#PB_EventType_Change: the current item changed
#PB_EventType_DragStart: the user tried to start a Drag & Drop operation.
Если заменить #PB_EventType_Change на #PB_EventType_LeftClick то будет реакция только на клик левой кнопкой мышки.

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


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

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


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

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


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

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