PureBoard

Code: Alles auswählen

;PureBasic-QuellCode "Spalten_Optimize" mit allen ModulBody´s
;erstellt durch Programm "PB_Mod2Body", Vers. 7A13a am 04.11.2007, 13:50

;Modul      Spalten_Optimize Version 1.1 vom 05.12.2005
;
;Funktion:  optimiert die SpaltenBreiten eines ListIcon´s entsprechend Inhalt
;           Die einzelnen Spalten eines ListIcon´s werden entsprechend dem
;           längstem Inhalt unter Berücksichtigung des aktuellen Font´s des
;           ListIcon´s ausgerichtet.
;           Z.Zt. ist das Ganze noch sehr großzügig: da gibt´s Ungenauigkeiten
;           in den API´s (anscheinden Font-abhängig...), so dass hier sicher=
;           heitshalber ´n bischen mehr Spaltenbreite als anscheinend nötig be=
;           nutzt wird...
;
;           Im Windows-DateiManager ist diese Funktion via [Strg]+[-] aufruf=
;           bar, Diese TastenKombination ist auch in allen Alstersoft-Prg´s zu
;           implementieren (ggf. weitere Tasten möglich, Details siehe Arbeits=
;           anweisung 5B21c {von Dirk !!!})
;           PreWinCtrlLoop:
;           AddKeyboardShortcut(#Win,#PB_Shortcut_Control|#PB_Shortcut_Add,fnc)
;                        (PB-Fehler: #PB_Shortcut_Add meint die Taste [-] !!!)
;           in WinCtrlLoop:
;             EventID = WaitWindowEvent()
;             Select EventID
;                Case #PB_Event_Menu
;                   Case Fnc ;Spalten optimieren
;                      Spalten_Optimize(#TabNr,1)
;
;Aufruf:    Spalten_Optimize(#ListIcon_GadNr, TitelBreit.l)
;           #ListIcon_GadNr = #Gadget-Nr eines ListIcon´s
;           TitelBreit      = Flag: auch TitelText-Breiten berücksichtigen ?
;                             (0=nö, <>0=ja)
;
;#jaPBeExt exit
;
#SpOp_Debug = 0
;==========  Begin Modul "C:\ALSTERSOFT\PUREBASIC\MODULE\GADGET\LISTICON\LI_HITTEST_DEF.PBI"  ==========
#LVM_SUBITEMHITTEST = #LVM_FIRST+57
Structure LVHITTESTINFO 
   pt.POINT 
   flags.l 
   iItem.l 
   iSubItem.l 
EndStructure 
;==========  Ende Modul "C:\ALSTERSOFT\PUREBASIC\MODULE\GADGET\LISTICON\LI_HITTEST_DEF.PBI"  ==========
Procedure Spalten_Optimize(SO_GadNr, SO_HeadBreit)
   Protected TabID, pInfo.LVHITTESTINFO, TextSize.SIZE, SpaltData.LV_COLUMN, FontID, DC, Text$, LastSpalt, Spalte, Zeile, breit
   TabID = GadgetID(SO_GadNr)
   If #SpOp_Debug : Debug "SpaltOptimize: GadNr="+Str(SO_GadNr)+", ID="+Str(TabID) : EndIf
   If TabID
      FontID = SendMessage_(TabID,#WM_GETFONT,0,0)         ;FontHdl des ListIcon´s holen
      If #SpOp_Debug : Debug "SpaltOptimize: FontID="+Str(FontID) : EndIf
      DC = GetDC_(TabID)                                   ;device context holen
      If FontID : SelectObject_(DC,FontID) : EndIf         ;Font aktivieren für WinFnc GetTextExtentPoint...
      Spalte = 0                                           ;begin mit 1. Spalte (=ListIcon-Index 0)
      Repeat                                               ;alle Spalten durchgehen...
         breit = SendMessage_(TabID, #LVM_GETCOLUMNWIDTH,Spalte,0) ; aktuelle SpaltenBreite holen (=Spalte vorhanden ?)
         If breit>GetSystemMetrics_(#SM_CXSCREEN) : breit = 0 : EndIf ;manchmal kommt hier Blödsinn an...
         If breit                                          ;Spalte vorhanden ?
            If #SpOp_Debug : Debug "SpaltOptimize: found "+Str(Spalte+1)+". Spalten" : EndIf
            breit = 0                                        ;using now as maxBreit
            If SO_HeadBreit                                ;auch Spalten-Überschriften einbeziehen
               Text$ = Space(256)
               SpaltData\mask = #LVCF_TEXT
               SpaltData\pszText = @Text$
               SpaltData\cchTextMax = Len(Text$)
               SendMessage_(TabID,#LVM_GETCOLUMN,Spalte,@SpaltData) ;hole SpaltenÜberschrift
               If Text$>"" : Text$+"  "                    ;Ausgleich Unexaktheit
                  If GetTextExtentPoint32_(DC,Text$,Len(Text$),@TextSize) ;hole TextLen [Pixel] der SpaltenÜberschrift
                     breit = TextSize\cx*1.2                 ;noch´n Ausgleich Unexaktheit
                     If #SpOp_Debug : Debug "SpaltOptimize: "+Str(Spalte+1)+". Spalte, Titel: "+Text$+" --> "+Str(TextSize\cx)+" (max="+Str(breit)+")" : EndIf
                  EndIf
               EndIf
            EndIf
            For Zeile = 0 To CountGadgetItems(SO_GadNr)-1    ;nun alle Zeilen durchgehen
               Text$ = GetGadgetItemText(SO_GadNr,Zeile,Spalte)+"   " ;hole Zellen-Text (auch hier: add spaces wg Ausgleich Unexaktheit)
               If Text$>""
                  If GetTextExtentPoint32_(DC,Text$,Len(Text$),@TextSize) ;hole TextLen [Pixel] des ZellenTextes
                     breit = Max(breit,TextSize\cx)          ;maximale Breite bestimmen
                     If #SpOp_Debug : Debug "SpaltOptimize: "+Str(Spalte+1)+". Spalte, "+Str(Zeile+1)+". Zeile: "+Text$+" --> "+Str(TextSize\cx)+" (max="+Str(breit)+")" : EndIf
                  EndIf
               EndIf
            Next
            If #SpOp_Debug : Debug "SpaltOptimize: "+Str(Spalte+1)+". Spalte: set Breite="+Str(breit) : EndIf
            SendMessage_(TabID, #LVM_SETCOLUMNWIDTH,Spalte,breit) ;SpaltenBreite setzen
            Spalte+1
         EndIf
      Until breit = 0
      HideGadget(SO_GadNr,1)                               ;repaint ListIcon
      HideGadget(SO_GadNr,0)
      ReleaseDC_(TabID,DC)
   EndIf
EndProcedure