home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-11-01 | 21.7 KB | 849 lines | [TEXT/CWIE] |
- unit MyDialogs;
-
- interface
-
- uses
- Windows, Dialogs, Menus,
- MyUtils;
-
- const
- i_ok = 1;
- i_cancel = 2;
- i_discard = 3;
-
- var
- grey_pattern: PixPatHandle;
-
- var
- gStandardModalFilterProc:UniversalProcPtr;
- gCancelModalFilterProc:UniversalProcPtr;
- gDiscardModalFilterProc:UniversalProcPtr;
- gOutlineDefault1Proc:UniversalProcPtr;
-
- procedure StartupDialogs;
- procedure SetMyDialogFont(ft:MyFontType);
- procedure EnterWindow (window: WindowPtr; ft:MyFontType; face: Style; var saved: SavedWindowInfo);
- procedure ExitWindow (saved: SavedWindowInfo);
- procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
- procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
- function GetItemTextF (dlg: dialogPtr; item: integer): str255;
- procedure OutlineDefault1 (dp: dialogPtr; item: integer);
- procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
- procedure FlashDItem (dlg: dialogPtr; item: integer);
- procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
- procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
- procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
- procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
- function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
- function GetDItemHandle (dp: dialogPtr; item: integer): handle;
- procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
- function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
- procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
- function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
- procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
- function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
- procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
- procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
- function GetDCtlValue (dp: dialogPtr; item: integer): integer;
- procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
- function GetDCtlMax (dp: dialogPtr; item: integer): integer;
- procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
- function GetDCtlMin (dp: dialogPtr; item: integer): integer;
- procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
- function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
- procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
- procedure DrawDItem (dp: dialogPtr; item: integer);
- function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
- procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
- procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
- procedure SetWindowTitle (window: windowPtr; title: str255);
- function SelectedTextItem (dlg: DialogPtr): integer;
- procedure SelectDialogItem(dlg: DialogPtr; item: integer);
- procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
- procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
- { s= "font:size:style:just:text" }
- procedure ShiftTab (dlg: DialogPtr);
- procedure ManualTab (dlg: DialogPtr; shift: boolean);
- function CountDItems (dlg: DialogPtr): integer;
- procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
- procedure SetDialogTextFont (dlg: DialogPtr; ft:MyFontType; face: Style);
- function StandardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- function DiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
- function OverEditTextItem: Boolean;
-
- { procedure GetDAFont (var font: integer); -- use LMGetDlgFont }
-
- implementation
-
- uses
- Quickdraw, Fonts, Palettes,
- MyTypes, MyStrings, MyUtils, TextEdit, MyCallProc, MySystemGlobals, MyStartup;
- var
- gOutlineDeviceLoopProc:UniversalProcPtr;
-
- procedure PenPatGray;
- begin
- if grey_pattern = nil then begin
- PenPat(GetQDGlobals^.gray);
- end
- else begin
- PenPixPat(grey_pattern);
- end;
- end;
-
- procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
- var
- it: integer;
- ih: handle;
- box: rect;
- oldtext: str255;
- begin
- GetDialogItem(dlg, item, it, ih, box);
- GetDialogItemText(ih, oldtext);
- if oldtext <> text then begin
- SetDialogItemText(ih, text);
- end;
- end;
-
- procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
- var
- it: integer;
- ih: handle;
- box: rect;
- begin
- GetDialogItem(dlg, item, it, ih, box);
- GetDialogItemText(ih, text);
- end;
-
- function GetItemTextF (dlg: dialogPtr; item: integer): str255;
- var
- text: str255;
- begin
- GetItemText(dlg, item, text);
- GetItemTextF := text;
- end;
-
- var
- gODRect:Rect;
- gODEnabled:Boolean;
-
- procedure OutlineDeviceLoop (depth: integer; deviceFlags: integer; targetDevice: GDHandle; ignore:longInt);
- var
- backGround,foreGround:RGBColor;
- dummy:boolean;
- begin
- deviceFlags := deviceFlags; { UNUSED! }
- ignore := ignore; { UNUSED! }
- if not gODEnabled then begin
- if depth=1 then begin
- PenPat(GetQDGlobals^.gray);
- end else begin
- MakeRGBColor($0000,$0000,$0000,backGround);
- MakeRGBColor($FFFF,$FFFF,$FFFF,foreGround);
- dummy:=GetGray(targetDevice,backGround,foreGround);
- RGBForeColor(foreGround);
- end;
- end;
- FrameRoundRect(gODRect, 16, 16);
- PenPat(GetQDGlobals^.black);
- ForeColor(blackColor);
- end;
-
- procedure OutlineDefault1 (dp: dialogPtr; item: integer);
- begin
- SetPort(dp);
- GetDItemRect(dp, item, gODRect);
- InsetRect(gODRect, 2, 2);
- gODEnabled := GetDCtlEnable(dp, 1) & (FrontWindow = dp) & InForeground;
- PenSize(3, 3);
- SafeDeviceLoopRect(gODRect, gOutlineDeviceLoopProc, 0, 0);
- PenNormal;
- end;
-
- procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
- var
- kind: integer;
- h: handle;
- r: rect;
- begin
- GetDialogItem(dp, def_item, kind, h, r);
- InsetRect(r, -6,-6);
- SetDialogItem(dp, user_item, userItem, handle(gOutlineDefault1Proc), r);
- end;
-
- procedure FlashDItem (dlg: dialogPtr; item: integer);
- var
- f: longInt;
- begin
- SetDCtlHilite(dlg, item, kControlButtonPart);
- Delay(2, f);
- SetDCtlHilite(dlg, item, 0);
- end;
-
- procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
- var
- kind: integer;
- h: handle;
- r: rect;
- begin
- GetDialogItem(dp, item, kind, h, r);
- SetDialogItem(dp, item, kind, h, rr);
- end;
-
- procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
- var
- kind: integer;
- h: handle;
- begin
- GetDialogItem(dp, item, kind, h, rr);
- end;
-
- procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
- var
- kk: integer;
- h: handle;
- r: rect;
- begin
- GetDialogItem(dp, item, kk, h, r);
- SetDialogItem(dp, item, k, h, r);
- end;
-
- procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
- var
- r: rect;
- h: handle;
- begin
- GetDialogItem(dp, item, k, h, r);
- end;
-
- function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
- begin
- GetDControlHandle := ControlHandle(GetDItemHandle(dp, item));
- end;
-
- function GetDItemhandle (dp: dialogPtr; item: integer): handle;
- var
- kind: integer;
- h: handle;
- r: rect;
- begin
- GetDialogItem(dp, item, kind, h, r);
- GetDItemhandle := h;
- end;
-
- procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
- var
- kind: integer;
- hh: handle;
- r: rect;
- begin
- GetDialogItem(dp, item, kind, hh, r);
- SetDialogItem(dp, item, kind, h, r);
- end;
-
- function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
- begin
- GetDCtlHilite := controlHandle(GetDItemHandle(dlg, item))^^.contrlHilite;
- end;
-
- procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
- var
- ch: ControlHandle;
- begin
- ch := controlHandle(GetDItemHandle(dlg, item));
- if ch^^.contrlHilite <> hilite then begin
- HiliteControl(ch, hilite);
- end;
- end;
-
- function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
- begin
- GetDCtlEnable := GetDCtlHilite(dlg, item) <> 255;
- end;
-
- procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
- begin
- SetDCtlHilite(dp, item, 255 * ord(not on))
- end;
-
- function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
- var
- s: str255;
- begin
- GetControlTitle(GetDControlHandle(dp, item), s);
- GetDCtlTitle := s;
- end;
-
- procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
- var
- ch: ControlHandle;
- old: str255;
- begin
- ch := GetDControlHandle(dp, item);
- GetControlTitle(ch, old);
- if old <> s then begin
- SetControlTitle(ch, s);
- end;
- end;
-
- function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
- begin
- GetDCtlBoolean := GetControlValue(GetDControlHandle(dp, item)) <> 0;
- end;
-
- procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
- begin
- SetControlValue(GetDControlHandle(dp, item), ord(value));
- end;
-
- procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
- begin
- SetDCtlBoolean(dp, item, not GetDCtlBoolean(dp, item));
- end;
-
- function GetDCtlValue (dp: dialogPtr; item: integer): integer;
- begin
- GetDCtlValue := GetControlValue(GetDControlHandle(dp, item));
- end;
-
- procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
- begin
- SetControlValue(GetDControlHandle(dp, item), value);
- end;
-
- function GetDCtlMax (dp: dialogPtr; item: integer): integer;
- begin
- GetDCtlMax := GetControlMaximum(GetDControlHandle(dp, item));
- end;
-
- procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
- begin
- SetControlMaximum(GetDControlHandle(dp, item), value);
- end;
-
- function GetDCtlMin (dp: dialogPtr; item: integer): integer;
- begin
- GetDCtlMin := GetControlMinimum(GetDControlHandle(dp, item));
- end;
-
- procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
- begin
- SetControlMinimum(GetDControlHandle(dp, item), value);
- end;
-
- procedure DrawDItem (dp: dialogPtr; item: integer);
- begin
- Draw1Control(GetDControlHandle(dp, item));
- end;
-
- function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
- type
- MenuHandlePtr = ^MenuHandle;
- MenuHandleHandle = ^MenuHandlePtr;
- begin
- GetPopupMHandle := MenuHandleHandle(ControlHandle(GetDItemHandle(dlg, item))^^.contrlData)^^;
- end;
-
- procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
- var
- mh: MenuHandle;
- i, index: integer;
- s: str255;
- begin
- mh := GetPopupMHandle(dlg, item);
- if text = '' then begin
- GetMenuItemText(mh, 1, text);
- end;
- GetMenuItemText(mh, 2, s);
- if s = '-' then begin
- DeleteMenuItem(mh, 2);
- DeleteMenuItem(mh, 1);
- end;
- index := 0;
- for i := 1 to CountMItems(mh) do begin
- GetMenuItemText(mh, i, s);
- if (IUEqualString(s, text) = 0) then begin
- index := i;
- leave;
- end;
- end;
- if index = 0 then begin
- InsertMenuItem(mh, '(-;fred', 0);
- SetMenuItemText(mh, 1, text);
- index := 1;
- end;
- SetDCtlValue(dlg, item, index);
- end;
-
- procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
- var
- mh: MenuHandle;
- begin
- mh := GetPopupMHandle(dlg, item);
- GetMenuItemText(GetPopupMHandle(dlg, item), GetDCtlValue(dlg, item), text);
- end;
-
- procedure SetWindowTitle (window: windowPtr; title: str255);
- var
- s: str255;
- begin
- GetWTitle(window, s);
- if s <> title then begin
- SetWTitle(window, title);
- end;
- end;
-
- function SelectedTextItem (dlg: DialogPtr): integer;
- begin
- SelectedTextItem := DialogPeek(dlg)^.editField + 1;
- end;
-
- procedure SelectDialogItem(dlg: DialogPtr; item: integer);
- begin
- SelectDialogItemText(dlg, item, 0, maxint);
- end;
-
- function CountDItems (dlg: DialogPtr): integer;
- begin
- { count := CountDITL(dlg);}
- CountDItems := integerH(DialogPeek(dlg)^.items)^^ + 1;
- end;
-
- procedure ManualTab (dlg: DialogPtr; shift: boolean);
- var
- orgitem, i, count: integer;
- k: integer;
- begin
- orgitem := SelectedTextItem(dlg);
- count := CountDItems(dlg);
- if (orgitem > 0) & (count > 1) then begin
- i := orgitem;
- repeat
- if shift then begin
- i := i - 1;
- if i = 0 then begin
- i := count;
- end;
- end
- else begin
- i := i + 1;
- if i > count then begin
- i := 1;
- end;
- end;
- GetDItemKind(dlg, i, k);
- until (i = orgitem) | (k = editText);
- end;
- GetDItemKind(dlg, i, k);
- if k = editText then begin
- SelectDialogItem(dlg, i);
- end;
- end;
-
- procedure ShiftTab (dlg: DialogPtr);
- var
- orgitem, i, count: integer;
- k: integer;
- begin
- orgitem := SelectedTextItem(dlg);
- count := CountDItems(dlg);
- if (orgitem > 0) & (count > 1) then begin
- i := orgitem;
- repeat
- i := i - 1;
- if i = 0 then begin
- i := count;
- end;
- GetDItemKind(dlg, i, k);
- until (i = orgitem) | (k = editText);
- end;
- GetDItemKind(dlg, i, k);
- if k = editText then begin
- SelectDialogItem(dlg, i);
- end;
- end;
-
- procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
- var
- clip: RgnHandle;
- begin
- SetPort(window);
- PenNormal;
- clip := NewRgn;
- GetClip(clip);
- ClipRect(bounds);
- DrawGrowIcon(window);
- SetClip(clip);
- DisposeRgn(clip);
- end;
-
- function DoButtonKey(dlg:DialogPtr; item:integer; var er: EventRecord; var item_hit:integer):boolean;
- begin
- if GetDCtlEnable(dlg,item) then begin
- FlashDItem(dlg, item);
- item_hit:=item;
- DoButtonKey := true;
- end else begin
- SysBeep(10);
- er.what:=nullEvent;
- DoButtonKey := false;
- end;
- end;
-
- function StandardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- var
- ch: integer;
- begin
- StandardModalFilter := false;
- if (er.what = keyDown) or (er.what = autoKey) then begin
- ch := BAND(er.message, $FF);
- if (ch = ord(cr)) or (ch = ord(enter)) then begin
- StandardModalFilter:= DoButtonKey(dlg, i_ok, er, item);
- end;
- end;
- end;
-
- function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- var
- ch: integer;
- begin
- CancelModalFilter := false;
- if StandardModalFilter(dlg, er, item) then begin
- CancelModalFilter := true;
- end
- else if (er.what = keyDown) or (er.what = autoKey) then begin
- ch := BAND(er.message, $FF);
- if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
- CancelModalFilter:= DoButtonKey(dlg, i_cancel, er, item);
- end;
- end;
- end;
-
- function DiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
- var
- ch: integer;
- begin
- DiscardModalFilter := false;
- if CancelModalFilter(dlg, er, item) then begin
- DiscardModalFilter := true;
- end
- else if (er.what = keyDown) or (er.what = autoKey) then begin
- ch := BAND(er.message, $FF);
- if (ch = ord('d')) and (BAND(er.modifiers, cmdKey) <> 0) then begin
- DiscardModalFilter:= DoButtonKey(dlg, i_discard, er, item);
- end;
- end;
- end;
-
- procedure SetMyDialogFont(ft:MyFontType);
- var
- font, size:integer;
- begin
- GetMyFonts(ft, font, size);
- SetDialogFont(font);
- end;
-
- procedure EnterWindow (window: WindowPtr; ft:MyFontType; face: Style; var saved: SavedWindowInfo);
- begin
- GetPort(saved.oldport);
- SetPort(window);
- saved.thisport := window;
- saved.font := window^.txFont;
- saved.size := window^.txSize;
- saved.face := window^.txFace;
- SetMyFont(ft);
- TextFace(face);
- end;
-
- procedure ExitWindow (saved: SavedWindowInfo);
- begin
- SetPort(saved.thisport);
- TextFont(saved.font);
- TextSize(saved.size);
- TextFace(saved.face);
- SetPort(saved.oldport);
- end;
-
- procedure SetDialogTextFont (dlg: DialogPtr; ft:MyFontType; face: Style);
- var
- saved: SavedWindowInfo;
- fi: FontInfo;
- te: TEHandle;
- font, size: integer;
- begin
- EnterWindow(dlg, ft, face, saved);
- GetFontInfo(fi);
- GetMyFonts(ft, font, size);
- te := DialogPeek(dlg)^.textH;
- te^^.txFont := font;
- te^^.txSize := size;
- te^^.txFace := face;
- te^^.lineHeight := fi.ascent + fi.descent + fi.leading;
- te^^.fontAscent := fi.ascent;
- TECalText(te);
- ExitWindow(saved);
- end;
-
- procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
- const
- left_indent = 20;
- gap = 2;
- var
- r, er: rect;
- fi: FontInfo;
- sw: integer;
- saved: SavedWindowInfo;
- begin
- EnterWindow(dlg, MFT_Geneva9, [], saved);
- GetDItemRect(dlg, item, r);
- GetFontInfo(fi);
- MoveTo(r.left + left_indent, r.top + fi.ascent);
- sw := StringWidth(title);
- er.top := r.top;
- er.bottom := er.top + fi.ascent + fi.descent;
- er.left := r.left + left_indent;
- er.right := er.left + sw;
- EraseRect(er);
- DrawString(title);
- PenPatGray;
- r.top := r.top + (fi.ascent) div 2;
- MoveTo(er.left - gap, r.top);
- LineTo(r.left, r.top);
- LineTo(r.left, r.bottom);
- LineTo(r.right, r.bottom);
- LineTo(r.right, r.top);
- LineTo(er.right + gap, r.top);
- PenNormal;
- ExitWindow(saved);
- end;
-
- function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
- var
- rgn:RgnHandle;
- procedure AddItem(i:integer);
- var
- itemrect:Rect;
- tmp:RgnHandle;
- begin
- if i <> 0 then begin
- GetDitemRect(window,i,itemrect);
- tmp := NewRgn;
- RectRgn(tmp, itemrect);
- UnionRgn(rgn, tmp, rgn);
- DisposeRgn(tmp);
- end;
- end;
- var
- inside,newinside:boolean;
- mouse:Point;
- begin
- rgn := NewRgn;
- AddItem(i1);
- AddItem(i2);
- AddItem(i3);
- InvertRgn(rgn);
- inside:=true;
- while StillDown do begin
- GetMouse(mouse);
- newinside := PtInRgn(mouse,rgn);
- if newinside <> inside then begin
- InvertRgn(rgn);
- inside := newinside;
- end;
- end;
- if inside then begin
- InvertRgn(rgn);
- end;
- TrackItems := inside;
- end;
-
- procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
- var
- box: rect;
- just: integer;
- this: str255;
- font, size, i, j, def_font, def_size: integer;
- st: Style;
- fi: FontInfo;
- fixsize: boolean;
- oldfont, oldsize: integer;
- oldface: Style;
- hot: Boolean; { parse for <> and blue-underline them }
- teh:TEHandle;
- tsr:TextStyle;
- begin
- SetPort(dlg);
- oldfont := dlg^.txFont;
- oldsize := dlg^.txSize;
- oldface := dlg^.txFace;
- GetMyFonts(MFT_Geneva9, def_font, def_size);
- GetDItemRect(dlg, item, box);
- if Split(':', s, this, s) then begin
- hot := false;
- fixsize := false;
- if this = '' then begin
- font := def_font;
- end
- else begin
- GetFNum(this, font);
- if font = 0 then begin
- fixsize := true;
- font := def_font;
- end;
- end;
- if Split(':', s, this, s) then begin
- if this = '' then begin
- size := def_size;
- end
- else begin
- size := StrToNum(this);
- end;
- if Split(':', s, this, s) then begin
- st := [];
- for i := 1 to length(this) do begin
- case this[i] of
- '0'..'7':begin
- st := st + [StyleItem(ord(this[i]) - 48)];
- end;
- 'H','h': begin
- hot := true;
- end;
- otherwise begin
- end;
- end;
- end;
- if Split(':', s, this, s) then begin
- if this = '' then begin
- just := teJustLeft;
- end
- else begin
- just := StrToNum(this);
- end;
- TextFont(font);
- TextSize(size);
- TextFace(st);
- if fixsize then begin
- GetFontInfo(fi);
- while (fi.ascent + fi.descent > box.bottom - box.top) do begin
- if size > 48 then begin
- size := 48;
- end
- else if size > 36 then begin
- size := 36;
- end
- else if size > 27 then begin
- size := 27;
- end
- else if size > 24 then begin
- size := 24;
- end
- else if size > 18 then begin
- size := 18;
- end
- else if size > 14 then begin
- size := 14;
- end
- else if size > 12 then begin
- size := 12;
- end
- else begin
- size := 9;
- TextSize(size);
- leave;
- end;
- TextSize(size);
- GetFontInfo(fi);
- end;
- end;
- if false then begin
- TETextBox(@s[1], length(s), box, just);
- end else begin
- teh := TEStyleNew(box,box);
- if teh<>nil then begin
- TESetText(@s[1],length(s),teh);
- TESetAlignment(just,teh);
- if hot then begin
- for i := 1 to length(s) do begin
- if s[i] = '<' then begin
- j := i + 1;
- while (j <= length(s)) & (s[j] <> '>') do begin
- j := j + 1;
- end;
- TESetSelect(i,j-1,teh);
- tsr.tsFace := st + [underline];
- tsr.tsColor.red := 0;
- tsr.tsColor.green := 0;
- tsr.tsColor.blue := $FFFF;
- TESetStyle(doFace + doColor,tsr,false,teh);
- end;
- end;
- end;
- TEUpdate(box,teh);
- TEDispose(teh);
- end;
- end;
- end;
- end;
- end;
- end;
- TextFont(oldfont);
- TextSize(oldsize);
- TextFace(oldface);
- end;
-
- function OverEditTextItem: Boolean;
- var
- window: WindowPtr;
- editext: Boolean;
- pt: Point;
- k: integer;
- item: integer;
- begin
- window := FrontWindow;
- editext := false;
- if (window <> nil) & (WindowPeek(window)^.windowKind = kDialogWindowKind) then begin
- SetPort(window);
- GetMouse(pt);
- item := FindDialogItem(window, pt) + 1;
- if item > 0 then begin
- GetDItemKind(window, item, k);
- if k = editText then begin
- editext := true;
- end;
- end;
- end;
- OverEditTextItem := editext;
- end;
-
- function InitMyDialogs(var msg: integer): OSStatus;
- var
- grey_colour: RGBColor;
- sysenv: sysEnvRec;
- begin
- msg := msg; { Unused }
- gStandardModalFilterProc:=NewModalFilterProc(@StandardModalFilter);
- gCancelModalFilterProc:=NewModalFilterProc(@CancelModalFilter);
- gDiscardModalFilterProc:=NewModalFilterProc(@DiscardModalFilter);
- gOutlineDefault1Proc:=NewUserItemProc(@OutlineDefault1);
- gOutlineDeviceLoopProc:=NewDeviceLoopDrawingProc(@OutlineDeviceLoop);
- if (SysEnvirons(1, sysEnv) = noErr) & sysenv.hasColorQD then begin
- grey_pattern := NewPixPat;
- end
- else begin
- grey_pattern := nil;
- end;
- if grey_pattern <> nil then begin
- MakeRGBColor($8000,$8000,$8000,grey_colour);
- MakeRGBPat(grey_pattern, grey_colour);
- end;
- InitMyDialogs := noErr;
- end;
-
- procedure StartupDialogs;
- begin
- SetStartup(InitMyDialogs, nil, 0, nil);
- end;
-
- end.