cpwtwin2.pas

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

var
   ShowBuf         : ShowTreeBuf;
   TheDialog       : PSelectTreesDialog;
   P1, P2, P3, P4  : PCheckBox;
   PN1, PN2        : PNumEdit;
   T1, T2          : longint;
   Compress,
   IncludeInactive : Boolean;
begin
  { Defaults }
  ShowBuf.Radio1   := bf_Checked;
  ShowBuf.Radio2   := bf_UnChecked;
  ShowBuf.Check1   := bf_UnChecked;
  ShowBuf.Check2   := bf_UnChecked;
  ShowBuf.FromTree := 1;
  ShowBuf.ToTree   := P^.CurBlock^.TotalTrees;
  TheDialog := new(PSelectTreesDialog, Init (@Self, 'SHOW_TREES_DIALOG',
                      HELPID_TREES_SHOW_DIALOG));
  P1 := new (PRadioButton, InitResource (TheDialog, id_ShowAll));
  P2 := new (PRadioButton, InitResource (TheDialog, id_ShowFromTo));
  P3 := new (PRadioButton, InitResource (TheDialog, id_Compress));
  P4 := new (PRadioButton, InitResource (TheDialog, id_IncludeInactive));
  PN1 := new (PNumEdit, InitResource (TheDialog, id_From,
              7, 1, P^.CurBlock^.TotalTrees));
  PN2 := new (PNumEdit, InitResource (TheDialog, id_To,
              7, 1, P^.CurBlock^.TotalTrees));
  TheDialog^.TransferBuffer := @ShowBuf;
  if Application^.ExecDialog (TheDialog) = id_OK then begin
     with ShowBuf do begin
        Compress        := ((Check1 and bf_Checked) = bf_Checked);
        IncludeInactive := ((Check2 and bf_Checked) = bf_Checked);
        if ((Radio1 and bf_Checked) = bf_Checked) then begin
           T1 := 1;
           T2 := P^.CurBlock^.TotalTrees;
           end
        else begin
           T1 := min (FromTree, ToTree);
           T2 := max (FromTree, ToTree);
           end;
        end;

     OpenDisplayBox ('SHOW_TREES_INFO_DIALOG');
     writeln (NewLog);
     writeln (NewLog, 'COMMAND: Trees Show');
     writeln (NewLog);
     P^.CurBlock^.ShowTrees (T1, T2, Compress, IncludeInactive);
     CleanUpDisplayBox;
     DisplayBuffer.UpDate;
     end;
end;

{----------------------------CMTreesRemoveDuplicates-----------------------}

procedure TreeWindow.CMTreesRemoveDuplicates (var Msg: TMessage);
var
   Result       : integer;
   WasAllBinary : Boolean;
   OldCursor    : HCursor;
begin
  WasAllBinary := P^.CurBlock^.IsFlag (pr_AllBinary);
  OpenDisplayBox ('REMOVE_DUPLICATES_INFO_DIALOG');
  writeln (NewLog);
  writeln (NewLog, 'COMMAND: Trees Remove Duplicates');
  writeln (NewLog);
  Result := P^.CurBlock^.RemoveDuplicates;
  CleanUpDisplayBox;
  DisplayBuffer.UpDate;
  case Result of
     -1: { no memory }
         begin
            MessageBox (HWindow, 'Insufficient memory', 'Error',
               mb_IconInformation); 
         end;
      0: { no duplicate trees found }
         begin
         end;
      else begin
         { duplicate trees were found }


         if (P^.CurBlock^.A.AOutgroup.Cardinality > 2) then begin
            { check outgroup }

            OldCursor := SetCursor (LoadCursor (0, idc_Wait));
            OpenDisplayBox ('CHECK_OUTGRP_DIALOG');
            with P^.CurBlock^ do
              Update (False, (A.AOutgroup.cardinality > 2),
                    A.AOutgroup);
            EnableWindow (Parent^.HWindow, True);
            Counter^.Destroy;
            SetCursor (OldCursor);
            end;
         UpDateParentMenu;
         if (P^.CurBlock^.Trees = 1) then
            SendMessage (Parent^.HWindow, um_EnableT2T, 0, 0);
         Update;
         DisplayBuffer.UpDate;
         end;
      end; { case }
end;


{----------------------------CMTreesPrint----------------------------------}

{ Display a WYSIWYG print preview dialog box. }
procedure TreeWindow.CMTreesPrint(var Msg: TMessage);
var
   TheDialog   : PPVWindow;  { print preview dialog }
begin
   { Dialog }
   TheDialog := new(PPVWindow, Init (@Self,
                   'TREE_PRINT_PREVIEW_DIALOG',
                    HELPID_TREES_PRINT_DIALOG, P));
   { Run the dialog }
   SendMessage (Parent^.HWindow, um_Working, 0, 0);
   Application^.ExecDialog (TheDialog);
   SendMessage (Parent^.HWindow, um_Ready, 0, 0);
