cpwtwin2.pas

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

         if (ChkBinary or ChkOutGrp) then begin

            OldCursor := SetCursor (LoadCursor (0, idc_Wait));

            Counter := new(PCounterDialog, Init
                        (Parent, 'CHECK_OUTGRP_DIALOG'));
            Application^.MakeWindow (Counter);
            SendMessage (Parent^.HWindow, um_Working, 0, 0);
            UpDate (ChkBinary, ChkOutGrp, NewOutGrp);

            EnableWindow (Parent^.HWindow, True);
            Counter^.Destroy;
            SetCursor (OldCursor);
            end;

         { Check affects of new leaves on outgroup }
         if ChkOutGrp and not OutGroupOK then begin
            { Outgroup no longer valid, either pruned off
              or restored leaves make it impossible to root
              some trees. UnRoot the trees. }
            BWCCMessageBox (Parent^.HWindow,
                'No longer able to root trees with outgroup.',
                'COMPONENT',mb_IconInformation);
            EnableMenuItem (GetMenu(Parent^.HWindow), cm_OutgroupRooted,
               mf_Grayed or mf_ByCommand);
            if (GetRoot = rOUTGROUP) then
               Root (rUNROOTED);
            end;
         end;
      { Update tree display }
      Update;
      end;
end;

{----------------------------CMTreesStatistics------------------------------}

procedure TreeWindow.CMTreesStatistics (var Msg:TMessage);
var
   H: HISTPTR;
begin
   OpenDisplayBox ('TREES_STATISTICS_INFO_DIALOG');
   ErrorRec.Init;
   H := NIL;
   writeln (NewLog);
   writeln (NewLog, 'COMMAND: Trees Statistics');
   writeln (NewLog);
   P^.CurBlock^.Statistics (H);
   CleanUpDisplayBox;
   DisplayBuffer.UpDate;
   if (H <> NIL) then begin
       H^.SetCaptions ('Topology','Trees','Distribution of tree topologies');
       Application^.ExecDialog (new(PHistDlg,
         Init (@Self, 'HISTOGRAM_DIALOG',H)));
       Dispose (H);
       end;
end;

{----------------------------CMTreesSave-----------------------------------}

procedure TreeWindow.CMTreesSave (var Msg: TMessage);
type
   ExportBuffer = record
      ComboStrings : PStrCollection;
      ComboSel     : array[0..20] of char;
      end;
var
   FileName  : array[0..fsPathName] of char;
   TheDialog : PExportDialog;
   ExportBuf : ExportBuffer;
   PC        : PComboBox;
   Format    : word;
begin
   StrCopy (FileName, '*.NEX');
   TheDialog := new(PExportDialog, Init(@Self, 'TREES_EXPORT_DIALOG',
                    FileName, HELPID_TREES_SAVE_DIALOG));
   with ExportBuf do begin
      ComboStrings := new(PStrCollection, Init (10, 1));
      with ComboStrings^ do begin
         Insert (StrNew ('NEXUS'));
         Insert (StrNew ('Hennig86 tree file'));
         Insert (StrNew ('NEXUS (TREES block)'));
         if P^.CurBlock^.IsFlag (pr_ALLBINARY) then begin
            Insert (Strnew ('FREQPARS'));
            Insert (StrNew ('PHYLIP'));
            end;
         end;
      StrCopy (ComboSel, 'NEXUS');
      end;
   New(PC, InitResource(TheDialog, 105, 20));
   TheDialog^.TransferBuffer := @ExportBuf;

   { Execute }
   if Application^.ExecDialog(TheDialog) = id_Ok then begin
      case ExportBuf.ComboSel[0] of
         'F': Format := frmt_FREQPARS;
         'H': Format := frmt_HENNIG86;
         'N': begin
                 if (StrPos (ExportBuf.ComboSel, 'TREES') <> NIL) then
                    Format := frmt_NEXUS_TABLE
                 else Format := frmt_DEFAULT;
              end;
         'P': Format := frmt_PHYLIP;
         else
            Format := frmt_DEFAULT;
         end;

     writeln (NewLog);
     writeln (NewLog, 'COMMAND: Trees Save to file ', StrUpper (FileName));
     writeln (NewLog);
     writeln (NewLog, '   File format = ', ExportBuf.ComboSel);
     writeln (NewLog);

     { Set up display box }
     OpenDisplayBox ('WRITE_TREES_INFO_DIALOG');
     P^.CurBlock^.WriteTrees (StrPas(FileName), NIL,Format);
     CleanUpDisplayBox;
     DisplayBuffer.UpDate;
     end;
