Grid - maximální šířka sloupce

V některých programech lze v gridu či jeho ekvivalentech doubleclickem na rozdělovací čáře sloupců nastavit maximální šířku sloupce pro viditelný text. Není to zas tak složité, jak to vypadá.

Vlastní kód lze vložit do metody DblClick() objektu Header přímo ve vizuálním návrhu či v programové definici třídy sloupce/hlavičky.
Navíc je udělán tak, aby jej bylo možno spustit ihned.

Metoda DblClick() - zdrojový kód: 

LOCAL liMRow, liMRowMax,liSele,liRecno,liHeight,liRow,lolbl,liRelRow,lcSource,loColumn,liMax,luVal,lcType

*** Tento kód lze nahradit metodou SplitLineHitTest()
liMRow=MCOL(Thisform.Name,3) && pozice myši
liMRowMax=OBJTOCLIENT(This,2)+This.Parent.Width+1 && Pozice sloupce + šířka sloupce převedeno na formulář
* Pokuď seš mimo
IF ! BETWEEN(liMRow,liMRowMax-5,liMRowMax+5)
   RETURN && Pak se vrať
ENDIF
*** Metoda SplitLineHitTest()

IF EOF(This.Parent.Parent.RecordSource) && Pokud tam není ani záznam
   RETURN && Pak se vrať
ENDIF

liSele=SELE() && Uschovej si oblast
lolbl=CREATEOBJECT("label") && Pomocný objekt
SELE (This.Parent.Parent.RecordSource) && Skoč na tabulku

*** Tento kód lze nahradit metodou GetVisibleRow()
WITH This.Parent.Parent
liHeight=.Height-.HeaderHeight-IIF(INLIST(.ScrollBars,1,3),16,0)
liRow=INT(liHeight/.RowHeight)
ENDWITH
*** Metoda GetVisibleRow()

liRelRow=This.Parent.Parent.RelativeRow && Relativní řádek
loColumn=This.Parent && Aktivní sloupec
lcSource=loColumn.ControlSource && Zdroj dat

* Zjištění typu položky
lcType=TYPE("EVAL(lcSource)")

* Překopíruj údaje do labelu
lolbl.FontName=loColumn.FontName
lolbl.FontSize=loColumn.FontSize
lolbl.FontBold=loColumn.FontBold
lolbl.FontItalic=loColumn.FontItalic

* Nyní projdu viditelný řádky a zjistím šířku textu
liRecno=RECNO() && Zjisti původní větu

SKIP -1*(liRelRow-1) && Skoč na začátek viditelného obsahu
liMax=0
SCAN NEXT liRow
     * Jen pokud to není General pole
     luVal=IIF(lcType#"G",EVAL(lcSource),"") && Načti údaj

     lolbl.Caption=IIF(ISNULL(luVal),".NULL.",;
                   IIF(lcType="C",RTRIM(luVal),;
                   IIF(lcType="M","Memo",;
                   IIF(lcType="L",IIF(luVal,"T","F"),;
                   IIF(lcType="I",LTRIM(STR(luVal,20)),;
                   IIF(lcType$"Y,N,F,B",ALLT(STR(luVal,20,4)),;
                   IIF(lcType="D",DTOC(luVal),;
                   IIF(lcType="T",TTOC(luVal),"General"))))))))

     lolbl.Width=TXTWIDTH(lolbl.Caption,lolbl.FontName,lolbl.FontSize,IIF(lolbl.FontBold,"B","")+IIF(lolbl.FontItalic,"I",""))
     IF lolbl.Width+4>liMax
        liMax=lolbl.Width+4
     ENDIF
ENDSCAN
IF liMax>0 && Pokud tam něco je
   loColumn.Width=liMax && Pak nastav novou šířku
ENDIF
GO liRecno && Skoč na původní větu
SELE (liSele)

Výklad:
Nejdříve se provede test, zda je ukazatel myši na oddělovací čarou a zda tabulka není prázdná.
Vytvoří se pomocný objekt dle třídy Label a spočítá se viditelný počet řádků v gridu. Do pomocnýho objektu se překopírují informace o fontu (název,velikost a styl). Zapamatuje si aktuální větu a skočí na začátek viditelného obsahu gridu. Poté se začne procházet jen n viditelných vět. Vyhodnotí se obsah sloupce a dle typu se přivede na řetězec. Pomocí funkce TEXTWIDTH() se spočítá šířka textu + 4 pixely. Pokud je nová šířka větší než poslední, pak si ji zapamatuje. Po skončení smyčky se nastaví nová šířka sloupce (pokud není nulová) a skočí na původní větu.

Tento zdrojový kód nemá programovou chybu, pouze logickou. Jak by vypadal zdrojový kód, který by onu logickou chybu odstranil ?

<< Předchozí díl Následující díl >>