end;


{----------------------------Root-------------------------------------------}

procedure TreeWindow.Root (NewRoot: ROOTTYPE);
var
   M: HMenu;
begin
   M := GetMenu (Parent^.HWindow);
   case P^.CurBlock^.GetRoot of
      rUNROOTED : CheckMenuItem (M, cm_UnRooted, mf_ByCommand or mf_UnChecked);
      rROOTED   : CheckMenuItem (M, cm_Rooted, mf_ByCommand or mf_UnChecked);
      rOUTGROUP : CheckMenuItem (M, cm_OutgroupRooted, mf_ByCommand or mf_UnChecked);
      end;
   case NewRoot of
      rUNROOTED : CheckMenuItem (M, cm_UnRooted, mf_ByCommand or mf_Checked);
      rROOTED   : CheckMenuItem (M, cm_Rooted, mf_ByCommand or mf_Checked);
      rOUTGROUP : CheckMenuItem (M, cm_OutgroupRooted, mf_ByCommand or mf_Checked);
      end;

   P^.CurBlock^.SetRoot (NewRoot);
   Repaint;
end;
{-----------------------------CMTreesRoot----------------------------------}
procedure TreeWindow.CMTreesRoot;
begin
   writeln (newlog);
   writeln (newlog, 'COMMAND: Trees Rooted');
   writeln (newlog);
   Root (rROOTED);
end;
{-----------------------------CMTreesUnroot--------------------------------}
procedure TreeWindow.CMTreesUnRoot;
begin
   writeln (newlog);
   writeln (newlog, 'COMMAND: Trees Unrooted');
   writeln (newlog);
   Root (rUNROOTED);
end;
{-----------------------------CMTreesOutgroupRoot--------------------------}
procedure TreeWindow.CMTreesOutgroupRoot;
begin
   writeln (newlog);
   writeln (newlog, 'COMMAND: Trees Root with outgroup');
   writeln (newlog);
   Root (rOUTGROUP);
end;

{-----------------------------CMNNI----------------------------------------}

procedure TreeWindow.CMNNI (var Msg:TMessage);
type
   NNIBuf = record
      dra,
      drs,
      dru : word;
      end;
var
   NNIBuffer : NNIBuf;
   Measure   : word;
   Radio1,
   Radio2,
   Radio3    : PRadioButton;
   TheDialog : PDialog;
begin
   with NNIBuffer do begin
      dra := bf_Checked;
      drs := bf_UnChecked;
      dru := bf_UnChecked;
      end;
   TheDialog := new(PCPWDialog, Init(@Self, 'NNI_DIALOG',
                                             HELPID_NNI_DIALOG_BOX));
   New(Radio1, InitResource(TheDialog, id_dra));
   New(Radio2, InitResource(TheDialog, id_drs));
   New(Radio3, InitResource(TheDialog, id_dru));
   TheDialog^.TransferBuffer := @NNIBuffer;
   if (Application^.ExecDialog (TheDialog) = id_OK) then begin
      Measure := 0;
      with NNIBuffer do begin
         if (dra and bf_Checked = bf_Checked) then
            Measure := Measure or flg_dra;
         if (drs and bf_Checked = bf_Checked) then
            Measure := Measure or flg_drs;
         if (dru and bf_Checked = bf_Checked) then
            Measure := Measure or flg_dru;
         end;
      TreeToTree (Measure, True);
      end;
end;

{-----------------------------CMPartitions---------------------------------}

procedure TreeWindow.CMPartitions (var Msg:TMessage);
begin
   TreeToTree (PARTITION, True);
end;

{-----------------------------CMTreesAgreement-----------------------------}

procedure TreeWindow.CMTreesAgreement (var Msg:TMessage);
begin
   TreeToTree (flg_SUBTREE, True);
end;

{-----------------------------CMQuartets-----------------------------------}

procedure TreeWindow.CMQuartets (var Msg:TMessage);
type
   QBuf = record
      d,
      s,
      SD,
      SJA,
      All: word;
      end;
var
   QBuffer : QBuf;
   Measure : word;
   Radio1,
   Radio2,
   Radio3,
   Radio4,
   Radio5    : PRadioButton;
   TheDialog : PDialog;
begin
   with QBuffer do begin
      d   := bf_Checked;
      s   := bf_UnChecked;
      SD  := bf_UnChecked;
      SJA := bf_UnChecked;
      All := bf_UnChecked;
      end;
   TheDialog := new(PCPWDialog, Init(@Self, 'QUARTETS_DIALOG',
                                             HELPID_QUARTETS_DIALOG_BOX));
   New(Radio1, InitResource(TheDialog, id_d));
   New(Radio2, InitResource(TheDialog, id_s));
   New(Radio3, InitResource(TheDialog, id_SD));
   New(Radio4, InitResource(TheDialog, id_SJA));
   New(Radio5, InitResource(TheDialog, id_All));
   TheDialog^.TransferBuffer := @QBuffer;
   if (Application^.ExecDialog (TheDialog) = id_OK) then begin
      Measure := Q_Q;
      with QBuffer do begin
         if (d   and bf_Checked = bf_Checked) then
            Measure := Measure or Q_d;
         if (s   and bf_Checked = bf_Checked) then
            Measure := Measure or Q_s;
         if (SD  and bf_Checked = bf_Checked) then
            Measure := Measure or Q_SD;
         if (SJA and bf_Checked = bf_Checked) then
            Measure := Measure or Q_SJA;
         if (All and bf_Checked = bf_Checked) then
            Measure := Measure or Q_All;
         end;
      TreeToTree (Measure, True);
      end;
