home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.mactech.com 2010
/
ftp.mactech.com.tar
/
ftp.mactech.com
/
macintosh-pascal
/
macintoshp-1.2-demos.sit.hqx
/
chap23pascal_demo
/
chap19pascal_demoPPC
/
CDEFsPascalPPC
/
CDEF1PascalPPC.p
next >
Wrap
Text File
|
1997-01-21
|
10KB
|
364 lines
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// CDEF1PascalPPC.p Custom control definition function for radio button control
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This CDEF displays:
//
// • 3D coloured radio buttons on colour displays set to pixel depths greater than 2.
//
// • Black-and-white buttons on colour displays set to pixel depths less than 4.
//
// • Black-and-white radio buttons if Color QuickDraw is not present.
//
// This CDEF utilises six 'cicn' resources (purgeable). The bitmap component, as opposed
// to the pixel map component, of each of these resources is automatically utilised if
// the icon is being displayed on a colour device for which the pixel depth has been set
// to 1 or 2. The appearance of the coloured radio buttons conforms to the specification
// for radio button controls contained in the document Apple Grayscale Appearance for
// System 7.5 published by Apple Computer Inc.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }
unit CDEF1Pascal;
{ ……………………………………………………………………………………………………………………………………………………………………… unit interface section }
interface
{ ………………………………………………………………………………………………………………… include the following Universal Interfaces }
uses
Controls, Fonts, Menus, Quickdraw, QuickdrawText, Processes, Types, Icons,
Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, QDOffscreen, SegLoad, Retrace,
Traps, GestaltEqu, LowMem;
{ ………………………………………………………………………………………………………………………………………………… define the following constants }
const
rActiveDeselect = 128;
rActiveSelect = 129;
rInactiveDeselect = 130;
rInactiveSelect = 131;
rFeedbackDeselect = 132;
rFeedbackSelect = 133;
partCode = 1;
{ ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
{$MAIN}
function main(varCode : integer; controlHdl : ControlHandle; message : integer;
param : longint) : longint;
{ ………………………………………………………………………………………………………………………………………………………… unit implementation section }
implementation
{ ……………………………………………………………………………………………………………………………………………………………………………………… global variables }
var
gTheQDGlobalsPtr : QDGlobalsPtr;
gColorQuickDrawPresent : boolean;
gColorDisplay : boolean;
gActiveDeselectHdl : CIconHandle;
gActiveSelectHdl : CIconHandle;
gInactiveDeselectHdl : CIconHandle;
gInactiveSelectHdl : CIconHandle;
gFeedbackDeselectHdl : CIconHandle;
gFeedbackSelectHdl : CIconHandle;
{ ………………………………………………………………………………………………………………………………………… procedure and function interfaces }
procedure DoInitMessage; forward;
procedure DoDrawMessage(controlHdl : ControlHandle); forward;
procedure DrawColour(controlHdl : ControlHandle; controlValue : integer;
controlRect : Rect); forward;
procedure DrawMono(controlHdl : ControlHandle; controlValue : integer;
controlRect : Rect); forward;
function DoTestMessage(controlHdl : ControlHandle;
param : longint) : longint; forward;
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ main }
function main(varCode : integer; controlHdl : ControlHandle; message : integer;
param : longint) : longint;
var
returnValue : longint;
{$IFC GENERATING68k} { For PowerPC }
oldA4, ignored : longint;
{$ENDC} { For PowerPC }
begin
{$IFC GENERATING68K } { For PowerPC }
oldA4 := SetCurrentA4;
{$ENDC} { For PowerPC }
case (message) of
initCntl: begin
DoInitMessage;
end;
drawCntl: begin
if (controlHdl^^.contrlVis <> 0) then
DoDrawMessage(controlHdl);
returnValue := 0;
end;
testCntl: begin
returnValue := DoTestMessage(controlHdl, param);
end;
otherwise begin
returnValue := 0;
end;
end;
{of case statement}
main := returnValue;
{$IFC GENERATING68K } { For PowerPC }
ignored := SetA4(oldA4);
{$ENDC} { For PowerPC }
end;
{of main procedure}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitMessage }
procedure DoInitMessage;
var
theErr : OSErr;
response : longint;
begin
gTheQDGlobalsPtr :=
QDGlobalsPtr(longint(Ptr(SetCurrentA5)) - (sizeof(QDGlobals) - sizeof(GrafPtr)));
theErr := Gestalt(gestaltQuickdrawVersion, response);
if (response >= gestalt8BitQD) then
gColorQuickDrawPresent := true
else
gColorQuickDrawPresent := false;
gColorDisplay := false;
gActiveDeselectHdl := nil;
gActiveSelectHdl := nil;
gInactiveDeselectHdl := nil;
gInactiveSelectHdl := nil;
gFeedbackDeselectHdl := nil;
gFeedbackSelectHdl := nil;
end;
{of procedure DoInitMessage}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawMessage }
procedure DoDrawMessage(controlHdl : ControlHandle);
var
theWindowPtr : WindowPtr;
oldPort : GrafPtr;
oldFont, oldSize, oldTextMode, controlValue, fontNum : integer;
oldPenState : PenState;
controlRect : Rect;
mainDeviceHdl : GDHandle;
bitsPerPixel : integer;
begin
theWindowPtr := WindowPtr(controlHdl^^.contrlOwner);
GetPort(oldPort);
oldFont := theWindowPtr^.txFont;
oldSize := theWindowPtr^.txSize;
oldTextMode := theWindowPtr^.txMode;
GetPenState(oldPenState);
SetPort(theWindowPtr);
controlValue := GetControlValue(controlHdl);
controlRect := controlHdl^^.contrlRect;
controlRect.right := controlRect.left + 12;
controlRect.bottom := controlRect.top + 12;
GetFNum('Chicago', fontNum);
TextFont(fontNum);
TextSize(12);
if (gColorQuickDrawPresent) then
begin
if (gActiveDeselectHdl = nil) then
gActiveDeselectHdl := GetCIcon(rActiveDeselect);
if (gActiveSelectHdl = nil) then
gActiveSelectHdl := GetCIcon(rActiveSelect);
if (gInactiveDeselectHdl = nil) then
gInactiveDeselectHdl := GetCIcon(rInactiveDeselect);
if (gInactiveSelectHdl = nil) then
gInactiveSelectHdl := GetCIcon(rInactiveSelect);
if (gFeedbackDeselectHdl = nil) then
gFeedbackDeselectHdl := GetCIcon(rFeedbackDeselect);
if (gFeedbackSelectHdl = nil) then
gFeedbackSelectHdl := GetCIcon(rFeedbackSelect);
end;
mainDeviceHdl := LMGetMainDevice;
bitsPerPixel := mainDeviceHdl^^.gdPMap^^.pixelSize;
if (bitsPerPixel > 1) then
gColorDisplay := true
else
gColorDisplay := false;
if (gColorQuickDrawPresent and gColorDisplay) then
DrawColour(controlHdl, controlValue, controlRect)
else
DrawMono(controlHdl, controlValue, controlRect);
SetPenState(oldPenState);
TextMode(oldTextMode);
TextFont(oldFont);
TextSize(oldSize);
SetPort(oldPort);
end;
{of procedure DoDrawMessage}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawColour }
procedure DrawColour(controlHdl : ControlHandle; controlValue : integer;
controlRect : Rect);
var
oldForeColour : RGBColor;
blackColour : RGBColor;
gray8 : RGBColor;
begin
blackColour.red := $0000;
blackColour.green := $0000;
blackColour.blue := $0000;
gray8.red := $7777;
gray8.green := $7777;
gray8.blue := $7777;
GetForeColor(oldForeColour);
if (controlHdl^^.contrlHilite = 255) then
begin
if (gColorDisplay) then
RGBForeColor(gray8)
else
TextMode(grayishTextOr);
if (controlValue = 1) then
PlotCIcon(controlRect, gInactiveSelectHdl)
else
PlotCIcon(controlRect, gInactiveDeselectHdl);
end
else if (controlHdl^^.contrlHilite = 0) then
begin
RGBForeColor(blackColour);
TextMode(srcOr);
if (controlValue = 1) then
PlotCIcon(controlRect, gActiveSelectHdl)
else
PlotCIcon(controlRect, gActiveDeselectHdl);
end
else if (controlHdl^^.contrlHilite = partCode) then
begin
if (controlValue = 1) then
PlotCIcon(controlRect, gFeedbackSelectHdl)
else
PlotCIcon(controlRect, gFeedbackDeselectHdl);
end;
MoveTo(controlRect.left + 17, controlRect.top + 10);
DrawString(controlHdl^^.contrlTitle);
RGBForeColor(oldForeColour);
end;
{of procedure DrawColour}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DrawMono }
procedure DrawMono(controlHdl : ControlHandle; controlValue : integer; controlRect : Rect);
begin
ForeColor(blackColor);
BackColor(whiteColor);
PenNormal;
if ((controlHdl^^.contrlHilite = 255) or (controlHdl^^.contrlHilite = 0)) then
begin
if (controlHdl^^.contrlHilite = 255) then
begin
PenPat(gTheQDGlobalsPtr^.gray);
TextMode(grayishTextOr);
end
else begin
PenPat(gTheQDGlobalsPtr^.black);
TextMode(srcOr);
end;
FrameOval(controlRect);
InsetRect(controlRect, 1, 1);
FillOval(controlRect, gTheQDGlobalsPtr^.white);
InsetRect(controlRect, -1, -1);
if (controlValue = 1) then
begin
InsetRect(controlRect, 3, 3);
if (controlHdl^^.contrlHilite = 255) then
FillOval(controlRect, gTheQDGlobalsPtr^.gray)
else
FillOval(controlRect, gTheQDGlobalsPtr^.black);
InsetRect(controlRect, -3, -3);
end;
end
else if (controlHdl^^.contrlHilite = partCode) then
begin
InsetRect(controlRect, 1, 1);
FrameOval(controlRect);
InsetRect(controlRect, -1, -1);
end;
MoveTo(controlRect.left + 17, controlRect.top + 10);
DrawString(controlHdl^^.contrlTitle);
end;
{of procedure DrawMono}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoTestMessage }
function DoTestMessage(controlHdl : ControlHandle; param : longint) : longint;
var
controlRect : Rect;
mouseXY : Point;
begin
controlRect := controlHdl^^.contrlRect;
mouseXY.v := HiWord(param);
mouseXY.h := LoWord(param);
if (PtInRect(mouseXY, controlRect)) then
DoTestMessage := partCode
else
DoTestMessage := 0;
end;
{of function DoTestMessage}
end.
{of unit CDEF1Pascal}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }