DialogLord4.p

Unit DialogLord4;

{ Versione 4.0 del 23 dicembre 1996.
Basata sulla versione 3.2.3 del 21 nov 96

Revisione globale per evitare i set.

v4.0.1 del 13 aprile 97: eliminato un crashing bug nel filtro, gestione Return

v4.1 del 19, aprile 1997. Grazie a TaskMaster, durante la presenza a video delle
finestre di dialogo, vengono aggiornate le finestre di secondo piano da ridisegnare

v4.5, Appearance savy, per quanto si pu˜ (e non  molto). Gestisce il disabling dei
controlli nelle finestre che passano in secondo piano.
}

Interface

	USES
		{ List 1 - always include these }
		Types
		,QuickDraw
		{ List 2 - only require List 1 types }
		,Controls
		,Events
		,TextEdit
		{ List 3 - needs List 1/2 types }
		,Windows			{ needs Events, Controls }
		{ List 4 - needs List 1/2/3 types }
		,Dialogs			{ needs TextEdit, Windows }
		;

CONST
	kDL4maxFamilyMembers = 32;
	
Type
   Family = PACKED ARRAY [1..kDL4maxFamilyMembers] OF BOOLEAN;

PROCEDURE ClearFamily (VAR f: Family);

{ Si tratta di una serie semplicissima di routine create per
	usare con estrema semplicitˆ il Dialog Manager.
	I nomi sono presi dal Dialog Manager dell'Apple IIgs }

Procedure SetItemValue (d: DialogPtr; item, v: integer);
Function GetItemValue (d: DialogPtr; item: integer): Integer;
Procedure GetItemRect (d: DialogPtr; item: integer; var r: rect);
Procedure SetItemText (d: DialogPtr; item: integer; v: str255);
Procedure GetItemText (d: DialogPtr; item: integer; var v: str255);
Procedure DisableDialogItem (d: DialogPtr; item: integer);
Procedure EnableDialogItem (d: DialogPtr; item: integer);
{ Vanno ricordate le seguenti funzioni dal Dialog Manager 128K
	(cfr Inside macintosh Vol. IV, pag. 59 segg.)
	Procedure HideDialogItem (theDialog: DialogPtr; item: integer);
	Procedure ShowDialogItem (theDialog: DialogPtr; item: integer);
	}

PROCEDURE SetItemProcedure (d: DialogPtr; item: Integer; proc: UserItemProcPtr);
{ Per assegnare una user procedure ad un item. In questo caso alla chiusura della
finestra  indispensabile chiamate: }
PROCEDURE ResetItemProcedure (d: DialogPtr; item: Integer);
{ É che provvede a deallocare la memoria usata nel primo caso }

Procedure DefaultButton (d: DialogPtr; containsTextEdits: Boolean);
{ Evidenzia il bottone di default (numero 1) in modo consono alla User Interface.
  Caratterizza il bottone numero due come bottone Annulla.
	Il port deve essere giˆ settato. Se il bottone  disattivo, la cornice
	viene disegnata in grigio. }
	
PROCEDURE SelectButton (d: DialogPtr; item: integer);
{ Quando in una window abbiamo un bottone di default, e l'utente preme OK,
chiamare questa procedure in modo che il bottone venga evidenziato }

{ Ed ecco due funzioni che permettono di trattare le famiglie di
	Radio Button in modo coerente: }
Procedure SetRadio (d: DialogPtr; item: integer;
					numitems: integer; f: family);
	{ Accende il RadioButton numero item della famiglia family }
Function GetRadio (d: DialogPtr; numitems: integer; f: family): integer;
	{ Restituisce il numero del radio button acceso }


{ Ecco i blockbuster di oggi: }

FUNCTION AlertLord (alertID, numItems: Integer; familyOfBtns: Family): Integer; 
{ Per gestire gli alert in modo che accettino la pressione
del tasto equivalente sulla tastiera }

FUNCTION DialogLord (d: DialogPtr; numitems: integer;
	RadioOne, RadioTwo, Buttons, Checks,
	TEnumOnly, TEtextOnly, TEmaxLen: family; maxLen: Integer; 
	var ev: eventrecord): integer;
	{ La funzione gestisce i dialoghi modali, trattando in modo
	coerente i radio, check e simple buttons. Supporta sino
	a due famiglie di radio button, e se vede arrivare un evento che
	riguarda un item inserito in Buttons ritorna al chiamante con
	lo itemhit e l'evento. Se un item non  inserito in nessun
	set esso non verrˆ considerato dall'applicazione. }

Implementation

		USES
			Appearance,
			GestaltEqu,
			MixedMode,
			OSUtils,
			Resources,
			Scrap,
			
			Cilindro,
			TaskMaster3;
var
	itembox : rect;
	itemtype : integer;
	itemhdl : handle;

{$S UtilMain}
PROCEDURE ClearFamily (VAR f: Family);
BEGIN
	Longint (f) := 0
END;

{$S UtilMain}
PROCEDURE SetItemProcedure (d: DialogPtr; item: Integer; proc: UserItemProcPtr);
VAR
	theProc: UserItemUPP;
BEGIN
	theProc := NewUserItemProc (proc);
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	SetDialogItem(d, item, itemtype, Handle (theProc), itembox);
END;

{$S UtilMain}
PROCEDURE ResetItemProcedure (d: DialogPtr; item: Integer);
VAR
	theProc: UserItemUPP;
BEGIN
	GetDialogItem(d, item, itemtype, Handle (theProc), itembox);
	DisposeRoutineDescriptor (theProc)
END;

{$S UtilMain}
Procedure SetItemValue (d: DialogPtr; item, v: integer);
VAR
	max: Integer;
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	{ Il blocco seguente serve solo per i 3D buttons }
	max := GetControlMaximum(ControlHandle(itemhdl));
	if (max < v) THEN
		SetControlMaximum(ControlHandle(itemhdl), v);
	{ Setta il nuovo valore }
	setControlvalue (controlhandle(itemhdl),v)
end;

{$S UtilMain}
Function GetItemValue (d: DialogPtr; item: integer): Integer;
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	GetItemValue := GetControlvalue (controlhandle(itemhdl))
end;

{$S UtilMain}
Procedure GetItemRect (d: DialogPtr; item: integer; var r: rect);
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	r := itembox
end;

{$S UtilMain}
Procedure SetItemText (d: DialogPtr; item: integer; v: str255);
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	SetDialogItemText (itemhdl, v)
end;

{$S UtilMain}
Procedure GetItemText (d: DialogPtr; item: integer; var v: str255);
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	GetDialogItemText (itemhdl, v)
end;

{$S UtilMain}
Procedure DisableDialogItem (d: DialogPtr; item: integer);
VAR
	newItemType: Integer;
begin
	ShowWindow (d);
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	{ Disabilito anche "logicamente", chiamando DlogMgr. Questo permette
	alla filter proc di dialog lord di riconoscere i pulsanti disabilitati }
	newItemType := BOr(itemType, kItemDisableBit);
	SetDialogItem (d, item, newItemType, itemHdl, itemBox);
	IF BAnd (itemType, kControlDialogItem) <> 0 THEN
		{ é un control, chiedi a Control Mgr di fare il lavoro }
		HiliteControl(controlhandle(itemHdl), 255);
end;

{$S UtilMain}
Procedure EnableDialogItem (d: DialogPtr; item: integer);
VAR
	newItemType: Integer;
begin
	GetDialogItem (d,item,itemtype,itemhdl,itembox);
	{ Abilito anche "logicamente", chiamando DlogMgr. Questo permette
	alla filter proc di dialog lord di riconoscere i pulsanti disabilitati }
	newItemType := BAnd (itemType, BNot (kItemDisableBit));
	SetDialogItem (d, item, newItemType, itemHdl, itemBox);
	IF BAnd (itemType, kControlDialogItem) <> 0 THEN
		{ é un control, chiedi a Control Mgr di fare il lavoro }
		HiliteControl(controlhandle(itemHdl), 0);
end;

{$S UtilMain}
Procedure DefaultButton (d: DialogPtr; containsTextEdits: Boolean);
VAR
	err: OSErr;
begin
	err := SetDialogDefaultItem (d, kStdOkItemIndex);
	err := SetDialogCancelItem (d, kStdCancelItemIndex);
	IF containsTextEdits THEN
		err := SetDialogTracksCursor (d, true);
END;

{$S UtilMain}
PROCEDURE SelectButton (d: DialogPtr; item: integer);
	CONST
		kDelayTime			= 8;	{ For the delay time when flashing the
										menubar and highlighting a button.
										8/60ths of a second}
		kSelect 				= 1;	{ select the control }
		kDeselect			= 0;	{ deselect the control }
	VAR
		finalTicks: 		LONGINT;

	BEGIN
		GetDialogItem (d,item,itemtype,itemhdl,itembox);
		HiliteControl(ControlHandle(itemhdl), kSelect);
		Delay(kDelayTime, finalTicks);
		HiliteControl(ControlHandle(itemhdl), kDeselect);
	END;											{ SelectButton }

{$S UtilMain}
Procedure SetRadio (d: DialogPtr; item: integer;
					numitems: integer; f: family);
var
	i: integer;
begin
	{ Resetta tutti i button a zero }
	for i := 1 to numitems do
		if f[i] then
			SetItemValue (d, i, 0);
	{ Setta quello dato }
	SetItemValue (d, item, 1)
end;

{$S UtilMain}
Function GetRadio (d: DialogPtr; numitems: integer; f: family): integer;
var
	i, value, itemfound: integer;
begin
	for i := 1 to numitems do
		if f[i] then begin
			value := GetItemValue (d, i);
			if value <> 0 then
				itemfound := i;
			end; { if }
	GetRadio := itemfound
end;


VAR
	gTEnumOnly, gTEtextOnly, gTEmaxLen, gButtons: family;
	gMaxLen: Integer;

{$S UtilMain}
FUNCTION DLFilterProc (theDialog:  DialogPtr; VAR theEvent:  EventRecord;
                   VAR itemHit:  INTEGER) :  BOOLEAN;
VAR
	result, wasAKey: Boolean;
	key, uppercaseKey: Char;
	lenOfSelection,
	textItemHit: Integer;	{ Scopro a quale textedit va assegnato il char corrente }
	resultLen,			{ Length after insertion }
	scrapLen,			{ Length of text in clipboard }
	offset: Longint;
	tempText: str255;
	gestaltResult: Longint;

	FUNCTION HasSelectionRange: Integer;
	VAR
    	theTERecord: TEHandle;
	BEGIN
		theTERecord := DialogPeek(theDialog)^.textH;
    	HasSelectionRange := theTERecord^^.selEnd  - theTERecord^^.selStart;
	END; { HasSelectionRange }

BEGIN
	{myItemHit := itemHit;}
	result := FALSE;						{ Salvo eccezioni, tutto bene }
	wasAKey := (theEvent.what = keyDown) | (theEvent.what = autoKey);
	key := chr (BAnd(theEvent.message, charCodeMask));
	uppercaseKey := chr (BAnd (ord(key), $FFDF));	{ Make it uppercase }
	textItemHit := DialogPeek(theDialog)^.editField + 1;
	
	IF (theEvent.what = updateEvt) AND (theEvent.message <> Longint (theDialog)) THEN
		IF TMDoUpdateStuff (WindowPtr (theEvent.message), tmEverything) THEN
			result := TRUE; { handled }
	
	(*** Funziona solo sotto Mac OS 8. In 7, se un dialogo richiama un dialogo,
	TM disattiva tutti i pulsanti del chiamante,
	e all'uscita dal secondo, disastro... ***)
	
	IF (theEvent.what = activateEvt) & (theEvent.message <> Longint (theDialog)) &
		(Gestalt (gestaltAppearanceAttr, gestaltResult) = noErr) THEN BEGIN
		TMDoActivateStuff (WindowPtr (theEvent.message), tmEverything, BAnd(theEvent.modifiers, activeFlag) = 0);
		result := TRUE; { handled }
		END;
	
	(*** If a non-printing key then avoid checking ***)
	IF wasAKey THEN
		CASE key OF
			chBackspace, chLeft, chRight, chUp, chDown, chTab: BEGIN
				DLFilterProc := FALSE;
				Exit (DLFilterProc)
				END;
			chEscape: BEGIN
				{ C' un pulsante Cancel, default e abilitato? }
				GetDialogItem (theDialog, kStdCancelItemIndex, itemType, itemHdl, itemBox);
				{ Se si, mappa esc su di esso }
				IF (BAnd(itemType, kControlDialogItem) <> 0) &	{ Questo accetta anche i pulsanti 3D }
				(BAnd (itemType, kItemDisableBit) = 0) &
				gButtons[kStdCancelItemIndex] THEN BEGIN
					itemHit := kStdCancelItemIndex;
					SelectButton (theDialog, kStdCancelItemIndex);
					END;
				DLFilterProc := TRUE;
				Exit (DLFilterProc)
				END;
			chReturn,
			chEnter: BEGIN
				{ C' un pulsante OK, default e abilitato? }
				GetDialogItem (theDialog, kStdOkItemIndex, itemType, itemHdl, itemBox);
				{ Se si, mappa il return su di esso }
				IF (BAnd(itemType, kControlDialogItem) <> 0) &	{ Questo accetta anche i pulsanti 3D }
				(BAnd (itemType, kItemDisableBit) = 0) &
				gButtons[kStdOkItemIndex] THEN BEGIN
					itemHit := kStdOkItemIndex;
					SelectButton (theDialog, kStdOkItemIndex);
					DLFilterProc := TRUE;
					Exit (DLFilterProc)
					END;
				{ No. Allora lo lascio passare, a meno che il cursore non sia in 
				un TextEdit che accetta solo lettere o numeri }
				IF (textItemHit > 0) & (gTEnumOnly[textItemHit] | gTEtextOnly[textItemHit]) THEN BEGIN
					DLFilterProc := TRUE;
					Exit (DLFilterProc)
					END;
				END { caso return }
			END; { case }
	
	(*** Check for number-only textedit ***)
	IF wasAKey & gTEnumOnly[textItemHit] & ((key < '0') | (key > '9')) THEN BEGIN
        SysBeep(1);							{ complain a little }
        result := true;						{ tell DM to discard the event }
		END;

	(*** Check for maxlen textedit ***)
	IF wasAKey & gTEmaxLen[textItemHit] THEN BEGIN
		{ Was there a selection range? }
		lenOfSelection := HasSelectionRange;
		{ Is there something to paste? }
		scrapLen := GetScrap (nil, 'TEXT', offset);
		{ Is there something already in the textedit? }
		GetItemText (DialogPtr (theDialog), textItemHit, tempText);
		{ What length, if we do a Paste? }
		resultLen := length (tempText) + scrapLen - lenOfSelection;
		{ If it was a paste and the result is lengthier that allowed,
		refuse }
		IF (BAnd (theEvent.modifiers, cmdKey) <> 0) & (uppercaseKey = 'V') & (resultLen > gMaxLen) THEN BEGIN
      		SysBeep(1);							{ complain a little }
        	result := true;						{ tell DM to discard the event }
			END
		ELSE
		{ If it was an insertion and we are at the max, refuse }
			IF length (tempText) - lenOfSelection >= gMaxLen THEN BEGIN
      		SysBeep(1);							{ complain a little }
        	result := true;						{ tell DM to discard the event }
			END
		END; { check for maxlen textedit }
	
	(*** Check for text-only textedit ***)
	IF wasAKey & gTEtextOnly[textItemHit] &
		(((uppercaseKey < 'A') | (uppercaseKey > 'Z')) & (key <> ' ')) THEN BEGIN
        SysBeep(1);							{ complain a little }
        result := true;						{ tell DM to discard the event }
		END;

	DLFilterProc := result
END;

{$S UtilMain}
FUNCTION AlertFilterProcForKeys (theDialog:  DialogPtr; VAR theEvent:  EventRecord;
                   VAR itemHit:  INTEGER) :  BOOLEAN;
VAR
	result, wasAKey: Boolean;
	key, uppercaseKey: Char;
	i: Integer;
BEGIN
	result := FALSE;						{ Salvo eccezioni, tutto bene }

	wasAKey := (theEvent.what = keyDown) | (theEvent.what = autoKey);
	key := chr (BAnd(theEvent.message, charCodeMask));
	uppercaseKey := chr (BAnd (ord(key), $FFDF));	{ Make it uppercase }

	IF wasAKey THEN
		IF ((uppercaseKey < 'A') OR (upperCaseKey > 'Z')) THEN BEGIN
			CASE key OF
				chr (13): IF gButtons[kStdOkItemIndex] THEN BEGIN
					result := TRUE;
					SelectButton (DialogPtr(theDialog), kStdOkItemIndex);
					itemHit := kStdOkItemIndex
					END;
				chr (27): IF gButtons[kStdCancelItemIndex] THEN BEGIN
					result := TRUE;
					SelectButton (DialogPtr(theDialog), kStdCancelItemIndex);
					itemHit := kStdCancelItemIndex
					END
				END { case }
			END { if not alpha key }
		ELSE FOR i := 1 TO gMaxLen { Num items in alert } DO
			IF gButtons[i] { buttons } THEN BEGIN
				GetDialogItem (DialogPtr(theDialog),i,itemtype,itemhdl,itembox);
				IF ControlHandle(itemHdl)^^.contrlTitle[1] = uppercaseKey THEN BEGIN
					{ Gotcha! }
					SelectButton (DialogPtr(theDialog), i);
					itemHit := i;
					result := TRUE
					END;
				END;
	
	AlertFilterProcForKeys := result
END;

{$S UtilMain}
FUNCTION AlertLord (alertID, numItems: Integer; familyOfBtns: Family): Integer; 
VAR
	myFilter: ModalFilterUPP;
BEGIN
	{ Salva i parametri in var globali ad uso della funzione filtro }
	gMaxLen := numItems;
	gButtons := familyOfBtns;
	{ Crea uno UPP per compatibilitˆ con PowerPC }
	myFilter := NewModalFilterProc (@AlertFilterProcForKeys);
	{ Chiama Alert del Toolbox }
	AlertLord := Alert (alertID, myFilter);
	{ Grazie, il filtro non serve pi, per ora }
	DisposeRoutineDescriptor (myFilter)
END;

{$S UtilMain}
FUNCTION DialogLord (d: DialogPtr; numItems: integer;
	radioOne, radioTwo, buttons, checks,
	TEnumOnly, TEtextOnly, TEmaxLen: Family; maxLen: Integer; 
	var ev: eventrecord): integer;
var
	itemHit: integer;
	esci, dummy: boolean;
	myFilter: ModalFilterUPP;
begin
	{ Copia i parametri che servono alla filter proc anche nelle globali }
	gTEnumOnly := TEnumOnly;
	gTEtextOnly := TEtextOnly;
	gTEmaxLen := TEmaxLen;
	gmaxLen := maxLen;
	gButtons := buttons;
	
	esci := false;
	myFilter := NewModalFilterProc (@DLFilterProc);
	repeat
		ModalDialog (myFilter,itemHit);
		dummy := eventavail(everyevent,ev);
		IF (itemHit > 0) AND (itemHit <=numItems) THEN BEGIN { Arriva -1 a volte what }
			if radioOne[itemHit] then
				SetRadio (d, itemHit, numitems, RadioOne);
			if radioTwo[itemHit] then
				SetRadio (d, itemHit, numitems, RadioTwo);
			if checks[itemHit] then
				SetItemValue (d, itemHit, 1-GetItemValue(d, itemHit));
			if buttons[itemHit] then begin
				DialogLord := itemHit;
				esci := true
				end { if button }
			END
	until esci;
	{ Grazie, il filtro non serve pi, per ora }
	DisposeRoutineDescriptor (myFilter)
end;

end. { unit }