unit Shared;
{ =======================================================================
  Library of shared procedures and functions V1.0 7/1/95
  (c) J. Dempster, University of Strathclyde 1996-67. All Rights Reserved
  ======================================================================= }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Spin, Global, Grids, Printers, ClipBrd,
  ToolHelp, maths ;

  procedure InitializeDisplay( var Chan : array of TChannel ;
                                         nChannels : Integer ;
                                         const RecHDR : TRecHeader ;
                                         var TMinLabel,TMaxLabel : TLabel ;
                                         const PB : TPaintBox ) ;

  procedure EraseDisplay( const PB: TPaintbox ) ;

  function ExtractFloat ( CBuf : string ; Default : Single ) : extended ;
  function ExtractListOfFloats ( const CBuf : string ;
                                var Values : Array of Single ;
                                PositiveOnly : Boolean ) : Integer ;
  function ExtractInt ( CBuf : string ) : LongInt ;
  function VerifyInt( text : string ; LoLimit,HiLimit : LongInt ) : string ;
  procedure AppendFloat(  var Dest : array of char;  Keyword : string ; Value : Extended ) ;
  procedure ReadFloat(  const Source : array of char;  Keyword : string ; var Value : Single ) ;
  procedure AppendInt( var Dest : array of char;  Keyword : string ; Value : LongInt ) ;
  procedure ReadInt(  const Source : array of char;  Keyword : string ; var Value : LongInt ) ;
  procedure AppendLogical( var Dest : array of char;  Keyword : string ; Value : Boolean ) ;
  procedure ReadLogical(  const Source : array of char;  Keyword : string ; var Value : Boolean ) ;
  procedure AppendString( var Dest : Array of char; Keyword, Value : string ) ;
  procedure ReadString( const Source : Array of char; Keyword : string ; var Value : string ) ;

  procedure CopyStringToArray( var Dest : array of char ; Source : string ) ;
  procedure FindParameter( const Source : array of char ;
                                 Keyword : string ;
                                 var Parameter : string ) ;
  Function GetFromEditBox( var ed : TEdit ;
                         Default, Min, Max : Single ;
                         const FormatString,Units : string ) : Single ;
  procedure GetIntRangeFromEditBox( var ed : TEdit ; var Lo,Hi : LongInt ;
                                  Min,Max : LongInt ) ;
  Procedure GetRangeFromEditBox( const ed : TEdit ;
                                 var LoValue,HiValue : Single ;
                                 Min,Max : Single ;
                                 const FormatString : String ;
                                 const Units : String ) ;
  function Contains( const Target,Buf : string ) : boolean ;



  procedure TransmitLine( ComHandle : Integer ; const Line : string ) ;
  function  ReceiveLine(  ComHandle : Integer ) : string ;
  procedure SetCED1902( const CED1902 : TCED1902 ) ;
  function TimeInMilliseconds : LongInt ;
  function ReplaceFileEnding( FileName,Ending : string ) : string ;
  function ExtractFileNameOnly( FilePath : string ) : string ;
  
  procedure MoveLabel( var lb : TLabel ;
                       const pb : TPaintBox ;
                       const Channel : TChannel ;
                       CursorPos : Integer  ) ;

  procedure DrawHorizontalCursor( var pb : TPaintBox ; Const Chan : TChannel ;
                                Level : Integer ) ;
  function OverVerticalCursor( X, CursorIndex : Integer ;
                               const Channel : TChannel ) : Boolean;
  Procedure MoveVerticalCursor( var pb : TPaintbox ;
                              var NewPosition, OldPosition : Integer ;
                              const CursorChannel : TChannel ;
                              var CursorLabel : TLabel ) ;
  procedure DrawCursor( var pb : TPaintBox ;
                      Index : LongInt;
                      const Chan : TChannel ; const Lab : TLabel ) ;
  procedure VerticalCursorScale( MouseXPos : Integer ;
                               var CurrentIndex,OldIndex : Integer ;
                               const Chan : TChannel ) ;
  procedure HorizontalCursorScale( MouseYPos : Integer ;
                                 var CurrentLevel,OldLevel : LongInt ;
                                 const Channel : TChannel ) ;
  function OverHorizontalCursor( Y : Integer ; const Channel : TChannel ) : Boolean ;
  procedure MoveHorizontalCursor( var pb : TPaintbox ;
                                var NewLevel,OldLevel : LongInt ;
                                const Channel : TChannel ) ;
  
  procedure PrintStringGrid( const Table : TStringGrid ) ;
  procedure CopyStringGrid( const Table : TStringGrid ) ;
  function GetChannelOffset( Chan, NumChannels : LongInt ) : Integer ;
  const
     MaxSingle = 1E38 ;

