purebasic.info

PureBasic forum
Текущее время: Вс дек 16, 2018 2:05 pm

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




Начать новую тему Ответить на тему  [ Сообщений: 48 ]  На страницу 1, 2, 3, 4  След.
Автор Сообщение
 Заголовок сообщения: Картинка в одной из ячеек ListIconGadget
СообщениеДобавлено: Вт авг 02, 2011 9:53 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
Наверное многие видели в программах-качалках или аналогичных, рисунок-индикатор загрузки файла в ячейке ListIcon'а.
Как такое реализовать?

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


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

Зарегистрирован: Чт ноя 20, 2008 5:17 am
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Создать обработчик для гаджета ListIconGadget и самому рисовать каждый итем, например так:

Код:
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
 
Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
  Protected result, row, col
  Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
  result = #PB_ProcessPureBasicEvents
 
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #NM_CUSTOMDRAW
          *LVCDHeader.NMLVCUSTOMDRAW = lParam
          Select *LVCDHeader\nmcd\dwDrawStage
            Case #CDDS_PREPAINT
              result = #CDRF_NOTIFYITEMDRAW
            Case #CDDS_ITEMPREPAINT
              result = #CDRF_NOTIFYSUBITEMDRAW
            Case #CDDS_SUBITEMPREPAINT
              row = *LVCDHeader\nmcd\dwItemSpec
              col = *LVCDHeader\iSubItem
              If col <> -1 ; Use the same font throughout the column
                *LVCDHeader\clrTextBk = RGB(200,200,200) ;background col
                *LVCDHeader\clrText = #Blue ;Text color
                If even(row)
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontID(1))
                Else
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontID(2))
                EndIf
              EndIf
              result = #CDRF_NEWFONT
            EndSelect
      EndSelect
  EndSelect
  ProcedureReturn result
EndProcedure
 
 



Либо, копировать картинку (.RECT) контрола прогресс бар и отправлять как бэкграунд итему.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн авг 08, 2011 11:29 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
Не получилось.
Структура RECT не заполнена.
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
 
Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
   Protected result, row, col
   Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
   result = #PB_ProcessPureBasicEvents
 
   Select uMsg
     Case #WM_NOTIFY
       *pnmh.NMHDR = lParam
       Select *pnmh\code
         Case #NM_CUSTOMDRAW
           *LVCDHeader.NMLVCUSTOMDRAW = lParam
           Select *LVCDHeader\nmcd\dwDrawStage
             Case #CDDS_PREPAINT
               ;result = #CDRF_NOTIFYITEMDRAW
             Case #CDDS_ITEMPREPAINT
               result = #CDRF_NOTIFYSUBITEMDRAW
             Case #CDDS_SUBITEMPREPAINT
               row = *LVCDHeader\nmcd\dwItemSpec
               col = *LVCDHeader\iSubItem
               If col <> -1 ; Use the same font throughout the column
                 
                 brush = CreateSolidBrush_($4B04B4)
                 If brush
                   Debug *LVCDHeader\nmcd\rc\bottom
                   FillRect_(*LVCDHeader\nmcd\hdc,*LVCDHeader\nmcd\rc,brush)
                   DeleteObject_(brush)
                 EndIf
                 result = #CDRF_NOTIFYSUBITEMDRAW
               EndIf
             EndSelect
       EndSelect
   EndSelect
   ProcedureReturn result
 EndProcedure
 
