AkkosLDEF.p

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 1994
Rivisto per usare le Universal Interfaces.
Bug fix: ora testo la lunghezza del nome prima di disegnare
}

INTERFACE

Uses
			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);
	
IMPLEMENTATION

USES
	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 }
BEGIN
END;

{$S LDEF}
PROCEDURE ShutdownLDEF;
{ Chiamata dal List Manager quando la lista viene distrutta (il
	mio codice sta per essere tolto dalla memoria }
BEGIN
END;

{$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.