implementation

uses plotlib ;

procedure InitializeDisplay( var Chan : array of TChannel ;
                                         nChannels : Integer ;
                                         const RecHDR : TRecHeader ;
                                         var TMinLabel,TMaxLabel : TLabel ;
                                         const PB : TPaintBox ) ;
{ ----------------------------
  Initialise a display window
  ---------------------------}
var
   Height,ch,cTop,NumInUse : LongInt ;
begin

     { Set trace colour }

     PB.canvas.pen.color := Chan[0].color ;

     { Determine number of channels in use and the height
       available for each channel }

     NumInUse := 0 ;
     for ch := 0 to nChannels-1 do
         if Chan[ch].InUse then NumInUse := NumInUse + 1 ;
     Height := PB.Height div MaxInt( [NumInUse,1] ) ;

     { Define display area for each channel in use }

     cTop := 0 ;
     for ch := 0 to nChannels-1 do begin
          if Chan[ch].InUse then begin
             Chan[ch].Left := 0 ;
             Chan[ch].Right := PB.width ;
             Chan[ch].Top := cTop ;
             Chan[ch].Bottom := Chan[ch].Top + Height ;
             Chan[ch].xMin := Chan[0].xMin ;
             Chan[ch].xMax := Chan[0].xMax ;
             Chan[ch].xScale := (Chan[ch].Right - Chan[ch].Left) /
                                (Chan[ch].xMax - Chan[ch].xMin ) ;
             Chan[ch].yScale := (Chan[ch].Bottom - Chan[ch].Top) /
                                (Chan[ch].yMax - Chan[ch].yMin ) ;
             cTop := cTop + Height ;
             end ;
          end ;

     TMinLabel.caption := Format( '%5.4g %s', [Chan[0].xMin*RecHDR.dt*Settings.TScale,
                                               Settings.TUnits] ) ;
     TMaxLabel.caption := Format( '%5.4g %s', [Chan[0].xMax*RecHDR.dt*Settings.TScale,
                                               Settings.TUnits] ) ;

     { Display Channel Name(s) }

     for ch := 0 to nChannels-1 do
        if Chan[ch].InUse then
           PB.Canvas.TextOut( Chan[ch].Left,
           (Chan[ch].Top + Chan[ch].Bottom) div 2,' ' + Chan[ch].ADCName ) ;

     end ;

procedure EraseDisplay( const PB: TPaintbox ) ;
{ ------------------
  Erase display area
  ------------------}
begin
     PB.canvas.brush.color := clWhite ;
     PB.canvas.fillrect(PB.canvas.ClipRect);
     end ;


function ExtractFloat ( CBuf : string ; Default : Single ) : extended ;
{ ---------------------------------------------------
  Extract a floating point number from a string which
  may contain additional non-numeric text
  ---------------------------------------}

var
   CNum : string ;
   i : integer ;
   Done,NumberFound : Boolean ;
begin
     { Extract number from othr text which may be around it }
     CNum := '' ;
     Done := False ;
     NumberFound := False ;
     i := 1 ;
     repeat 
         if CBuf[i] in ['0'..'9', 'E', 'e', '+', '-', '.' ] then begin
            CNum := CNum + CBuf[i] ;
            NumberFound := True ;
            end
         else if NumberFound then Done := True ;
         Inc(i) ;
         if i > Length(CBuf) then Done := True ;
         until Done ;

     { Convert number from ASCII to real }
     try
        if Length(CNum)>0 then ExtractFloat := StrToFloat( CNum )
                          else ExtractFloat := Default ;
     except
        on E : EConvertError do ExtractFloat := Default ;
        end ;
end ;

function ExtractInt ( CBuf : string ) : longint ;
{ ---------------------------------------------------
  Extract a 32 bit integer number from a string which
  may contain additional non-numeric text
  ---------------------------------------------------}

Type
    TState = (RemoveLeadingWhiteSpace, ReadNumber) ;
var CNum : string ;
    i : integer ;
    Quit : Boolean ;
    State : TState ;

