Lista3.p

Unit Lista3;

{ Permette l'uso semplificato del list manager per creare e gestire
	liste a video, mono o bidimensionali (spreadsheet) di celle alfanumeriche.
	La lista appare nello spazio rect scelto dall'utilizzatore della unit,
	all'interno di una window o di un dialog.
	Quando si riceve un evento all'interno dello spazio della lista si chiama
	FindList e si agisce a seconda del risultato di questa. Attenzione: se
	la lista si trova in un dialog modale, per avere a disposizione lo event
	record da passare alla unit eseguire in questo modo lo event loop:

	var
		theEvent: EventRecord;
		listClick: Result;
		cellSelected: Cell;
	begin
		repeat
			ModalDialog (nil, itemHit);
			dummy := EventAvail (everyEvent, theEvent);
			case itemHit of
				kLista: ListClick := FindList (listaInfoRec, theEvent, cellSelected);
		...
	}


{ 2.0 del 1 set 93:
	BASATO SU
		¥ Lista.p 1.3.1 (main body)
		¥ ListaDA.p 1.1 (codice global-free)
		¥ LtoLdragUnit 1.0 (dragging code, from MacTech magazine)
}

{ v3.0 del 22 novembre 1993
	¥ Permette l'uso di custom LDEF. Per ora  calibrato per AkkosLDEF, lo LDEF
		dreato per Dream. Per usare una LDEF, passare nella wishList a NuovaLista
		la costante WantCustomLDEF.
	¥ Corretto un bug che affliggeva la creazione di liste bidimensionali

3.0.1, 25 settembre 1993
	Bug fix: una chiamata a NewRgn non era bilanciata con il corrispondente
	CloseRgn
	
3.1, 28 maggio 1996
	Aggiornato a PowerPC

3.1.1, 11mag97. Irrobustito FindList.

3.2, 17 ago 97. Chiamo Taskmaster perchŽ la lista funzioni anche nel main pane di una TMWindow
	Bug fix: non serve pi chiamare Validrect dopo Ridisegna
	Usa Appearance se lo trova per disegnare il bordo attorno alla lista
}

Interface

Uses
			Types,
			QuickDraw,
			
			Controls,
			Events,
			Memory,
			MixedMode,
			Lists,
			Windows;

Type
	Result = (NotMe, Click, DoubleClick, NeverMind,
		DraggedOut, DraggedToOther);	{ risultati da FindList }

	ListInfoRec = record
		theList: ListHandle;
		listRect: Rect;
		vScrollRect, hScrollRect: Rect;
		numCelleH, numCelleV, flags: Integer;	{ Flags  la wishList, salvata dalla v3.1.2 }
		listWind: WindowPtr
		end;
	ListInfoRecPtr = ^ListInfoRec;