end;

{-----------------------------CMSelect-------------------------------------}

{ Let user select a range of trees }
procedure TreeWindow.CMTreesSelect (var Msg: TMessage);
type
   SelectTreeBuffer = record
      Radio1,
      Radio2   : word;
      TheRange : array[0..2042] of char;
      end;
var
   TheDialog : PSelectTreesDialog;
   P1, P2    : PRadioButton;
   PN1       : PRangeEdit;
   SelectBuf : SelectTreeBuffer;
begin
   with P^.CurBlock^, SelectBuf do
     if (GetRange (TheRange, SizeOf (TheRange) - 1) < 0) then
        MessageBox (HWindow,
           'The current selection is too large to be displayed.',
           'Warning', mb_IconInformation);

  TheDialog := new(PSelectTreesDialog, Init (@Self, 'SELECT_TREES_DIALOG',
               HELPID_TREES_SELECT_DIALOG));
  P1 := new (PRadioButton, InitResource (TheDialog, id_ShowAll));
  P2 := new (PRadioButton, InitResource (TheDialog, id_ShowFromTo));
  PN1 := new (PRangeEdit, InitResource (TheDialog, id_From, 255, 1,
                    P^.CurBlock^.TotalTrees));

  with SelectBuf, P^.CurBlock^ do begin
     if (TotalTrees = Trees) then begin
        Radio1 := bf_Checked;
        Radio2 := bf_UnChecked;
        end
     else begin
        Radio1 := bf_UnChecked;
        Radio2 := bf_Checked;
        end;
{     GetRange (TheRange);}
     end;

  TheDialog^.TransferBuffer := @SelectBuf;
  if Application^.ExecDialog (TheDialog) = id_OK then begin
     writeln (NewLog);
     writeln (NewLog, 'COMMAND: Trees Select');
     writeln (NewLog);

     with SelectBuf do begin
        if ((Radio1 and bf_Checked) = bf_Checked) then begin
           P^.CurBlock^.B.SwitchAllTreesOn;
           writeln (NewLog, 'All ', P^.CurBlock^.Trees,' trees are now active.');
           end
        else begin
           writeln (NewLog, 'Selection: ',TheRange);
           P^.CurBlock^.SelectTrees (TheRange);
           writeln (newlog, P^.CurBlock^.Trees, ' tree(s) are now active.');
           end;
        end;

     { Update tree information. }
     OpenDisplayBox ('CHECK_OUTGRP_DIALOG');
     with P^.CurBlock^ do
        Update (True, (A.AOutgroup.cardinality > 2),
                    A.AOutgroup);
     EnableWindow (Parent^.HWindow, True);
     Counter^.Destroy;
     DisplayBuffer.ShowElapsedTime;

     UpDateParentMenu;
     if (P^.CurBlock^.Trees> 1) then
        SendMessage (Parent^.HWindow, um_EnableT2T, 1, 0)
     else SendMessage (Parent^.HWindow, um_EnableT2T, 0, 0);
     Update;
     DisplayBuffer.UpDate;
     end;
end;

{-----------------------------CompareTreeWith------------------------------}

procedure TreeWindow.CompareTreeWith (var Msg: TMessage);
type
   CompareBuffer = record
      Check1,
      Check2,
      Check3,
      Check4,
      Check5 : word;
      CfTree: longint;
      end;
var
   TheDialog  : PDialog;
   P1, P2, P3,
   P4, P5     : PCheckBox;
   PN1        : PExcludeNumEdit;
   T2         : longint;
   CompareBuf : CompareBuffer;
   Methods    : word;
