cpwbuf.pas

生物信息学中的遗传数据分析的delphi源码。

   else
      Append (LogFile); { Append to log file }
end;

{-----------------------------SetStrip-------------------------------------}

procedure TEXTBUFFER.SetStrip (Flag: Boolean);
begin
   Strip := Flag;
end;

{-----------------------------OpenLogFile----------------------------------}

procedure TEXTBUFFER.OpenLogFile (FileName: string);
begin
   { Close any existing log file. }
   if Echo then
      CloseLogFile;
   { Open a new log file. }
   Assign (logfile, FileName);
   {$I-}
   Rewrite (logfile);
   Close (logfile);
   {$I+}
   ErrorRec.UpDate (IOResult);
end;

{-----------------------------AppendLogFile--------------------------------}

{ Given an already existing log file, open the
  file for appending. }
procedure TEXTBUFFER.AppendLogFile (FileName:string);
begin
   { Close any existing log file. }
   if Echo then
      CloseLogFile;
   { Open new log file for appending. }
   Assign (logfile, FileName);
   {$I-}
   Append (logfile);
   {$I+}
   ErrorRec.UpDate (IOResult);
end;

{-----------------------------CloseLogFile---------------------------------}

procedure TEXTBUFFER.CloseLogFile;
begin
   if Echo then begin
      {$I-}
      Close (logfile);
      {$I+}
      ErrorRec.UpDate (IOResult);
      end;
   Echo := False;
end;


{**************************** WINDOWS code ********************************}

{ Windows specific code to handle the display window }

{$IFDEF WINDOWS}

{-----------------------------Edit-----------------------------------------}

{ Insert display buffer in EditorHWnd }
function TEXTBUFFER.Edit (EditorHWnd: HWnd; OEMStrip:Boolean):Boolean;
const
   LineBreak:PChar = #10#0;
var
   p, q, r : PChar;
   Bytes   : word; { essential since Bytes+1 can be > 32767. }