begin
     CNum := '' ;
     i := 1;
     Quit := False ;
     State := RemoveLeadingWhiteSpace ;
     while not Quit do begin

           case State of

                { Ignore all non-numeric characters before number }
                RemoveLeadingWhiteSpace : begin
                   if CBuf[i] in ['0'..'9','+','-'] then State := ReadNumber
                                                    else i := i + 1 ;
                   end ;

                { Copy number into string CNum }
                ReadNumber : begin
                    {End copying when a non-numeric character
                    or the end of the string is encountered }
                    if CBuf[i] in ['0'..'9','E','e','+','-','.'] then begin
                       CNum := CNum + CBuf[i] ;
                       i := i + 1 ;
                       end
                    else Quit := True ;
                    end ;
                else end ;

           if i > Length(CBuf) then Quit := True ;
           end ;
     try


        ExtractInt := StrToInt( CNum ) ;
     except
        ExtractInt := 1 ;
        end ;
     end ;


function VerifyInt( text : string ; LoLimit,HiLimit : LongInt ) : string ;
{ -------------------------------------------------------------
  Ensure an ASCII edit field contains a value within set limits
  -------------------------------------------------------------}
var
   Value : LongInt ;
begin
     Value := ExtractInt( text ) ;
     if Value < LoLimit then Value := LoLimit ;
     If Value > HiLimit then Value := HiLimit ;
     VerifyInt := IntToStr( Value ) ;
     end ;


function ExtractListOfFloats ( const CBuf : string ;
                                var Values : Array of Single ;
                                PositiveOnly : Boolean ) : Integer ;
{ -------------------------------------------------------------
  Extract a series of floating point number from a string which
  may contain additional non-numeric text
  ---------------------------------------}

var
   CNum : string ;
   i,nValues : integer ;
   EndOfNumber : Boolean ;
begin
     nValues := 0 ;
     CNum := '' ;
     for i := 1 to length(CBuf) do begin

         { If character is numeric ... add it to number string }
         if PositiveOnly then begin
            { Minus sign is treated as a number separator }
            if CBuf[i] in ['0'..'9', 'E', 'e', '.' ] then begin
               CNum := CNum + CBuf[i] ;
               EndOfNumber := False ;
               end
            else EndOfNumber := True ;
            end
         else begin
            { Positive or negative numbers }
            if CBuf[i] in ['0'..'9', 'E', 'e', '.', '-' ] then begin
               CNum := CNum + CBuf[i] ;
               EndOfNumber := False ;
               end
            else EndOfNumber := True ;
            end ;

         { If all characters are finished ... check number }
         if i = length(CBuf) then EndOfNumber := True ;

         if (EndOfNumber) and (Length(CNum) > 0)
            and (nValues <= High(Values)) then begin
              try
                 Values[nValues] := StrToFloat( CNum ) ;
                 CNum := '' ;
                 Inc(nValues) ;
              except
                    on E : EConvertError do CNum := '' ;
                    end ;
              end ;
         end ;
     { Return number of values extracted }
     Result := nValues ;
     end ;


procedure AppendFloat( var Dest : Array of char; Keyword : string ; Value : Extended ) ;
{ --------------------------------------------------------
  Append a floating point parameter line
  'Keyword' = 'Value' on to end of the header text array
  --------------------------------------------------------}
begin
     CopyStringToArray( Dest, Keyword ) ;
     CopyStringToArray( Dest, format( '%.6g',[Value] ) ) ;
     CopyStringToArray( Dest, chr(13) + chr(10) ) ;
     end ;


procedure ReadFloat( const Source : Array of char; Keyword : string ; var Value : Single ) ;
var
   Parameter : string ;
begin
     FindParameter( Source, Keyword, Parameter ) ;
     if Parameter <> '' then Value := ExtractFloat( Parameter, 1. ) ;
     end ;



procedure AppendInt( var Dest : Array of char; Keyword : string ; Value : LongInt ) ;
{ -------------------------------------------------------
  Append a long integer point parameter line
  'Keyword' = 'Value' on to end of the header text array
  ------------------------------------------------------ }
begin
     CopyStringToArray( Dest, Keyword ) ;
     CopyStringToArray( Dest, InttoStr( Value ) ) ;
     CopyStringToArray( Dest, chr(13) + chr(10) ) ;
     end ;


procedure ReadInt( const Source : Array of char; Keyword : string ; var Value : LongInt ) ;
var
   Parameter : string ;
begin
     FindParameter( Source, Keyword, Parameter ) ;
     if Parameter <> '' then Value := ExtractInt( Parameter ) ;
     end ;

{ Append a text string parameter line
  'Keyword' = 'Value' on to end of the header text array}