begin
  { Local defaults }
  with CompareBuf do begin
     Check1 := bf_Checked;
     Check2 := bf_UnChecked;
     Check3 := bf_UnChecked;
     Check4 := bf_UnChecked;
     Check5 := bf_UnChecked;
     if (P^.GetCurTreeNum = 1) then
        CfTree := 2
     else CfTree := 1;
     end;

  { Ensure available methods are appropriate }
  Methods := 0;
  if not P^.CurBlock^.IsFlag (pr_AllBinary) then
     Methods := Methods or tc_NNI or tc_Subtree;
  TheDialog := new(PCTWDialog, Init (@Self, 'COMPARE_TREE_WITH_DIALOG',
                                     HELPID_TREES_COMPARE_WITH_DIALOG,
                                     methods));
  P1 := new (PCheckBox, InitResource (TheDialog, id_Partitions));
  P2 := new (PCheckBox, InitResource (TheDialog, id_Triplets));
  P3 := new (PCheckBox, InitResource (TheDialog, id_Quartets));
  P4 := new (PCheckBox, InitResource (TheDialog, id_NNI));
  P5:= new (PCheckBox, InitResource (TheDialog, id_GSubTree));
  with P^ do
     PN1 := new (PExcludeNumEdit, InitResource (TheDialog, id_Tree, 7, 1,
                 CurBlock^.TotalTrees,GetCurTreeNum));
  TheDialog^.TransferBuffer := @CompareBuf;

  if Application^.ExecDialog (TheDialog) = id_OK then begin
     Methods := 0;
     with CompareBuf do begin
        if ((Check1 and bf_Checked) = bf_Checked) then
           Methods := Methods or tc_Partitions;
        if ((Check2 and bf_Checked) = bf_Checked) then
           Methods := Methods or tc_Triplets;
        if ((Check3 and bf_Checked) = bf_Checked) then
           Methods := Methods or tc_Quartets;
        if ((Check4 and bf_Checked) = bf_Checked) then
           Methods := Methods or tc_NNI;
        if ((Check5 and bf_Checked) = bf_Checked) then
           Methods := Methods or tc_Subtree;
        T2 := CfTree;
        end;

     if (Methods = 0) then
        Exit;

     { Set up display box }
     OpenDisplayBox ('CTW_INFO_DIALOG');
     Counter^.UpDateText (id_Status, 'Comparing');
     writeln (NewLog);
     Writeln (NewLog, 'COMMAND: Trees Compare tree with');
     writeln (NewLog);
     with P^ do
        CurBlock^.CompareTwoTrees (GetCurTreeNum, T2, Methods);
     CleanUpDisplayBox;
     DisplayBuffer.UpDate;
     end;
end;




{$IFDEF MACWIN}

{-----------------------------WMCreate-------------------------------------}

{ Override WMCreate to ensure that when window is created it
  displays arrow cursor. }
procedure TreeWindow.WMCreate (var Msg:TMessage);
begin
   TWindow.WMCreate (Msg);
   CurrentCursor := LoadCursor (0, idc_Arrow);
   SetCursor (CurrentCursor);
end;

{-----------------------------SetMode--------------------------------------}

procedure TreeWindow.SetMode (NewMode:integer);
var
   TextPtr      : PChar;
   UndoMenuText : array[0..50] of char;
   M            : HMenu;