begin
   if (Tail = Head) and (Head = 0) then
      { Buffer is empty. }
      Edit := False
   else begin
      { Space required for buffer. }
      if (Tail > Head) then
         Bytes := Tail - Head
      else Bytes := TEXTBUFFERSIZE;
      { Can we allocate enough memory to
        edit the whole buffer? }
      if (SendMessage (EditorHWnd, em_LimitText, Bytes, 0) <> 0)
         then begin
         { ...yes can edit whole buffer }
         { allocate string on heap. }

         p := MemAlloc (TEXTBUFFERSIZE+1);
         if (p <> NIL) then begin
            if (Tail > Head) then begin
               { Copy just the bytes in the text buffer }
               q := @Buffer^[0];
               StrMove (p, q, Bytes);
               end
            else begin
               { Copy the whole buffer }
               q := @Buffer^[Head];
               StrMove (p, q, TEXTBUFFERSIZE - Head + 1);
               q := @Buffer^[0];
               r := @p[TEXTBUFFERSIZE - Head + 1];
               StrMove (r, q, Tail);
               end;
            p[Bytes] := #0;

            { Use Windows API function to convert
              OEM chars to ANSI equivalents. }
            if OEMStrip then
               OemToAnsi (p, p);

            SendMessage (EditorHWnd, wm_SetText, 0, longint(p));

            { Clean up. }
            FreeMem (p, SizeOf(p));
            Edit := True;
            end { if p <> NIL }
         else begin
            { couldn't allocate p }
            {$IFDEF BWCC}
            BWCCMessageBox (DisplayWindow^.HWindow,
                'Insufficent memory to copy display buffer', szProgName,
                mb_IconInformation);
            {$ELSE}
            MessageBox (DisplayWindow^.HWindow,
                'Insufficent memory to copy display buffer', szProgName,
                mb_IconInformation);
            {$ENDIF}
            Edit := False;
            end;
         end { if SendMessage then }
      else begin
         { Editor cannot hold all the text. }
         {$IFDEF BWCC}
         BWCCMessageBox (DisplayWindow^.HWindow,
          'Display buffer is too large to edit',
            szProgName, mb_IconInformation);
         {$ELSE}
         MessageBox (DisplayWindow^.HWindow,
          'Display buffer is too large to edit',
            szProgName, mb_IconInformation);
         {$ENDIF}
         Edit := False;
         end;
      end;
end;

{-----------------------------WClear---------------------------------------}

{ Clear the buffer by reseting all the pointers and
  counters, and then clearing the display window. }
procedure TEXTBUFFER.WClear;
begin
   BufPtr      := 0;
   Head        := 0;
   Tail        := Head;
   Lines       := 0;
   Overwriting := False;
   ALine.Clear;
   writeln (NewLog, 'COMPONENT for Windows');
   writeln (NewLog, DateStr + ', ' + TimeStr);
   with DisplayWindow^ do begin
      InvalidateRect (HWindow, NIL, True);
      Scroller^.SetRange (LINEBUFFERSIZE, 0);
      UpdateWindow (HWindow);
      end;
end;

{-----------------------------WShowLines-----------------------------------}

{ Print lines between Start and Stop using display context hdcPrn }
procedure TEXTBUFFER.PrintLines (hdcPrn:HDC; Start, Stop:integer);
var
   LineEnd,
   Count     : integer;
   S         : array[0..LINEBUFFERSIZE] of char;
   XPos      : word;
   TabSPosn : integer;
begin
   TabSPosn := 0;
   XPos      := 1;
   while (Start < Stop) do begin
      LineEnd := NextLinebreak (Start);     { end of line in buffer }
      Count   := Succ (LineEnd - Start);    { bytes in line }
      Move (Buffer^[Start], S[0], Count);   { move line to display buffer }

      { strip CR/LF and append #0 }
      S[Count - 2] := #0;

      { Convert chars }
      OemToAnsi (S, S);

      TabbedTextOut (hdcPrn, XPos, LCount * yChar, S, StrLen(S), 0, TabSPosn, 0);

      { If we're at the end of the buffer but not at the
        end of a line of text, then we need to add the next
        bit of text at the end of the current line. }
      if ((LineEnd = TEXTBUFFERSIZE) and
         (Buffer^[TEXTBUFFERSIZE] <> LineBreak)) then begin
         Xpos := LoWord (GetTextExtent (hdcPrn, S, StrLen(s)));
         end
      else begin
         Inc (LCount);
         XPos := 1;

         if (LCount mod LinesPerPage = 0) then begin
            if (Escape (hdcPrn, NEWFRAME, 0, NIL, NIL) < 0) then begin
               bError := True;
               Exit;
               end
            else begin
               LCount := 0;
               end;
            end;
         end;

      if bUserAbort then
         Exit
      else Start := Start + Count;               { next line }
      end;
end;

{-----------------------------WShow----------------------------------------}

{ Print the whole text buffer }
procedure TEXTBUFFER.Print (hdcPrn:HDC);
var
   tm          : TTextMetric;
   Start, Stop : integer;
begin
   GetTextMetrics (hdcPrn, tm);
   yChar        := tm.tmheight + tm.tmExternalLeading;
   LinesPerPage := GetDeviceCaps (hdcPrn, VERTRES) div yChar;
   LCount       := 0;

   Start := Head;
   if (Tail < Head) then begin
      { The buffer has been overwritten }
      Stop := TEXTBUFFERSIZE;
      PrintLines (hdcPrn, Start, Stop);
      if (bUserAbort or bError) then
         Exit;
      PrintLines (hdcPrn, 0, Tail);
      if (bUserAbort or bError) then
         Exit;
      end
   else begin
      { We haven't yet started to overwrite the buffer }
      Stop := Max (BufPtr, Tail);
      PrintLines (hdcPrn, Start, Stop);
      if (bUserAbort or bError) then
         Exit;
      end;
   if (Escape (hdcPrn, NewFrame, 0, NIL, NIL) < 0) then
      bError := True;
end;

{-----------------------------WShowPage------------------------------------}

{ Called by display window's Paint method to repaint
  part of the screen with lines Top...Bottom. }
procedure TEXTBUFFER.WShowPage (DC:HDC; Top, Bottom: integer);
var
   i,
   LineEnd,
   LineCount,
   Start,
   Count     : integer;
   S         : array[0..LINEBUFFERSIZE] of char;
   XPos      : word;
   height    : integer;
   Metrics   : TTextMetric;
   XOffSet,
   Offset    : integer;
   TabSPosn  : integer;
begin
   TabSPosn := 0;

   { Font height }
   GetTextMetrics (DC, Metrics);
   Height    := Metrics.tmHeight + Metrics.tmExternalLeading;

   { Device units from top of DC due to skipped lines }
   Offset    := Height * Top;

   { Indent from left border by one character width }
   XOffSet   := Metrics.tmAveCharWidth;

   { Skip lines before Top }
   i     := 0;
   Start := Head;
   while (i < Top) do begin
      Start := NextLinebreak (Start);
      if ((Start = TEXTBUFFERSIZE) and (Buffer^[Start] <> Linebreak)) then
         Start := 0
      else Inc (i);
      end;

   { If lines have been skipped then Start
     points to the LineBreak character in the last
     line skipped, so increment it. }
   if (Start <> Head) then
      Inc (Start);

   { Display the lines }
   XPos         := XOffSet;
   LineCount    := 0;

   { Ensure we don't go past the end of the buffer }
   if (Bottom > Pred (Lines)) then
      Bottom := Pred (Lines);
   LinesPerPage := Bottom - Top + 1;

   { Loop }
   while (LineCount < LinesPerPage) do begin
      LineEnd := NextLineBreak (Start);
      Count   := Succ (LineEnd - Start);    { bytes in line }
      Move (Buffer^[Start], S[0], Count);   { move line to display buffer }

      if S[Pred(Count)] = LineBreak then
         S[Count-2] := #0
      else S[Count] := #0;

      TabbedTextOut (DC, XPos, LineCount * Height + Offset, S, StrLen(S), 0, TabSPosn, 0);

      { If we're at the end of the buffer but not at the
        end of a line of text, then we need to add the next
        bit of text at the end of the current line. }
      if ((LineEnd = TEXTBUFFERSIZE) and
         (Buffer^[TEXTBUFFERSIZE] <> LineBreak)) then begin
         Xpos  := LoWord (GetTextExtent (DC, S, StrLen(s))) + XOffSet;
         Start := 0;   { go to start of buffer to complete this line }
         end
      else begin
         Inc (LineCount);
         XPos  := XOffSet;
         Start := Start + Count;               { next line }
         end;
      end; { while LineCount }
end;

{-----------------------------UpDate---------------------------------------}

{ Hook for program to update the display after
  user has performed an analysis. Calls the
  Windows API procedure UpdateWindow which
  sends wm_Paint message to the display window,
  then adjusts the window's scroller. }
procedure TEXTBUFFER.UpDate;
begin
  with DisplayWindow^ do begin
     { Paint window }
     UpdateWindow (HWindow);
     { Adjust scroller range }
     if (Lines > Scroller^.YPage) then
        Scroller^.SetRange (LINEBUFFERSIZE, Lines-Scroller^.YPage);
     end;
end;

{-----------------------------CanClear-------------------------------------}

{ Returns a Boolean value indicating whether or not it is Ok to clear
  the LogWindow text.  Returns True if the log buffer has not been
  changed, or if Oks the clearing of the text. }
function TEXTBUFFER.CanClear: Boolean;
var
  S         : array[0..fsPathName+27] of Char;
  P         : PChar;
  Rslt      : Integer;
  LogDialog : PFileDialog;
  f         : text;
begin
  CanClear := True;
  if IsModified and not Echo then begin
     { Buffer has been changed, and user hasn't been echoing
       to disk. }
     Rslt := BWCCMessageBox (DisplayWindow^.HWindow,
      'The contents of the display buffer will be lost unless saved. Save?',
      szProgName, mb_IconQuestion or mb_YesNoCancel);
     case Rslt of
       id_No:
          CanClear := True;
       id_Cancel:
          CanClear := False;
       id_Yes:
        begin
           LogDialog := new(PFileDialog, Init(DisplayWindow, 'LOG_SAVE_FILE_DIALOG',
                  StrCopy (s, '*.out')));
           if Application^.ExecDialog(LogDialog) = id_OK then begin
              {$I-}
              Assign (f, s);
              Rewrite (f);
              {$I+}
              ErrorRec.UpDate (IOResult);
              if ErrorRec.NotOK then
                 CanClear := False;
              Show (f);
              {$I-}
              Close (f);
              {$I+}
              ErrorRec.UpDate (IOResult);
              CanClear := (not ErrorRec.NotOK);
              end
           else CanClear := False;
           end;
       end; { case }
    end;
end;
{$ENDIF} {WINDOWS}

{$IFNDEF DEVICE}
{**************************** No Device ***********************************}

{-----------------------------Insert---------------------------------------}

{ Insert the current working line buffer into the display buffer }
procedure TEXTBUFFER.Insert;
var
   S: ABUFFER;
begin
   Aline.NullLineString (S);
   InsertText (S);
end;


{$IFDEF WINDOWS}

{ This next part of the code is generally applicable,
  but for now MS DOS code simply writes buffer to "output,"
  so I've provided separate code for Windows. }

{-----------------------------InsertNewLine--------------------------------}

{ Insert a blank line into the text buffer }
procedure TEXTBUFFER.InsertNewLine;
var
   S: ABUFFER;
begin
   S[0] := #13;      { CR }
   S[1] := #10;      { LF }
   S[2] := #0;       { \0 }
   InsertText (S);
end;

{-----------------------------InsertATitle---------------------------------}

{ Insert a title string into the display buffer }
procedure TEXTBUFFER.InsertATitle (ATitle:string);
begin
   ALine.Clear;
   ALine.AppendString (ATitle);
   Insert;
end;

{-----------------------------InsertLineBuffer-----------------------------}

{ Insert text from a line buffer object into the display buffer }
procedure TEXTBUFFER.InsertLineBuffer (var L: BUFFEROBJ);
var
   S: ABUFFER;
begin
   L.NullLineString(S);
   InsertText (S);
end;

{$ENDIF} {WINDOWS}

{-----------------------------MSDOS code-----------------------------------}

{ Temporary until MSDOS version has it's own display window }

{$IFDEF MSDOS}

{-----------------------------InsertATitle---------------------------------}

procedure TEXTBUFFER.InsertATitle (ATitle: string);
begin
   ALine.Clear;
   ALine.AppendString (ATitle);
   ALine.Show;
end;

{-----------------------------InsertNewLine--------------------------------}

procedure TEXTBUFFER.InsertNewLine;
begin
   ALine.NewLine;
end;

{-----------------------------InsertLineBuffer-----------------------------}

procedure TEXTBUFFER.InsertLineBuffer (var L:BUFFEROBJ);
begin
   L.Show;
end;

{$ENDIF} {MSDOS}

{**************************** No Device ***********************************}
{$ENDIF} {NO DEVICE}



procedure TEXTBUFFER.StartStopWatch;
begin
  GetClock (StartTime);
end;

procedure TEXTBUFFER.ShowElapsedTime;
begin
   StopClock (StartTime, ElapsedTime);
   writeln (NewLog);
   writeln (Newlog, 'Time used: ' + TimeToStr (ElapsedTime));
   writeln (NewLog);
end;

function TEXTBUFFER.BytesInBuffer:word;
begin
   if (Tail > Head) then
      BytesInBuffer := Tail - Head
   else BytesInBuffer := TEXTBUFFERSIZE;
end;



end.