procedure AppendString( var Dest : Array of char; Keyword, Value : string ) ;
begin
CopyStringToArray( Dest, Keyword ) ;
CopyStringToArray( Dest, Value ) ;
CopyStringToArray( Dest, chr(13) + chr(10) ) ;
end ;

procedure ReadString( const Source : Array of char; Keyword : string ; var Value : string ) ;
var
   Parameter : string ;
begin
     FindParameter( Source, Keyword, Parameter ) ;
     if Parameter <> '' then Value := Parameter  ;
     end ;

{ Append a boolean True/False parameter line
  'Keyword' = 'Value' on to end of the header text array}

procedure AppendLogical( var Dest : Array of char; Keyword : string ; Value : Boolean ) ;
begin
     CopyStringToArray( Dest, Keyword ) ;
     if Value = True then CopyStringToArray( Dest, 'T' )
                     else CopyStringToArray( Dest, 'F' )  ;
     CopyStringToArray( Dest, chr(13) + chr(10) ) ;
     end ;

procedure ReadLogical( const Source : Array of char; Keyword : string ; var Value : Boolean ) ;
var
   Parameter : string ;
begin
     FindParameter( Source, Keyword, Parameter ) ;
     if pos('T',Parameter) > 0 then Value := True
                               else Value := False ;
     end ;

{ Copy a string variable to character array
  NOTE. array MUST have been filled with 0 characters before
        using the function }

procedure CopyStringToArray( var Dest : array of char ; Source : string ) ;
var
   i,j : Integer ;
begin

     { Find end of character array }
     j := 0 ;
     while (Dest[j] <> chr(0)) and (j < High(Dest) ) do j := j + 1 ;

     if (j + length(Source)) < High(Dest) then
     begin
          for i := 1 to length(Source) do
          begin
               Dest[j] := Source[i] ;
               j := j + 1 ;
               end ;
          end
     else
         MessageDlg( ' Array Full ', mtWarning, [mbOK], 0 ) ;

     end ;

procedure FindParameter( const Source : array of char ;
                               Keyword : string ;
                               var Parameter : string ) ;
var
s,k : integer ;
Found : boolean ;
begin

     { Search for the string 'keyword' within the
       array 'Source' }

     s := 0 ;
     k := 1 ;
     Found := False ;
     while (not Found) and (s < High(Source)) do
     begin
          if Source[s] = Keyword[k] then
          begin
               k := k + 1 ;
               if k > length(Keyword) then Found := True
               end
               else k := 1;
         s := s + 1;
         end ;

    { Copy parameter value into string 'Parameter'
      to be returned to calling routine }

    Parameter := '' ;
    if Found then
    begin
        while (Source[s] <> chr(13)) and (s < High(Source)) do
        begin
             Parameter := Parameter + Source[s] ;
             s := s + 1
             end ;
        end ;
    end ;


Function GetFromEditBox( var ed : TEdit ;
                         Default, Min, Max : Single ;
                         const FormatString,Units : string ) : Single ;
{ --------------------------------------------------------------------
  Get a number from an edit box, ensure that it is within valid limits,
  and update the box with the value used.
  ed ... Edit box to get text from
  Default ... value to use if box does not contain valid data
  Min ... Minimum valid value
  Max ... Maximum valid value
  FormatString ... format used to update box
  Units ... units of value
  --------------------------------------------------------------------}
var
   Value : single ;
begin
     Value := ExtractFloat( ed.text, Default ) ;
     if Value < Min then Value := Abs(Value) ;
     if Value < Min then Value := Min ;
     if Value > Max then Value := Max ;
     ed.text := format( FormatString, [Value] ) + ' ' + Units ;
     GetFromEditBox := Value ;
     end ;

procedure GetIntRangeFromEditBox( var ed : TEdit ; var Lo,Hi : LongInt ;
                                  Min,Max : LongInt ) ;
var
   LoValue,HiValue : single ;
begin
     {if ed.text = '' then ed.text := format( ' %d-%d', [Lo,Hi]) ;}
     GetRangeFromEditBox( ed, LoValue,HiValue, Min, Max,'%.0f-%.0f','' ) ;
     Lo := Trunc( LoValue ) ;
     Hi := Trunc( HiValue ) ;
     end ;


procedure GetRangeFromEditBox( const ed : TEdit ;
                               var LoValue,HiValue : Single ;
                               Min,Max : Single ;
                               const FormatString : String ;
                               const Units : String ) ;
var
   Values : Array[0..10] of Single ;
   Temp : Single ;
   nValues : Integer ;