begin
   { Toggle cursor }
   Mode := NewMode;
   case Mode of
      cm_MOVE        : CurrentCursor := LoadCursor (0, idc_Arrow);
      cm_BRANCH      : CurrentCursor := LoadCursor (HInstance, 'BRANCH_CURSOR');
      cm_COLLAPSE    : CurrentCursor := LoadCursor (HInstance, 'CLADE_CURSOR');
      cm_REROOT      : CurrentCursor := LoadCursor (HInstance, 'REROOT_CURSOR');
      cm_LADDERLEFT  : CurrentCursor := LoadCursor (HInstance, 'LADDER_LEFT');
      cm_LADDERRIGHT : CurrentCursor := LoadCursor (HInstance, 'LADDER_RIGHT');
      cm_EXCHANGE    : CurrentCursor := LoadCursor (HInstance, 'EXCHANGE_CURSOR');
      cm_FLIP        : CurrentCursor := LoadCursor (HInstance, 'FLIP_CURSOR');
      cm_ZOOM        : CurrentCursor := LoadCursor (HInstance, 'ZOOM_CURSOR');
      end;
   SetCursor (CurrentCursor);


   { Toggle Undo command. Ensure appropriate text is displayed
     and Undo command is disabled. }
   case Mode of
      cm_MOVE:     StrCopy (UndoMenuText, '&Undo branch move');
      cm_BRANCH:   StrCopy (UndoMenuText, '&Undo branch collapse');
      cm_COLLAPSE: StrCopy (UndoMenuText, '&Undo clade collapse');
      cm_REROOT:   StrCopy (UndoMenuText, '&Undo rerooting');
      else         StrCopy (UndoMenuText, '&Undo');
      end;
   StrCat (UndoMenuText, #9);
   StrCat (UndoMenuText, 'Alt+BkSp');
   M := GetMenu (Parent^.HWindow);
   ModifyMenu (M, cm_EditUndo, mf_ByCommand or mf_String,
                cm_EditUndo, UndoMenuText);
   EnableMenuItem (M, cm_EditUndo,
                   mf_Grayed or mf_ByCommand);

   { Display appropriate status message. }
   if TreeExpanded and (Mode = cm_ZOOM) then
      { Load the "Shrink clade" string. }
      LoadString (HInstance, cm_ZOOM+1, StatusStr, MsgLength)
   else LoadString (HInstance, Mode, StatusStr, MsgLength);
   TextPtr := StatusStr;
   SendMessage (Parent^.HWindow, FW_StatusBarUpDate, 0, longint(TextPtr));
end;


{-----------------------------RepaintBranch--------------------------------}

procedure TreeWindow.RepaintBranch (DC:HDC; Brush: HBrush; Node:NODE_PTR);
var
   OldBrush : HBrush;
begin
   OldBrush := SelectObject (DC, Brush);
   { Plot }
   Node^.Plot (DC, tp_Slant);
   Brush := SelectObject(DC, OldBrush);
   DeleteObject (Brush);
end;

{-----------------------------WMMouseMove----------------------------------}

{ Handle wm_MouseMove messages. This is where
  we handle dragging a line over the screen. }
procedure TreeWindow.WMMouseMove(var Msg: TMessage);
var
   Oldr2 : integer;
   R     : TRect;
   TP    : TPoint;
   Node  : NODE_PTR;
   DC    : HDC;
   Flash : Boolean;
   xm, ym: integer;
begin
   if InEditMode and (TheTree <> NIL) then begin
      { If mouse is over a branch and that branch can be
        manipulated with the current tool, and the mouse
        button isn't pressed down, then "flash" the branch. }
      if FlashOn and not ButtonDown then begin
         xm := Integer(Msg.LParamLo);
         ym := Integer(Msg.LParamHi);
         Node := TheTree^.MouseOnBranch (xm, ym);
         if (Node <> NIL) or (FlashBranch <> NIL) then begin
            DC := GetDC (HWindow);
            if (FlashBranch <> NIL) and (Node <> FlashBranch) then
               RepaintBranch (DC,
                  CreateSolidBrush (GetSysColor(color_WindowText)),
                  FlashBranch);
				if (Node <> NIL) then begin
               case Mode of
                  cm_MOVE        :  Flash := (Node <> TheTree^.Root);
                  cm_BRANCH      :  Flash := Node^.IsFlag (tn_INTERNAL)
                                             and (Node <> TheTree^.Root);
                  cm_COLLAPSE    :  Flash := (Node^.GetWeight <> Node^.NodeDegree)
                                             and Node^.IsFlag(tn_INTERNAL);
                  cm_FLIP        :  Flash := Node^.IsBinary and Node^.IsFlag(tn_Internal);
                  cm_REROOT      :  Flash := (Node <> TheTree^.Root) and
                                             (Node^.anc <> TheTree^.Root);
                  cm_LADDERLEFT,
                  cm_LADDERRIGHT :  Flash := (Node^.GetWeight > 2);
                  cm_EXCHANGE    :  Flash := (Node <> TheTree^.Ro