-
Notifications
You must be signed in to change notification settings - Fork 1
/
AkkosLDEF.p
204 lines (183 loc) · 5.99 KB
/
AkkosLDEF.p
1
Unit AkkosLDEF;{ 1.0.1, 6 gennaio 1993.List manager lascia evidenziare all'utente le celle vuote anche se contengono zero.Modifico HighlightCell per rimediare io 1.0.2, 11 dicembre 1994Rivisto per usare le Universal Interfaces.Bug fix: ora testo la lunghezza del nome prima di disegnare}INTERFACEUses Types, QuickDraw, Controls ,Events ,FixMath ,Icons ,Memory ,OSUtils ,QuickDrawText ,Lists ,Script;TYPE { Contenuto di ogni cella } IconString = String[31]; CellDataRecord = RECORD iconID: Integer; { Resource ID della icona } iconName: IconString END; CellDataPtr = ^CellDataRecord;{$MAIN}PROCEDURE LDEF (lMessage: Integer; lselect: Boolean; lRect: Rect; lCell: Cell; lDataOffset, lDataLen: Integer; lHandle: ListHandle); IMPLEMENTATIONUSES LowMem;PROCEDURE StartupLDEF;FORWARD;PROCEDURE ShutdownLDEF;FORWARD;PROCEDURE HighlightCell (drawSelected: Boolean; drawWhere: Rect; cellData: CellDataPtr; dataLen: Integer);FORWARD;PROCEDURE DrawCell (drawSelected: Boolean; drawWhere: Rect; cellData: CellDataPtr; dataLen: Integer);FORWARD;{$S LDEF}PROCEDURE LDEF (lMessage: Integer; lSelect: Boolean; lRect: Rect; lCell: Cell; lDataOffset, lDataLen: Integer; lHandle: ListHandle);BEGIN CASE lMessage OF lInitMsg: StartupLDEF; lCloseMsg: ShutdownLDEF; lDrawMsg: DrawCell (lSelect, lRect, CellDataPtr(Ord4(StripAddress(lHandle^^.cells^))+ldataOffset), lDataLen); lHiliteMsg: (* IF lSelect THEN *) HighlightCell (lSelect, lRect, CellDataPtr(Ord4(StripAddress(lHandle^^.cells^))+ldataOffset), lDataLen) (* ELSE DrawCell (lSelect, lRect, CellDataPtr(Ord4(StripAddress(lHandle^^.cells^))+ldataOffset), lDataLen); *) END;END;{$S LDEF}PROCEDURE StartupLDEF;{ Chiamata dal List Manager quando la lista viene inizializzata (il mio codice appena stato caricato in memoria }BEGINEND;{$S LDEF}PROCEDURE ShutdownLDEF;{ Chiamata dal List Manager quando la lista viene distrutta (il mio codice sta per essere tolto dalla memoria }BEGINEND;{$S LDEF}PROCEDURE HighlightCell (drawSelected: Boolean; drawWhere: Rect; cellData: CellDataPtr; dataLen: Integer);BEGIN IF (cellData^.iconID < 128) THEN Exit (HighlightCell); { Usa il colore sulle macchine a colori } LMSetHiliteMode (BAnd (LMGetHiliteMode, $7F)); IF drawSelected THEN { Se va selezionata, basta evidenziarla nel colore di highlight. } InvertRect(drawWhere) ELSE { Altrimenti, per evitare paciughi, biosogna ripulire il tutto } DrawCell (drawSelected, drawWhere, cellData, dataLen);END;{$S LDEF}PROCEDURE DrawCell (drawSelected: Boolean; drawWhere: Rect; cellData: CellDataPtr; dataLen: Integer);{ New for v2.0: uses cicn when available }VAR r: Rect; err: OSErr; smallFont: Longint; spaceForCell, smallFontID, smallFontSize, hostFontID, hostFontSize, stringLen: Integer; info: FontInfo; hostPort: GrafPtr; grandeHandle: CIconHandle;BEGIN { Quando gli arriva l'ordine di deattivare la lista (perchŽ la finestra che la contiene finita in background), il List manager inspiegabilmente chiama DrawCell sulla cella attiva, e non banalmente HighlightCell con ordine di de-evidenziare. Per questo motivo devo mettere un EraseRect qui. Se non lo facessi, questo codice si limiterebbe a ridisegnare l'icona e riscrivere il testo, ma resterebbe lo sfondo nel colore evidenziato. } EraseRect (drawWhere); { Caso speciale: cella vuota } IF (cellData^.iconID < 128) OR (cellData^.iconID > 9999) OR (Length (cellData^.iconName) = 0) THEN Exit (DrawCell); spaceForCell := drawWhere.right - drawWhere.left; { Salva i dati dell'ambiente grafico che cambieremo } GetPort (hostPort); hostFontID := hostPort^.txFont; hostFontSize := hostPort^.txSize; { Disegna l'icona in alto e in centro nel rettangolo fornito } grandeHandle := GetCIcon (cellData^.iconID); { Se la cicn esiste... } IF grandeHandle <> NIL THEN WITH r DO BEGIN top := drawWhere.top; bottom := top + grandeHandle^^.iconPMap.bounds.bottom; left := drawWhere.left + (spaceForCell - grandeHandle^^.iconPMap.bounds.right) DIV 2; right := left + grandeHandle^^.iconPMap.bounds.right; { Do draw } err := PlotCiconHandle (r, atNone, ttNone, grandeHandle); DisposeCicon (grandeHandle) END ELSE WITH r DO BEGIN { icl8 } top := drawWhere.top; bottom := top + 64; left := drawWhere.left + (spaceForCell - 64) DIV 2; right := left + 64; err := PlotIconID (r, atNone, ttNone, cellData^.iconID); END; { icl8 } { Il ListMrg mi fa sempre disegnare una fila intera, e se la fila non completa mi ordina di disegnare celle inesistenti. Lo exit qui sotto mi consente di evitare di scrivere garbage quando lo Icon manager ha riconosciuto che non esiste quel che dovrei raffigurare qui (perchŽ non c' una icona del genere) } IF (err <> noErr) OR { Se c' lo spazio solo per disegnare un pezzetto della cella, List Mgr mi chiama passandomi un rettangolino drawWhere pi pic- colo del solito. Debbo rendermene conto, o rischierei di scrivere sopra alla icona } (drawWhere.bottom - drawWhere.top < 42) THEN Exit (DrawCell); { Disegna il testo subito sotto l'icona); { 1. Trova in che font posso scrivere } smallFont := GetScriptVariable (smSystemScript, smScriptSmallFondSize); smallFontID := HiWrd (smallFont); smallFontSize := LoWrd (smallFont); TextFont (smallFontID); TextSize (smallFontSize); { Scopri quanti pixel occuperˆ la scritta } stringLen := StringWidth (cellData^.iconName); GetFontInfo(info); { Per trovare quanti pixel sotto la baseline devo lasciare } { Se ci sta, centrala; altrimenti stampa quel che puoi } IF stringLen < spaceForCell THEN MoveTo (drawWhere.left + (spaceForCell - stringLen) DIV 2, drawWhere.bottom - info.descent - 1) ELSE MoveTo (drawWhere.left, drawWhere.bottom - info.descent - 1); DrawString (cellData^.iconName); { Ripristina le condizioni di partenza } TextFont (hostFontID); TextSize (hostFontSize); { Se la icona andava evidenziata, evidenziala } IF drawSelected THEN HighlightCell (TRUE, drawWhere, cellData, dataLen)END;END.