Такой вот набросок гаджета типа ListIcon в силу своих умений.
Исходил из того, что это будет работать в связке с базой данных.
Хотелось бы замечаний, поправок, советов. И вообще, той ли дорогой иду или лисапед изобретаю?
Код:
Global m=-25, t, Dim id(0)
Procedure draw()
CreateImage(1, 498, 26, 24, $FEFEFE)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_Outlined)
Box(-1, 0, 201, 26, $CCCCCC)
Box(199, 0, 199, 26, $CCCCCC)
Box(298, 0, 201, 26, $CCCCCC)
Box(21, 6, 14, 14, $202020)
StopDrawing()
EndProcedure
Procedure sel(y)
DrawingMode(#PB_2DDrawing_XOr)
Box(1, m+1, 496, 24, $001638)
Box(21, m+6, 14, 14, $001638)
Box(1, y+1, 496, 24, $001638)
Box(21, y+6, 14, 14, $001638)
EndProcedure
Procedure met(y)
p=Point(24, y)
If p=16711422
Box(24, y, 8, 8, $606060)
ElseIf p=6316128
Box(24, y, 8, 8, $FEFEFE)
EndIf
EndProcedure
Procedure met2(y,it)
p=Point(8, y)
If p=16711422
Box(8, y, 8, 8, $606060)
For k=it+1 To -id(it)+it
Box(24, k*25+9, 8, 8, $606060)
Next
ElseIf p=6316128
Box(8, y, 8, 8, $FEFEFE)
For k=it+1 To -id(it)+it
Box(24, k*25+9, 8, 8, $FEFEFE)
Next
EndIf
EndProcedure
Procedure razm()
SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, 28+t*25)
SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, 481)
ResizeGadget(1, #PB_Ignore, #PB_Ignore, #PB_Ignore, 28+t*25)
EndProcedure
Procedure group(txt.s)
Box(5, 6+t*25, 14, 14, $202020)
Box(6, 7+t*25, 12, 12, $FEFEFE)
DrawText(24, 4+t*25, txt, $CC0000, $FFFFFF)
t+1
EndProcedure
Procedure item(s1.s,s2.s,s3.s,s4.s)
DrawImage(ImageID(1), 0, t*25)
DrawText(41, 4+t*25, s1)
DrawText(206, 4+t*25, s2)
DrawText(305, 4+t*25, s3)
DrawText(404, 4+t*25, s4)
t+1
EndProcedure
LoadFont(0, "Tahoma", 12)
SetGadgetFont(#PB_Default, FontID(0))
OpenWindow(0, 0, 0, 520, 374, "", #PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
TextGadget(10, 10, 10, 201, 25, " Нулевой столбец", #WS_BORDER)
TextGadget(11, 210, 10, 100, 25, " Первый", #WS_BORDER)
TextGadget(12, 308, 10, 101, 25, " Второй", #WS_BORDER)
TextGadget(13, 407, 10, 103, 25, " Третий", #WS_BORDER)
ScrollAreaGadget(0, 10, 34, 500, 330, 498, 326, 20, #PB_ScrollArea_Flat)
SetGadgetColor(0, #PB_Gadget_BackColor, #White)
CanvasGadget(1, 0, 0, 499, 326)
draw()
; Демонстрация
; Запрос к базе на кол-во неких групп и кол-во записей в них
; Допустим кол-во групп - 3 шт.
kg1=5 ; Кол-во записей в 1-й группе
kg2=3 ; Кол-во во 2-й
kg3=7 ; В 3-й
t=2+kg1+kg2+kg3 ; Общее кол-во задействованных строк гаджета (отсчет с нуля)
Dim id(t) ; Массив для хранения id записи из базы данных (для связи с ней и пр.)
If t>12 : razm() : EndIf ; Изменить размер гаджета (чтобы влезло)
t=0
; Имитация заполнения
StartDrawing(CanvasOutput(1))
DrawingFont(FontID(0))
BackColor($FEFEFE) : FrontColor($000000)
id(t)=-kg1 ; Кол-во записей в группе
group("Группа номер один")
For k=1 To kg1
id(t)=t ; Просто имитация реального id
item("Строка "+k,"Test "+k,Str(Random(1000,50)),Str(Random(1000,50)))
Next
id(t)=-kg2 : group("Группа номер два")
For k=1 To kg2
id(t)=t : item("Строка "+k,Str(Random(1000,50)),"Test "+k,Str(Random(1000,50)))
Next
id(t)=-kg3 : group("Группа номер три")
For k=1 To kg3
id(t)=t : item("Строка "+k,Str(Random(1000,50)),Str(Random(1000,50)),"Test "+k)
Next
StopDrawing()
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Select EventType()
Case #PB_EventType_LeftButtonDown
x=GetGadgetAttribute(1, #PB_Canvas_MouseX)
y=GetGadgetAttribute(1, #PB_Canvas_MouseY)/25
yd=y*25
If y<t
StartDrawing(CanvasOutput(1))
If id(y)>0 And (x>35 Or x<20)
sel(yd) : m=yd
ElseIf x<35 And x>20
met(yd+9)
ElseIf id(y)<0 And x<19
met2(yd+9,y)
EndIf
StopDrawing()
EndIf
Case #PB_EventType_MouseWheel
vv=GetGadgetAttribute(0, #PB_ScrollArea_Y)-GetGadgetAttribute(1, #PB_Canvas_WheelDelta)*40
SetGadgetAttribute(0, #PB_ScrollArea_Y, vv)
EndSelect
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEverОтредактировано Andruk (12.04.2025 12:43:59)
