PureCOLOR library : coloring gadgets (and much more)

gnozal · Post by **gnozal** » Wed Jan 25, 2006 12:08 pm

Update

Changes :
- fixed subclassing problem reported here : http://forums.purebasic.com/german/viewtopic.php?t=6578

Flype · Post by **Flype** » Wed Jan 25, 2006 12:23 pm

very thank you for your suggestion about the cell callback - exactly what i need.

and of course for this fix (which i needed too).

gnozal · Post by **gnozal** » Wed Jan 25, 2006 1:25 pm

Update

Changes :
- some subclassing optimizations

Flype · Post by **Flype** » Mon Jan 30, 2006 4:31 pm

hello, found a strange bug, not easy to isolate :

Code: Select all

Procedure.l myCallback(gID.l,row.l,column.l,*TextColor.l,*BackColor.l)
  
  Select gID
    Case 0
      Select column
        Case 0
          PokeL(*TextColor,$AA4444)
      EndSelect
  EndSelect
  
EndProcedure

If OpenWindow(0,0,0,640,480,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Bug()")
  
  If CreateGadgetList(WindowID())
    ListIconGadget(0,5,5,630,470,"A",120,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines)
    AddGadgetColumn(0,1,"B",120)
    AddGadgetColumn(0,2,"C",120)
    AddGadgetColumn(0,3,"D",120)
    For i=0 To 40
      AddGadgetItem(0,i,"A"+Str(i)+#LF$+"B"+Str(i)+#LF$+"C"+Str(i)+#LF$+"D"+Str(i))
    Next
  EndIf
  
  ;PureCOLOR_SetCellColorCallback(0,@myCallback())
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case 0
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
                position = GetGadgetState(0)
                If position <> -1
                  InputRequester("","",GetGadgetItemText(0,position,3))
                EndIf
            EndSelect
        EndSelect
    EndSelect
  ForEver
  
EndIf

1/ Double click on a line into the ListIconGadget.
2/ The InputRequester() display what it should display.
3/ Now, uncomment the line 26 [PureCOLOR_SetCellColorCallback(0,@myCallback())]
4/ Redo the test, and have a funny but surprising result.

But if you do this, it does the job !?#%$? Strange, no ?

Code: Select all

value$ = GetGadgetItemText(0,position,3)
InputRequester("","",value$)

Good Luck, Gnozal

Flype · Post by **Flype** » Mon Jan 30, 2006 5:06 pm

And by the way, do you think it is possible to implement a new parameter to change the font format of a specific cell ? It could be usefull...

Code: Select all

Procedure.l myCallback(gID.l,row.l,column.l,*TextColor.l,*BackColor.l,*FontID.l)
EndProcedure

gnozal · Post by **gnozal** » Mon Jan 30, 2006 6:20 pm

Flype wrote:hello, found a strange bug, not easy to isolate :

Strange indeed.

Some facts :
- If you replace 'InputRequester("","",GetGadgetItemText(0,Position,3))' by 'MessageRequester("", GetGadgetItemText(0,Position,3))', there is no bug.

Code: Select all

; bug
            InputRequester("","",GetGadgetItemText(0,Position,3))

Code: Select all

; no bug !
            MessageRequester("", GetGadgetItemText(0,Position,3))

Code: Select all

; no bug !!
            InputRequester("","",GetGadgetItemText(0,Position,3))
            MessageRequester("", GetGadgetItemText(0,Position,3))

- If I remove the window subclassing, no bug.
=> It is because of the window subclassing, but why ? And why only the InputRequester ??

It seems to be a Purebasic bug !

I can reproduce it without my lib but with subclassing :

Code: Select all

Procedure.s GetGadgetClass(hGadget.l) 
  Protected Class.s
  Class = Space(255)
  GetClassName_(hGadget, @Class, 254) 
  ProcedureReturn Class
EndProcedure 

Procedure.l myCallback(WindowID, message, wParam, lParam)
  Shared OldCallback
  Result = CallWindowProc_(OldCallback, WindowID, message, wParam, lParam)
  b$ = GetGadgetClass(WindowID) 
  ProcedureReturn Result 
EndProcedure 

If OpenWindow(0,0,0,640,480,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Bug()") 
  
  If CreateGadgetList(WindowID()) 
    ListIconGadget(0,5,5,630,470,"A",120,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines) 
    AddGadgetColumn(0,1,"B",120) 
    AddGadgetColumn(0,2,"C",120) 
    AddGadgetColumn(0,3,"D",120) 
    For i=0 To 40 
      AddGadgetItem(0,i,"A"+Str(i)+#LF$+"B"+Str(i)+#LF$+"C"+Str(i)+#LF$+"D"+Str(i)) 
    Next 
  EndIf 
  
  OldCallback = SetWindowLong_(WindowID(0), #GWL_WNDPROC, @myCallback())
  
  Repeat 
    Select WaitWindowEvent() 
      Case #PB_Event_CloseWindow 
        Break 
      Case #PB_Event_Gadget 
        Select EventGadgetID() 
          Case 0 
            Select EventType() 
              Case #PB_EventType_LeftDoubleClick 
                Position = GetGadgetState(0) 
                If Position <> -1 
                  InputRequester("","",GetGadgetItemText(0,Position,3)) ; <=== the bug : displays the window class !!!!
                EndIf 
            EndSelect 
        EndSelect 
    EndSelect 
  ForEver 
  
EndIf

Is it a bug or is there some error in the above code ?

Flype wrote:And by the way, do you think it is possible to implement a new parameter to change the font format of a specific cell ? It could be usefull...

It could be usefull, yes... Will see ...

Flype · Post by **Flype** » Mon Jan 30, 2006 6:39 pm

ok, you think it could be a purebasic bug, not sure but it could be.
i was wondering about that, i will investigate a bit more and let you informed.

but, first, you should post your code (subclassing without your lib) in the bug section. this bug can't stay unsolved.

DoubleDutch · Post by **DoubleDutch** » Mon Jan 30, 2006 7:00 pm

I had a similar problem with input requester and getgadgetitemtext, it went away if it got the text before the inputrequester.

eg

inputrequester("","",getgadgetitemtext..... <--- bug - seemed to show something from the clipboard!!!

a$=getgadgetitemtext....
inputrequester("","",a$) <--- worked - the proper text displayed

it may not be to do with subclassing, but something else?

edit:

I seem to remember random things happening with left(...) as the 3rd parameter of input requester too. I think it went when I simplified things as above. Maybe the bug is related to setting the default item???

I didn't mention it on the forum because it was one of the times the forum wasn't working properly.

Flype · Post by **Flype** » Mon Jan 30, 2006 8:48 pm

fixed. see bug report.

gnozal · Post by **gnozal** » Tue Jan 31, 2006 8:38 am

Flype wrote:fixed. see bug report.

Ok, waiting for PB 4.00

gnozal · Post by **gnozal** » Tue Jan 31, 2006 9:41 am

Update

Changes :
- new parameter to change the font for a specific listicon cell

Code: Select all

FontID = LoadFont(0, "Courier New", 9, #PB_Font_Bold)
;
Procedure MyCellColorCallback(GadgetNumber.l, CellRow.l, CellColumn.l, *TextColor.LONG, *BackColor.LONG, *FontID.LONG)
  Shared FontID
  If GadgetNumber = 1
    CellText.s = GetGadgetItemText(GadgetNumber, CellRow, CellColumn)
    Debug Str(CellRow) + ":" + Str(CellColumn) + ">" + CellText
    Select CellText
      Case "Red"
        *TextColor\l = #Red
        Debug "-> Red"
      Case "Blue"
        *BackColor\l = #Blue
        *TextColor\l = #White
        Debug "-> Blue"
      Case "Green"
        *TextColor\l = #Green
        Debug "-> Green"
      Default
        *FontID\l = FontID
        Debug "-> Font"
    EndSelect
  EndIf
EndProcedure
; Create Window
OpenWindow(0, 100, 300, 400, 200, #PB_Window_SystemMenu, "PureCOLOR test : cell callback demo") 

If CreateGadgetList(WindowID()) 
  ListIconGadget(1, 1, 1, 300, 160, "0", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  ;
  AddGadgetColumn(1, 1, "1", 100)
  AddGadgetColumn(1, 2, "2", 100)
  AddGadgetItem(1, -1, "0:0" + Chr(10) + "0:1" + Chr(10) + "Red")
  AddGadgetItem(1, -1, "1:0" + Chr(10) + "1:1" + Chr(10) + "1:2")
  AddGadgetItem(1, -1, "Blue" + Chr(10) + "Green" + Chr(10) + "2:2")
  AddGadgetItem(1, -1, "3:0" + Chr(10) + "Red" + Chr(10) + "3:2")
  AddGadgetItem(1, -1, "Red" + Chr(10) + "4:1" + Chr(10) + "Red")
  AddGadgetItem(1, -1, "Green" + Chr(10) + "Blue" + Chr(10) + "5:2")
  AddGadgetItem(1, -1, "6:0" + Chr(10) + "6:1" + Chr(10) + "6:2")
  AddGadgetItem(1, -1, "Red" + Chr(10) + "Blue" + Chr(10) + "7:2")
EndIf
PureCOLOR_SetCellColorCallback(0, @MyCellColorCallback())
Repeat 
  EventID.l = WaitWindowEvent()
  If EventID = #PB_EventCloseWindow 
    Break
  EndIf
ForEver
;
End

Flype · Post by **Flype** » Tue Jan 31, 2006 10:22 am

Ho, thank you again for this fast, and usefull update.

DoubleDutch · Post by **DoubleDutch** » Tue Jan 31, 2006 11:26 am

Now we can use wingdings to add some wierd stuff to a particular cell...

Anyone know if all 3 wingdings are with all versions of windows?

gnozal · Post by **gnozal** » Tue Jan 31, 2006 11:32 am

DoubleDutch wrote:Anyone know if all 3 wingdings are with all versions of windows?

What 3 ?
I only see one wingding.ttf [WinNT4 / Win98SE]

nicolaus · Post by **nicolaus** » Tue Jan 31, 2006 12:24 pm

In Win XP and Win 2000 you have 2 or 3 of Wingding fonts