begin
     LoValue := Min ;
     HiValue := Max ;
     nValues := ExtractListofFloats( ed.text, Values, True ) ;
     if nValues >=1 then LoValue := Values[0] ;
     if nValues >=2 then HiValue := Values[1] ;
     if LoValue > HiValue then begin
        Temp := LoValue ;
        LoValue := HiValue ;
        HiValue := Temp ;
        end ;
     ed.text := format( FormatString, [LoValue,HiValue] ) + ' ' + Units ;
     end ;


function Contains( const Target,Buf : string ) : boolean ;
{ Determine whether the sub-string in 'Target' is contained in 'Buf'
  ... return True if it is. }
begin
     if Pos( UpperCase(Target), UpperCase(Buf) ) > 0 then Contains := True
                                                     else Contains := False ;
     end ;



procedure TransmitLine( ComHandle : Integer ; const Line : string ) ;
var
i,nC,nWritten : Integer ;
xBuf : array[0..258] of char ;
begin
     nC := Length(Line) ;
     for i := 1 to nC do xBuf[i-1] := Line[i] ;
     xBuf[nC] := chr(13) ;
     nWritten := WriteComm( ComHandle, xBuf, nC+1 ) ;
     end ;


function ReceiveLine( ComHandle : Integer ) : string ;
var
nRead : Integer ;
Line : string ;
rBuf : array[0..1] of char ;
begin
     Line := '' ;
     repeat
        rBuf[0] := ' ' ;
        nRead := ReadComm( ComHandle, rBuf, 1 ) ;
        if nRead > 0 then begin
           if (rBuf[0] <> chr(13)) and (rBuf[0]<>chr(10)) then
                                   Line := Line + rBuf[0] ;
           end ;
        until rBuf[0] = chr(13) ;
     Result := Line ;
     end ;

procedure SetCED1902( const CED1902 : TCED1902 ) ;
{ Transmit new gain/filter settings to CED 1902 amplifier }
const
     IP_GROUNDED = 1 ;
     IP_TRANSDUCER_SE = 2 ;
     IP_TRANSDUCER_DIFF = 3 ;
     IP_TRANSDUCER_INV = 4 ;
     IP_ELECTRODES_GROUNDED = 5 ;
     IP_ELECTRODES = 6 ;