end;

{-----------------------------CMTriplets-----------------------------------}

procedure TreeWindow.CMTriplets (var Msg:TMessage);
type
   QBuf = record
      d,
      s,
      SD,
      SJA,
      All: word;
      end;
var
   QBuffer : QBuf;
   Measure : word;
   Radio1,
   Radio2,
   Radio3,
   Radio4,
   Radio5    : PRadioButton;
   TheDialog : PDialog;
begin
   with QBuffer do begin
      d   := bf_Checked;
      s   := bf_UnChecked;
      SD  := bf_UnChecked;
      SJA := bf_UnChecked;
      All := bf_UnChecked;
      end;

   TheDialog := new(PCPWDialog, Init(@Self, 'TRIPLETS_DIALOG',
                                             HELPID_TRIPLETS_DIALOG_BOX));
   New(Radio1, InitResource(TheDialog, id_d));
   New(Radio2, InitResource(TheDialog, id_s));
   New(Radio3, InitResource(TheDialog, id_SD));
   New(Radio4, InitResource(TheDialog, id_SJA));
   New(Radio5, InitResource(TheDialog, id_All));
   TheDialog^.TransferBuffer := @QBuffer;
   if (Application^.ExecDialog (TheDialog) = id_OK) then begin
      Measure := Q_T;
      with QBuffer do begin
         if (d   and bf_Checked = bf_Checked) then
            Measure := Measure or Q_d;
         if (s   and bf_Checked = bf_Checked) then
            Measure := Measure or Q_s;
         if (SD  and bf_Checked = bf_Checked) then
            Measure := Measure or Q_SD;
         if (SJA and bf_Checked = bf_Checked) then
            Measure := Measure or Q_SJA;
         if (All and bf_Checked = bf_Checked) then
            Measure := Measure or Q_All;
         end;
      TreeToTree (Measure, True);
      end;
end;

{-----------------------------TreeToTree-----------------------------------}

{ Set up counter dialog box and then compute Tree-to-tree distances. }
procedure TreeWindow.TreeToTree (Measure:word; ShowHist:Boolean);
var
   H: HISTPTR;
begin
   OpenDisplayBox ('TREE_TO_TREE_INFO_DIALOG');
   Counter^.UpDateText (id_Status, 'Comparing trees');

   writeln (NewLog);
   writeln (NewLog, 'COMMAND: Trees Tree-to-tree distances');
   writeln (NewLog);

   { Compare trees }
   ErrorRec.Init;
   H := NIL;
   P^.CurBlock^.NewSelfCompare (Measure, True, H);

   CleanUpDisplayBox;
   DisplayBuffer.UpDate;
   { Show histogram }
   if (H <> NIL) then begin
       Application^.ExecDialog (new(PHistDlg,
          Init (@Self, 'HISTOGRAM_DIALOG',H)));
       Dispose (H);
       end;
end;

{-----------------------------OpenDisplayBox-------------------------------}

{ Create the dialog box that display's the program's progress,
  put the 'Working' message on the status bar, and start the
  stop watch. }
procedure TreeWindow.OpenDisplayBox (Title: PChar);
begin
   Counter := new(PCounterDialog, Init (Parent, Title));
   Application^.MakeWindow (Counter);
   SendMessage (Parent^.HWindow, um_Working, 0, 0);
   DisplayBuffer.StartStopWatch;
end;

{-----------------------------CleanUpDisplayBox----------------------------}

{ Remove the dialog box that display's program's progress,
  and reset parent window's status bar. }
procedure TreeWindow.CleanUpDisplayBox;
begin
   if ErrorRec.NotOK then begin
      { Houston, we have a problem... }
      if ErrorRec.UserAborted then begin
         {...user has aborted. }
         writeln (NewLog, '***User terminated***');
         Counter^.UserAborted;
         repeat until Counter^.Cleared;
         Counter^.Destroy;
         end
      else begin
         {...program encountered an error. }
         writeln (NewLog, ErrorRec.Msg);
         EnableWindow (Parent^.HWindow, True);
         Counter^.Destroy;
         end
      end
   else begin
      { Everything's fine! }
      { Update dialog box and wait for user to clear }
      Counter^.Successful;
      repeat until Counter^.Cleared;
      Counter^.Destroy;
      end;