home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Frameworks / TransSkel 3.24 / Demos / Pascal Demos / MultiSkel / MSkelHelp.p < prev    next >
Encoding:
Text File  |  1996-01-25  |  5.6 KB  |  240 lines  |  [TEXT/CWIE]
  1. unit MultiSkelHelp;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, MixedMode, Memory, Resources, QuickDrawText, QuickDraw, Windows, Menus, Controls,
  7.         TextEdit, TransSkel, MSkelGlobals;
  8.  
  9.     procedure HelpWindInit;
  10.  
  11. implementation
  12.  
  13.     var
  14.  
  15.         teHelp: TEHandle;
  16.         helpScroll: ControlHandle;
  17.         helpLine: Integer;
  18.         halfPage: Integer;
  19.  
  20.         trackProc: ControlActionUPP;
  21.  
  22.  
  23.     procedure DoScroll (lDelta: Integer);
  24.         var
  25.             newLine: Integer;
  26.     begin
  27.         newLine := helpLine + lDelta;
  28.         if (newLine < 0) then
  29.             newLine := 0;
  30.         if (newLine > GetControlMaximum(helpScroll)) then
  31.             newLine := GetControlMaximum(helpScroll);
  32.         SetControlValue(helpScroll, newLine);
  33.         lDelta := (helpLine - newLine) * teHelp^^.lineHeight;
  34.         TEScroll(0, lDelta, teHelp);
  35.         helpLine := newLine;
  36.     end;
  37.  
  38.  
  39.     procedure TrackScroll (theScroll: ControlHandle;
  40.                                     partCode: Integer);
  41.     var
  42.             lDelta: Integer;
  43.     begin
  44.         if (partCode = GetControlReference(theScroll)) then
  45.             begin
  46. {$IFC OLDROUTINENAMES }
  47.                 case partCode of
  48.                     inUpButton: 
  49.                         lDelta := -1;
  50.                     inDownButton: 
  51.                         lDelta := 1;
  52.                     inPageUp: 
  53.                         lDelta := -halfPage;
  54.                     inPageDown: 
  55.                         lDelta := halfPage;
  56.                 end;
  57. {$ELSEC}
  58.                 case partCode of
  59.                     kControlUpButtonPart: 
  60.                         lDelta := -1;
  61.                     kControlDownButtonPart: 
  62.                         lDelta := 1;
  63.                     kControlPageUpPart: 
  64.                         lDelta := -halfPage;
  65.                     kControlPageDownPart: 
  66.                         lDelta := halfPage;
  67.                 end;
  68. {$ENDC}
  69.                 DoScroll(lDelta);
  70.             end;
  71.     end;
  72.  
  73.  
  74.     procedure Mouse (pt: Point;
  75.                                     t: LongInt;
  76.                                     mods: Integer);
  77.         var
  78.             thePart: Integer;
  79.             ignore: Integer;
  80.     begin
  81.         thePart := TestControl(helpScroll, pt);
  82. {$IFC OLDROUTINENAMES }
  83.         if (thePart = inThumb) then
  84. {$ELSEC}
  85.         if (thePart = kControlIndicatorPart) then
  86. {$ENDC}
  87.             begin
  88.                 ignore := TrackControl(helpScroll, pt, nil);
  89.                 DoScroll(GetControlValue(helpScroll) - helpLine);
  90.             end
  91.         else if (thePart <> 0) then
  92.             begin
  93.                 SetControlReference(helpScroll, thePart);
  94.                 ignore := TrackControl(helpScroll, pt, trackProc);
  95.             end;
  96.     end;
  97.  
  98.  
  99.     procedure Update (resized: Boolean);
  100.         var
  101.             r: Rect;
  102.             visLines: Integer;
  103.             lHeight: Integer;
  104.             topLines: Integer;
  105.             nLines: Integer;
  106.             scrollLines: Integer;
  107.     begin
  108.         r := helpWind^.portRect;
  109.         EraseRect(r);
  110.         if (resized) then
  111.             begin
  112.                 r.left := r.left + 4;
  113.                 r.bottom := r.bottom - 2;
  114.                 r.top := r.top + 2;
  115.                 r.right := r.right - 19;
  116.                 teHelp^^.destRect.right := r.right;
  117.                 teHelp^^.viewRect := r;
  118.                 TECalText(teHelp);
  119.                 lHeight := teHelp^^.lineHeight;
  120.                 nLines := teHelp^^.nLines;
  121.                 visLines := (r.bottom - r.top) div lHeight;
  122.                 halfPage := visLines div 2;
  123.                 topLines := (r.top - teHelp^^.destRect.top) div lHeight;
  124.                 scrollLines := visLines - (nLines - topLines);
  125.                 if ((scrollLines > 0) and (topLines > 0)) then
  126.                     begin
  127.                         if (scrollLines > topLines) then
  128.                             scrollLines := topLines;
  129.                         TEScroll(0, scrollLines * lHeight, teHelp);
  130.                     end;
  131.                 scrollLines := nLines - visLines;
  132.                 helpLine := (r.top - teHelp^^.destRect.top) div lHeight;
  133.                 HideControl(helpScroll);
  134.                 r := helpWind^.portRect;
  135.                 r.left := r.right - 15;
  136.                 r.bottom := r.bottom - 14;
  137.                 r.top := r.top - 1;
  138.                 r.right := r.right + 1;
  139.                 SizeControl(helpScroll, r.right - r.left, r.bottom - r.top);
  140.                 MoveControl(helpScroll, r.left, r.top);
  141.                 if ((nLines - visLines) < 0) then
  142.                     SetControlMaximum(helpScroll, 0)
  143.                 else
  144.                     SetControlMaximum(helpScroll, nLines - visLines);
  145.                 SetControlValue(helpScroll, helpLine);
  146.                 ShowControl(helpScroll);
  147.             end;
  148.         DrawGrowBox(helpWind);
  149.         DrawControls(helpWind);
  150.         r := teHelp^^.viewRect;
  151.         TEUpdate(r, teHelp);
  152.         ValidRect(helpWind^.portRect);
  153.     end;
  154.  
  155.  
  156.     procedure Activate (active: Boolean);
  157.     begin
  158.         DrawGrowBox(helpWind);
  159.         if (active) then
  160.             begin
  161.                 DisableItem(editMenu, 0);
  162.                 if (GetControlMaximum(helpScroll) > 0) then
  163.                     HiliteControl(helpScroll, normalHilite)
  164.                 else
  165.                     HiliteControl(helpScroll, dimHilite);
  166.             end
  167.         else
  168.             begin
  169.                 EnableItem(editMenu, 0);
  170.                 if (GetControlMaximum(helpScroll) > 0) then
  171.                     HiliteControl(helpScroll, dimHilite);
  172.             end;
  173.         DrawMenuBar;
  174.     end;
  175.  
  176.  
  177.     procedure Clobber;
  178.     begin
  179.         DisposeRoutineDescriptor (trackProc);
  180.         TEDispose(teHelp);
  181.         DisposeControl(helpScroll);
  182.         DisposeWindow(helpWind);
  183.     end;
  184.  
  185.  
  186.     procedure HelpWindInit;
  187.         var
  188.             r: Rect;
  189.             textHandle: Handle;
  190.             visLines: Integer;
  191.             scrollLines: Integer;
  192.             ignore: Boolean;
  193.     begin
  194.         if (SkelQuery(skelQHasColorQD) <> 0) then
  195.             helpWind := GetNewCWindow(helpWindRes, nil, WindowPtr(-1))
  196.         else
  197.             helpWind := GetNewWindow(helpWindRes, nil, WindowPtr(-1));
  198.         if (helpWind = nil) then
  199.             exit(HelpWindInit);
  200.         ignore := SkelWindow(helpWind, @Mouse, nil, @Update, @Activate, nil, @Clobber, nil, false);
  201.  
  202.         TextFont(0);
  203.         TextSize(0);
  204.  
  205.         r := helpWind^.portRect;
  206.         r.left := r.left + 4;
  207.         r.bottom := r.bottom - 2;
  208.         r.top := r.top + 2;
  209.         r.right := r.right - 19;
  210.         teHelp := TENew(r, r);
  211.         textHandle := GetResource('TEXT', helpTextRes);
  212.         HLock(textHandle);
  213.         TEInsert(textHandle^, GetHandleSize(textHandle), teHelp);
  214.         HUnlock(textHandle);
  215.         ReleaseResource(textHandle);
  216.  
  217.         visLines := (r.bottom - r.top) div teHelp^^.lineHeight;
  218.         scrollLines := teHelp^^.nLines - visLines;
  219.         halfPage := visLines div 2;
  220.         helpLine := 0;
  221.         r := helpWind^.portRect;
  222.         r.left := r.right - 15;
  223.         r.bottom := r.bottom - 14;
  224.         r.top := r.top - 1;
  225.         r.right := r.right + 1;
  226.  
  227.         helpScroll := NewControl(helpWind, r, '', true, helpLine, 0, scrollLines, scrollBarProc, 0);
  228.  
  229.         {
  230.             Set up a variable to point to the scroll tracking procedure.  For 68K code this
  231.             is just a direct pointer to TrackScroll().  For PowerPC code it is a
  232.             routine descriptor into which the address of TrackScroll() is stuffed.
  233.         }
  234.  
  235.         trackProc := NewControlActionProc (@TrackScroll);
  236.  
  237.         ValidRect(helpWind^.portRect);
  238.     end;
  239.  
  240. end.