cpwedit.pas

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

  if FileName = nil then P[1] := '(Untitled)'
  else P[1] := AFileName;
  if Attr.Title = nil then SetWindowText(HWindow, P[1])
  else
  begin
    WVSPrintF(NewCaption, '%0.40s - %0.37s', P[0]);
    SetWindowText(HWindow, NewCaption);
  end;
end;

{-----------------------------NewFile--------------------------------------}

{ Begins the edit of a new file, after determining that it is Ok to
  clear the TEdit's text. }
procedure BaseEditWindow.NewFile;
begin
  if CanClear then
  begin
    Editor^.Clear;
    InvalidateRect(Editor^.HWindow, nil, False);
    Editor^.ClearModify;
    IsNewFile := True;
    SetFileName(nil);
  end;
end;

{-----------------------------ReplaceWith----------------------------------}

{ Replaces the current file with the given file. }
procedure BaseEditWindow.ReplaceWith(AFileName: PChar);
begin
  SetFileName(AFileName);
  Read;
  InvalidateRect(Editor^.HWindow, nil, False);
end;

{-----------------------------Open-----------------------------------------}

{ Brings up a dialog allowing the user to open a file into this
  window.  Save as selecting File|Open from the menus. }
procedure BaseEditWindow.Open;
var
  TmpName: array[0..fsPathName] of Char;
begin
  if CanClear and (Application^.ExecDialog(New(PFileDialog,
     Init(@Self, PChar(sd_FileOpen), StrCopy(TmpName, '*.*')))) = id_Ok) then
    ReplaceWith(TmpName);
end;

{-----------------------------Read-----------------------------------------}

{ Reads the contents of a previously-specified file into the TEdit
  child control. }
procedure BaseEditWindow.Read;
const
  BufferSize = 1024;
var
  CharsToRead: LongInt;
  BlockSize: Integer;
  AStream: PDosStream;
  ABuffer: PChar;
begin
  AStream := New(PDosStream, Init(FileName, stOpen));
  ABuffer := MemAlloc(BufferSize + 1);
  CharsToRead := AStream^.GetSize;
  if ABuffer <> nil then
  begin
    Editor^.Clear;
    while CharsToRead > 0 do
    begin
      if CharsToRead > BufferSize then
        BlockSize := BufferSize
      else BlockSize := CharsToRead;
      AStream^.Read(ABuffer^, BlockSize);
      ABuffer[BlockSize] := Char(0);
      Editor^.Insert(ABuffer);
      CharsToRead := CharsToRead - BlockSize;
    end;
    IsNewFile := False;
    Editor^.ClearModify;
    Editor^.SetSelection(0, 0);
    FreeMem(ABuffer, BufferSize + 1);
  end;
  Dispose(AStream, Done);
end;

{-----------------------------Save-----------------------------------------}

{ Saves the contents of the TEdit child control into the file currently
  being editted.  Returns true if the file was saved. }
function BaseEditWindow.Save: Boolean;
begin
  Save := True;
  if Editor^.IsModified then
    if IsNewFile then Save := SaveAs
    else Write;
end;

{-----------------------------SaveAs---------------------------------------}

{ Saves the contents of the TEdit child control into a file whose name
  is retrieved from the user, through execution of a "Save" file
  dialog.  Returns true if the file was saved. }
function BaseEditWindow.SaveAs: Boolean;
var
  TmpName: array[0..fsPathName] of Char;
begin
  SaveAs := False;
  if FileName <> nil then StrCopy(TmpName, FileName)
  else StrCopy (TmpName, '*.NEX');
  if Application^.ExecDialog(New(PTreesSaveDlg,
		Init(@Self, PChar(sd_FileSave), TmpName, nil))) = id_Ok then
     begin
     SetFileName(TmpName);
     Write;
     SaveAs := True;
     end;
end;

{-----------------------------Write----------------------------------------}

{ A complete rewrite of TFileWindow.Write, which seems to have some
  bugs, at least when I used it in cpw.pas.

  Editor^.GetLineLength returns the number of characters before
  the CR/LF linebreak, hence for a blank line it returns 0.

  If file is executable then the parent window is notified.
}
procedure BaseEditWindow.Write;

var
   CharsToWrite : integer;
   NumLines     : Integer;
   ATextString  : array[0..500] of char;
   Line         : integer;
   f            : text;
begin
  NumLines := Editor^.GetNumLines;
  if (NumLines > 0) then begin
     assign (f, FileName);
     rewrite (f);
     for Line := 0 to Pred(NumLines) do begin            { lines are 0..n-1 }
        CharsToWrite := Editor^.GetLineLength (Line);
        if (CharsToWrite = 0) then
           writeln (f)
        else
           { Remember to allow for #0 in string, hence the +1 }
           if Editor^.GetLine (ATextString, CharsToWrite + 1, Line) then
              writeln (f, ATextString);
        end;
     Editor^.ClearModify;
     IsNewFile := False;
     close (f);

     { Text has been saved, so notify parent }
     UpDateParent;
     end;
end;

{-----------------------------Print----------------------------------------}

{ Print contents of edit window }
procedure BaseEditWindow.Print (FromLine, ToLine:integer);
var
   ATextString  : array[0..500] of char;
   tm: TTextMetric;
   yChar,
   nTotalLines,
   nLine, nLineNum,
   nLinesperPage,
   nPage,
   nCharsPerLine,
   nTotalPages : integer;
   PrinterDC : HDC;
   lpfnPrintDlgProc,
   lpfnAbortProc : TFarProc;
begin
   nTotalLines := Succ (ToLine - FromLine);
   if (nTotalLines > 0) then begin
      bError    := False;
      PrinterDC := DefPrinterDC;
      if (PrinterDC = 0) then
         bError := True
      else begin
         { Use font info to calculate how many lines can fit on
           a page. }
         GetTextMetrics (PrinterDC, tm);
         yChar         := tm.tmheight + tm.tmExternalLeading;
         nLinesPerPage := GetDeviceCaps (PrinterDC, VERTRES) div yChar;
         nTotalPages   := (nTotalLines + nLinesPerPage - 1) div nLinesPerPage;

         { Set up abort proc }
         EnableWindow (Parent^.HWindow, False);
         bUserAbort       := False;
         lpfnPrintDlgProc := MakeProcInstance(@PrintDlgProc, HInstance);
         hDlgPrint        := CreateDialog (HInstance, 'PRINT_DIALOG',
                                           HWindow, lpfnPrintDlgProc);

         lpfnAbortProc    := MakeProcInstance(@AbortProc, HInstance);
         Escape (PrinterDC, SetAbortProc, 0, lpfnAbortProc, NIL);

         { Start printing }
         if Escape (PrinterDC, StartDoc,
            StrLen (szAppName), szAppName, NIL) > 0 then begin
            nLineNum := 0;
            nPage    := 0;
            while (nPage < nTotalPages) and not bError and not bUserAbort
               do begin
               nLine := 0;
               { Print one page }
               while (nLine < nLinesPerPage) and (nLineNum < nTotalLines) do begin
                  nCharsPerLine := Editor^.GetLineLength (FromLine + nLineNum);
                  Editor^.GetLine (ATextString, nCharsPerLine + 1, FromLine + nLineNum);
                  TextOut (PrinterDC, 0, yChar * nLine, ATextString, StrLen(ATextString));
                  Inc (nLine);
                  Inc (nLineNum);
                  end;
               { Next page }
               Inc (nPage);
               bError := (Escape (PrinterDC, NewFrame, 0, Nil, Nil) < 0);
               end;
            end
         else bError := True;

         { if OK then finish job }
         if not bError then
            Escape (PrinterDC, EndDoc, 0, Nil, Nil);

         { If user didn't abort then remove dialog box }
         if not bUserAbort then begin
            EnableWindow (Parent^.HWindow, True);
            DestroyWindow (hDlgPrint);
            end;

         { clean up }
         FreeProcInstance (lpfnPrintDlgProc);
         FreeProcInstance (lpfnAbortproc);
         DeleteDC (PrinterDC);
         end; { if PrinterDC <> 0 }

      { Report any errors }
      if bError then
         BWCCMessageBox (HWindow,'Could not print edit window.',
            'COMPONENT', mb_IconInformation);
      end; { if nTotalLines > 0 }
end;

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

{ Returns a Boolean value indicating whether or not it is Ok to clear
  the TEdit's text.  Returns True if the text has not been changed, or
  if the user Oks the clearing of the text. }
function BaseEditWindow.CanClear: Boolean;
var
  AMsg : array[0..128] of char;
  P    : PChar;
  Rslt : Integer;
begin
   CanClear := True;
   if Editor^.IsModified then begin
      if FileName = nil then
         StrCopy(AMsg, 'Untitled file has changed. Save?')
      else begin
         P := FileName;
         WVSPrintF(AMsg, 'File "%s" has changed.  Save?', P);
         end;
      Rslt := BWCCMessageBox (HWindow, AMsg, 'COMPONENT', mb_IconQuestion or mb_YesNoCancel);
      if (Rslt = id_Yes) then
         CanClear := Save
      else CanClear := (Rslt <> id_Cancel);
      end;
end;

{-----------------------------CanClose-------------------------------------}

{ Returns a Boolean value indicating whether or not it is Ok to close
  the TEdit's text.  Returns the result of a call to Self.CanClear. }
function BaseEditWindow.CanClose: Boolean;
begin
  CanClose := CanClear;
end;

{-----------------------------CMFileSave-----------------------------------}

{ Responds to an incoming "Save" command (with a cm_FileSave command
  identifier) by calling Self.Save. }
procedure BaseEditWindow.CMFileSave(var Msg: TMessage);
begin
  Save;
end;

{-----------------------------CMFileSaveAs---------------------------------}

{ Responds to an incoming "SaveAs" command (with a cm_FileSaveAs command
  identifier) by calling Self.SaveAs. }
procedure BaseEditWindow.CMFileSaveAs(var Msg: TMessage);
begin
  SaveAs;
end;

{-----------------------------CMFilePrint----------------------------------}

{ Print all the text. }
procedure BaseEDitWindow.CMFilePrint (var Msg:TMessage);
begin
   Print (0, Editor^.GetNumLines - 1);
end;

{-----------------------------CMFilePrintSelection-------------------------}

{ Print the currently lines containing the currently selected text. }
procedure BaseEDitWindow.CMFilePrintSelection (var Msg:TMessage);
var
   StartSel, EndSel: integer;
begin
   Editor^.GetSelection (StartSel, EndSel);
   if (StartSel <> EndSel) then
      Print (Editor^.GetLineFromPos (StartSel),
             Editor^.GetLineFromPos (EndSel));
end;


{-----------------------------WMMDIActivate--------------------------------}

{ Inform parent that window is active. }
procedure BaseEditWindow.WMMDIActivate (var Msg:TMessage);
begin
   if (Msg.wParam <> 0) then begin
      DefMDIChildProc (HWindow, Msg.Message, Msg.wParam, Msg.lParam);
      SendMessage (Parent^.HWindow, um_EditWindow, 0,0);
      UpdateParent;
      end
   else begin
     SendMessage (Parent^.HWindow, um_UpDateExecute, 0, 0);
     DefMDIChildProc (HWindow, Msg.Message, Msg.wParam, Msg.lParam);
     end;
end;

{-----------------------------ExecutableFile-------------------------------}

{ Abstract, override in descendants }
function BaseEditWindow.ExecutableFile:Boolean;
begin
   ExecutableFile := False;
end;

{-----------------------------UpDateParent---------------------------------}

procedure BaseEditWindow.UpDateParent;
begin
   Editor^.UpDatePosn;
end;

{*****************************MyEditWindow*********************************}

{-----------------------------ExecutableFile-------------------------------}

{ If the editor is not empty, and its first
  line is '#NEXUS' and it has been saved then
  file can be executed. }
function MyEditWindow.ExecutableFile:Boolean;
var
   ATextString:array[0..80] of char;
begin
   ExecutableFile := False;
   if (Editor^.GetNumLines > 0) then
      if (Editor^.GetLine (ATextString, Sizeof (ATextString) - 1,0))
         then begin
         StrUpper (ATextString);
         ExecutableFile := (StrPos (ATextString, NexusHeader) <> NIL);
         end;
end;

{-----------------------------UpDateParent---------------------------------}

{ Ensure File|Execute command is correct:
  If the window holds a saved NEXUS file
  (either because it has been loaded from disk or
  the user has saved it, then pass to the parent
  the um_UpDateExecute message, the handle
  of the edit window, and the name of the file
  being edited. Otherwise just send the um_UpDateExecute
  message which causes the File|Execute command to be
  grayed.
}
procedure MyEditWindow.UpDateParent;
begin
   BaseEditWindow.UpDateParent;
   if ExecutableFile then
      { Send window handle and file name }
      SendMessage (Parent^.HWindow, um_UpDateExecute,
                   Editor^.HWindow, longint(FileName))
   else
      { Clear window handle and file name }
      SendMessage (Parent^.HWindow, um_UpDateExecute, 0, 0);
end;

{-----------------------------WMDestroy------------------------------------}

{ Tell parent to clean up File|Execute command by
  sending um_UpDateExecute message with wParam=lParam=0 }
procedure MyEditWindow.WMMDIDestroy (var Msg: TMessage);
begin
   SendMessage (Parent^.HWindow, um_UpDateExecute, 0, 0);
   DefWndProc (Msg);
end;

{-----------------------------GetWindowClass-------------------------------}

{ Use editor icon. }
procedure MyEditWindow.GetWindowClass (var AWndClass:TWndClass);
begin
   BaseEditWindow.GetWindowClass (AWndClass);
   { Load icon here }
   AWndClass.hIcon := LoadIcon(HInstance, 'EDITWINDOW_ICON');
end;

{-----------------------------GetClassName---------------------------------}

function MyEditWindow.GetClassName:PChar;
begin
   GetClassName := 'MyEditWindow';
end;

end.