If OpenWindow(0, 100, 100, 300, 100, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   ListIconGadget(0, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
   AddGadgetColumn(0, 1, "Address", 250)
   AddGadgetItem(0, -1, "Harry Rannit"+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
   AddGadgetItem(0, -1, "Ginger Brokeit"+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
   
   SetWindowCallback(@WinCallbackproc())
   
   Repeat
     Event = WaitWindowEvent()
   Until Event = #PB_Event_CloseWindow
 EndIf
 


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


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
Кажется это сработало.
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
 
 Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
    Protected result, row, col
    Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
    result = #PB_ProcessPureBasicEvents
 
    Select uMsg
      Case #WM_NOTIFY
        *pnmh.NMHDR = lParam
        Select *pnmh\code
          Case #NM_CUSTOMDRAW
            *LVCDHeader.NMLVCUSTOMDRAW = lParam
            Select *LVCDHeader\nmcd\dwDrawStage
              Case #CDDS_PREPAINT
                ;result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                result = #CDRF_NOTIFYSUBITEMDRAW
              Case #CDDS_SUBITEMPREPAINT
                row = *LVCDHeader\nmcd\dwItemSpec
                col = *LVCDHeader\iSubItem
                If col = 1 ; Use the same font throughout the column
                  rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=col:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
                  brush = CreateSolidBrush_($4B04B4)
                  If brush
                   
                    FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
                    DeleteObject_(brush)
                  EndIf
                  result = #CDRF_SKIPDEFAULT
                EndIf
              EndSelect
        EndSelect
    EndSelect
    ProcedureReturn result
  EndProcedure
 
 If OpenWindow(0, 100, 100, 300, 100, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ListIconGadget(0, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
    AddGadgetColumn(0, 1, "Progress", 50)
    AddGadgetColumn(0, 2, "Address", 150)
    AddGadgetItem(0, -1, "Harry Rannit"+Chr(10)+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
    AddGadgetItem(0, -1, "Ginger Brokeit"+Chr(10)+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
     
    SetWindowCallback(@WinCallbackproc())
     
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf


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


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт авг 09, 2011 11:14 am 
Не в сети
профессор

Зарегистрирован: Ср янв 14, 2009 4:12 pm
Сообщений: 2002
Благодарил (а): 12 раз.
Поблагодарили: 101 раз.
Пункты репутации: 43
Пётр писал(а):
Кажется это сработало.

Ну и как из этого заюзать прогрессбар? В код архиве есть примерчик ProgressBar_in_ListView.pb, но он криво работает.

_________________
Всё должно быть просто, настолько просто, насколько возможно, но не проще. (c) Альберт Эйнштейн
Изображение


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
pablov писал(а):
Ну и как из этого заюзать прогрессбар?
Можно вот так, только хз как сделать чтобы текст инвретировал свой цвет когда на него наезжает полоса прогресса.
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
 
  Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
     Protected result, row, col
     Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
     result = #PB_ProcessPureBasicEvents
 
     Select uMsg
       Case #WM_NOTIFY
         *pnmh.NMHDR = lParam
         Select *pnmh\code
           Case #NM_CUSTOMDRAW
             *LVCDHeader.NMLVCUSTOMDRAW = lParam
             Select *LVCDHeader\nmcd\dwDrawStage
               Case #CDDS_PREPAINT
                 ;result = #CDRF_NOTIFYITEMDRAW
               Case #CDDS_ITEMPREPAINT
                 result = #CDRF_NOTIFYSUBITEMDRAW
               Case #CDDS_SUBITEMPREPAINT
                 row = *LVCDHeader\nmcd\dwItemSpec
                 col = *LVCDHeader\iSubItem
                 If col = 1 ; Use the same font throughout the column
                   rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=col:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
                   Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
                   Progress = GetGadgetItemData(Gadget, row)
                   If rc\left>0 And rc\left < rc\right
                     Right = rc\right
                     brush = CreateSolidBrush_($4B04B4)
                     If brush
                       x.f=Progress/(100/(rc\right-rc\left))
                       If rc\right>rc\left+x
                         rc\right=rc\left+x
                       EndIf
                       FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
                       DeleteObject_(brush)
                     EndIf
                     rc\right = Right
                     SetTextColor_(*LVCDHeader\nmcd\hdc, $2F6234)
                     SetBkColor_(*LVCDHeader\nmcd\hdc, #TRANSPARENT)
                     String.s = Str(Progress)+"%"
                     DrawText_(*LVCDHeader\nmcd\hdc, String, Len(String), @rc, #DT_CENTER)
                   EndIf
                   result = #CDRF_SKIPDEFAULT
                 EndIf
               EndSelect
         EndSelect
     EndSelect
     ProcedureReturn result
   EndProcedure
 
Procedure UpdateProgress(Gadget, Item, Progress)
  SetGadgetItemData(Gadget, Item, Progress)
  rc.RECT
  rc\left=#LVIR_BOUNDS
  rc\top=1
  SendMessage_(GadgetID(Gadget),#LVM_GETSUBITEMRECT,Item,@rc)
  InvalidateRect_(GadgetID(Gadget), @rc, #True)
EndProcedure
 
  If OpenWindow(0, 100, 100, 300, 100, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
     ListIconGadget(2, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
     AddGadgetColumn(2, 1, "Progress", 50)
     AddGadgetColumn(2, 2, "Address", 150)
     AddGadgetItem(2, -1, "Harry Rannit"+Chr(10)+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
     AddGadgetItem(2, -1, "Ginger Brokeit"+Chr(10)+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
       
     SetWindowCallback(@WinCallbackproc())
     AddWindowTimer(0,0, 100)
     
     pb1=0
     pb2=0
     Repeat
       Event = WaitWindowEvent()
       
       If Event = #PB_Event_Timer
         If EventTimer() = 0
           pb1+1
           If pb1>100 : pb1=0 : EndIf
           UpdateProgress(2, 0, pb1)
            If pb1&1
              pb2+1
              If pb2>100 : pb2=0 : EndIf
              UpdateProgress(2, 1, pb2)
           EndIf
         EndIf
       EndIf
       
     Until Event = #PB_Event_CloseWindow
   EndIf


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


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

Зарегистрирован: Ср янв 14, 2009 4:12 pm
Сообщений: 2002
Благодарил (а): 12 раз.
Поблагодарили: 101 раз.
Пункты репутации: 43
А что, достойно получилось. У буржуев на форуме я ничего подобного не нашел. На счет инверсии , просто цвет прогреса взять посветлее и все ОК

_________________
Всё должно быть просто, настолько просто, насколько возможно, но не проще. (c) Альберт Эйнштейн
Изображение


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

Зарегистрирован: Чт ноя 20, 2008 5:17 am
Сообщений: 33
Благодарил (а): 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
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
 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT
 
   Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
      Protected result, row, col
      Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
      result = #PB_ProcessPureBasicEvents
 
      Select uMsg
        Case #WM_NOTIFY
          *pnmh.NMHDR = lParam
          Select *pnmh\code
            Case #NM_CUSTOMDRAW
              *LVCDHeader.NMLVCUSTOMDRAW = lParam
              Select *LVCDHeader\nmcd\dwDrawStage
                Case #CDDS_PREPAINT
                  ;result = #CDRF_NOTIFYITEMDRAW
                Case #CDDS_ITEMPREPAINT
                  result = #CDRF_NOTIFYSUBITEMDRAW
                Case #CDDS_SUBITEMPREPAINT
                  row = *LVCDHeader\nmcd\dwItemSpec
                  col = *LVCDHeader\iSubItem
                  If col = 1 ; Use the same font throughout the column
                    ;GetWindowRect_(GadgetID(10),  rc.RECT)
                    ;Debug rc\right
 
                    rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=col:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
                    Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
                    Progress = GetGadgetItemData(Gadget, row)      
                   
                    If rc\left>0 And rc\left < rc\right
                      Right = rc\right
                      ;brush = CreateSolidBrush_($4B04B4)
                      If brush
                        x.f=Progress/(100/(rc\right-rc\left))
                        If rc\right>rc\left+x
                          rc\right=rc\left+x
                        EndIf
                        ;FillRect_(HDC,@rc,brush)
                        ;DeleteObject_(brush)
                      EndIf
                      rc\right = Right
                     
                      ResizeGadget(10,#PB_Ignore,#PB_Ignore,rc\right-rc\left-2,#PB_Ignore)                      
                      SetGadgetState(10,Progress)
                      ;InvalidateRect_(GadgetID(10),0,0)
                     
                      pb_hWnd = GadgetID(10)
                      rc2.RECT
                      GetClientRect_(pb_hWnd, @rc2)
                      hDC.l=GetDC_(pb_hWnd)
                   
                      BitBlt_(*LVCDHeader\nmcd\hdc,rc\left+1,rc\top,rc2\right,rc2\bottom,hDC,0,0,#SRCCOPY)
                      DeleteDC_(hDC)
                     
                      rc\top = rc\top+1
                      SetTextColor_(*LVCDHeader\nmcd\hdc, $2F6234)
                      SetBkColor_(*LVCDHeader\nmcd\hdc, #TRANSPARENT)
                      String.s = Str(Progress)+"%"
                      DrawText_(*LVCDHeader\nmcd\hdc, String, Len(String), @rc, #DT_CENTER)
                    EndIf
                    result = #CDRF_SKIPDEFAULT
                  EndIf
                EndSelect
          EndSelect
      EndSelect
      ProcedureReturn result
    EndProcedure
 
 Procedure UpdateProgress(Gadget, Item, Progress)
   SetGadgetItemData(Gadget, Item, Progress)
   rc.RECT
   rc\left=#LVIR_BOUNDS
   rc\top=1
   SendMessage_(GadgetID(Gadget),#LVM_GETSUBITEMRECT,Item,@rc)
   InvalidateRect_(GadgetID(Gadget), @rc, #True)
 EndProcedure
 
   If OpenWindow(0, 100, 100, 300, 200, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
      ListIconGadget(2, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
      AddGadgetColumn(2, 1, "Progress", 50)
      AddGadgetColumn(2, 2, "Address", 150)
      AddGadgetItem(2, -1, "Harry Rannit"+Chr(10)+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
      ;AddGadgetItem(2, -1, "Ginger Brokeit"+Chr(10)+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
     
      ProgressBarGadget(10,  30, 170, 40,  15, 0, 100)
         
      SetWindowCallback(@WinCallbackproc())
      AddWindowTimer(0,0, 100)
       
      pb1=0
      pb2=0
      Repeat
        Event = WaitWindowEvent()
         
        If Event = #PB_Event_Timer
          If EventTimer() = 0
            pb1+1
            If pb1>100 : pb1=0 : EndIf
            UpdateProgress(2, 0, pb1)
             If pb1&1
               pb2+1
               If pb2>100 : pb2=0 : EndIf
               UpdateProgress(2, 1, pb2)
            EndIf
          EndIf
        EndIf
         
      Until Event = #PB_Event_CloseWindow
    EndIf
 



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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
Все таки не могу понять как изменить цвет текста на белый когда на него наезжает индикатор прогресса?
Максимум что получилось - инвертировать цвет текста относительно фона, но цвет получился оранжевый (зависит от цвета индикатора прогресса).
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
FontDefault = GetStockObject_(#DEFAULT_GUI_FONT)
 
Procedure DrawProgressBar(*LVCDHeader.NMLVCUSTOMDRAW)
  Shared FontDefault
 
  rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=*LVCDHeader\iSubItem:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
  Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
  Progress = GetGadgetItemData(Gadget, *LVCDHeader\nmcd\dwItemSpec)
  If rc\left>=0 And rc\left < rc\right
    Right = rc\right
    brush = CreateSolidBrush_($EE5F02)
    If brush
      x.f=Progress/(100/(rc\right-rc\left))
      If rc\right>rc\left+x
        rc\right=rc\left+x
      EndIf
      FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
      DeleteObject_(brush)
    EndIf
    rc\right = Right
    hMemoryDC = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
    If hMemoryDC
      hBitmap = CreateBitmap_(rc\right-rc\left,rc\bottom-rc\top,1,1,0)
      ;hBitmap = CreateCompatibleBitmap_(hMemoryDC, rc\right-rc\left, rc\bottom-rc\top)
      If hBitmap
        SelectObject_(hMemoryDC, hBitmap)
        SelectObject_(hMemoryDC, FontDefault)
        SetTextColor_(hMemoryDC, $FFFFFF)
        SetBkColor_(hMemoryDC, $0)
        Text.RECT
        Text\left = 0 : Text\top = 0
        Text\right = rc\right-rc\left : Text\bottom = rc\bottom-rc\top
        String.s = Str(Progress)+" %"
        DrawText_(hMemoryDC, String, Len(String), @Text, #DT_CENTER)
        BitBlt_(*LVCDHeader\nmcd\hdc, rc\left, rc\top, rc\right-rc\left, rc\bottom-rc\top, hMemoryDC, 0,0, #SRCINVERT);
        DeleteObject_(hBitmap)
      EndIf
      DeleteDC_(hMemoryDC)
    EndIf
   
  EndIf
EndProcedure
 
Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
  Protected result, row, col
  Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
  result = #PB_ProcessPureBasicEvents
 
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #NM_CUSTOMDRAW
          *LVCDHeader.NMLVCUSTOMDRAW = lParam
          row = *LVCDHeader\nmcd\dwItemSpec
          col = *LVCDHeader\iSubItem
          If col = 1
            Select *LVCDHeader\nmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                result = #CDRF_NOTIFYSUBITEMDRAW
              Case #CDDS_SUBITEMPREPAINT
                DrawProgressBar(lParam)
                result = #CDRF_SKIPDEFAULT
            EndSelect
          EndIf  
      EndSelect
     
  EndSelect
  ProcedureReturn result
EndProcedure
 
Procedure UpdateProgress(Gadget, Item, Column, Progress)
  SetGadgetItemData(Gadget, Item, Progress)
  rc.RECT
  rc\left=#LVIR_BOUNDS
  rc\top=Column
  SendMessage_(GadgetID(Gadget),#LVM_GETSUBITEMRECT,Item,@rc)
  InvalidateRect_(GadgetID(Gadget), @rc, #True)
EndProcedure
 
If OpenWindow(0, 100, 100, 300, 100, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(2, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
  AddGadgetColumn(2, 1, "Progress", 50)
  AddGadgetColumn(2, 2, "Address", 150)
  AddGadgetItem(2, -1, "Harry Rannit"+Chr(10)+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
  AddGadgetItem(2, -1, "Ginger Brokeit"+Chr(10)+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
 
  SetWindowCallback(@WinCallbackproc())
  AddWindowTimer(0,0, 100)
 
  pb1=0
  pb2=0
  Repeat
    Event = WaitWindowEvent()
   
    If Event = #PB_Event_Timer
      If EventTimer() = 0
        pb1+1
        If pb1>100 : pb1=0 : EndIf
        UpdateProgress(2, 0, 1, pb1)
        If pb1&1
          pb2+1
          If pb2>100 : pb2=0 : EndIf
          UpdateProgress(2, 1, 1, pb2)
        EndIf
      EndIf
    EndIf
   
  Until Event = #PB_Event_CloseWindow
EndIf


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


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
С помощью костылей удалось таки получить требуемый результат - если индикатор прогресса не на картинке, то текст черный, а если индикатор пересекает текст, то он становится белым.
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
FontDefault = GetStockObject_(#DEFAULT_GUI_FONT)
 
Procedure DrawProgressBar(*LVCDHeader.NMLVCUSTOMDRAW)
  Shared FontDefault
 
  rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=*LVCDHeader\iSubItem:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
  Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
  Progress = GetGadgetItemData(Gadget, *LVCDHeader\nmcd\dwItemSpec)
  If rc\left>=0 And rc\left < rc\right
   
    If *LVCDHeader\nmcd\dwItemSpec=0
      Color = $EE5F02
    Else
      Color = $90B448
    EndIf
 
    Right = rc\right
    brush = CreateSolidBrush_(Color)
    If brush
      x.f=Progress/(100/(rc\right-rc\left))
      If rc\right>rc\left+x
        rc\right=rc\left+x
      EndIf
      FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
      DeleteObject_(brush)
    EndIf
    rc\right = Right
    hMemoryDC = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
    If hMemoryDC
      hMemoryDC_1 = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
      If hMemoryDC_1
       
        hBitmap_1 = CreateCompatibleBitmap_(*LVCDHeader\nmcd\hdc, rc\right-rc\left, rc\bottom-rc\top)
        If hBitmap_1
          Text.RECT
          Text\left = 0 : Text\top = 0
          Text\right = Text\left+x : Text\bottom = rc\bottom-rc\top
          SelectObject_(hMemoryDC_1, hBitmap_1)
          brush = CreateSolidBrush_(Color)
          If brush
            FillRect_(hMemoryDC_1,@Text,brush)
            DeleteObject_(brush)
          EndIf
         
          hBitmap = CreateBitmap_(rc\right-rc\left,rc\bottom-rc\top,1,1,0)
          If hBitmap
            SelectObject_(hMemoryDC, hBitmap)
            SelectObject_(hMemoryDC, FontDefault)
            SetTextColor_(hMemoryDC, $FFFFFF)
            SetBkColor_(hMemoryDC, $0)
            String.s = Str(Progress)+"%"
            Text.RECT
            Text\left = 0 : Text\top = 0
            Text\right = rc\right-rc\left : Text\bottom = rc\bottom-rc\top
            DrawText_(hMemoryDC, String, Len(String), @Text, #DT_CENTER)
            MaskBlt_(hMemoryDC_1, Text\left, Text\top, Text\right-Text\left, Text\bottom-Text\top, hMemoryDC,0, 0, hBitmap, 0, 0 ,#SRCINVERT)
            BitBlt_(*LVCDHeader\nmcd\hdc, rc\left, rc\top, rc\right-rc\left, rc\bottom-rc\top, hMemoryDC_1, 0,0, #SRCINVERT)
           
            DeleteObject_(hBitmap)
          EndIf
          DeleteObject_(hBitmap_1)  
        EndIf
        DeleteDC_(hMemoryDC_1)
      EndIf
      DeleteDC_(hMemoryDC)
    EndIf
   
  EndIf
EndProcedure
 
Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
  Protected result, row, col
  Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
  result = #PB_ProcessPureBasicEvents
 
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #NM_CUSTOMDRAW
          *LVCDHeader.NMLVCUSTOMDRAW = lParam
          row = *LVCDHeader\nmcd\dwItemSpec
          col = *LVCDHeader\iSubItem
          If col = 1
            Select *LVCDHeader\nmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                result = #CDRF_NOTIFYSUBITEMDRAW
              Case #CDDS_SUBITEMPREPAINT
                DrawProgressBar(lParam)
                result = #CDRF_SKIPDEFAULT
            EndSelect
          EndIf  
      EndSelect
     
  EndSelect
  ProcedureReturn result
EndProcedure
 
Procedure UpdateProgress(Gadget, Item, Column, Progress)
  SetGadgetItemData(Gadget, Item, Progress)
  rc.RECT
  rc\left=#LVIR_BOUNDS
  rc\top=Column
  SendMessage_(GadgetID(Gadget),#LVM_GETSUBITEMRECT,Item,@rc)
  InvalidateRect_(GadgetID(Gadget), @rc, #True)
EndProcedure
 
If OpenWindow(0, 100, 100, 300, 100, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(2, 5, 5, 290, 90, "Name", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
  AddGadgetColumn(2, 1, "Progress", 50)
  AddGadgetColumn(2, 2, "Address", 150)
  AddGadgetItem(2, -1, "Harry Rannit"+Chr(10)+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
  AddGadgetItem(2, -1, "Ginger Brokeit"+Chr(10)+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
 
  SetWindowCallback(@WinCallbackproc())
  AddWindowTimer(0,0, 100)
 
  pb1=0
  pb2=0
  Repeat
    Event = WaitWindowEvent()
   
    If Event = #PB_Event_Timer
      If EventTimer() = 0
        pb1+1
        If pb1>100 : pb1=0 : EndIf
        UpdateProgress(2, 0, 1, pb1)
        If pb1&1
          pb2+1
          If pb2>100 : pb2=0 : EndIf
          UpdateProgress(2, 1, 1, pb2)
        EndIf
      EndIf
    EndIf
   
  Until Event = #PB_Event_CloseWindow
EndIf



PS.
Не совсем понял почему рисунки, созданные из контекста в памяти (получен с помощью CreateCompatibleDC), могут быть только черно-белыми. :shock: :?

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


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

Зарегистрирован: Чт ноя 20, 2008 5:17 am
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Пётр
Можно даже в примеры перенести.


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

Зарегистрирован: Сб июл 18, 2009 8:25 am
Сообщений: 815
Благодарил (а): 22 раз.
Поблагодарили: 4 раз.
Пункты репутации: 0
В uTorrent, если не ошибаюсь, это реализовано тоже на GDI практически тем же способом.


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

Зарегистрирован: Ср янв 14, 2009 4:12 pm
Сообщений: 2002
Благодарил (а): 12 раз.
Поблагодарили: 101 раз.
Пункты репутации: 43
Пётр писал(а):
С помощью костылей

Хорошие костыли, крепкие :D
Прилепил к твоему коду качалку файлов из инета. Еще бы по плавней прогресс сделать, чтоб шагал через десятые доли процента
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
 
#HTTP_QUERY_CONTENT_LENGTH    = 5
#HTTP_QUERY_FLAG_NUMBER       = $20000000
#HTTP_QUERY_LAST_MODIFIED     = 11
#INTERNET_OPEN_TYPE_PRECONFIG = 0            ; устанавливает тип доступа в соответствии с установками в реестре
#INTERNET_OPEN_TYPE_DIRECT    = 1
#INTERNET_OPEN_TYPE_PROXY     = 3
#INTERNET_FLAG_RELOAD         = $80000000
 
Structure DOWNLOAD
  hURL.l
  hInet.l
  FileSize.l
EndStructure
 
Global hThread.l
 
 
 FontDefault = GetStockObject_(#DEFAULT_GUI_FONT)
 
 Procedure DrawProgressBar(*LVCDHeader.NMLVCUSTOMDRAW)
   Shared FontDefault
   
   rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=*LVCDHeader\iSubItem:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
   Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
   Progress = GetGadgetItemData(Gadget, *LVCDHeader\nmcd\dwItemSpec)
   If rc\left>=0 And rc\left < rc\right
     
;      If *LVCDHeader\nmcd\dwItemSpec=0
;        Color = $EE5F02
;      Else
;        Color = $90B448
;      EndIf
     Color = $90B448
 
     Right = rc\right
     brush = CreateSolidBrush_(Color)
     If brush
       x.f=Progress/(100/(rc\right-rc\left))
       If rc\right>rc\left+x
         rc\right=rc\left+x
       EndIf
       FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
       DeleteObject_(brush)
     EndIf
     rc\right = Right
     hMemoryDC = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
     If hMemoryDC
       hMemoryDC_1 = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
       If hMemoryDC_1
         
         hBitmap_1 = CreateCompatibleBitmap_(*LVCDHeader\nmcd\hdc, rc\right-rc\left, rc\bottom-rc\top)
         If hBitmap_1
           Text.RECT
           Text\left = 0 : Text\top = 0
           Text\right = Text\left+x : Text\bottom = rc\bottom-rc\top
           SelectObject_(hMemoryDC_1, hBitmap_1)
           brush = CreateSolidBrush_(Color)
           If brush
             FillRect_(hMemoryDC_1,@Text,brush)
             DeleteObject_(brush)
           EndIf
           
           hBitmap = CreateBitmap_(rc\right-rc\left,rc\bottom-rc\top,1,1,0)
           If hBitmap
             SelectObject_(hMemoryDC, hBitmap)
             SelectObject_(hMemoryDC, FontDefault)
             SetTextColor_(hMemoryDC, $FFFFFF)
             SetBkColor_(hMemoryDC, $0)
             String.s = Str(Progress)+"%"
             Text.RECT
             Text\left = 0 : Text\top = 0
             Text\right = rc\right-rc\left : Text\bottom = rc\bottom-rc\top
             DrawText_(hMemoryDC, String, Len(String), @Text, #DT_CENTER)
             MaskBlt_(hMemoryDC_1, Text\left, Text\top, Text\right-Text\left, Text\bottom-Text\top, hMemoryDC,0, 0, hBitmap, 0, 0 ,#SRCINVERT)
             BitBlt_(*LVCDHeader\nmcd\hdc, rc\left, rc\top, rc\right-rc\left, rc\bottom-rc\top, hMemoryDC_1, 0,0, #SRCINVERT)
             
             DeleteObject_(hBitmap)
           EndIf
           DeleteObject_(hBitmap_1)  
         EndIf
         DeleteDC_(hMemoryDC_1)
       EndIf
       DeleteDC_(hMemoryDC)
     EndIf
     
   EndIf
 EndProcedure
 
 Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
   Protected result, row, col
   Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
   result = #PB_ProcessPureBasicEvents
   
   Select uMsg
     Case #WM_NOTIFY
       *pnmh.NMHDR = lParam
       Select *pnmh\code
         Case #NM_CUSTOMDRAW
           *LVCDHeader.NMLVCUSTOMDRAW = lParam
           row = *LVCDHeader\nmcd\dwItemSpec
           col = *LVCDHeader\iSubItem
           If col = 1
             Select *LVCDHeader\nmcd\dwDrawStage
               Case #CDDS_PREPAINT
                 result = #CDRF_NOTIFYITEMDRAW
               Case #CDDS_ITEMPREPAINT
                 result = #CDRF_NOTIFYSUBITEMDRAW
               Case #CDDS_SUBITEMPREPAINT
                 DrawProgressBar(lParam)
                 result = #CDRF_SKIPDEFAULT
             EndSelect
           EndIf  
       EndSelect
       
   EndSelect
   ProcedureReturn result
 EndProcedure
 
Procedure UpdateProgress(Progress)
  SetGadgetItemData(2, 0, Progress)
  rc.RECT
  rc\left=#LVIR_BOUNDS
  rc\top=1
  SendMessage_(GadgetID(2),#LVM_GETSUBITEMRECT,0,@rc)
  InvalidateRect_(GadgetID(2), @rc, #True)
EndProcedure
 
Procedure DownloadFile(*Parameters.DOWNLOAD)
  isLoop.b = 1
  Bytes.l = 0
  fBytes.l = 0
  Buffer.l = *Parameters\FileSize / 100
  memID = AllocateMemory(Buffer)
  Repeat
    InternetReadFile_(*Parameters\hURL, memID, Buffer, @Bytes)
    If Bytes = 0
      isLoop=0
    Else
      fBytes=fBytes+Bytes
      SetGadgetItemText(2, 0, Str(fBytes), 2)
      If *Parameters\FileSize >= fBytes
   ;       a + 1
          UpdateProgress(a)
          a + 1
      EndIf    
      WriteData(1,memID, Bytes)
    EndIf
  Until isLoop = 0
;  UpdateProgress(0)
  InternetCloseHandle_(*Parameters\hURL)
  InternetCloseHandle_(*Parameters\hInet)
  CloseFile(1)    
  FreeMemory(memID)
EndProcedure
 
Procedure UrlFileInfo(myFile.s, URL.s)
 lpBuffer.s = Space(20)
 lpdwBufferLength.l = Len(lpBuffer)
 If CreateFile(1, myFile)
   hInet  = InternetOpen_("", #INTERNET_OPEN_TYPE_PRECONFIG, #Null, #Null, 0)
   hURL   = InternetOpenUrl_(hInet, URL, #Null, 0, #INTERNET_FLAG_RELOAD, 0)
   If HttpQueryInfo_(hURL, #HTTP_QUERY_CONTENT_LENGTH, @lpBuffer, @lpdwBufferLength, 0)   ; |#HTTP_QUERY_FLAG_NUMBER
      *myDownload.DOWNLOAD = AllocateMemory(SizeOf(DOWNLOAD))
      *myDownload\hInet = hInet
      *myDownload\hURL  = hURL
      *myDownload\FileSize = Val(lpBuffer)
      hThread = CreateThread(@DownloadFile(), *myDownload)
   EndIf
 EndIf
EndProcedure
 
If OpenWindow(0, 100, 100, 720, 150, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(2, 5, 5, 710, 90, "File", 150, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
  AddGadgetColumn(2, 1, "Progress", 250)
  AddGadgetColumn(2, 2, "Bytes", 150)
  AddGadgetItem(2, -1, ""+Chr(10)+Chr(10)+"")
  ButtonGadget(3, 670, 115, 40, 20, "Start")
  StringGadget(4, 5, 115, 650, 18, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg")
  ; Покрупнее файлики
  ; http://www.spectralcore.com/download/trial-fcent.exe                           - 9.5 Mb
  ; http://www.autodealer.ru/downloads_file/soft/autodealer/demo/autodealer.zip    -  70 Mb
  SetWindowCallback(@WinCallbackproc())
 
  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_Gadget  
      Select EventGadget()
        Case 3
          URL.s = GetGadgetText(4)
          myFile.s= Right(URL, FindString(ReverseString(URL),"/",1)-1)
          SetGadgetItemText(2, 0, myFile, 0)
          SetGadgetItemText(2, 0, "", 2)
          UpdateProgress(0)
          myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:")
          If myFolder
             UrlFileInfo(myFolder + myFile, URL)
          Else    
             SetGadgetItemText(2, 0, "", 0)
             SetGadgetItemText(2, 0, "", 1)
             SetGadgetItemText(2, 0, "", 2)
          EndIf  
      EndSelect
    EndIf  
  Until EventID = #PB_Event_CloseWindow
   If IsThread(hThread) : KillThread(hThread) : EndIf
EndIf
End


_________________
Всё должно быть просто, настолько просто, насколько возможно, но не проще. (c) Альберт Эйнштейн
Изображение


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

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11336
Благодарил (а): 4 раз.
Поблагодарили: 443 раз.
pablov писал(а):
ще бы по плавней прогресс сделать, чтоб шагал через десятые доли процента
Можно, только у меня такая скорость инета, что при скачивании того файла, не то что десятые, единицы процентов не различить.
Код:
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
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
 
 #HTTP_QUERY_CONTENT_LENGTH    = 5
 #HTTP_QUERY_FLAG_NUMBER       = $20000000
 #HTTP_QUERY_LAST_MODIFIED     = 11
 #INTERNET_OPEN_TYPE_PRECONFIG = 0            ; устанавливает тип доступа в соответствии с установками в реестре
 #INTERNET_OPEN_TYPE_DIRECT    = 1
 #INTERNET_OPEN_TYPE_PROXY     = 3
 #INTERNET_FLAG_RELOAD         = $80000000
 
 Structure DOWNLOAD
   hURL.l
   hInet.l
   FileSize.l
 EndStructure
 
 Global hThread.l
 
 
  FontDefault = GetStockObject_(#DEFAULT_GUI_FONT)
 
  Procedure DrawProgressBar(*LVCDHeader.NMLVCUSTOMDRAW)
    Shared FontDefault
     
    rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=*LVCDHeader\iSubItem:SendMessage_(*LVCDHeader\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*LVCDHeader\nmcd\dwItemSpec,@rc)
    Gadget = GetDlgCtrlID_(*LVCDHeader\nmcd\hdr\hwndfrom)
    *Point=GetGadgetItemData(Gadget, *LVCDHeader\nmcd\dwItemSpec)
    If *Point
      Progress.f = PeekF(*Point)
    Else
      Progress.f = 0
    EndIf
    If rc\left>=0 And rc\left < rc\right
       
 ;      If *LVCDHeader\nmcd\dwItemSpec=0
 ;        Color = $EE5F02
 ;      Else
 ;        Color = $90B448
 ;      EndIf
      Color = $90B448
 
      Right = rc\right
      brush = CreateSolidBrush_(Color)
      If brush
        x.f=Progress/(100/(rc\right-rc\left))
        If rc\right>rc\left+x
          rc\right=rc\left+x
        EndIf
        FillRect_(*LVCDHeader\nmcd\hdc,@rc,brush)
        DeleteObject_(brush)
      EndIf
      rc\right = Right
      hMemoryDC = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
      If hMemoryDC
        hMemoryDC_1 = CreateCompatibleDC_(*LVCDHeader\nmcd\hdc)
        If hMemoryDC_1
           
          hBitmap_1 = CreateCompatibleBitmap_(*LVCDHeader\nmcd\hdc, rc\right-rc\left, rc\bottom-rc\top)
          If hBitmap_1
            Text.RECT
            Text\left = 0 : Text\top = 0
            Text\right = Text\left+x : Text\bottom = rc\bottom-rc\top
            SelectObject_(hMemoryDC_1, hBitmap_1)
            brush = CreateSolidBrush_(Color)
            If brush
              FillRect_(hMemoryDC_1,@Text,brush)
              DeleteObject_(brush)
            EndIf
             
            hBitmap = CreateBitmap_(rc\right-rc\left,rc\bottom-rc\top,1,1,0)
            If hBitmap
              SelectObject_(hMemoryDC, hBitmap)
              SelectObject_(hMemoryDC, FontDefault)
              SetTextColor_(hMemoryDC, $FFFFFF)
              SetBkColor_(hMemoryDC, $0)
              String.s = StrF(Progress, 1)+" %"
              Text.RECT
              Text\left = 0 : Text\top = 0
              Text\right = rc\right-rc\left : Text\bottom = rc\bottom-rc\top
              DrawText_(hMemoryDC, String, Len(String), @Text, #DT_CENTER)
              MaskBlt_(hMemoryDC_1, Text\left, Text\top, Text\right-Text\left, Text\bottom-Text\top, hMemoryDC,0, 0, hBitmap, 0, 0 ,#SRCINVERT)
              BitBlt_(*LVCDHeader\nmcd\hdc, rc\left, rc\top, rc\right-rc\left, rc\bottom-rc\top, hMemoryDC_1, 0,0, #SRCINVERT)
               
              DeleteObject_(hBitmap)
            EndIf
            DeleteObject_(hBitmap_1)  
          EndIf
          DeleteDC_(hMemoryDC_1)
        EndIf
        DeleteDC_(hMemoryDC)
      EndIf
       
    EndIf
  EndProcedure
 
  Procedure WinCallbackproc(hWnd, uMsg, wParam, lParam)
    Protected result, row, col
    Protected *pnmh.NMHDR, *LVCDHeader.NMLVCUSTOMDRAW
    result = #PB_ProcessPureBasicEvents
     
    Select uMsg
      Case #WM_NOTIFY
        *pnmh.NMHDR = lParam
        Select *pnmh\code
          Case #NM_CUSTOMDRAW
            *LVCDHeader.NMLVCUSTOMDRAW = lParam
            row = *LVCDHeader\nmcd\dwItemSpec
            col = *LVCDHeader\iSubItem
            If col = 1
              Select *LVCDHeader\nmcd\dwDrawStage
                Case #CDDS_PREPAINT
                  result = #CDRF_NOTIFYITEMDRAW
                Case #CDDS_ITEMPREPAINT
                  result = #CDRF_NOTIFYSUBITEMDRAW
                Case #CDDS_SUBITEMPREPAINT
                  DrawProgressBar(lParam)
                  result = #CDRF_SKIPDEFAULT
              EndSelect
            EndIf  
        EndSelect
         
    EndSelect
    ProcedureReturn result
  EndProcedure
 
 Procedure UpdateProgress(*Progress)
   SetGadgetItemData(2, 0, *Progress)
   rc.RECT
   rc\left=#LVIR_BOUNDS
   rc\top=1
   SendMessage_(GadgetID(2),#LVM_GETSUBITEMRECT,0,@rc)
   InvalidateRect_(GadgetID(2), @rc, #True)
 EndProcedure
 
 Procedure DownloadFile(*Parameters.DOWNLOAD)
   isLoop.b = 1
   Bytes.l = 0
   fBytes.l = 0
   Buffer.l = *Parameters\FileSize / 1000
   memID = AllocateMemory(Buffer)
   Repeat
     InternetReadFile_(*Parameters\hURL, memID, Buffer, @Bytes)
     If Bytes = 0
       isLoop=0
     Else
       fBytes=fBytes+Bytes
       SetGadgetItemText(2, 0, Str(fBytes), 2)
       If *Parameters\FileSize >= fBytes
    ;       a + 1
           UpdateProgress(@a.f)
           a + 0.1
       EndIf      
       WriteData(1,memID, Bytes)
     EndIf
   Until isLoop = 0
   a = 100
   UpdateProgress(@a)
   InternetCloseHandle_(*Parameters\hURL)
   InternetCloseHandle_(*Parameters\hInet)
   CloseFile(1)    
   FreeMemory(memID)
 EndProcedure
 
 Procedure UrlFileInfo(myFile.s, URL.s)
  lpBuffer.s = Space(20)
  lpdwBufferLength.l = Len(lpBuffer)
  If CreateFile(1, myFile)
    hInet  = InternetOpen_("", #INTERNET_OPEN_TYPE_PRECONFIG, #Null, #Null, 0)
    hURL   = InternetOpenUrl_(hInet, URL, #Null, 0, #INTERNET_FLAG_RELOAD, 0)
    If HttpQueryInfo_(hURL, #HTTP_QUERY_CONTENT_LENGTH, @lpBuffer, @lpdwBufferLength, 0)   ; |#HTTP_QUERY_FLAG_NUMBER
       *myDownload.DOWNLOAD = AllocateMemory(SizeOf(DOWNLOAD))
       *myDownload\hInet = hInet
       *myDownload\hURL  = hURL
       *myDownload\FileSize = Val(lpBuffer)
       hThread = CreateThread(@DownloadFile(), *myDownload)
    EndIf
  EndIf
 EndProcedure
 
 If OpenWindow(0, 100, 100, 720, 150, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   ListIconGadget(2, 5, 5, 710, 90, "File", 150, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
   AddGadgetColumn(2, 1, "Progress", 250)
   AddGadgetColumn(2, 2, "Bytes", 150)
   AddGadgetItem(2, -1, ""+Chr(10)+Chr(10)+"")
   ButtonGadget(3, 670, 115, 40, 20, "Start")
   StringGadget(4, 5, 115, 650, 18, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg")
   ; Покрупнее файлики
   ; http://www.spectralcore.com/download/trial-fcent.exe                           - 9.5 Mb
   ; http://www.autodealer.ru/downloads_file/soft/autodealer/demo/autodealer.zip    -  70 Mb
   SetWindowCallback(@WinCallbackproc())
   
   Repeat
     EventID = WaitWindowEvent()
     If EventID = #PB_Event_Gadget  
       Select EventGadget()
         Case 3
           URL.s = GetGadgetText(4)
           myFile.s= Right(URL, FindString(ReverseString(URL),"/",1)-1)
           SetGadgetItemText(2, 0, myFile, 0)
           SetGadgetItemText(2, 0, "", 2)
           UpdateProgress(0)
           myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:")
           If myFolder
              UrlFileInfo(myFolder + myFile, URL)
           Else    
              SetGadgetItemText(2, 0, "", 0)
              SetGadgetItemText(2, 0, "", 1)
              SetGadgetItemText(2, 0, "", 2)
           EndIf    
       EndSelect
     EndIf  
   Until EventID = #PB_Event_CloseWindow
    If IsThread(hThread) : KillThread(hThread) : EndIf
 EndIf
 End


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


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

Зарегистрирован: Сб июл 18, 2009 8:25 am
Сообщений: 815
Благодарил (а): 22 раз.
Поблагодарили: 4 раз.
Пункты репутации: 0
Полоска стала бежать намного приятней!
Вот теперь можно и перенести.


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

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


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

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


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

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