Const
	{ per la wishList }
	wantHScroll = 1;	{ Vuoi una scroll bar orizzontale? }
	wantVScroll = 2;	{ Verticale? }
	wantAutoScroll = 4; { ListMgr permette AutoScroll solo H o V, noi no }
	wantCustomLDEF = 8;	{ Use custom LDEF, ID 128 }
	wantTaskMaster = 16;{ New for v3.1.2 }
	
	{ Sono in caso di Akko's LDEF (con icone }
	kIconCellVertSize = 77;

FUNCTION NuovaLista (TheWindow: WindowPtr; MySpace: Rect;
		HinView: integer; wishList: Integer; SelFlags: SignedByte): ListInfoRec;
	{ Inizializza la unit e ListMgr. Crea uno spazio per la lista,
	con la lista vuota. Il dialogo occupa lo spazio stabilito da MySpace,
	(coordinate locali) nel dialogo il cui puntatore viene passato.
	Vanno visualizzate HinView celle in orizzontale. wishList si compila
	sommando le const sopra definite, e SelFlags viene passato direttamente
	a ListMgr, e lo istruisce come da Inside Mac IV-267.
	Normalmente SelFlags vale LOnlyOne + LNoNilHilite }
Procedure NuovaCella (var l: ListInfoRec; c: cell; Testo: StringPtr);
	{ Aggiunge una cella alla lista nella posizione c. Si noti che
	le celle esistenti formano sempre un rettangolo e che l'aggiunta
	avviene se possibile per righe, senn˜ per colonne.
	NUOVA CELLA NON ONORA wantTaskMaster PER MOTIVI DI PRESTAZIONI. DISABILITARE
	IL RIDISEGNO DELLA LISTA CON LsetDrawing PRIMA DI CHIAMARE NUOVALISTA }
Procedure AggiornaCella (var l: ListInfoRec; c: cell; Testo: StringPtr);
	{ Per avere una cella vuota, passare una stringa nulla }

{ Analoghe per l'uso con custom LDEF }
Procedure NuovaCCella (var l: ListInfoRec; c: cell; i: Integer; testo: StringPtr);
Procedure AggiornaCCella (var l: ListInfoRec; c: cell; i: Integer; testo: StringPtr);

Procedure Ridisegna (l: ListInfoRec);
	{ Utile per ridisegnare la lista quando arriva un update event.
	deve essere chiamato tra il beginUpdate e lo endUpdate corrispondente }
Procedure CancellaCella (VAR l: ListInfoRec; c: cell);
	{ Cancella la riga contenente la cella dalla lista }
Procedure CancellaLista (VAR l: ListInfoRec);
	{ Vuota la lista corrente }
(*
Procedure ListaZoom (var l: ListInfoRec; r: rect);
*)
	{ Cambia il rettangolo assegnato alla lista. A causa delle
	limitazioni del List manager, l'angolo TopLeft deve essere
	invariato rispetto a quello iniziale }
Function DammiCella (var l: ListInfoRec; var c: cell): boolean;
	{ Restituisce la (prima) cella correntemente selezionata.
   Se nessuna cella  selezionata, restituisce false, senn˜ true. }
Procedure ListaShutdown (l: ListInfoRec);
	{ Da usare per porre fine alle operazioni su una lista }
Function FindList (sourceList: ListInfoRecPtr; Ev: EventRecord; var c: cell;
	destList: ListInfoRecPtr): Result;
	{ Si comporta in modo analogo a FindWindow. In c si restituisce
	la cella in cui  avvenuto l'evento, se applicabile.
	Se il dialogo usato  modale,  necessario fare uso di EventAvail
	in modo da poter passare l'eventrecord a FindList se lo itemHit
	si rivela essere lo useritem riservato alla lista.
	Se destList  NIL, FindList gestisce i clic sulla lista specificata
	e non fa null'altro. Se destList non  NIL, FindList permette di trascinare
	le celle delle lista. In questo caso:
		¥ Se sourceList = findList
			¥ Se il trascinamento termina dentro la lista, FindList
				restituisce Click o DoubleClick, come appropriato.
			¥ Se il trascinamento termina fuori dalla lista, FindList restituisce
				DraggedOut
		¥ Se sourceList <> destList
			¥ Se il trascinamento termina dentro il rect di sourceList, FindList
				restituisce Click o DoubleClick, come appropriato.
			¥ Se il trascinamento termina dentro il rect di destList, FindList
				restituisce DraggedToOther.
			¥ Se il trascinamento termina fuori da ogni lista, FindList restituisce
				DraggedOut
	}
	{ N.B. Se ci sono entrambe le scroll bar, il click nella zona quadrata
	in basso a destra NON permette lo zoom; in quel caso il risultato
	di findList  indefinito! }

Implementation

USES
	Appearance,
	GestaltEqu,
	OSUtils,
	
	TaskMaster3;

CONST
	{ Per la custom LDEF }
	rAkkosLDEF = 200;

TYPE
	{ In sync con la definizione dentro AkkosLDEF }
	IconString = String[31];

	CellDataRecord = RECORD
		iconID: Integer;		{ Resource ID della icona }
		iconName: IconString
		END;
	CellDataPtr = ^CellDataRecord;

VAR
	w: result;				{ Per l'uso di FindList e della click loop proc }
	anchorPoint: Point;		{ Click loop proc: punto del primo click }
	gSourceList: ListHandle; { Click loop proc: lista sorgente }
	portRect,				{ Spazio entro il quale si effettua il drag }
	targetRect: Rect;		{ Rect della lista destinazione }
	firstTime: Boolean;		{ Al primo richiamo la click loop proc deve uscire subito! }

Procedure Ridisegna (l: ListInfoRec);
var
   r1: rect;
   err: OSErr;
   gestaltResult: Longint;
begin
	with l do begin
		
		IF (Gestalt (gestaltAppearanceAttr, gestaltResult) = noErr) THEN
			err := DrawThemeListBoxFrame (listRect, ord(ord(WindowPeek(listWind)^.hilited)<>0))
		ELSE BEGIN { System 7 }
			r1 := listRect;
			InsetRect (r1, -1, -1);
			FrameRect (r1);	{ Disegna rettangolo attorno a }
			END;

		{ disegna le celle all'interno }
		LUpdate (listWind^.visRgn, theList);
		ValidRect (r1)	{ Bug fix 3.2 }
		END; { with }
end;

FUNCTION NuovaLista (TheWindow: WindowPtr; MySpace: Rect;
		HinView: integer; wishList: Integer; SelFlags: SignedByte): ListInfoRec;
var
	r1: rect;
	ScrollHoriz, ScrollVert: boolean;
	Cella: cell;
	ldefId: Integer;
	l: ListInfoRec;
begin
	SetPort (theWindow);
	{ Set up the info }
	WITH l DO BEGIN
		flags := wishList;
		if BAnd (wishList, WantVScroll) > 0 then begin
			ScrollVert := true;
			vScrollRect := MySpace;	{ trova il rettangolo della scrollbar v }
			vScrollRect.left := vScrollRect.right - 15;
			MySpace.right := MySpace.right - 15	{spazio per scrollbar}
			end
		else begin
			ScrollVert := false;
			vScrollRect.top := 0;					{ rettangolo vuoto }
			vScrollRect.bottom := -1
			end;
		if BAnd (wishList, WantHScroll) > 0 then begin
			ScrollHoriz := true;
			hScrollRect := MySpace;
			hScrollRect.top := hScrollRect.bottom - 15;
			MySpace.bottom := MySpace.bottom - 15
			end
		else begin
			ScrollHoriz := false;
			hScrollRect.top := 0;
			hScrollRect.bottom := -1
			end;
		listRect := MySpace;
		numCelleH := 0;
		numCelleV := 0;
	
		WITH cella DO BEGIN
			{ Custom list definition procedure? }
			h := (MySpace.right-MySpace.left) DIV HinView;
			IF BAnd (wishList, WantCustomLDEF) <> 0 THEN BEGIN
				{ Si, quindi lascia spazio per le icone }
				lDefID := rAkkosLDEF;
				v := kIconCellVertSize
				END
			ELSE BEGIN
				ldefId := 0;
				v := 15;
				END { else }
			END;
	
		SetRect (r1, 0, 0, 1, 0);
		{ setta la lista di zero colonne e una riga }
	
		{ Se  il main pane di una TMWindow, non terrei conto delle coordinate
		logiche se non scrivessiÉÊ}
		IF BAnd (wishList, wantTaskMaster) <> 0 THEN
			TMBeginDirectDraw (theWindow);
	
		{ Pulisci, just in case }
		EraseRect (mySpace);
		listWind := theWindow;
		theList := lNew (listRect, r1, cella, ldefId, theWindow,
			false, false, ScrollHoriz, ScrollVert );
		if BAnd (wishList, WantAutoScroll) > 0 then
			theList^^.ListFlags := LDoVAutoScroll + LDoHAutoScroll;
		theList^^.SelFlags := SelFlags;
		LSetDrawingMode (true, theList);
	
		Ridisegna (l);	{ Serve solo a fare il rettangolo }

		IF BAnd (wishList, wantTaskMaster) <> 0 THEN
			TMEndDirectDraw (theWindow);
		END; { with }
	NuovaLista := l
end;

Procedure ListaShutdown (l: ListInfoRec);
Begin
	LDispose (l.theList)
End;

Procedure AggiornaCella (var l: ListInfoRec; c: cell; testo: StringPtr);
var
	p: Ptr;
begin
	p := Ptr (1 + Ord4 (StripAddress(testo)));
	
	IF BAnd (l.flags, wantTaskMaster) <> 0 THEN BEGIN
		SetPort (l.listWind);
		TMBeginDirectDraw (l.listWind);
		END;
	LSetCell (p, length (testo^), c, l.theList);
	LDraw (c, l.theList);
	IF BAnd (l.flags, wantTaskMaster) <> 0 THEN
		TMEndDirectDraw (l.listWind);
end;

Procedure NuovaCella (var l: ListInfoRec; c: cell; Testo: StringPtr);
var
	j: integer;
	p: ptr;
	copiaDiC: Cell;
begin
	WITH l DO BEGIN
		copiaDiC.v := c.v;
		copiaDiC.h := 0;
		IF NOT PtInRect (copiaDiC, theList^^.dataBounds) THEN BEGIN
			{ Need a new row }
			j := LAddRow (c.v-numCelleV+1, c.v, theList);
			numCelleV := c.v+1;
			IF numCelleH = 0 THEN
				numCelleH := 1	{ Solo se la lista era vuota }
			END;
		IF NOT PtInRect (c, theList^^.dataBounds) THEN BEGIN
			{ Need a new column }
			j := LAddColumn (c.h-numCelleH+1, c.h, theList);
			numCelleH := c.h+1;
			END;
		p := ptr (1 + Ord4(StripAddress (testo)));
		LSetCell (p, length (Testo^), c, theList);
		{LDraw (c, theList);}
		END { with }
end;

Procedure NuovaCCella (var l: ListInfoRec; c: cell; i: Integer; Testo: StringPtr);
var
	temp: CellDataRecord;
	j, len: integer;
	copiaDiC: Cell;
begin
	{ Setup record to be copied }
	len := length (testo^);
	WITH temp DO BEGIN
		BlockMoveData (testo, @iconName, SizeOf (IconString));
		IF len > 31 THEN
			iconName[0] := chr (31);
		iconID := i
		END;

	WITH l DO BEGIN
		copiaDiC.v := c.v;
		copiaDiC.h := 0;
		IF NOT PtInRect (copiaDiC, theList^^.dataBounds) THEN BEGIN
			{ Need a new row }
			j := LAddRow (c.v-numCelleV+1, c.v, theList);
			numCelleV := c.v+1;
			IF numCelleH = 0 THEN
				numCelleH := 1	{ Solo se la lista era vuota }
			END;
		IF NOT PtInRect (c, theList^^.dataBounds) THEN BEGIN
			{ Need a new column }
			j := LAddColumn (c.h-numCelleH+1, c.h, theList);
			numCelleH := c.h+1;
			END;
		LSetCell (@temp, len+3 {str+lenbyte+integer}, c, theList);
		END { with }
end;

Procedure AggiornaCCella (var l: ListInfoRec; c: cell; i: Integer; testo: StringPtr);
var
	temp: CellDataRecord;
	len: integer;
begin
	{ Setup record to be copied }
	len := length (testo^);
	WITH temp DO BEGIN
		BlockMoveData (testo, @iconName, SizeOf (IconString));
		IF len > 31 THEN
			iconName[0] := chr (31);
		iconID := i
		END;
	{ Do copy }
	IF BAnd (l.flags, wantTaskMaster) <> 0 THEN BEGIN
		SetPort (l.listWind);
		TMBeginDirectDraw (l.listWind);
		END;
	LSetCell (@temp, len+3, c, l.theList);
	IF BAnd (l.flags, wantTaskMaster) <> 0 THEN
		TMBeginDirectDraw (l.listWind);
end;

(*
Non pi supportato dalla versione 3.x 

Procedure ListaZoom (var l: ListInfoRec; r: rect);
begin
	WITH l DO BEGIN
		listrect := r;
		if VScrollRect.top < VScrollRect.bottom { c' scrollbar verticale } then begin
			VScrollRect := r;	{ trova il rettangolo della scrollbar v }
			VScrollRect.left := VScrollRect.right - 15;
			listrect.right := listrect.right - 15	{spazio per scrollbar}
			end;
		if HScrollRect.top < HScrollRect.bottom { c' scrollbar orizzontale } then begin
			HScrollRect := r;
			HScrollRect.top := HScrollRect.bottom - 15;
			ListRect.bottom := ListRect.bottom - 15
			end;
		LSize (ListRect.right-ListRect.left,ListRect.bottom-ListRect.top, theList)
		END { WITH }
	end;
*)

Function DammiCella (var l: ListInfoRec; var c: cell): boolean;
begin
	SetPt (c, 0, 0);
	DammiCella := LGetSelect (true, c, l.theList)
end;

Procedure CancellaCella (VAR l: ListInfoRec; c: cell);
begin
	WITH l DO BEGIN
		LDelRow (1, c.v, theList);
		NumCelleV := Pred (NumCelleV);
		if NumCelleV = 0 then
			NumCelleH := 0;

		IF BAnd (flags, wantTaskMaster) <> 0 THEN BEGIN
			SetPort (listWind);
			TMBeginDirectDraw (listWind);
			END;
		Ridisegna (l);
		IF BAnd (flags, wantTaskMaster) <> 0 THEN
			TMEndDirectDraw (listWind);
		END;
end;

Procedure CancellaLista (VAR l: ListInfoRec);
Begin
	WITH l DO BEGIN
		IF BAnd (flags, wantTaskMaster) <> 0 THEN BEGIN
			SetPort (listWind);
			TMBeginDirectDraw (listWind);
			END;
		LDelRow (0, 0, theList);
		NumCelleH := 0;
		NumCelleV := 0;
		EraseRect (listRect);
		IF BAnd (flags, wantTaskMaster) <> 0 THEN
			TMEndDirectDraw (listWind);
		END
end;

FUNCTION FindCell(VAR Selected_Cell: Point; TheList : ListHandle) : BOOLEAN;
{Return the currently selected cell in TheList}
BEGIN
	SetPt(Selected_Cell, 0, 0);
	FindCell:= LGetSelect(TRUE,
		Selected_Cell, TheList);
END;	 

FUNCTION  LtoLClickProc : BOOLEAN;
CONST
	kInvalidDrag	=	$8000;
VAR
	R 				: RgnHandle;
	L				: LongInt;
	DestCell,
	SourceCell		: Point;
	CellRect 		: Rect;
	LimitRect, SlopRect : Rect;
BEGIN
	LtoLClickProc := TRUE;

	Delay (5, l);	{ Se non c' un delay, per qualche motivo non prende doppio click }
	IF firstTime THEN BEGIN
		{ Non ha ancora cominciato a muoversi, quindi non far apparire il drag rect
		e lascia che la cella venga selezionata. }
		firstTime := FALSE;
		LtoLClickProc := TRUE;
		Exit (LtoLClickProc);
		END;
	
	IF FindCell(sourceCell, gSourceList) THEN
	BEGIN
		LRect(cellRect, sourceCell, gSourceList);
		SetRect(LimitRect, portRect.Left
							+ (AnchorPoint.h - CellRect.Left),
							portRect.Top + 
							(AnchorPoint.v - CellRect.Top),
							portRect.Right - 
							(CellRect.Right - AnchorPoint.h),
							portRect.Bottom - 
							(CellRect.Bottom - AnchorPoint.v));
		SlopRect := portRect;
		END;
		{now that we have selected a cell, use}
		{DragGrayRgn to drag it around}
		InsetRect (SlopRect, -1, -1);
		R := NewRgn;
		CloseRgn (r);
		RectRgn(R, CellRect);
		L := DragGrayRgn(R, AnchorPoint, LimitRect,
			SlopRect, noConstraint, NIL);
		DisposeRgn (r);
		IF HiWrd(L) <> kInvalidDrag THEN BEGIN
			{ Dove ha rilasciato il mouse? }
			destCell.v := AnchorPoint.v + HiWrd(L);
			destCell.h := AnchorPoint.h + LoWrd(L);
			IF PtInRect(destCell, gSourceList^^.rView) THEN { Rilasciato su me stesso }
				w := Click
			ELSE IF PtInRect (destCell, targetRect) THEN
				w := DraggedToOther
			ELSE w := DraggedOut
		END;	{if not kinvaliddrag}
END;	{LtoLClickProc}

Function FindList (sourceList: ListInfoRecPtr; Ev: EventRecord; var c: cell;
	destList: ListInfoRecPtr): Result;
var
	temp: boolean;
	draggingProc: ListClickLoopUPP;	{ PPC }
	oldPort: GrafPtr;
begin
	GetPort (oldPort);
	SetPort (sourceList^.listWind);
	{ Inzializza risultato "nullo" }
	w := NotMe;
	WITH sourceList^ DO BEGIN
		{ Sistema il caso in cui devo usare una clickloop proc }
		IF destList = NIL THEN
			theList^^.lClickLoop := NIL
		ELSE BEGIN
			draggingProc := NewListClickLoopProc (@LtoLClickProc);
			theList^^.lClickLoop := draggingProc;
			gSourceList := theList;
			firstTime := TRUE;
			IF StripAddress(destList) = StripAddress(sourceList) THEN
				{ Non c' una "lista destinazione" diversa da me stesso, quindi }
				SetRect(targetRect,1,0,0,0)		{ rect vuoto }
			ELSE
				{ Prendi nota del bersaglio }
				targetRect := destList^.listRect;
			portRect := listWind^.portRect;
			END;
		anchorPoint := ev.Where;
		globaltolocal(anchorPoint);
		
		IF BAnd (flags, wantTaskMaster) <> 0 THEN
			TMBeginDirectDraw (listWind);

		if PtInRect (anchorPoint, listRect) then begin
			temp := LClick (anchorPoint, Ev.modifiers, theList);{ passa palla a list mgr }
			c := LLastClick (theList);
			IF w = NotMe THEN
				IF temp THEN
					w := DoubleClick
				else
					w := Click
			end;
		if PtInRect (anchorPoint, hScrollRect) | PtInrect (anchorPoint, vScrollRect) then begin
			temp := LClick (anchorPoint, Ev.modifiers, theList);{ passa palla a list mgr }
			w := NeverMind;	{ Trattato noi }
			end;

		IF BAnd (flags, wantTaskMaster) <> 0 THEN
			TMEndDirectDraw (listWind);

		{ Free memory }
		IF destList <> NIL THEN
			DisposeRoutineDescriptor (draggingProc)
		END; { with }
	FindList := w;
	SetPort (oldPort)
end;

end.