var
ComHandle,Err,cStart : Integer ;
Buf : array[0..256] of char ;
DCB : TDCB ;
begin

     if (CED1902.ComPort > 0) and
        (CED1902.ComPort < 3) and
        CED1902.InUse then begin

          { Set Com port to match requirements of CED 1902 }

          StrPCopy( Buf, 'COM'+IntToStr(CED1902.ComPort) ) ;
          ComHandle := OpenComm( Buf ,256,256) ;

          StrPCopy( Buf, format('COM%d:9600,e,7,1',[CED1902.ComPort]) );
          Err := BuildCommDCB( Buf , DCB );

          DCB.Id := ComHandle ;
          Err := SetCommState( DCB ) ;

         { Problem Here ?? First command to 1902 getting ignored }
         TransmitLine(ComHandle, 'IP' + IntToStr(CED1902.Input) + ';') ;

         TransmitLine(ComHandle, 'IP' + IntToStr(CED1902.Input) + ';') ;
         TransmitLine(ComHandle, 'GN' + IntToStr(CED1902.Gain) + ';') ;
         TransmitLine(ComHandle, 'LP' + IntToStr(CED1902.LPFilter) + ';') ;
         TransmitLine(ComHandle, 'HP' + IntToStr(CED1902.HPFilter) + ';') ;
         TransmitLine(ComHandle, 'AC' + IntToStr(CED1902.ACCoupled) + ';') ;
         TransmitLine(ComHandle, 'NF' + IntToStr(CED1902.NotchFilter) + ';') ;

         { Set DC Offset (Note different offset ranges for different inputs }
         case CED1902.Input of
              IP_ELECTRODES, IP_ELECTRODES_GROUNDED, IP_TRANSDUCER_SE : begin
                    TransmitLine(ComHandle, 'OR2;' ) ;
                    end ;
              else
                  TransmitLine(ComHandle, 'OR1;' ) ;
              end ;
         TransmitLine(ComHandle, 'OF' + IntToStr(CED1902.DCOffset) + ';' ) ;

         Err := CloseComm( ComHandle ) ;
         end ;
     end ;


function TimeInMilliseconds : LongInt ;
{ Returns current time of day in milliseconds }
var
   TimerInfo : TTimerInfo ;
begin
     TimerInfo.dwSize := Sizeof(TimerInfo) ;
     TimerCount( @TimerInfo ) ;
     TimeInMilliseconds := TimerInfo.dwmsSinceStart ;
     end ;





function ReplaceFileEnding( FileName,Ending : string ) : string ;
{ -------------------------------------------------
  Replace the '.???' ending of FileName with Ending
  -------------------------------------------------}
var
   iExt : LongInt ;
begin
     iExt := pos( '.', FileName ) ;
     if iExt > 0 then begin
        Delete( FileName, iExt, 4 ) ;
        Insert( Ending, FileName, iExt ) ;

        end
     else FileName := FileName + Ending ;
     ReplaceFileEnding := FileName ;
     end ;


function ExtractFileNameOnly( FilePath : string ) : string ;
{ -----------------------------------------------------
  Extract file name (without extension) from file path
  ----------------------------------------------------}
var
   FileName : string ;
   FileExt : string[6] ;
begin
     FileName := ExtractFileName(FilePath) ;
     FileExt := ExtractFileExt(FileName) ;
     Delete( FileName,Pos(FileExt,FileName),Length(FileExt) ) ;
     ExtractFileNameOnly := FileName ;
     end ;





procedure MoveLabel( var lb : TLabel ;
                     const pb : TPaintBox ;
                     const Channel : TChannel ;
                     CursorPos : Integer   ) ;
{ --------------------------
  Add a label below a cursor
  --------------------------}
begin
     lb.Left := pb.Left + Trunc( Channel.xScale*(CursorPos-Channel.xMin) ) ;
     lb.Top := pb.Top + pb.Height  + 1 ;
     lb.Visible := True ;
     end ;


procedure DrawHorizontalCursor( var pb : TPaintBox ;
                                Const Chan : TChannel ;
                                Level : Integer ) ;
{ -------------------------------------------------
  Draw dotted horizontal cursor at ADC level 'Level'
  in display area defined by  record data channel 'Chan'
  ----------------------------------------------------}
var
   yPix,xPix,TicSize : Integer ;
   OldColor : TColor ;
   OldStyle : TPenStyle ;
   OldMode : TPenMode ;
begin
     with pb.canvas do begin
          OldColor := pen.color ;
          OldStyle := pen.Style ;
          OldMode := pen.mode ;
          pen.mode := pmXor ;
          pen.color := clRed ;
          end ;

     yPix := Trunc( Chan.Bottom - (Level - Chan.yMin)*Chan.yScale ) ;
     pb.canvas.polyline([Point(Chan.Left,yPix),Point(Chan.Right,yPix)]);

     { if zero level has been calculated from record show the point used }

     if (Chan.xMin <= Chan.ADCZeroAt) and (Chan.ADCZeroAt <= Chan.xMax ) then begin
          xPix := Trunc((Chan.ADCZeroAt - Chan.xMin)*Chan.xScale - Chan.Left) ;
          TicSize := pb.Canvas.textheight('X') ;
          pb.canvas.polyline( [Point( xPix, yPix+TicSize ),
                               Point( xPix, yPix-TicSize )] );
          end ;

     with pb.canvas do begin
          pen.style := OldStyle ;
          pen.color := OldColor ;
          pen.mode := OldMode ;
          end ;

    end ;


function OverVerticalCursor( X, CursorIndex : Integer ;
                             const Channel : TChannel ) : Boolean ;
const
     Margin = 4 ;
var
   XofCursor :LongInt  ;
begin
     XofCursor := Trunc( (CursorIndex - Channel.xMin) *
                          Channel.xScale ) + Channel.Left  ;
     if Abs(X - XofCursor) < Margin then OverVerticalCursor := True
                                    else OverVerticalCursor := False ;
     end ;


procedure MoveVerticalCursor( var pb : TPaintbox ;
                              var NewPosition, OldPosition : Integer ;
                              const CursorChannel : TChannel ;
                              var CursorLabel : TLabel ) ;
{ ---------------------------------------
  Move vertical cursor on signal display
  --------------------------------------}
begin
     DrawCursor( pb, OldPosition, CursorChannel, CursorLabel ) ;
     if NewPosition < CursorChannel.xMin then NewPosition := Trunc(CursorChannel.xMin) ;
     if NewPosition > CursorChannel.xMax then NewPosition := Trunc(CursorChannel.xMax) ;
     DrawCursor( pb, NewPosition, CursorChannel, CursorLabel ) ;
     end ;


procedure DrawCursor( var pb : TPaintBox ;
                      Index : LongInt;
                      const Chan : TChannel ; const Lab : TLabel ) ;
{ --------------------------------------------------------
  Draw/Remove a vertical cursor on the record display area
  --------------------------------------------------------}
var
   Diam,xPos : LongInt ;
   OldColor : TColor ;
   OldStyle : TPenStyle ;
   OldMode : TPenMode ;
begin

     with pb.canvas do begin
          OldColor := pen.color ;
          OldStyle := pen.Style ;
          OldMode := pen.mode ;
          pen.mode := pmXor ;
          pen.color := Chan.color ;
          end ;

     { If cursor on screen, exclusive OR the line to remove an existing
       cursor / add a new one }
     if Index >= 0 then begin
        xPos := Trunc((Index - Chan.xMin)*Chan.xScale - Chan.Left) ;
        pb.canvas.polyline([Point(xPos,Chan.Top),Point(xPos,Chan.Bottom)] ) ;

        if (xPos >= Chan.Left) and (xPos <= Chan.Right) then begin
              Lab.Left := pb.Left + xPos ;
              Lab.Top := pb.Top + pb.Height + 2;
              Lab.visible := True ;
              end
        else Lab.visible := False ;

        end
     else
         Lab.visible := False ;

     with pb.canvas do begin
          pen.style := OldStyle ;
          pen.color := OldColor ;
          pen.mode := OldMode ;
          end ;
     end ;

procedure VerticalCursorScale( MouseXPos : Integer ;
                               var CurrentIndex,OldIndex : Integer ;
                               const Chan : TChannel ) ;
{ -----------------------------------------------------------
  Get the index into the A/D channel from the mouse X position
  -----------------------------------------------------------}
begin
     OldIndex := CurrentIndex ;
     CurrentIndex := Trunc( (MouseXPos - Chan.Left)/Chan.xScale + Chan.xMin ) ;
     end ;


procedure HorizontalCursorScale( MouseYPos : Integer ;
                                 var CurrentLevel,OldLevel : LongInt ;
                                 const Channel : TChannel ) ;
{ -----------------------------------------------------------
  Get the A/D signal level from the mouse Y position
  -----------------------------------------------------------}
begin
     OldLevel := CurrentLevel ;
     CurrentLevel := Trunc((Channel.Bottom - MouseYPos)/Channel.yScale + Channel.yMin ) ;
     end ;


function OverHorizontalCursor( Y : Integer ; const Channel : TChannel ) : Boolean ;
const
     Margin = 4 ;
var
   YOfCursor : Integer ;
begin
     YofCursor := Trunc( Channel.Bottom -
                         ((Channel.ADCZero - Channel.yMin)*Channel.yScale) ) ;
     if Abs(Y - YofCursor) < Margin then OverHorizontalCursor := True
                                    else OverHorizontalCursor := False ;
     end ;


procedure MoveHorizontalCursor( var pb : TPaintbox ;
                                var NewLevel,OldLevel : LongInt ;
                                const Channel : TChannel ) ;

begin
     { Remove existing cursor }
     DrawHorizontalCursor( pb, Channel, OldLevel ) ;

     { Keep cursor within display limits }
     if NewLevel < Channel.yMin then NewLevel := Trunc(Channel.yMin) ;
     if NewLevel > Channel.yMax then NewLevel := Trunc(Channel.yMax) ;

     { Draw new cursor }
     DrawHorizontalCursor( pb, Channel, NewLevel ) ;
     end ;



procedure PrintStringGrid( const Table : TStringGrid ) ;
{ -----------------------------------------------
  Print the contents of a string grid spreadsheet
  -----------------------------------------------}
var
   CharWidth,CharHeight,ColHeight,Row,Col,w : Integer ;
   PageLeft,PageTop,PageBottom,Line,ColLeft,PageNum,LastPage : Integer ;
   ColWidth : Array[0..20] of Integer ;
   NewPage : boolean ;
   FontScale : Integer ;
begin

     Screen.Cursor := crHourglass ;



     { Set print font and size }
     Printer.Canvas.font.name := Settings.Plot.FontName ;
     FontScale := PrinterPointsToPixels(10) ;
     Printer.Canvas.font.Height := FontScale ;

     CharWidth := Printer.canvas.TextWidth('X') ;
     CharHeight := Printer.canvas.TextHeight('X') ;
     PageTop := CharHeight*5 ;
     PageBottom := printer.PageHeight - PageTop ;
     PageLeft := CharWidth*8 ;

     Printer.BeginDoc ;

     { Calculate column widths of table}
     for col := 0 to Table.ColCount-1 do begin
         ColWidth[Col] := 0 ;
         for row := 0 to Table.RowCount-1 do begin
             w := Printer.canvas.TextWidth(Table.cells[Col,Row]) ;
             if ColWidth[Col] < w then ColWidth[Col] := w ;
             end ;
         end ;
     for col := 0 to Table.ColCount-1 do ColWidth[Col] := ColWidth[Col] +
                                           2*CharWidth ;

     ColHeight := (12*Printer.canvas.TextHeight(Table.cells[0,0])) div 10 ;

     { Calculate number of pages to be printed }
     LastPage := 0 ;
     PageNum := 1 ;
     for row := 0 to Table.RowCount-1 do begin
         if LastPage <> PageNum then begin
            Line := PageTop + ColHeight*3 ;
            LastPage := PageNum ;
            end ;
         Line := Line + ColHeight ;
         if Line > PageBottom then Inc(PageNum) ;
         end ;

     { Print table
       ===========}



     PageNum := -1 ;
     for row := 0 to Table.RowCount-1 do begin
         {Print header lines on each new page }
         if Printer.PageNumber <> PageNum then begin
            PageNum := Printer.PageNumber ;
            Line := PageTop ;
            printer.canvas.textout(PageLeft,Line, 'File ... ' + fH.FileName
                                   + format(' ( Page %d of %d )',
                                            [PageNum,LastPage])) ;
            Line := Line + ColHeight ;
            printer.canvas.textout(PageLeft,Line, fH.IdentLine) ;
            Line := Line + ColHeight*2 ;
            NewPage := False ;
            end ;

         { Print row }
         ColLeft := PageLeft ;
         Printer.Canvas.Pen.Width := 1 ;
         for col := 0 to Table.ColCount-1 do begin
             printer.canvas.rectangle( ColLeft,Line,ColLeft+ColWidth[Col],
                                       Line+ColHeight ) ;
             printer.canvas.textout( ColLeft + CharWidth,
                                     Line + CharHeight div 10,
                                     Table.cells[Col,Row] ) ;
             ColLeft := ColLeft + ColWidth[Col] ;
             end ;

         { New page when line crosses bottom margin }
         Line := Line + ColHeight ;
         if Line > PageBottom then Printer.NewPage ;

         end ;

     Printer.EndDoc ;

     Screen.Cursor := crDefault ;

     end ;

procedure CopyStringGrid( const Table : TStringGrid ) ;
{ -----------------------------------------------
  Print the contents of a string grid spreadsheet
  -----------------------------------------------}
const
     BufSize = 65100 ;
     BufLimit = 65000 ;
var
   Row,Col,LastCol : Integer ;
   n : LongInt ;
   Line : String ;
   CopyBuf0,Line0 : PChar ;
   UseColumn : Array[0..20] of boolean ;
begin
     { Allocate buffers }
     CopyBuf0 := StrAlloc( BufSize ) ;
     StrPCopy( CopyBuf0, '' ) ;
     Line0 := StrAlloc(  256 ) ;

     { Find which columns contain data (based on first row) }
     for Col := Table.Selection.Left to Table.Selection.Right do
         if Table.Cells[Col,0] = '' then UseColumn[Col] := False
                                    else begin
                                         LastCol := Col ;
                                         UseColumn[Col] := True ;
                                         end ;

     { Copy table to string buffer }
     n := 0 ;
     for Row := Table.Selection.Top to Table.Selection.Bottom do begin
         Line := '' ;
         for Col := Table.Selection.Left to Table.Selection.Right do begin
             if UseColumn[Col] then begin
                Line := Line + Table.Cells[Col,Row] ;
                if Col < LastCol then Line := Line + chr(9)
                                 else Line := Line + chr(13) + chr(10) ;
                end ;
             end ;
         n := n + length(Line) ;
         StrPCopy( Line0, Line ) ;
         if n < BufLimit then CopyBuf0 := StrCat(CopyBuf0,Line0) ;
         end ;

     { Copy string buffer to clipboard }
     ClipBoard.SetTextBuf( CopyBuf0 ) ;

     { Dispose of buffers }
     StrDispose( Line0 ) ;
     StrDispose( CopyBuf0 ) ;
     end ;


function GetChannelOffset( Chan, NumChannels : LongInt ) : Integer ;
begin
     Result := NumChannels - 1 - Chan ;
     end ;

end.

