home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyDialogs.p < prev    next >
Encoding:
Text File  |  1995-11-01  |  21.7 KB  |  849 lines  |  [TEXT/CWIE]

  1. unit MyDialogs;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Windows, Dialogs, Menus,
  7.         MyUtils;
  8.  
  9.     const
  10.         i_ok = 1;
  11.         i_cancel = 2;
  12.         i_discard = 3;
  13.  
  14.     var
  15.         grey_pattern: PixPatHandle;
  16.  
  17.     var
  18.         gStandardModalFilterProc:UniversalProcPtr;
  19.         gCancelModalFilterProc:UniversalProcPtr;
  20.         gDiscardModalFilterProc:UniversalProcPtr;
  21.         gOutlineDefault1Proc:UniversalProcPtr;
  22.         
  23.     procedure StartupDialogs;
  24.     procedure SetMyDialogFont(ft:MyFontType);
  25.     procedure EnterWindow (window: WindowPtr; ft:MyFontType; face: Style; var saved: SavedWindowInfo);
  26.     procedure ExitWindow (saved: SavedWindowInfo);
  27.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  28.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  29.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  30.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  31.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  32.     procedure FlashDItem (dlg: dialogPtr; item: integer);
  33.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  34.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  35.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  36.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  37.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  38.     function GetDItemHandle (dp: dialogPtr; item: integer): handle;
  39.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  40.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  41.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  42.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  43.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  44.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  45.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  46.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  47.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  48.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  49.     function GetDCtlMax (dp: dialogPtr; item: integer): integer;
  50.     procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
  51.     function GetDCtlMin (dp: dialogPtr; item: integer): integer;
  52.     procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
  53.     function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
  54.     procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
  55.     procedure DrawDItem (dp: dialogPtr; item: integer);
  56.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  57.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  58.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  59.     procedure SetWindowTitle (window: windowPtr; title: str255);
  60.     function SelectedTextItem (dlg: DialogPtr): integer;
  61.     procedure SelectDialogItem(dlg: DialogPtr; item: integer);
  62.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  63.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  64. { s= "font:size:style:just:text" }
  65.     procedure ShiftTab (dlg: DialogPtr);
  66.     procedure ManualTab (dlg: DialogPtr; shift: boolean);
  67.     function CountDItems (dlg: DialogPtr): integer;
  68.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  69.     procedure SetDialogTextFont (dlg: DialogPtr; ft:MyFontType; face: Style);
  70.     function StandardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  71.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  72.     function DiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  73.     function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
  74.     function OverEditTextItem: Boolean;
  75.  
  76. {    procedure GetDAFont (var font: integer);  -- use LMGetDlgFont }
  77.  
  78. implementation
  79.  
  80.     uses
  81.         Quickdraw, Fonts, Palettes,
  82.         MyTypes, MyStrings, MyUtils, TextEdit, MyCallProc, MySystemGlobals, MyStartup;
  83.     var
  84.         gOutlineDeviceLoopProc:UniversalProcPtr;
  85.     
  86.     procedure PenPatGray;
  87.     begin
  88.         if grey_pattern = nil then begin
  89.             PenPat(GetQDGlobals^.gray);
  90.         end
  91.         else begin
  92.             PenPixPat(grey_pattern);
  93.         end;
  94.     end;
  95.  
  96.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  97.         var
  98.             it: integer;
  99.             ih: handle;
  100.             box: rect;
  101.             oldtext: str255;
  102.     begin
  103.         GetDialogItem(dlg, item, it, ih, box);
  104.         GetDialogItemText(ih, oldtext);
  105.         if oldtext <> text then begin
  106.             SetDialogItemText(ih, text);
  107.         end;
  108.     end;
  109.  
  110.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  111.         var
  112.             it: integer;
  113.             ih: handle;
  114.             box: rect;
  115.     begin
  116.         GetDialogItem(dlg, item, it, ih, box);
  117.         GetDialogItemText(ih, text);
  118.     end;
  119.  
  120.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  121.         var
  122.             text: str255;
  123.     begin
  124.         GetItemText(dlg, item, text);
  125.         GetItemTextF := text;
  126.     end;
  127.  
  128.     var
  129.         gODRect:Rect;
  130.         gODEnabled:Boolean;
  131.         
  132.     procedure OutlineDeviceLoop (depth: integer; deviceFlags: integer; targetDevice: GDHandle; ignore:longInt);
  133.         var
  134.             backGround,foreGround:RGBColor;
  135.             dummy:boolean;
  136.     begin
  137.         deviceFlags := deviceFlags; { UNUSED! }
  138.         ignore := ignore; { UNUSED! }
  139.         if not gODEnabled then begin
  140.             if depth=1 then begin
  141.                 PenPat(GetQDGlobals^.gray);
  142.             end else begin
  143.                 MakeRGBColor($0000,$0000,$0000,backGround);
  144.                 MakeRGBColor($FFFF,$FFFF,$FFFF,foreGround);
  145.                 dummy:=GetGray(targetDevice,backGround,foreGround);
  146.                 RGBForeColor(foreGround);
  147.             end;
  148.         end;
  149.         FrameRoundRect(gODRect, 16, 16);
  150.         PenPat(GetQDGlobals^.black);
  151.         ForeColor(blackColor);
  152.     end;
  153.     
  154.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  155.     begin
  156.         SetPort(dp);
  157.         GetDItemRect(dp, item, gODRect);
  158.         InsetRect(gODRect, 2, 2);
  159.         gODEnabled := GetDCtlEnable(dp, 1) & (FrontWindow = dp) & InForeground;
  160.         PenSize(3, 3);
  161.         SafeDeviceLoopRect(gODRect, gOutlineDeviceLoopProc, 0, 0);
  162.         PenNormal;
  163.     end;
  164.  
  165.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  166.         var
  167.             kind: integer;
  168.             h: handle;
  169.             r: rect;
  170.     begin
  171.         GetDialogItem(dp, def_item, kind, h, r);
  172.         InsetRect(r, -6,-6);
  173.         SetDialogItem(dp, user_item, userItem, handle(gOutlineDefault1Proc), r);
  174.     end;
  175.  
  176.     procedure FlashDItem (dlg: dialogPtr; item: integer);
  177.         var
  178.             f: longInt;
  179.     begin
  180.         SetDCtlHilite(dlg, item, kControlButtonPart);
  181.         Delay(2, f);
  182.         SetDCtlHilite(dlg, item, 0);
  183.     end;
  184.  
  185.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  186.         var
  187.             kind: integer;
  188.             h: handle;
  189.             r: rect;
  190.     begin
  191.         GetDialogItem(dp, item, kind, h, r);
  192.         SetDialogItem(dp, item, kind, h, rr);
  193.     end;
  194.  
  195.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  196.         var
  197.             kind: integer;
  198.             h: handle;
  199.     begin
  200.         GetDialogItem(dp, item, kind, h, rr);
  201.     end;
  202.  
  203.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  204.         var
  205.             kk: integer;
  206.             h: handle;
  207.             r: rect;
  208.     begin
  209.         GetDialogItem(dp, item, kk, h, r);
  210.         SetDialogItem(dp, item, k, h, r);
  211.     end;
  212.  
  213.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  214.         var
  215.             r: rect;
  216.             h: handle;
  217.     begin
  218.         GetDialogItem(dp, item, k, h, r);
  219.     end;
  220.  
  221.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  222.     begin
  223.         GetDControlHandle := ControlHandle(GetDItemHandle(dp, item));
  224.     end;
  225.  
  226.     function GetDItemhandle (dp: dialogPtr; item: integer): handle;
  227.         var
  228.             kind: integer;
  229.             h: handle;
  230.             r: rect;
  231.     begin
  232.         GetDialogItem(dp, item, kind, h, r);
  233.         GetDItemhandle := h;
  234.     end;
  235.  
  236.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  237.         var
  238.             kind: integer;
  239.             hh: handle;
  240.             r: rect;
  241.     begin
  242.         GetDialogItem(dp, item, kind, hh, r);
  243.         SetDialogItem(dp, item, kind, h, r);
  244.     end;
  245.  
  246.     function GetDCtlHilite (dlg: DialogPtr; item: integer): integer;
  247.     begin
  248.         GetDCtlHilite := controlHandle(GetDItemHandle(dlg, item))^^.contrlHilite;
  249.     end;
  250.  
  251.     procedure SetDCtlHilite (dlg: DialogPtr; item: integer; hilite: integer);
  252.         var
  253.             ch: ControlHandle;
  254.     begin
  255.         ch := controlHandle(GetDItemHandle(dlg, item));
  256.         if ch^^.contrlHilite <> hilite then begin
  257.             HiliteControl(ch, hilite);
  258.         end;
  259.     end;
  260.  
  261.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  262.     begin
  263.         GetDCtlEnable := GetDCtlHilite(dlg, item) <> 255;
  264.     end;
  265.  
  266.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  267.     begin
  268.         SetDCtlHilite(dp, item, 255 * ord(not on))
  269.     end;
  270.  
  271.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  272.         var
  273.             s: str255;
  274.     begin
  275.         GetControlTitle(GetDControlHandle(dp, item), s);
  276.         GetDCtlTitle := s;
  277.     end;
  278.  
  279.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  280.         var
  281.             ch: ControlHandle;
  282.             old: str255;
  283.     begin
  284.         ch := GetDControlHandle(dp, item);
  285.         GetControlTitle(ch, old);
  286.         if old <> s then begin
  287.             SetControlTitle(ch, s);
  288.         end;
  289.     end;
  290.  
  291.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  292.     begin
  293.         GetDCtlBoolean := GetControlValue(GetDControlHandle(dp, item)) <> 0;
  294.     end;
  295.  
  296.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  297.     begin
  298.         SetControlValue(GetDControlHandle(dp, item), ord(value));
  299.     end;
  300.  
  301.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  302.     begin
  303.         SetDCtlBoolean(dp, item, not GetDCtlBoolean(dp, item));
  304.     end;
  305.  
  306.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  307.     begin
  308.         GetDCtlValue := GetControlValue(GetDControlHandle(dp, item));
  309.     end;
  310.  
  311.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  312.     begin
  313.         SetControlValue(GetDControlHandle(dp, item), value);
  314.     end;
  315.  
  316.     function GetDCtlMax (dp: dialogPtr; item: integer): integer;
  317.     begin
  318.         GetDCtlMax := GetControlMaximum(GetDControlHandle(dp, item));
  319.     end;
  320.  
  321.     procedure SetDCtlMax (dp: dialogPtr; item: integer; value: integer);
  322.     begin
  323.         SetControlMaximum(GetDControlHandle(dp, item), value);
  324.     end;
  325.  
  326.     function GetDCtlMin (dp: dialogPtr; item: integer): integer;
  327.     begin
  328.         GetDCtlMin := GetControlMinimum(GetDControlHandle(dp, item));
  329.     end;
  330.  
  331.     procedure SetDCtlMin (dp: dialogPtr; item: integer; value: integer);
  332.     begin
  333.         SetControlMinimum(GetDControlHandle(dp, item), value);
  334.     end;
  335.  
  336.     procedure DrawDItem (dp: dialogPtr; item: integer);
  337.     begin
  338.         Draw1Control(GetDControlHandle(dp, item));
  339.     end;
  340.  
  341.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  342.         type
  343.             MenuHandlePtr = ^MenuHandle;
  344.             MenuHandleHandle = ^MenuHandlePtr;
  345.     begin
  346.         GetPopupMHandle := MenuHandleHandle(ControlHandle(GetDItemHandle(dlg, item))^^.contrlData)^^;
  347.     end;
  348.  
  349.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  350.         var
  351.             mh: MenuHandle;
  352.             i, index: integer;
  353.             s: str255;
  354.     begin
  355.         mh := GetPopupMHandle(dlg, item);
  356.         if text = '' then begin
  357.             GetMenuItemText(mh, 1, text);
  358.         end;
  359.         GetMenuItemText(mh, 2, s);
  360.         if s = '-' then begin
  361.             DeleteMenuItem(mh, 2);
  362.             DeleteMenuItem(mh, 1);
  363.         end;
  364.         index := 0;
  365.         for i := 1 to CountMItems(mh) do begin
  366.             GetMenuItemText(mh, i, s);
  367.             if (IUEqualString(s, text) = 0) then begin
  368.                 index := i;
  369.                 leave;
  370.             end;
  371.         end;
  372.         if index = 0 then begin
  373.             InsertMenuItem(mh, '(-;fred', 0);
  374.             SetMenuItemText(mh, 1, text);
  375.             index := 1;
  376.         end;
  377.         SetDCtlValue(dlg, item, index);
  378.     end;
  379.  
  380.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  381.         var
  382.             mh: MenuHandle;
  383.     begin
  384.         mh := GetPopupMHandle(dlg, item);
  385.         GetMenuItemText(GetPopupMHandle(dlg, item), GetDCtlValue(dlg, item), text);
  386.     end;
  387.  
  388.     procedure SetWindowTitle (window: windowPtr; title: str255);
  389.         var
  390.             s: str255;
  391.     begin
  392.         GetWTitle(window, s);
  393.         if s <> title then begin
  394.             SetWTitle(window, title);
  395.         end;
  396.     end;
  397.  
  398.     function SelectedTextItem (dlg: DialogPtr): integer;
  399.     begin
  400.         SelectedTextItem := DialogPeek(dlg)^.editField + 1;
  401.     end;
  402.  
  403.     procedure SelectDialogItem(dlg: DialogPtr; item: integer);
  404.     begin
  405.         SelectDialogItemText(dlg, item, 0, maxint);
  406.     end;
  407.     
  408.     function CountDItems (dlg: DialogPtr): integer;
  409.     begin
  410. {    count := CountDITL(dlg);}
  411.         CountDItems := integerH(DialogPeek(dlg)^.items)^^ + 1;
  412.     end;
  413.  
  414.     procedure ManualTab (dlg: DialogPtr; shift: boolean);
  415.         var
  416.             orgitem, i, count: integer;
  417.             k: integer;
  418.     begin
  419.         orgitem := SelectedTextItem(dlg);
  420.         count := CountDItems(dlg);
  421.         if (orgitem > 0) & (count > 1) then begin
  422.             i := orgitem;
  423.             repeat
  424.                 if shift then begin
  425.                     i := i - 1;
  426.                     if i = 0 then begin
  427.                         i := count;
  428.                     end;
  429.                 end
  430.                 else begin
  431.                     i := i + 1;
  432.                     if i > count then begin
  433.                         i := 1;
  434.                     end;
  435.                 end;
  436.                 GetDItemKind(dlg, i, k);
  437.             until (i = orgitem) | (k = editText);
  438.         end;
  439.         GetDItemKind(dlg, i, k);
  440.         if k = editText then begin
  441.             SelectDialogItem(dlg, i);
  442.         end;
  443.     end;
  444.  
  445.     procedure ShiftTab (dlg: DialogPtr);
  446.         var
  447.             orgitem, i, count: integer;
  448.             k: integer;
  449.     begin
  450.         orgitem := SelectedTextItem(dlg);
  451.         count := CountDItems(dlg);
  452.         if (orgitem > 0) & (count > 1) then begin
  453.             i := orgitem;
  454.             repeat
  455.                 i := i - 1;
  456.                 if i = 0 then begin
  457.                     i := count;
  458.                 end;
  459.                 GetDItemKind(dlg, i, k);
  460.             until (i = orgitem) | (k = editText);
  461.         end;
  462.         GetDItemKind(dlg, i, k);
  463.         if k = editText then begin
  464.             SelectDialogItem(dlg, i);
  465.         end;
  466.     end;
  467.  
  468.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  469.         var
  470.             clip: RgnHandle;
  471.     begin
  472.         SetPort(window);
  473.         PenNormal;
  474.         clip := NewRgn;
  475.         GetClip(clip);
  476.         ClipRect(bounds);
  477.         DrawGrowIcon(window);
  478.         SetClip(clip);
  479.         DisposeRgn(clip);
  480.     end;
  481.  
  482.     function DoButtonKey(dlg:DialogPtr; item:integer; var er: EventRecord; var item_hit:integer):boolean;
  483.     begin
  484.         if GetDCtlEnable(dlg,item) then begin
  485.             FlashDItem(dlg, item);
  486.             item_hit:=item;
  487.             DoButtonKey := true;
  488.         end else begin
  489.             SysBeep(10);
  490.             er.what:=nullEvent;
  491.             DoButtonKey := false;
  492.         end;
  493.     end;
  494.     
  495.     function StandardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  496.         var
  497.             ch: integer;
  498.     begin
  499.         StandardModalFilter := false;
  500.         if (er.what = keyDown) or (er.what = autoKey) then begin
  501.             ch := BAND(er.message, $FF);
  502.             if (ch = ord(cr)) or (ch = ord(enter)) then begin
  503.                 StandardModalFilter:= DoButtonKey(dlg, i_ok, er, item);
  504.             end;
  505.         end;
  506.     end;
  507.  
  508.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  509.         var
  510.             ch: integer;
  511.     begin
  512.         CancelModalFilter := false;
  513.         if StandardModalFilter(dlg, er, item) then begin
  514.             CancelModalFilter := true;
  515.         end
  516.         else if (er.what = keyDown) or (er.what = autoKey) then begin
  517.             ch := BAND(er.message, $FF);
  518.             if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
  519.                 CancelModalFilter:= DoButtonKey(dlg, i_cancel, er, item);
  520.             end;
  521.         end;
  522.     end;
  523.  
  524.     function DiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  525.         var
  526.             ch: integer;
  527.     begin
  528.         DiscardModalFilter := false;
  529.         if CancelModalFilter(dlg, er, item) then begin
  530.             DiscardModalFilter := true;
  531.         end
  532.         else if (er.what = keyDown) or (er.what = autoKey) then begin
  533.             ch := BAND(er.message, $FF);
  534.             if (ch = ord('d')) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  535.                 DiscardModalFilter:= DoButtonKey(dlg, i_discard, er, item);
  536.             end;
  537.         end;
  538.     end;
  539.  
  540.     procedure SetMyDialogFont(ft:MyFontType);
  541.         var
  542.             font, size:integer;
  543.     begin
  544.         GetMyFonts(ft, font, size);
  545.         SetDialogFont(font);
  546.     end;
  547.  
  548.     procedure EnterWindow (window: WindowPtr; ft:MyFontType; face: Style; var saved: SavedWindowInfo);
  549.     begin
  550.         GetPort(saved.oldport);
  551.         SetPort(window);
  552.         saved.thisport := window;
  553.         saved.font := window^.txFont;
  554.         saved.size := window^.txSize;
  555.         saved.face := window^.txFace;
  556.         SetMyFont(ft);
  557.         TextFace(face);
  558.     end;
  559.  
  560.     procedure ExitWindow (saved: SavedWindowInfo);
  561.     begin
  562.         SetPort(saved.thisport);
  563.         TextFont(saved.font);
  564.         TextSize(saved.size);
  565.         TextFace(saved.face);
  566.         SetPort(saved.oldport);
  567.     end;
  568.  
  569.     procedure SetDialogTextFont (dlg: DialogPtr; ft:MyFontType; face: Style);
  570.         var
  571.             saved: SavedWindowInfo;
  572.             fi: FontInfo;
  573.             te: TEHandle;
  574.             font, size: integer;
  575.     begin
  576.         EnterWindow(dlg, ft, face, saved);
  577.         GetFontInfo(fi);
  578.         GetMyFonts(ft, font, size);
  579.         te := DialogPeek(dlg)^.textH;
  580.         te^^.txFont := font;
  581.         te^^.txSize := size;
  582.         te^^.txFace := face;
  583.         te^^.lineHeight := fi.ascent + fi.descent + fi.leading;
  584.         te^^.fontAscent := fi.ascent;
  585.         TECalText(te);
  586.         ExitWindow(saved);
  587.     end;
  588.  
  589.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  590.         const
  591.             left_indent = 20;
  592.             gap = 2;
  593.         var
  594.             r, er: rect;
  595.             fi: FontInfo;
  596.             sw: integer;
  597.             saved: SavedWindowInfo;
  598.     begin
  599.         EnterWindow(dlg, MFT_Geneva9, [], saved);
  600.         GetDItemRect(dlg, item, r);
  601.         GetFontInfo(fi);
  602.         MoveTo(r.left + left_indent, r.top + fi.ascent);
  603.         sw := StringWidth(title);
  604.         er.top := r.top;
  605.         er.bottom := er.top + fi.ascent + fi.descent;
  606.         er.left := r.left + left_indent;
  607.         er.right := er.left + sw;
  608.         EraseRect(er);
  609.         DrawString(title);
  610.         PenPatGray;
  611.         r.top := r.top + (fi.ascent) div 2;
  612.         MoveTo(er.left - gap, r.top);
  613.         LineTo(r.left, r.top);
  614.         LineTo(r.left, r.bottom);
  615.         LineTo(r.right, r.bottom);
  616.         LineTo(r.right, r.top);
  617.         LineTo(er.right + gap, r.top);
  618.         PenNormal;
  619.         ExitWindow(saved);
  620.     end;
  621.  
  622.     function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
  623.         var
  624.             rgn:RgnHandle;
  625.         procedure AddItem(i:integer);
  626.             var
  627.                 itemrect:Rect;
  628.                 tmp:RgnHandle;
  629.         begin
  630.             if i <> 0 then begin
  631.                 GetDitemRect(window,i,itemrect);
  632.                 tmp := NewRgn;
  633.                 RectRgn(tmp, itemrect);
  634.                 UnionRgn(rgn, tmp, rgn);
  635.                 DisposeRgn(tmp);
  636.             end;
  637.         end;
  638.         var
  639.             inside,newinside:boolean;
  640.             mouse:Point;
  641.     begin
  642.         rgn := NewRgn;
  643.         AddItem(i1);
  644.         AddItem(i2);
  645.         AddItem(i3);
  646.         InvertRgn(rgn);
  647.         inside:=true;
  648.         while StillDown do begin
  649.             GetMouse(mouse);
  650.             newinside := PtInRgn(mouse,rgn);
  651.             if newinside <> inside then begin
  652.                 InvertRgn(rgn);
  653.                 inside := newinside;
  654.             end;
  655.         end;
  656.         if inside then begin
  657.             InvertRgn(rgn);
  658.         end;
  659.         TrackItems := inside;
  660.     end;
  661.  
  662.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  663.         var
  664.             box: rect;
  665.             just: integer;
  666.             this: str255;
  667.             font, size, i, j, def_font, def_size: integer;
  668.             st: Style;
  669.             fi: FontInfo;
  670.             fixsize: boolean;
  671.             oldfont, oldsize: integer;
  672.             oldface: Style;
  673.             hot: Boolean; { parse for <> and blue-underline them }
  674.             teh:TEHandle;
  675.             tsr:TextStyle;
  676.     begin
  677.         SetPort(dlg);
  678.         oldfont := dlg^.txFont;
  679.         oldsize := dlg^.txSize;
  680.         oldface := dlg^.txFace;
  681.         GetMyFonts(MFT_Geneva9, def_font, def_size);
  682.         GetDItemRect(dlg, item, box);
  683.         if Split(':', s, this, s) then begin
  684.             hot := false;
  685.             fixsize := false;
  686.             if this = '' then begin
  687.                 font := def_font;
  688.             end
  689.             else begin
  690.                 GetFNum(this, font);
  691.                 if font = 0 then begin
  692.                     fixsize := true;
  693.                     font := def_font;
  694.                 end;
  695.             end;
  696.             if Split(':', s, this, s) then begin
  697.                 if this = '' then begin
  698.                     size := def_size;
  699.                 end
  700.                 else begin
  701.                     size := StrToNum(this);
  702.                 end;
  703.                 if Split(':', s, this, s) then begin
  704.                     st := [];
  705.                     for i := 1 to length(this) do begin
  706.                         case this[i] of
  707.                             '0'..'7':begin
  708.                                 st := st + [StyleItem(ord(this[i]) - 48)];
  709.                             end;
  710.                             'H','h': begin
  711.                                 hot := true;
  712.                             end;
  713.                             otherwise begin
  714.                             end;
  715.                         end;
  716.                     end;
  717.                     if Split(':', s, this, s) then begin
  718.                         if this = '' then begin
  719.                             just := teJustLeft;
  720.                         end
  721.                         else begin
  722.                             just := StrToNum(this);
  723.                         end;
  724.                         TextFont(font);
  725.                         TextSize(size);
  726.                         TextFace(st);
  727.                         if fixsize then begin
  728.                             GetFontInfo(fi);
  729.                             while (fi.ascent + fi.descent > box.bottom - box.top) do begin
  730.                                 if size > 48 then begin
  731.                                     size := 48;
  732.                                 end
  733.                                 else if size > 36 then begin
  734.                                     size := 36;
  735.                                 end
  736.                                 else if size > 27 then begin
  737.                                     size := 27;
  738.                                 end
  739.                                 else if size > 24 then begin
  740.                                     size := 24;
  741.                                 end
  742.                                 else if size > 18 then begin
  743.                                     size := 18;
  744.                                 end
  745.                                 else if size > 14 then begin
  746.                                     size := 14;
  747.                                 end
  748.                                 else if size > 12 then begin
  749.                                     size := 12;
  750.                                 end
  751.                                 else begin
  752.                                     size := 9;
  753.                                     TextSize(size);
  754.                                     leave;
  755.                                 end;
  756.                                 TextSize(size);
  757.                                 GetFontInfo(fi);
  758.                             end;
  759.                         end;
  760.                         if false then begin
  761.                             TETextBox(@s[1], length(s), box, just);
  762.                         end else begin
  763.                             teh := TEStyleNew(box,box);
  764.                             if teh<>nil then begin
  765.                                 TESetText(@s[1],length(s),teh);
  766.                                 TESetAlignment(just,teh);
  767.                                 if hot then begin
  768.                                     for i := 1 to length(s) do begin
  769.                                         if s[i] = '<' then begin
  770.                                             j := i + 1;
  771.                                             while (j <= length(s)) & (s[j] <> '>') do begin
  772.                                                 j := j + 1;
  773.                                             end;
  774.                                             TESetSelect(i,j-1,teh);
  775.                                             tsr.tsFace := st + [underline];
  776.                                             tsr.tsColor.red := 0;
  777.                                             tsr.tsColor.green := 0;
  778.                                             tsr.tsColor.blue := $FFFF;
  779.                                             TESetStyle(doFace + doColor,tsr,false,teh);
  780.                                         end;
  781.                                     end;
  782.                                 end;
  783.                                 TEUpdate(box,teh);
  784.                                 TEDispose(teh);
  785.                             end;
  786.                         end;
  787.                     end;
  788.                 end;
  789.             end;
  790.         end;
  791.         TextFont(oldfont);
  792.         TextSize(oldsize);
  793.         TextFace(oldface);
  794.     end;
  795.  
  796.     function OverEditTextItem: Boolean;
  797.         var
  798.             window: WindowPtr;
  799.             editext: Boolean;
  800.             pt: Point;
  801.             k: integer;
  802.             item: integer;
  803.     begin
  804.         window := FrontWindow;
  805.         editext := false;
  806.         if (window <> nil) & (WindowPeek(window)^.windowKind = kDialogWindowKind) then begin
  807.             SetPort(window);
  808.             GetMouse(pt);
  809.             item := FindDialogItem(window, pt) + 1;
  810.             if item > 0 then begin
  811.                 GetDItemKind(window, item, k);
  812.                 if k = editText then begin
  813.                     editext := true;
  814.                 end;
  815.             end;
  816.         end;
  817.         OverEditTextItem := editext;
  818.     end;
  819.     
  820.     function InitMyDialogs(var msg: integer): OSStatus;
  821.         var
  822.             grey_colour: RGBColor;
  823.             sysenv: sysEnvRec;
  824.     begin
  825.         msg := msg; { Unused }
  826.         gStandardModalFilterProc:=NewModalFilterProc(@StandardModalFilter);
  827.         gCancelModalFilterProc:=NewModalFilterProc(@CancelModalFilter);
  828.         gDiscardModalFilterProc:=NewModalFilterProc(@DiscardModalFilter);
  829.         gOutlineDefault1Proc:=NewUserItemProc(@OutlineDefault1);
  830.         gOutlineDeviceLoopProc:=NewDeviceLoopDrawingProc(@OutlineDeviceLoop);
  831.         if (SysEnvirons(1, sysEnv) = noErr) & sysenv.hasColorQD then begin
  832.             grey_pattern := NewPixPat;
  833.         end
  834.         else begin
  835.             grey_pattern := nil;
  836.         end;
  837.         if grey_pattern <> nil then begin
  838.             MakeRGBColor($8000,$8000,$8000,grey_colour);
  839.             MakeRGBPat(grey_pattern, grey_colour);
  840.         end;
  841.         InitMyDialogs := noErr;
  842.     end;
  843.  
  844.     procedure StartupDialogs;
  845.     begin
  846.         SetStartup(InitMyDialogs, nil, 0, nil);
  847.     end;
  848.  
  849. end.