home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyTextDisplay.p < prev    next >
Encoding:
Text File  |  1995-08-24  |  22.2 KB  |  845 lines  |  [TEXT/CWIE]
  1. unit MyTextDisplay;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Windows;
  7.  
  8.     type
  9.         LongArray = array[1..100000] of longInt;
  10.         LongArrayPtr = ^LongArray;
  11.         LongArrayHandle = ^LongArrayPtr;
  12.         MyTextDisplayRecord = record
  13. { You can change these and the call resize/recalc }
  14.                 leading: integer;
  15.                 width: integer;
  16.                 leave_room_for_grow: boolean;
  17. { You can read these }
  18.                 full_rect: rect;
  19.                 view: rect;
  20.                 full_view: rect;
  21.                 view_lines: longInt;
  22.                 total_length: longInt;
  23.                 view_width: integer;
  24.                 top_line: longInt;
  25.                 selStart, selEnd: longInt;
  26.                 hoffset: integer;
  27.                 window: WindowPtr;
  28.                 hcontrol, vcontrol: ControlHandle;
  29.                 font: integer;
  30.                 size: integer;
  31.                 fi: FontInfo;
  32.                 line_height: longInt;
  33.                 rn: integer;
  34.                 lines: longInt;
  35. { You should ignore these }
  36.                 last_click_time: longInt;
  37.                 last_click_offset: longInt;
  38.                 double_click: boolean;
  39.                 offsets: LongArrayHandle;
  40.             end;
  41.         LongPoint = record
  42.                 v: longInt;
  43.                 h: longInt;
  44.             end;
  45.  
  46.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  47.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  48.  
  49.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  50.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  51.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  52.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longInt);
  53.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longInt);
  54.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: handle);
  55.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: rect);
  56.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  57.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; var er: EventRecord);
  58.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  59.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  60.     procedure MTDActivateDeactivate (var mtd: MyTextDisplayRecord; activate: boolean);
  61.  
  62. implementation
  63.  
  64.     uses
  65.         TextUtils, ToolUtils, Devices,
  66.         MyTypes, MyMathUtils, MyFileSystemUtils, MyCursors, MyUtils;
  67.  
  68.     const
  69.         invis = 0;
  70.         vis = 255;
  71.  
  72.     procedure SectRectRgn (rgn: RgnHandle; r: rect);
  73.         var
  74.             rrgn: RgnHandle;
  75.     begin
  76.         rrgn := NewRgn;
  77.         RectRgn(rrgn, r);
  78.         SectRgn(rgn, rrgn, rgn);
  79.         DisposeRgn(rrgn);
  80.     end;
  81.  
  82.     procedure UnionRectRgn (rgn: RgnHandle; l, t, r, b: integer);
  83.         var
  84.             rrgn: RgnHandle;
  85.     begin
  86.         rrgn := NewRgn;
  87.         SetRectRgn(rrgn, l, t, r, b);
  88.         UnionRgn(rgn, rrgn, rgn);
  89.         DisposeRgn(rrgn);
  90.     end;
  91.  
  92.     function MyFSReadChunkPos (refnum: integer; pos: longInt; len: integer; var s: str255): OSErr;
  93.         var
  94.             pb: ParamBlockRec;
  95.             err: OSErr;
  96.     begin
  97.         if len > 255 then begin
  98.             len := 255;
  99.         end;
  100.         pb.ioRefNum := refnum;
  101. {$PUSH}
  102. {$R-}
  103.         pb.ioBuffer := @s[1];
  104.         pb.ioReqCount := len;
  105.         pb.ioPosMode := fsFromStart;
  106.         pb.ioPosOffset := pos;
  107.         err := PBReadSync(@pb);
  108.         if (err = eofErr) & (pb.ioActCount > 0) then begin
  109.             err := noErr;
  110.         end;
  111.         if err = noErr then begin
  112.             s[0] := chr(pb.ioActCount);
  113.         end;
  114. {$POP}
  115.         MyFSReadChunkPos := err;
  116.     end;
  117.  
  118.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  119.     begin
  120.         SetPort(mtd.window);
  121.         TextFont(mtd.font);
  122.         TextSize(mtd.size);
  123.         TextFace([]);
  124.     end;
  125.  
  126.     procedure MTDOffsetToLine (var mtd: MyTextDisplayRecord; offset: longInt; var thisline: longInt);
  127.         var
  128.             s, m, f: longInt;
  129.     begin
  130.         if offset <= 0 then begin
  131.             thisline := 1;
  132.         end
  133.         else if offset >= mtd.total_length then begin
  134.             thisline := mtd.lines;
  135.         end
  136.         else begin
  137.             s := 1;
  138.             f := mtd.lines + 1;
  139.             while s < f do begin
  140.                 m := (f + s) div 2;
  141.                 if offset >= mtd.offsets^^[m] then begin
  142.                     s := m;
  143.                 end;
  144.                 if offset < mtd.offsets^^[m + 1] then begin
  145.                     f := m;
  146.                 end;
  147.                 if offset = mtd.offsets^^[m + 1] then begin { cheat to make it work with filelen }
  148.                     s := m + 1;
  149.                     leave;
  150.                 end;
  151.             end;
  152.             thisline := s;
  153.         end;
  154.     end;
  155.  
  156.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  157.     begin
  158.         mtd.font := font;
  159.         mtd.size := size;
  160.         if size = 0 then begin
  161.             mtd.leading := 2;
  162.         end
  163.         else begin
  164.             mtd.leading := size div 6;
  165.             if mtd.leading = 0 then begin
  166.                 mtd.leading := 1;
  167.             end;
  168.         end;
  169.         MTDSetPort(mtd);
  170.         GetFontInfo(mtd.fi);
  171.         mtd.line_height := mtd.fi.ascent + mtd.fi.descent + mtd.leading;
  172.     end;
  173.  
  174.     procedure MTDSetControls (var mtd: MyTextDisplayRecord);
  175.         var
  176.             m: integer;
  177.     begin
  178.         mtd.vcontrol^^.contrlVis := invis;
  179.         m := Max(0, mtd.lines - mtd.view_lines);
  180.         SetControlMaximum(mtd.vcontrol, m);
  181.         mtd.top_line := Pin(0, mtd.top_line, m);
  182.         SetControlValue(mtd.vcontrol, mtd.top_line);
  183.         mtd.vcontrol^^.contrlVis := vis;
  184.         Draw1Control(mtd.vcontrol);
  185.  
  186.         if mtd.hcontrol <> nil then begin
  187.             mtd.hcontrol^^.contrlVis := invis;
  188.             m := Max(0, mtd.width - mtd.view_width);
  189.             SetControlMaximum(mtd.hcontrol, m);
  190.             mtd.hoffset := Pin(0, mtd.hoffset, m);
  191.             SetControlValue(mtd.hcontrol, mtd.hoffset);
  192.             mtd.hcontrol^^.contrlVis := vis;
  193.             Draw1Control(mtd.hcontrol);
  194.         end;
  195.     end;
  196.  
  197.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  198.         var
  199.             err: OSErr;
  200.             handlesize: longInt;
  201.             pos, nextpos: longInt;
  202.             offset, linebytes: longInt;
  203.             filelen: longInt;
  204.             line: str255;
  205.             slbc: StyledLineBreakCode;
  206.             textwidth: fixed;
  207.             orgoffset: longInt;
  208.             thisline: longInt;
  209.             initialline: longInt;
  210.     begin
  211.         MTDSetPort(mtd);
  212.         mtd.last_click_time := 0;
  213.         handlesize := GetHandleSize(handle(mtd.offsets)) div 4;
  214.         err := GetEOF(mtd.rn, filelen);
  215.         mtd.total_length := filelen;
  216.         if justappend & (mtd.lines > 1) then begin
  217.             mtd.lines := mtd.lines - 1;
  218.             pos := mtd.offsets^^[mtd.lines + 1];
  219.             orgoffset := maxLongInt;
  220.             initialline := 0; {mtd.lines}
  221.         end
  222.         else begin
  223.             orgoffset := mtd.offsets^^[Min(mtd.lines + 1, mtd.top_line + 1)];
  224.             mtd.lines := 0;
  225.             pos := 0;
  226.             initialline := 0;
  227.         end;
  228.         if err = noErr then begin
  229.             err := MyFSReadLineAt(mtd.rn, pos, line);
  230.             while err = noErr do begin
  231.                 nextpos := pos + length(line) + 1;
  232.                 offset := 0;
  233.                 while (offset = 0) or (offset < length(line)) do begin
  234.                     textwidth := BSL(mtd.width, 16);
  235.                     linebytes := 1;
  236. {$PUSH}
  237. {$R-}
  238.                     slbc := StyledLineBreak(@line[offset + 1], length(line) - offset, 0, length(line) - offset, 0, textwidth, linebytes);
  239. {$POP}
  240.                     mtd.lines := mtd.lines + 1;
  241.                     if mtd.lines > handlesize then begin
  242.                         handlesize := handlesize + 100;
  243.                         SetHandleSize(handle(mtd.offsets), handlesize * 4);
  244.                     end;
  245.                     mtd.offsets^^[mtd.lines] := pos + offset;
  246.                     if linebytes = 0 then begin
  247.                         offset := offset + 1;
  248.                     end
  249.                     else begin
  250.                         offset := offset + linebytes;
  251.                     end;
  252.                 end;
  253.                 pos := nextpos;
  254.                 err := MyFSReadLineAt(mtd.rn, pos, line);
  255.             end;
  256.         end;
  257.         SetHandleSize(handle(mtd.offsets), (mtd.lines + 1) * 4);
  258.         mtd.offsets^^[mtd.lines + 1] := filelen;
  259.         mtd.hoffset := 0;
  260.         MTDOffsetToLine(mtd, orgoffset, thisline);
  261.         mtd.top_line := Max(0, Min(thisline - 1, mtd.lines - mtd.view_lines));
  262.         MTDSetControls(mtd);
  263.         MTDDisplay(mtd, nil, initialline);
  264.     end;
  265.  
  266.     function MTDLinePosToHOffset (var mtd: MyTextDisplayRecord; var line: str255; linepos: integer): integer;
  267.     begin
  268. {$PUSH}
  269. {$R-}
  270.         MTDLinePosToHOffset := Char2Pixel(@line[1], length(line), 0, linepos, 1) + mtd.view.left - mtd.hoffset;
  271. {$POP}
  272.     end;
  273.  
  274.     function MTDHOffsetToLinePos (var mtd: MyTextDisplayRecord; var line: str255; hoffset: integer; var rightside: boolean): integer;
  275.         var
  276.             linepos: integer;
  277.     begin
  278.         mtd:=mtd; { UNUSED! }
  279. {$PUSH}
  280. {$R-}
  281.         linepos := Pixel2Char(@line[1], length(line), 0, hoffset, rightside);
  282. {$POP}
  283.         rightside := rightside <> false;
  284.         MTDHOffsetToLinePos := linepos;
  285.     end;
  286.  
  287.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longInt);
  288.         var
  289.             line: str255;
  290.         function LineSelectionPos (thisline, o: longInt): integer;
  291.             var
  292.                 base, pos: longInt;
  293.         begin
  294.             base := mtd.offsets^^[thisline];
  295.             if o <= base then begin
  296.                 LineSelectionPos := mtd.view.left;
  297.             end
  298.             else if o >= mtd.offsets^^[thisline + 1] then begin
  299.                 LineSelectionPos := mtd.view.right;
  300.             end
  301.             else begin
  302.                 pos := MTDLinePosToHOffset(mtd, line, o - base);
  303.                 if pos < mtd.view.left then begin
  304.                     pos := mtd.full_view.left;
  305.                 end
  306.                 else if pos >= mtd.view.right then begin
  307.                     pos := mtd.full_view.right;
  308.                 end;
  309.                 LineSelectionPos := pos;
  310.             end;
  311.         end;
  312.  
  313.         var
  314.             err: OSErr;
  315.             v: integer;
  316.             thisline: longInt;
  317.             s, f: longInt;
  318.             sh, fh: integer;
  319.             oldclip: RgnHandle;
  320.             r: rect;
  321.     begin
  322.         MTDSetPort(mtd);
  323.         oldclip := NewRgn;
  324.         GetClip(oldclip);
  325.         if draw_region = nil then begin
  326.             ClipRect(mtd.view);
  327.         end
  328.         else begin
  329.             SectRectRgn(draw_region, mtd.view);
  330.             SetClip(draw_region);
  331.         end;
  332.         v := mtd.view.top + mtd.leading + mtd.fi.ascent;
  333.         for thisline := mtd.top_line + 1 to Min(mtd.lines, mtd.top_line + mtd.view_lines) do begin
  334.             if thisline >= fromline then begin
  335.                 err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  336.                 if err <> noErr then begin
  337.                     leave;
  338.                 end;
  339.                 r := mtd.view;
  340.                 r.top := v - mtd.fi.ascent - mtd.leading;
  341.                 r.bottom := v + mtd.fi.descent;
  342.                 MoveTo(mtd.view.left - mtd.hoffset, v);
  343.                 EraseRect(r);
  344.                 DrawString(line);
  345.                 s := mtd.selStart;
  346.                 f := mtd.selEnd;
  347.                 if (s < f) & (s < mtd.offsets^^[thisline + 1]) & (mtd.offsets^^[thisline] < f) then begin { Selection }
  348.                     sh := LineSelectionPos(thisline, s);
  349.                     fh := LineSelectionPos(thisline, f);
  350.                     SetRect(r, sh, v - mtd.fi.ascent - mtd.leading, fh, v + mtd.fi.descent);
  351.                     HiliteInvertRect(r);
  352.                 end;
  353.             end;
  354.             v := v + mtd.line_height;
  355.         end;
  356.         SetClip(oldclip);
  357.         DisposeRgn(oldclip);
  358.     end;
  359.  
  360.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  361.         var
  362.             update: RgnHandle;
  363.     begin
  364.         scroll.v := Pin(-mtd.top_line, scroll.v, Max(0, mtd.lines - mtd.top_line - mtd.view_lines));
  365.         scroll.h := Pin(-mtd.hoffset, scroll.h, Max(0, mtd.width - mtd.hoffset - mtd.view_width));
  366.         if (scroll.v <> 0) or (scroll.h <> 0) then begin
  367.             update := NewRgn;
  368.             ScrollRect(mtd.view, -scroll.h, -scroll.v * mtd.line_height, update);
  369.             mtd.hoffset := mtd.hoffset + scroll.h;
  370.             mtd.top_line := mtd.top_line + scroll.v;
  371.             MTDDisplay(mtd, update, 0);
  372.             DisposeRgn(update);
  373.             MTDSetControls(mtd);
  374.         end;
  375.     end;
  376.  
  377.     procedure MTDPointToOffset (var mtd: MyTextDisplayRecord; pt: Point; var thisline, offset: longInt; var rightside: boolean; var line: str255; var scroll: LongPoint);
  378.         var
  379.             last_line: longInt;
  380.             h: integer;
  381.             err: OSErr;
  382.     begin
  383.         rightside := false;
  384.         scroll.h := 0;
  385.         scroll.v := 0;
  386.         line := '';
  387.         last_line := Min(mtd.top_line + mtd.view_lines, mtd.lines);
  388.         if pt.v < mtd.full_view.top then begin
  389.             scroll.v := -((mtd.view.top - pt.v) div mtd.line_height + 1);
  390.             offset := mtd.offsets^^[mtd.top_line + 1];
  391.             thisline := mtd.top_line + 1;
  392.         end
  393.         else if pt.v > mtd.full_view.bottom then begin
  394.             scroll.v := (pt.v - mtd.view.bottom) div mtd.line_height + 1;
  395.             offset := mtd.offsets^^[last_line + 1];
  396.             thisline := last_line;
  397.             rightside := false;
  398.         end
  399.         else begin
  400.             if pt.h < mtd.full_view.left then begin
  401.                 scroll.h := pt.h - mtd.view.left;
  402.             end
  403.             else if pt.h > mtd.full_view.right then begin
  404.                 scroll.h := pt.h - mtd.view.right;
  405.             end
  406.             else begin
  407.                 pt.h := Pin(mtd.view.left, pt.h, mtd.view.right);
  408.             end;
  409.             thisline := mtd.top_line + (pt.v - mtd.view.top) div mtd.line_height + 1;
  410.             if thisline > mtd.lines then begin
  411.                 thisline := mtd.lines + 1;
  412.                 offset := mtd.total_length;
  413.                 rightside := false;
  414.             end
  415.             else begin
  416.                 h := Max(0, pt.h - mtd.view.left + mtd.hoffset);
  417.                 err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  418.                 offset := MTDHOffsetToLinePos(mtd, line, h, rightside);
  419.                 if offset >= length(line) then begin
  420.                     offset := length(line);
  421.                     rightside := false;
  422.                 end;
  423.                 offset := mtd.offsets^^[thisline] + offset;
  424.             end;
  425.         end;
  426.     end;
  427.  
  428.     procedure MTDReadLine (var mtd: MyTextDisplayRecord; theline: longInt; var line: str255);
  429.         var
  430.             err: OSErr;
  431.     begin
  432.         line := '';
  433.         if theline <= mtd.lines then begin
  434.             err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[theline], mtd.offsets^^[theline + 1], line);
  435.         end;
  436.     end;
  437.  
  438.     procedure MTDOffsetToPoint (var mtd: MyTextDisplayRecord; offset: longInt; var pt: Point);
  439.         var
  440.             thisline: longInt;
  441.             line: str255;
  442.     begin
  443.         MTDOffsetToLine(mtd, offset, thisline);
  444.         if thisline <= mtd.top_line then begin
  445.             pt := mtd.view.topleft;
  446.             pt.v := pt.v - mtd.line_height;
  447.         end
  448.         else if thisline > mtd.top_line + mtd.view_lines + 1 then begin
  449.             pt := mtd.view.botright;
  450.             pt.v := pt.v + mtd.line_height;
  451.         end
  452.         else begin
  453.             MTDReadLine(mtd, thisline, line);
  454.             pt.v := mtd.view.top + mtd.leading + mtd.fi.ascent + (thisline - mtd.top_line - 1) * mtd.line_height;
  455.             pt.h := MTDLinePosToHOffset(mtd, line, offset - mtd.offsets^^[thisline]);
  456.         end;
  457.     end;
  458.  
  459.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: handle);
  460.         var
  461.             err: OSErr;
  462.     begin
  463.         HUnlock(h);
  464.         SetHandleSize(h, 0);
  465.         SetHandleSize(h, mtd.selEnd - mtd.selStart);
  466.         err := MyFSReadAt(mtd.rn, mtd.selStart, GetHandleSize(h), h^);
  467.         if err <> noErr then begin
  468.             SetHandleSize(h, 0);
  469.         end;
  470.     end;
  471.  
  472.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longInt);
  473.         function InView (v: integer): boolean;
  474.         begin
  475.             InView := (mtd.view.top <= v) & (v <= mtd.view.bottom);
  476.         end;
  477.         procedure GetSelRgn (s, f: longInt; r: RgnHandle);
  478.             var
  479.                 sp, fp: Point;
  480.                 ascent, descent, leading, left, right, top, bottom: integer;
  481.                 t, b: integer;
  482.         begin
  483.             if s < f then begin
  484.                 MTDOffsetToPoint(mtd, s, sp);
  485.                 MTDOffsetToPoint(mtd, f, fp);
  486.                 ascent := mtd.fi.ascent + mtd.leading;
  487.                 descent := mtd.fi.descent;
  488.                 leading := mtd.fi.leading;
  489.                 left := mtd.view.left;
  490.                 right := mtd.view.right;
  491.                 top := mtd.view.top;
  492.                 bottom := mtd.view.bottom;
  493.                 if sp.v = fp.v then begin
  494.                     if InView(sp.v) then begin
  495.                         SetRectRgn(r, sp.h, sp.v - ascent - leading, fp.h, sp.v + descent);
  496.                     end;
  497.                 end
  498.                 else begin
  499.                     if InView(sp.v) then begin
  500.                         SetRectRgn(r, sp.h, sp.v - ascent - leading, right, sp.v + descent);
  501.                         t := sp.v + descent;
  502.                     end
  503.                     else begin
  504.                         t := top;
  505.                     end;
  506.                     if InView(fp.v) then begin
  507.                         UnionRectRgn(r, left, fp.v - ascent - leading, fp.h, fp.v + descent);
  508.                         b := fp.v - ascent;
  509.                     end
  510.                     else begin
  511.                         b := bottom;
  512.                     end;
  513.                     UnionRectRgn(r, left, t, right, b);
  514.                 end;
  515.             end;
  516.             SectRectRgn(r, mtd.full_view);
  517.         end;
  518.         var
  519.             orgn, nrgn: RgnHandle;
  520.     begin
  521.         if (start <> mtd.selStart) or (fin <> mtd.selEnd) then begin
  522.             MTDSetPort(mtd);
  523.             orgn := NewRgn;
  524.             nrgn := NewRgn;
  525.             GetSelRgn(mtd.selStart, mtd.selEnd, orgn);
  526.             mtd.selStart := start;
  527.             mtd.selEnd := fin;
  528.             GetSelRgn(mtd.selStart, mtd.selEnd, nrgn);
  529.             XorRgn(orgn, nrgn, nrgn);
  530.             HiliteInvertRgn(nrgn);
  531.             DisposeRgn(nrgn);
  532.             DisposeRgn(orgn);
  533.         end;
  534.     end;
  535.  
  536.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: rect);
  537.         var
  538.             inset: integer;
  539.     begin
  540.         mtd.vcontrol^^.contrlVis := invis;
  541.         if mtd.hcontrol <> nil then begin
  542.             mtd.hcontrol^^.contrlVis := invis;
  543.         end;
  544.  
  545.         EraseRect(mtd.full_rect);
  546.         InvalRect(mtd.full_rect);
  547.  
  548.         mtd.full_rect := view;
  549.         mtd.view := view;
  550.         mtd.view.right := view.right - 16;
  551.         if (mtd.hcontrol <> nil) then begin
  552.             mtd.view.bottom := mtd.view.bottom - 16;
  553.         end;
  554.         mtd.full_view := mtd.view;
  555.         inset := Max(mtd.leading, 3);
  556.         InsetRect(mtd.view, inset, inset);
  557.         mtd.view_lines := (mtd.view.bottom - mtd.view.top) div mtd.line_height;
  558.         mtd.view.bottom := mtd.view.top + mtd.view_lines * mtd.line_height;
  559.         mtd.view_width := mtd.view.right - mtd.view.left;
  560.         if mtd.width = 0 then begin
  561.             mtd.width := mtd.view_width;
  562.         end;
  563.  
  564.         MoveControl(mtd.vcontrol, view.right - 15, view.top - 1);
  565.         SizeControl(mtd.vcontrol, 16, view.bottom - view.top - 16 * ord(mtd.leave_room_for_grow) + 3);
  566.  
  567.         if mtd.hcontrol <> nil then begin
  568.             MoveControl(mtd.hcontrol, view.left - 1, view.bottom - 15);
  569.             SizeControl(mtd.hcontrol, view.right - view.left - 13, 16);
  570.         end;
  571.  
  572.         MTDRecalculate(mtd, false);
  573.     end;
  574.  
  575.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  576.         var
  577.             bounds: rect;
  578.     begin
  579.         mtd.window := window;
  580.         SetRect(mtd.view, 0, 0, 0, 0);
  581.         mtd.width := width;
  582.         mtd.leave_room_for_grow := true;
  583.         mtd.rn := rn;
  584.         mtd.lines := 0;
  585.         mtd.total_length := 0;
  586.         mtd.top_line := 0;
  587.         mtd.hoffset := 0;
  588.         mtd.selStart := 0;
  589.         mtd.selEnd := 0;
  590.         mtd.last_click_time := 0;
  591.         mtd.offsets := LongArrayHandle(NewHandleClear(4));
  592.         SetRect(bounds, 0, 0, 15, 100);
  593.         mtd.vcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  594.         if hcontrol then begin
  595.             SetRect(bounds, 0, 0, 100, 15);
  596.             mtd.hcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  597.         end
  598.         else begin
  599.             mtd.hcontrol := nil;
  600.         end;
  601.         MTDSetFontSize(mtd, 0, 0);
  602.     end;
  603.  
  604.     var
  605.         action_mte: ^MyTextDisplayRecord;
  606.         action_amount: LongPoint;
  607.  
  608.     procedure MTDAction (control: ControlHandle; part: integer);
  609.     begin
  610.         control:=control; { UNUSED! }
  611.         if (part <> 0) then begin
  612.             MTDScroll(action_mte^, action_amount);
  613.         end;
  614.     end;
  615.  
  616.     procedure GetActionAmount (var mtd: MyTextDisplayRecord; control: ControlHandle; part: integer; var scroll: LongPoint);
  617.         var
  618.             amount, amount_pg, amount_line: integer;
  619.     begin
  620.         if control = mtd.vcontrol then begin
  621.             amount_pg := mtd.view_lines - 1;
  622.             amount_line := 1;
  623.         end
  624.         else begin
  625.             amount_pg := mtd.view_width;
  626.             amount_line := 8; { a few pixels }
  627.         end;
  628.         case part of
  629.             kControlUpButtonPart: 
  630.                 amount := -amount_line;
  631.             kControlDownButtonPart: 
  632.                 amount := amount_line;
  633.             kControlPageUpPart: 
  634.                 amount := -amount_pg;
  635.             kControlPageDownPart: 
  636.                 amount := amount_pg;
  637.             otherwise
  638.                 amount := 0;
  639.         end;
  640.         if control = mtd.vcontrol then begin
  641.             scroll.h := 0;
  642.             scroll.v := amount;
  643.         end
  644.         else begin
  645.             scroll.h := amount;
  646.             scroll.v := 0;
  647.         end;
  648.     end;
  649.  
  650.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; var er: EventRecord);
  651.         var
  652.             click_type: (CT_First, CT_Double, CT_Tripple);
  653.             rightside: boolean;
  654.             thisline: longInt;
  655.             line: str255;
  656.         procedure GetCurrentPos (offset: longInt; var s, f: longInt);
  657.             var
  658.                 base: longInt;
  659.                 offtab: OffsetTable;
  660.         begin
  661.             base := mtd.offsets^^[thisline];
  662.             case click_type of
  663.                 CT_First:  begin
  664.                     s := offset + ord(rightside);
  665.                     f := offset + ord(rightside);
  666.                 end;
  667.                 CT_Double:  begin
  668. {$PUSH}
  669. {$R-}
  670.                     FindWord(@line[1], length(line), offset - base, rightside, nil, offtab);
  671. {$POP}
  672.                     s := base + offtab[0].offFirst;
  673.                     f := base + offtab[0].offSecond;
  674.                 end;
  675.                 CT_Tripple:  begin
  676.                     s := base;
  677.                     if thisline <= mtd.lines then begin
  678.                         f := mtd.offsets^^[thisline + 1];
  679.                     end
  680.                     else begin
  681.                         f := base;
  682.                     end;
  683.                 end;
  684.             end; { case }
  685.         end;
  686.  
  687.         var
  688.             pt: Point;
  689.             control: ControlHandle;
  690.             part: integer;
  691.             scroll: LongPoint;
  692.             offset, ancors, ancorf, s, f, value: longInt;
  693.             shift: boolean;
  694.             amount: longInt;
  695.             MTDActionProc:UniversalProcPtr;
  696.     begin
  697.         MTDSetPort(mtd);
  698.         pt := er.where;
  699.         GlobalToLocal(pt);
  700.         if PtInRect(pt, mtd.full_view) then begin
  701.             shift := BAND(er.modifiers, shiftKey) <> 0;
  702.             MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  703.             if not shift & (er.when - mtd.last_click_time <= GetDblTime) & (offset = mtd.last_click_offset) then begin
  704.                 if mtd.double_click then begin
  705.                     click_type := CT_Tripple;
  706.                 end
  707.                 else begin
  708.                     click_type := CT_Double;
  709.                 end;
  710.                 mtd.double_click := true;
  711.             end
  712.             else begin
  713.                 click_type := CT_First;
  714.                 mtd.double_click := false;
  715.                 mtd.last_click_offset := offset;
  716.             end;
  717.             if not shift then begin
  718.                 GetCurrentPos(offset, ancors, ancorf);
  719.             end
  720.             else begin
  721.                 if mtd.selStart < mtd.selEnd then begin
  722.                     if offset > mtd.selStart then begin
  723.                         ancors := mtd.selStart;
  724.                         ancorf := mtd.selStart;
  725.                     end
  726.                     else begin
  727.                         ancors := mtd.selEnd;
  728.                         ancorf := mtd.selEnd;
  729.                     end;
  730.                 end
  731.                 else begin
  732.                     ancors := offset;
  733.                     ancorf := offset;
  734.                 end;
  735.             end;
  736.             MTDSetSelection(mtd, ancors, ancorf);
  737.             while StillDown do begin
  738.                 GetMouse(pt);
  739.                 MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  740.                 GetCurrentPos(offset, s, f);
  741.                 MTDSetSelection(mtd, Min(ancors, s), Max(ancorf, f));
  742.                 MTDScroll(mtd, scroll);
  743.             end;
  744.             mtd.last_click_time := TickCount;
  745.         end
  746.         else begin
  747.             part := FindControl(pt, mtd.window, control);
  748.             if part <> 0 then begin
  749.                 if part = kControlIndicatorPart then begin
  750.                     value := GetControlValue(control);
  751.                     part := TrackControl(control, pt, nil);
  752.                     if part <> 0 then begin
  753.                         amount := GetControlValue(control) - value;
  754.                         if amount <> 0 then begin
  755.                             if control = mtd.vcontrol then begin
  756.                                 scroll.v := amount;
  757.                                 scroll.h := 0;
  758.                             end
  759.                             else begin
  760.                                 scroll.h := amount;
  761.                                 scroll.v := 0;
  762.                             end;
  763.                             MTDScroll(mtd, scroll);
  764.                         end;
  765.                     end;
  766.                 end
  767.                 else begin
  768.                     GetActionAmount(mtd, control, part, action_amount);
  769.                     action_mte := @mtd;
  770.                     MTDActionProc := NewControlActionProc(@MTDAction);
  771.                     value := TrackControl(control, pt, MTDActionProc);
  772.                     DisposeRoutineDescriptor(MTDActionProc);
  773.                 end;
  774.             end
  775.             else begin
  776.                 SysBeep(1);
  777.             end;
  778.         end;
  779.     end;
  780.  
  781.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  782.         var
  783.             scroll: LongPoint;
  784.     begin
  785.         scroll.h := 0;
  786.         scroll.v := 0;
  787.         case ord(ch) of
  788.             homeChar:  begin
  789.                 scroll.v := -mtd.lines;
  790.             end;
  791.             endChar:  begin
  792.                 scroll.v := mtd.lines;
  793.             end;
  794.             pageUpChar:  begin
  795.                 GetActionAmount(mtd, mtd.vcontrol, kControlPageUpPart, scroll);
  796.             end;
  797.             pageDownChar:  begin
  798.                 GetActionAmount(mtd, mtd.vcontrol, kControlPageDownPart, scroll);
  799.             end;
  800.             otherwise
  801.                 SysBeep(1);
  802.         end;
  803.         MTDScroll(mtd, scroll);
  804.     end;
  805.  
  806.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  807.         var
  808.             pt: point;
  809.     begin
  810.         SetPort(mtd.window);
  811.         GetMouse(pt);
  812.         if PtInRect(pt, mtd.full_view) then begin
  813.             CursorSetIBeam;
  814.         end
  815.         else begin
  816.             CursorSetArrow;
  817.         end;
  818.     end;
  819.  
  820.     procedure MTDActivateDeactivate (var mtd: MyTextDisplayRecord; activate: boolean);
  821.     begin
  822.         if activate then begin
  823.             ShowControl(mtd.vcontrol);
  824.             if mtd.hcontrol <> nil then begin
  825.                 ShowControl(mtd.hcontrol);
  826.             end;
  827.         end
  828.         else begin
  829.             HideControl(mtd.vcontrol);
  830.             if mtd.hcontrol <> nil then begin
  831.                 HideControl(mtd.hcontrol);
  832.             end;
  833.         end;
  834.     end;
  835.  
  836.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  837.     begin
  838.         DisposeHandle(handle(mtd.offsets));
  839. {    DisposeControl(mtd.vcontrol);}
  840.         if mtd.hcontrol <> nil then begin
  841. {    DisposeControl(mtd.hcontrol);}
  842.         end;
  843.     end;
  844.  
  845. end.