Im ListIconGadget zeichnen

[rolaf]

@rolaf
Jetzt machste bitte Unicode in den Compileroptionen und Deine Liste ist in der zweiten Spalte leer

Nö, Irrtum - Unicode ist in den Compileroptionen schon aus (war und ist bei mir immer aus).

[ts-soft]

Da sollste ja anmachen, damit die zweite Spalte ganz leer wird.
PS: Wer kompiliert denn noch in ASCII? Das ist doch seit 12 Jahren
out. Wir sind Europa, die Grenzen sind in alle Richtungen offen,
da sollten wir auch die Sonderzeichen unserer Nachbarn beherrschen

[rolaf]

Leer ist anders.



Ich programmiere nur in Deutsch für Deutsche. Reiner reicht.

[RSBasic]

Wie sieht es damit aus?

Code: Alles auswählen

EnableExplicit

Define EventID
Define i, font
font = LoadFont(#PB_Any, "Terminal", 11)

Procedure ZeichneBalken(zeile)
  Static gerade
  Protected zahl=Val(GetGadgetItemText(1,zeile,0))
  Protected a$=LSet("",zahl, Chr($DB))
  gerade ! 1
  If gerade
    SetGadgetItemColor(1, zeile, #PB_Gadget_FrontColor, #Red)
  Else
    SetGadgetItemColor(1, zeile, #PB_Gadget_FrontColor, #Blue)
  EndIf
  SetGadgetItemText(1,zeile,a$,1)

EndProcedure

If OpenWindow(0,0,0,650,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ListIconGadget(1,10,10,WindowWidth(0)-20,WindowHeight(0)-20,"Zahl",50,#PB_ListIcon_GridLines)
  SetGadgetFont(1, FontID(font))
  AddGadgetColumn(1,1,"Balken",550)
 
  For i=0 To 9
    AddGadgetItem(1,-1,Str((Random(19)+1)*2))
  Next
 
  For i=0 To 9
    ZeichneBalken(i)
  Next
 
  Repeat
    EventID=WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      End
    EndIf
  ForEver
EndIf 

Kein Unocode notwendig. Nur ist die Schriftart für normalem Text etwas unschön. Vielleicht gibt es eine Möglichkeit, nur für eine Spalte die Schriftart zu ändern.

[rolaf]

Ich finde ein Balken kann auch so aussehen, einfach mit dem Standard-Font:

Code: Alles auswählen

EnableExplicit

Define EventID
Define i

Procedure ZeichneBalken(zeile)
  Static gerade
  Protected zahl=Val(GetGadgetItemText(1,zeile,0))
  Protected a$=LSet("",zahl, Chr(124))
  gerade ! 1
  If gerade
    SetGadgetItemColor(1, zeile, #PB_Gadget_FrontColor, #Red)
  Else
    SetGadgetItemColor(1, zeile, #PB_Gadget_FrontColor, #Blue)
  EndIf
  SetGadgetItemText(1,zeile,a$,1)

EndProcedure

If OpenWindow(0,0,0,650,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ListIconGadget(1,10,10,WindowWidth(0)-20,WindowHeight(0)-20,"Zahl",50,#PB_ListIcon_GridLines)
  AddGadgetColumn(1,1,"Balken",550)
 
  For i=0 To 19
    AddGadgetItem(1,-1,Str(Random(99)+1))
  Next
 
  For i=0 To 19
    ZeichneBalken(i)
  Next
 
  Repeat
    EventID=WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      End
    EndIf
  ForEver
EndIf 

[BSP]

Hallo.
Ich habe meine PB- Einstellungen wieder auf Standard zurück gesetzt.
Es bestätigen sich doch wieder meine Erfahrungen:
- "Wenn etwas funktioniert, lass es so".
Dadurch laufen meine Prgs sogar noch auf meinem alten Win- Me- Laptop.
- "Muß man erst viel Tricksen und Schrauben, damit etwas funktioniert, lass es".
Meistens hakt es sonst woanders und das Tricksen nimmt kein Ende.
Und mit Textzeichen zu "zeichnen", macht ja auch nicht wirklich Sinn.
Wenn der andere Nutzer den Zeichensatz nicht hat, wird eventuell die "schöne Darstellung" zerstört.

Wenn es also nicht anders zu machen ist, zeichne ich eben meine Tabelle weiterhin.
Oder, ich kürze meine Liste um die Balkenspalte und simuliere diese Spalte durch ein ImageGadget und verknüpfe die beiden Listen dann Programmtechnisch miteinander.

Dazu fällt mir gerade ein:
Gibt es eine Möglichkeit, die Scrollbalken bei dem ListIconGadget ab zu schalten?
Dann kann ich ja beide Gadgets, Li & Image in einem ScrollareaGadget zusammenfügen?!
Und schon geht die Trickserei wieder los.

Gruß & Dank:
Bernd

[ts-soft]

Hallo.
Ich habe meine PB- Einstellungen wieder auf Standard zurück gesetzt.
Es bestätigen sich doch wieder meine Erfahrungen:
- "Wenn etwas funktioniert, lass es so".
Dadurch laufen meine Prgs sogar noch auf meinem alten Win- Me- Laptop.

Du kannst doch die Standardeinstellungen lassen und nur für diese eine Datei
eben ändern, PB merkt sich das doch.

Wenn das Programm aber unter kleiner Win2000 laufen soll, dann wäre eine Nicht-Unicode-
Lösung wohl sinnvoll.
Der Font sollte ab W2K verfügbar sein, ansonsten nimmt Windows einen Ersatzfont,
wobei dann die Balken etwas kürzer werden, aber ansonsten sieht es immer noch Chick
aus

[Danilo]

Hier mal ein kleines Beispiel für Balken direkt zeichnen, prozentual abhängig von der Breite des GadgetColumn.

Code: Alles auswählen

;
; by Danilo, March 2012, PB4.60
;
; http://forums.purebasic.com/german/viewtopic.php?f=3&t=25336
;
; does not work on XP
;
EnableExplicit

Define EventID
Define i, font
font = LoadFont(#PB_Any, "Lucida Sans Unicode", 10)

Procedure WinCallback(hWnd, Msg, wParam, lParam) 
  If Msg = #WM_NOTIFY
    Protected *lvcd.NMLVCUSTOMDRAW = lParam
    If *lvcd And *lvcd\nmcd\hdr\code = #NM_CUSTOMDRAW
      Protected gadget = GetWindowLongPtr_(*lvcd\nmcd\hdr\hwndFrom,#GWLP_ID)
      Select *lvcd\nmcd\dwDrawStage
        Case #CDDS_PREPAINT

          ; optional: hintergrund loeschen -> auskommentieren für standard-hintergrund
              Protected background = CreateSolidBrush_(RGB($C2,$D4,$EF))                   ; hintergrundfarbe setzen
              If IsGadget(gadget) And GadgetType(gadget)=#PB_GadgetType_ListIcon
                SelectObject_(*lvcd\nmcd\hdc,background)
                SelectObject_(*lvcd\nmcd\hdc,GetStockObject_(#NULL_PEN))
                Rectangle_(   *lvcd\nmcd\hdc,0,0,GadgetWidth(gadget),GadgetHeight(gadget))
                DeleteObject_(background)
              EndIf

          ProcedureReturn #CDRF_NOTIFYITEMDRAW
        Case #CDDS_ITEMPREPAINT
          If *lvcd\iSubItem
            ProcedureReturn #CDRF_DODEFAULT
          Else
            With *lvcd\nmcd
            If IsGadget(gadget) And GadgetType(gadget)=#PB_GadgetType_ListIcon
              Protected text.s    = GetGadgetItemText(gadget,\dwItemSpec,0)                     ; text holen
              Protected width0    = GetGadgetItemAttribute(gadget,0,#PB_ListIcon_ColumnWidth)   ; breite von column 0 holen
              Protected width1.f  = GetGadgetItemAttribute(gadget,0,#PB_ListIcon_ColumnWidth,1) ; breite von column 1 holen
              Protected brush     = CreateSolidBrush_(RGB($00,$00,$FF))                    ; pinsel mit farbe für die balken erstellen
              Protected brushsel  = CreateSolidBrush_(RGB($FF,$FF,$00))                    ; pinsel mit farbe für selektierte items
              Protected percent.f = width1/100*ValF(text)                                  ; balkenlaenge in prozent ausrechnen

              ; XP fix
              ;
              ; http://msdn.microsoft.com/en-us/library/windows/desktop/bb774778(v=vs.85).aspx
              ;
              ; Bug on earlier versions of Windows
              ;
              ; Handling subitem pre-paint messages on Windows XP (perhaps all pre-Vista systems?)
              ; the handler receives incorrect top And bottom values in NMLVCUSTOMDRAW::nmcd.rc,
              ; sometimes they are zero, sometimes are Not updated since previous handler call
              ; (so basically the idea is that they are left uninitialized by comctl32 caller).
              ; In order To get correct subitem position the handler has To explicitly obtain
              ; rectangle using a separate message/call:
              ;
              ; RECT Position;
              ; ListView.GetSubItemRect((INT) pHeader->nmcd.dwItemSpec, pHeader->iSubItem, LVIR_BOUNDS, &Position);
              ;
              \rc\left = 0
              SendMessage_(GadgetID(gadget),#LVM_GETITEMRECT,\dwItemSpec,@\rc)


              If GetGadgetItemState(gadget,\dwItemSpec)=#PB_ListIcon_Selected
                SelectObject_(\hdc,brushsel)
                SelectObject_(\hdc,GetStockObject_(#NULL_PEN))
                Rectangle_(\hdc,0,\rc\top+1,\rc\right,\rc\bottom+1)                        ; hintergrund für ausgewaehlte items
              EndIf

              
              ; optional: den text umranden
                  ;SelectObject_(\hdc,GetStockObject_(#HOLLOW_BRUSH))                             ; innenfarbe durchsichtig
                  ;SelectObject_(\hdc,GetStockObject_(#BLACK_PEN))                                ; umrandung schwarz
                  ;Rectangle_(\hdc,\rc\left,\rc\top,\rc\left+width0,\rc\bottom+1)                 ; text umranden
                  ;Rectangle_(\hdc,\rc\left+width0-1,\rc\top,\rc\left+width0+width1,\rc\bottom+1) ; balken umranden

              ; text in column 0 zeichnen
              SetTextColor_(\hdc,RGB($00,$00,$00))                                         ; textfarbe setzen
              TextOut_(\hdc,\rc\left+5,\rc\top,@text,Len(text))

              ; balken mit dem pinsel in column 1 zeichen
              SelectObject_(\hdc,brush)
              SelectObject_(\hdc,GetStockObject_(#NULL_PEN))
              Rectangle_(\hdc,\rc\left+width0,\rc\top+2,\rc\left+width0+percent,\rc\bottom)       ; normale balken
              ;RoundRect_(\hdc,\rc\left+width0,\rc\top+2,\rc\left+width0+percent,\rc\bottom,12,12) ; alternativ: abgerundete balken ohne AntiAliasing

              ; pinsel loeschen
              DeleteObject_(brush)
              DeleteObject_(brushsel)
            EndIf
            EndWith
            ProcedureReturn #CDRF_SKIPDEFAULT
          EndIf
        EndSelect
    EndIf
  EndIf 
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

RandomSeed(3)

If OpenWindow(0,0,0,650,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  SetWindowCallback(@WinCallback())
 
  ListIconGadget(2,10,10,WindowWidth(0)-20,WindowHeight(0)-20,"Zahl",50,#LVS_OWNERDRAWFIXED|#PB_ListIcon_MultiSelect) ; ListIconGadget mit Flag #LVS_OWNERDRAWFIXED
  AddGadgetColumn(2,1,"Balken",550)
  SetGadgetFont(2, FontID(font))
 
  For i=0 To 199
    AddGadgetItem(2,-1,Str(Random(100)))
  Next
 
  Repeat
    EventID=WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      End
    EndIf
  ForEver
EndIf

Man kann natürlich auch ganz anderes in den \hdc zeichnen oder Bilder rein blitten.

[rolaf]

Danilo, das war nix, egal ob mit oder ohne Unicode und UTF8 es wird genau das angezeigt:



Nur alles Blau, nene machmal sollte man Sachen nicht unnötig komplizieren.

[ts-soft]

XP-Style aktivieren! Sollte dann auch unter dem klassischem Stil funktionieren.
Das sollte ja nun wirklich per Default an sein, ohne diesen Style kann man doch
keine Programme weitergeben, da werden die Benutzer aber bitter böse

Wer es nicht mag, nutzt den klassischen Stil (keine optische Veränderung durch XP-Stil)
und bei dem, der es mag, sollte der Style auch sein.

Sonst ab in die Tonne
Ich als Anwender entscheide selber, ob ich den Stil möchte!