alle Spalten werden auf die minimal benötigte Breite (=längster Text in
einer Spalte) gesetzt...
Das Ganze als PB3.90-Code:
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
