home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / gwedit / gwcurse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-16  |  3.6 KB  |  149 lines
  1.  
  2. { text cursor simulator. This unit simulates a flashing text cursor in}
  3. { graphics mode. Released to public domain 3/15/89 by author Michael Day}
  4. {for mouse support, enable the mouse unit in th euses statement and}
  5. {uncomment the HideMouse and ShowMouse procedures in this unit.}
  6.  
  7. Unit GwCurse;
  8. interface
  9.  
  10. uses Gstart,graph,AreaWr{,Mouse};
  11.  
  12. const GCputStyle : integer = NotPut;
  13.  
  14.       HiddenGcursor = 0;  {cursor styles}
  15.       NormalGcursor = 1;
  16.       FatGcursor    = 2;
  17.       BlockGcursor  = 3;
  18.  
  19.       GCFlashOn  = 6;   {cursor on time - in sys clock ticks - 0=always off}
  20.       GCFlashOff = 1;   {cursor off time - in sys clock ticks - 0=always on}
  21.  
  22. procedure GcursorOn;
  23. procedure GcursorOff;
  24. procedure GcursorFlash;
  25. procedure GcursorType(style:word);
  26. procedure SetGcursorPos(Area:rect;
  27.                         Wide,CPos:word;
  28.                         Color:ColorRec;
  29.                         var Len:integer);
  30.  
  31.  
  32. implementation
  33.  
  34. type Grect = record Xmin,Ymin,Xmax,Ymax:integer; end;
  35.  
  36. const
  37.      FlashCnt : word = 0;
  38.      GcursorS : boolean = false;  {true = visible cursor}
  39.      GCStyle  : integer = 0;      {0=off, 1=small, 2=half, 3=full}
  40.      GcX      : integer = 0;      {graphic cursor X position}
  41.      GcY      : integer = 0;      {graphic cursor Y position}
  42.  
  43.      GCBimage : pointer = nil;    {pointer to background save}
  44.      GCBsize  : word = 0;         {size of the image in bytes}
  45.  
  46. var  SysClk    : word absolute $40:$6C;
  47.      OldSysClk : word;
  48.      GCArea    : Grect;
  49.  
  50.  
  51. {---------------------}
  52. procedure SetGcursorPos(Area:rect;
  53.                         Wide,CPos:word;
  54.                         Color:ColorRec;
  55.                         var Len:integer);
  56. begin
  57.   AreaWritePos(Area,Color.WritePos,CPos,Wide,GcX,GcY,Len);
  58. end;
  59.  
  60. {---------------------}
  61. procedure GcursorType(style:word);
  62. begin
  63.   GCstyle := style;
  64. end;
  65.  
  66. {----------------------}
  67. procedure GcursorOn;
  68. begin
  69.   If (GCstyle = HiddenGCursor) or GcursorS then Exit;
  70.   with GCArea do
  71.   begin
  72.     Xmin := GcX;
  73.     Ymin := GcY;
  74.     Xmax := GcX+pred(BoxTextWidth);
  75.     Ymax := GcY+pred(BoxTextHeight);
  76.     case GCStyle of
  77. {1}   NormalGcursor : Ymin := Ymax-pred(BoxTextHeight shr 2); {small line}
  78. {2}   FatGcursor    : Ymin := Ymax-(BoxTextHeight shr 1); {half size}
  79. {3} end;  {else - BlockGcursor: - full size}
  80.  
  81.     GCBsize := ImageSize(Xmin,Ymin,Xmax,Ymax);
  82.     if MaxAvail > longint(GCBsize) then
  83.     begin
  84.       GetMem(GCBimage,GCBsize);
  85. {      HideMouse;   }
  86.       GetImage(Xmin,Ymin,Xmax,Ymax,GCBimage^);
  87.  
  88.       PutImage(Xmin,Ymin,GCBimage^,GCputStyle);
  89. {      ShowMouse; }
  90.       GcursorS := true;
  91.     end
  92.     else
  93.     begin
  94.       GcursorS := false;
  95.     end;
  96.   end;
  97. end;
  98.  
  99. {----------------------}
  100. procedure GcursorOff;
  101. begin
  102.    if not(GcursorS) then Exit;
  103.    GcursorS := false;
  104.    If not(GraphOn) then Exit;
  105. {   HideMouse; }
  106.    PutImage(GCArea.Xmin,GCArea.Ymin,GCBimage^,NormalPut);
  107.    FreeMem(GCBimage,GCBsize);
  108. {   ShowMouse; }
  109. end;
  110.  
  111. {---------------------}
  112. procedure GcursorFlash;
  113. var NewSysClk : word;
  114. begin
  115.   If not(GraphOn) or (GCstyle = HiddenGCursor) then Exit;
  116.  
  117.   if (FlashCnt = 1) then
  118.   begin
  119.     GcursorOn;
  120.   end
  121.   else
  122.   begin
  123.     if FlashCnt = GCFlashOn then
  124.     begin
  125.       GcursorOff;
  126.     end
  127.     else
  128.     begin
  129.       if FlashCnt > (GCFlashOn+GCFlashOff) then
  130.       begin
  131.         FlashCnt := 0;
  132.       end;
  133.     end;
  134.   end;
  135.  
  136.   NewSysClk := SysClk;
  137.   if NewSysClk <> OldSysClk then
  138.   begin
  139.     inc(FlashCnt);
  140.   end;
  141.   OldSysClk := NewSysClk;
  142. end;
  143.  
  144. {---------------------}
  145. begin
  146.    OldSysClk := SysClk;
  147. end.
  148.  
  149.