home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 June / MacFormat 25.iso / Shareware City / Developers / ICAppSourceKit1.0 / ICDialogs.p < prev    next >
Encoding:
Text File  |  1994-09-24  |  14.8 KB  |  600 lines  |  [TEXT/PJMM]
  1. unit ICDialogs;
  2.  
  3. interface
  4.  
  5.     const
  6.         i_ok = 1;
  7.         i_cancel = 2;
  8.         i_discard = 3;
  9.  
  10.     type
  11.         SavedWindowInfo = record
  12.                 oldport: GrafPtr;
  13.                 thisport: GrafPtr;
  14.                 font: integer;
  15.                 size: integer;
  16.                 face: Style;
  17.             end;
  18.  
  19.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  20.     procedure ExitWindow (saved: SavedWindowInfo);
  21.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  22.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  23.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  24.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  25.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  26.     procedure FlashItem (dlg: dialogPtr; item: integer);
  27.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  28.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  29.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  30.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  31.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  32.     function GetDItemHandle (dp: dialogPtr; item: integer): handle;
  33.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  34.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  35.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  36.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  37.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  38.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  39.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  40.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  41.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  42.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  43.     procedure DrawDItem (dp: dialogPtr; item: integer);
  44.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  45.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  46.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  47.     procedure GetDAFont (var font: integer);
  48.     procedure SetWindowTitle (window: windowPtr; title: str255);
  49.     function SelectedTextItem (dlg: DialogPtr): integer;
  50.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  51.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  52. { s= "font:size:style:just:text" }
  53.     procedure ShiftTab (dlg: DialogPtr);
  54.     function CountDItems (dlg: DialogPtr): integer;
  55.     function OKModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  56.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  57.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  58.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  59.  
  60. implementation
  61.  
  62.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  63.         var
  64.             it: integer;
  65.             ih: handle;
  66.             box: rect;
  67.             oldtext: str255;
  68.     begin
  69.         GetDItem(dlg, item, it, ih, box);
  70.         GetIText(ih, oldtext);
  71.         if oldtext <> text then
  72.             SetIText(ih, text);
  73.     end;
  74.  
  75.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  76.         var
  77.             it: integer;
  78.             ih: handle;
  79.             box: rect;
  80.     begin
  81.         GetDItem(dlg, item, it, ih, box);
  82.         GetIText(ih, text);
  83.     end;
  84.  
  85.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  86.         var
  87.             text: str255;
  88.     begin
  89.         GetItemText(dlg, item, text);
  90.         GetItemTextF := text;
  91.     end;
  92.  
  93.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  94.         var
  95.             kind: integer;
  96.             h: handle;
  97.             r: rect;
  98.     begin
  99.         SetPort(dp);
  100.         GetDItem(dp, 1, kind, h, r);
  101.         PenSize(3, 3);
  102.         InsetRect(r, -4, -4);
  103.         if controlHandle(h)^^.contrlHilite = 255 then
  104.             PenPat(gray);
  105.         FrameRoundRect(r, 16, 16);
  106.         if controlHandle(h)^^.contrlHilite = 255 then
  107.             PenPat(black);
  108.         PenNormal;
  109.     end;
  110.  
  111.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  112.         var
  113.             kind: integer;
  114.             h: handle;
  115.             r: rect;
  116.     begin
  117.         if def_item <> 1 then
  118.             DebugStr('SetUpDefaultOutline:Cant handle anything except 1 yet');
  119.         GetDItem(dp, user_item, kind, h, r);
  120.         InsetRect(r, -10, -10);
  121.         SetDItem(dp, user_item, userItem, handle(@OutlineDefault1), r);
  122.     end;
  123.  
  124.     procedure FlashItem (dlg: dialogPtr; item: integer);
  125.         var
  126.             kind: integer;
  127.             h: handle;
  128.             r: rect;
  129.             f: longInt;
  130.     begin
  131.         GetDItem(dlg, item, kind, h, r);
  132.         HiliteControl(controlHandle(h), inButton);
  133.         Delay(2, f);
  134.         HiliteControl(controlHandle(h), 0);
  135.     end;
  136.  
  137.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  138.         var
  139.             kind: integer;
  140.             h: handle;
  141.             r: rect;
  142.     begin
  143.         GetDItem(dp, item, kind, h, r);
  144.         SetDItem(dp, item, kind, h, rr);
  145.     end;
  146.  
  147.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  148.         var
  149.             kind: integer;
  150.             h: handle;
  151.     begin
  152.         GetDItem(dp, item, kind, h, rr);
  153.     end;
  154.  
  155.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  156.         var
  157.             kk: integer;
  158.             h: handle;
  159.             r: rect;
  160.     begin
  161.         GetDItem(dp, item, kk, h, r);
  162.         SetDItem(dp, item, k, h, r);
  163.     end;
  164.  
  165.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  166.         var
  167.             r: rect;
  168.             h: handle;
  169.     begin
  170.         GetDItem(dp, item, k, h, r);
  171.     end;
  172.  
  173.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  174.     begin
  175.         GetDControlHandle := ControlHandle(GetDItemHandle(dp, item));
  176.     end;
  177.  
  178.     function GetDItemhandle (dp: dialogPtr; item: integer): handle;
  179.         var
  180.             kind: integer;
  181.             h: handle;
  182.             r: rect;
  183.     begin
  184.         GetDItem(dp, item, kind, h, r);
  185.         GetDItemhandle := h;
  186.     end;
  187.  
  188.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  189.         var
  190.             kind: integer;
  191.             hh: handle;
  192.             r: rect;
  193.     begin
  194.         GetDItem(dp, item, kind, hh, r);
  195.         SetDItem(dp, item, kind, h, r);
  196.     end;
  197.  
  198.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  199.         var
  200.             k: integer;
  201.             h: handle;
  202.             r: rect;
  203.     begin
  204.         GetDItem(dlg, item, k, h, r);
  205.         GetDCtlEnable := controlHandle(h)^^.contrlHilite <> 255;
  206.     end;
  207.  
  208.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  209.         var
  210.             ch: ControlHandle;
  211.             hilite: integer;
  212.     begin
  213.         ch := GetDControlHandle(dp, item);
  214.         hilite := 255 * ord(not on);
  215.         if ch^^.contrlHilite <> hilite then begin
  216.             HiliteControl(ch, hilite);
  217.         end;
  218.     end;
  219.  
  220.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  221.         var
  222.             s: str255;
  223.     begin
  224.         GetCTitle(GetDControlHandle(dp, item), s);
  225.         GetDCtlTitle := s;
  226.     end;
  227.  
  228.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  229.         var
  230.             ch: ControlHandle;
  231.             old: str255;
  232.     begin
  233.         ch := GetDControlHandle(dp, item);
  234.         GetCTitle(ch, old);
  235.         if old <> s then begin
  236.             SetCTitle(ch, s);
  237.         end;
  238.     end;
  239.  
  240.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  241.     begin
  242.         GetDCtlBoolean := GetCtlValue(GetDControlHandle(dp, item)) <> 0;
  243.     end;
  244.  
  245.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  246.     begin
  247.         SetCtlValue(GetDControlHandle(dp, item), ord(value));
  248.     end;
  249.  
  250.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  251.     begin
  252.         SetDCtlBoolean(dp, item, not GetDCtlBoolean(dp, item));
  253.     end;
  254.  
  255.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  256.     begin
  257.         GetDCtlValue := GetCtlValue(GetDControlHandle(dp, item));
  258.     end;
  259.  
  260.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  261.     begin
  262.         SetCtlValue(GetDControlHandle(dp, item), value);
  263.     end;
  264.  
  265.     procedure DrawDItem (dp: dialogPtr; item: integer);
  266.     begin
  267.         Draw1Control(GetDControlHandle(dp, item));
  268.     end;
  269.  
  270.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  271.         type
  272.             MenuHandlePtr = ^MenuHandle;
  273.             MenuHandleHandle = ^MenuHandlePtr;
  274.     begin
  275.         GetPopupMHandle := MenuHandleHandle(ControlHandle(GetDItemHandle(dlg, item))^^.contrlData)^^;
  276.     end;
  277.  
  278.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  279.         var
  280.             mh: MenuHandle;
  281.             i, index, start: integer;
  282.             s: str255;
  283.             added: boolean;
  284.     begin
  285.         mh := GetPopupMHandle(dlg, item);
  286.         if text = '' then begin
  287.             GetItem(mh, 1, text);
  288.         end;
  289.         GetItem(mh, 2, s);
  290.         if s = '-' then begin
  291.             DelMenuItem(mh, 2);
  292.             DelMenuItem(mh, 1);
  293.         end;
  294.         index := 0;
  295.         for i := 1 to CountMItems(mh) do begin
  296.             GetItem(mh, i, s);
  297.             if (IUEqualString(s, text) = 0) then begin
  298.                 index := i;
  299.                 leave;
  300.             end;
  301.         end;
  302.         if index = 0 then begin
  303.             InsMenuItem(mh, '(-;fred', 0);
  304.             SetItem(mh, 1, text);
  305.             index := 1;
  306.         end;
  307.         SetDCtlValue(dlg, item, index);
  308.     end;
  309.  
  310.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  311.         var
  312.             mh: MenuHandle;
  313.     begin
  314.         mh := GetPopupMHandle(dlg, item);
  315.         GetItem(GetPopupMHandle(dlg, item), GetDCtlValue(dlg, item), text);
  316.     end;
  317.  
  318.     procedure GetDAFont (var font: integer);
  319.         type
  320.             intPtr = ^integer;
  321.         const
  322.             DlgFont = $AFA;
  323.     begin
  324.         font := intPtr(DlgFont)^;
  325.     end;
  326.  
  327.     procedure SetWindowTitle (window: windowPtr; title: str255);
  328.         var
  329.             s: str255;
  330.     begin
  331.         GetWTitle(window, s);
  332.         if s <> title then
  333.             SetWTitle(window, title);
  334.     end;
  335.  
  336.     function SelectedTextItem (dlg: DialogPtr): integer;
  337.     begin
  338.         SelectedTextItem := DialogPeek(dlg)^.editField + 1;
  339.     end;
  340.  
  341.     function CountDItems (dlg: DialogPtr): integer;
  342.         type
  343.             IntegerPtr = ^Integer;
  344.             IntegerHandle = ^IntegerPtr;
  345.     begin
  346.         CountDItems := IntegerHandle(DialogPeek(dlg)^.items)^^ + 1;
  347.     end;
  348.  
  349.     procedure ShiftTab (dlg: DialogPtr);
  350.         var
  351.             gv: longInt;
  352.             orgitem, i, count: integer;
  353.             k: integer;
  354.     begin
  355.         orgitem := SelectedTextItem(dlg);
  356.         count := CountDItems(dlg);
  357.         if (orgitem > 0) & (count > 1) then begin
  358.             i := orgitem;
  359.             repeat
  360.                 i := i - 1;
  361.                 if i = 0 then begin
  362.                     i := count;
  363.                 end;
  364.                 GetDItemKind(dlg, i, k);
  365.             until (i = orgitem) | (k = editText);
  366.         end;
  367.         GetDItemKind(dlg, i, k);
  368.         if k = editText then begin
  369.             SelIText(dlg, i, 0, 255);
  370.         end;
  371.     end;
  372.  
  373.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  374.         var
  375.             clip: RgnHandle;
  376.     begin
  377.         SetPort(window);
  378.         PenNormal;
  379.         clip := NewRgn;
  380.         GetClip(clip);
  381.         ClipRect(bounds);
  382.         DrawGrowIcon(window);
  383.         SetClip(clip);
  384.         DisposeRgn(clip);
  385.     end;
  386.  
  387.     function OKModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  388.         var
  389.             ch: integer;
  390.     begin
  391.         OKModalFilter := false;
  392.         if (er.what = keyDown) or (er.what = autoKey) then begin
  393.             ch := BAND(er.message, $FF);
  394.             if (ch = 13) or (ch = 3) then begin
  395.                 item := i_ok;
  396.                 FlashItem(dlg, item);
  397.                 OKModalFilter := true;
  398.             end;
  399.         end;
  400.     end;
  401.  
  402.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  403.         var
  404.             ch: integer;
  405.     begin
  406.         CancelModalFilter := false;
  407.         if (er.what = keyDown) or (er.what = autoKey) then begin
  408.             ch := BAND(er.message, $FF);
  409.             if (ch = 13) or (ch = 3) then begin
  410.                 item := i_ok;
  411.                 FlashItem(dlg, item);
  412.                 CancelModalFilter := true;
  413.             end
  414.             else if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
  415.                 item := i_cancel;
  416.                 FlashItem(dlg, item);
  417.                 CancelModalFilter := true;
  418.             end;
  419.         end;
  420.     end;
  421.  
  422.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  423.         var
  424.             ch: integer;
  425.             result: boolean;
  426.     begin
  427.         CancelDiscardModalFilter := false;
  428.         if CancelModalFilter(dlg, er, item) then begin
  429.             CancelDiscardModalFilter := true;
  430.         end
  431.         else if (er.what = keyDown) or (er.what = autoKey) then begin
  432.             ch := BAND(er.message, $FF);
  433.             if (ch = ord('d')) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  434.                 item := i_discard;
  435.                 FlashItem(dlg, item);
  436.                 CancelDiscardModalFilter := true;
  437.             end;
  438.         end;
  439.     end;
  440.  
  441.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  442.     begin
  443.         GetPort(saved.oldport);
  444.         SetPort(window);
  445.         saved.thisport := window;
  446.         saved.font := window^.txFont;
  447.         saved.size := window^.txSize;
  448.         saved.face := window^.txFace;
  449.         TextFont(font);
  450.         TextSize(size);
  451.         TextFace(face);
  452.     end;
  453.  
  454.     procedure ExitWindow (saved: SavedWindowInfo);
  455.     begin
  456.         SetPort(saved.thisport);
  457.         TextFont(saved.font);
  458.         TextSize(saved.size);
  459.         TextFace(saved.face);
  460.         SetPort(saved.oldport);
  461.     end;
  462.  
  463.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  464.         const
  465.             left_indent = 20;
  466.             gap = 2;
  467.         var
  468.             r, er: rect;
  469.             fi: FontInfo;
  470.             sw: integer;
  471.     begin
  472.         GetDItemRect(dlg, item, r);
  473.         GetFontInfo(fi);
  474.         MoveTo(r.left + left_indent, r.top + fi.ascent);
  475.         sw := StringWidth(title);
  476.         er.top := r.top;
  477.         er.bottom := er.top + fi.ascent + fi.descent;
  478.         er.left := r.left + left_indent;
  479.         er.right := er.left + sw;
  480.         EraseRect(er);
  481.         DrawString(title);
  482.         PenPat(gray);
  483.         r.top := r.top + (fi.ascent) div 2;
  484.         MoveTo(er.left - gap, r.top);
  485.         LineTo(r.left, r.top);
  486.         LineTo(r.left, r.bottom);
  487.         LineTo(r.right, r.bottom);
  488.         LineTo(r.right, r.top);
  489.         LineTo(er.right + gap, r.top);
  490.         PenNormal;
  491.     end;
  492.  
  493.     function Split (sub, s: str255; var s1, s2: str255): boolean;
  494.         var
  495.             p: integer;
  496.     begin
  497.         p := Pos(sub, s);
  498.         if p > 0 then begin
  499.             s1 := copy(s, 1, p - 1);
  500.             s2 := copy(s, p + length(sub), 255);
  501.         end;
  502.         Split := p > 0;
  503.     end;
  504.  
  505.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  506.         var
  507.             t: str255;
  508.             box: rect;
  509.             just: integer;
  510.             this: str255;
  511.             font, size, i, index: integer;
  512.             st: Style;
  513.             fi: FontInfo;
  514.             fixsize: boolean;
  515.             oldfont, oldsize: integer;
  516.             oldface: Style;
  517.     begin
  518.         SetPort(dlg);
  519.         oldfont := dlg^.txFont;
  520.         oldsize := dlg^.txSize;
  521.         oldface := dlg^.txFace;
  522.         GetDItemRect(dlg, item, box);
  523.         if Split(':', s, this, s) then begin
  524.             fixsize := false;
  525.             if this = '' then begin
  526.                 font := geneva;
  527.             end
  528.             else begin
  529.                 GetFNum(this, font);
  530.                 if font = 0 then begin
  531.                     fixsize := true;
  532.                     font := geneva;
  533.                 end;
  534.             end;
  535.             if Split(':', s, this, s) then begin
  536.                 if this = '' then begin
  537.                     size := 9;
  538.                 end
  539.                 else begin
  540.                     ReadString(this, size);
  541.                 end;
  542.                 if Split(':', s, this, s) then begin
  543.                     st := [];
  544.                     for i := 1 to length(this) do begin
  545.                         st := st + [StyleItem(ord(this[i]) - 48)]
  546.                     end;
  547.                     if Split(':', s, this, s) then begin
  548.                         if this = '' then begin
  549.                             just := teJustLeft;
  550.                         end
  551.                         else begin
  552.                             ReadString(this, just);
  553.                         end;
  554.                         TextFont(font);
  555.                         TextSize(size);
  556.                         TextFace(st);
  557.                         if fixsize then begin
  558.                             GetFontInfo(fi);
  559.                             while (fi.ascent + fi.descent > box.bottom - box.top) do begin
  560.                                 if size > 48 then begin
  561.                                     size := 48;
  562.                                 end
  563.                                 else if size > 36 then begin
  564.                                     size := 36;
  565.                                 end
  566.                                 else if size > 27 then begin
  567.                                     size := 27;
  568.                                 end
  569.                                 else if size > 24 then begin
  570.                                     size := 24;
  571.                                 end
  572.                                 else if size > 18 then begin
  573.                                     size := 18;
  574.                                 end
  575.                                 else if size > 14 then begin
  576.                                     size := 14;
  577.                                 end
  578.                                 else if size > 12 then begin
  579.                                     size := 12;
  580.                                 end
  581.                                 else begin
  582.                                     size := 9;
  583.                                     TextSize(size);
  584.                                     leave;
  585.                                 end;
  586.                                 TextSize(size);
  587.                                 GetFontInfo(fi);
  588.                             end;
  589.                         end;
  590.                         TextBox(@s[1], length(s), box, just);
  591.                     end;
  592.                 end;
  593.             end;
  594.         end;
  595.         TextFont(oldfont);
  596.         TextSize(oldsize);
  597.         TextFace(oldface);
  598.     end;
  599.  
  600. end.