{Generates tool cursors from tool font. Thanks to Borland for "OffScreenDrawing"}
{and "MysteryCursor" examples in "Turbo Pascal Tutor".}
var
TempPort: GrafPort;
tPort: GrafPtr;
aRect, bRect: Rect;
OffScreenBitMap: BitMap;
BlankMask: Bits16;
tool: ToolType;
i: integer;
TempCurH: CursHandle;
begin
GetPort(tPort);
OpenPort(@TempPort);
with OffScreenBitMap do begin
baseAddr := NewPtr(2 * 16); { allocate a bit image for 16x16 cursor}
rowBytes := 2; { 2 bytes per row}
SetRect(bounds, 0, 0, 16, 16); { define usable area and coordinate systme }
end;
SetPortBits(OffscreenBitMap);
for i := 0 to 15 do
BlankMask[i] := 0;
TextFont(ToolFont);
TextSize(12);
for tool := FirstTool to LastTool do begin
EraseRect(OffscreenBitMap.bounds);
MoveTo(0, 0);
DrawChar(ToolCursorChar[tool]);
with ToolCursor[tool] do begin
BlockMove(OffscreenBitMap.BaseAddr, @data, 32);
hotspot.h := 8;
hotspot.v := 8;
mask := BlankMask;
end;
end;
SetPort(tPort);
TempCurH := GetCursor(PickerCursorID);
PickerCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(CrossCursorPlusID);
CrossPlusCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(CrossCursorMinusID);
CrossMinusCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(CrossCursorID);
ToolCursor[SelectionTool] := TempCurH^^;
ToolCursor[FreehandTool] := TempCurH^^;
ToolCursor[PolygonTool] := TempCurH^^;
ToolCursor[ruler] := TempCurH^^;
ToolCursor[PlotTool] := TempCurH^^;
ToolCursor[OvalSelectionTool] := TempCurH^^;
ToolCursor[RoundedRectTool] := TempCurH^^;
ToolCursor[AngleTool] := TempCurH^^;
ToolCursor[PointingTool] := TempCurH^^;
ReleaseResource(handle(TempCurH));
ToolCursor[PickerTool] := PickerCursor;
TempCurH := GetCursor(LUTCursorID);
LUTCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(gmCursorID);
gmCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(GrabberCursorID);
ToolCursor[Grabber] := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(PencilCursorID);
ToolCursor[Pencil] := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(GlassCursorPlusID);
ToolCursor[MagnifyingGlass] := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(GlassCursorMinusID);
GlassMinusCursor := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(BucketCursorID);
ToolCursor[PaintBucket] := TempCurH^^;
ReleaseResource(handle(TempCurH));
TempCurH := GetCursor(WandCursorID);
ToolCursor[Wand] := TempCurH^^;
ReleaseResource(handle(TempCurH));
end;
procedure InitTools;
var
ToolTop, LinesTop, i: integer;
Tool: ToolType;
begin
FirstTool := MagnifyingGlass;
LastTool := PointingTool;
CurrentTool := SelectionTool;
isSelectionTool := true;
PreviousTool := CurrentTool;
ToolTop := 0;
for tool := FirstTool to LastTool do
with ToolRect[tool] do begin
top := ToolTop;
bottom := top + tmiddle;
if odd(ord(tool) + 1) then
left := 0
else begin
left := tmiddle;
ToolTop := ToolTop + tmiddle;
end;
right := left + tmiddle;
end;
ToolChar[Pencil] := chr(76);
ToolChar[SelectionTool] := chr(70);
ToolChar[MagnifyingGlass] := chr(66);
ToolChar[TextTool] := chr(72);
ToolChar[Grabber] := chr(71);
ToolChar[Brush] := chr(75);
ToolChar[ruler] := chr(112);
ToolChar[PaintBucket] := chr(104);
ToolChar[AirBrushTool] := chr(74);
ToolChar[PlotTool] := chr(94);
ToolChar[Wand] := chr(101);
ToolChar[Eraser] := chr(78);
ToolChar[FreehandTool] := chr(69);
ToolChar[PolygonTool] := chr(87);
ToolChar[OvalSelectionTool] := chr(83);
ToolChar[PickerTool] := chr(77);
ToolChar[RoundedRectTool] := chr(97);
ToolChar[LUTTool] := chr(86);
ToolChar[AngleTool] := chr(106);
ToolChar[PointingTool] := chr(113);
ToolCursorChar[SelectionTool] := chr(89);
ToolCursorChar[Pencil] := chr(76);
ToolCursorChar[MagnifyingGlass] := chr(66);
ToolCursorChar[TextTool] := chr(110);
ToolCursorChar[Grabber] := chr(71);
ToolCursorChar[brush] := chr(103);
ToolCursorChar[ruler] := chr(89);
ToolCursorChar[PaintBucket] := chr(89);
ToolCursorChar[RoundedRectTool] := chr(89);
ToolCursorChar[LUTTool] := chr(86);
ToolCursorChar[FreehandTool] := chr(89);
ToolCursorChar[AirbrushTool] := chr(100);
ToolCursorChar[PolygonTool] := chr(89);
ToolCursorChar[PlotTool] := chr(89);
ToolCursorChar[Wand] := chr(100);
ToolCursorChar[Eraser] := chr(68);
ToolCursorChar[OvalSelectionTool] := chr(89);
ToolCursorChar[PickerTool] := chr(77);
ToolCursorChar[AngleTool] := chr(89);
ToolCursorChar[PointingTool] := chr(89);
ToolTime := 0;
LutTime := 0;
StartOfLines := ToolRect[LastTool].bottom - 1;
LinesTop := StartOfLines + 10;
for i := 1 to nLineTypes do
with lines[i] do begin
left := LinesLeft;
top := LinesTop;
right := LinesRight;
case i of
1, 2, 3, 4:
bottom := top + i;
5:
bottom := top + 6;
6:
bottom := top + 8
end;
LinesTop := bottom + 4;
end;
LineWidth := 1;
LineIndex := 1;
with CheckRect do begin
left := 0;
top := StartOfLines;
right := LinesLeft;
bottom := theight;
end;
end;
procedure AllocateBuffers;
var
tPort: GrafPtr;
err: OSErr;
BufSizeStr: str255;
atemp: integer;
begin
NumToString(BufferSize div 1024, BufSizeStr);
BigBufSize := BufferSize * 2;
if FreeMem > (BigBufSize + 300000) then
BigBuf := NewPtr(BigBufSize)
else
BigBuf := nil;
if BigBuf = nil then
BigBufSize := 0;
if BigBuf <> nil then
UndoBuf := BigBuf
else begin
if FreeMem > (BufferSize + 200000) then
UndoBuf := NewPtr(BufferSize)
else
UndoBuf := nil;
end;
if UndoBuf <> nil then
UndoBufSize := BufferSize
else begin
PutMessage('There is not enough memory available to allocate the ', BufSizeStr, 'K Undo buffer. Many operations may fail or be Undoable.');
UndoBufSize := 0;
end;
if BigBuf <> nil then
ClipBuf := ptr(ord4(BigBuf) + BufferSize)
else begin
if FreeMem > (BufferSize + 300000) then
ClipBuf := NewPtr(BufferSize)
else
ClipBuf := nil;
end;
if ClipBuf <> nil then begin
ClipBufSize := BufferSize;
ClipBufInfoRec := NoInfo^;
with ClipBufInfo^ do begin
osroiRgn := NewRgn;
PicBaseAddr := ClipBuf;
GetPort(tPort);
new(osPort);
OpenCPort(osPort);
SetPort(tPort);
osPort^.portPixMap^^.BaseAddr := PicBaseAddr;
BytesPerRow := 0;
end;
end
else begin
PutMessage('There is not enough memory available to allocate the ', BufSizeStr, 'K Clipboard Buffer. Many operations, including Copy and Paste, may fail.');
ClipBufSize := 0;
end;
end;
procedure GetSettings;
var
Size, ticks: LongInt;
ok: boolean;
SettingsH: handle;
begin
SettingsH := GetResource('SETT', 1000);
if (ResError = NoErr) and (SettingsH <> nil) then begin