cpwtwin2.pas

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

   DisplayBuffer.ShowElapsedTime;
   SendMessage (Parent^.HWindow, um_Ready, 0, 0);
   ErrorRec.Init; { reset error messages }
end;


procedure TreeWindow.ResetUndoMenu;
var
   UndoMenuText: array[0..50] of char;
begin
   StrCopy (UndoMenuText, 'Undo');
   StrCat (UndoMenuText, #9);
   StrCat (UndoMenuText, 'Alt+BkSp');
   ModifyMenu (GetMenu (Parent^.HWindow),
      cm_EditUndo, mf_ByCommand or mf_String,
                cm_EditUndo, UndoMenuText);
   EnableMenuItem (Getmenu (Parent^.HWindow),
       cm_EditUndo, mf_ByCommand or mf_Grayed);
end;


procedure TreeWindow.UpdateStatusBar;
var
   szBuf   : array[0..10] of char;
   lpszBuf : PChar;
begin
   { Display info about trees on status line }
   StrCopy (StatusStr, ' Ready (');
   Str (P^.CurBlock^.TotalTrees, szBuf);
   StrCat (StatusStr, szBuf);
   StrCat (StatusStr, ' trees of which ');
   Str (P^.CurBlock^.Trees, szBuf);
   StrCat (StatusStr, szBuf);
   StrCat (StatusStr, ' are active)'); 
   lpszBuf := StatusStr;
   SendMessage (Parent^.HWindow, FW_StatusBarUpDate, 0,
       longint(lpszBuf));
end;



{ *** WINDOWS MESSAGES *** }

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

{ wParam of message <> 0 if window is being activated. }
procedure TreeWindow.WMMDIActivate (var Msg:TMessage);
begin
	if (Msg.wParam <> 0) then begin
		{ Window is being activated }
		if InEditMode then begin
			{ Tree edit mode }
 
			SetEdgeThickness (2);

			{ Place current mode on status bar }
			SetMode (Mode);
			SendMessage (Parent^.HWindow, um_TreeEditor, HWindow, longint (P));

			{ 29 April 1993 -- MADD}
         { Ensure Edit | Tree command is checked }
			CheckMenuItem (GetMenu(Parent^.HWindow), cm_TreesEdit,
				mf_ByCommand or mf_Checked);

         { Show the tool box }
         ShowWindow (PD, sw_Show);
			end
		else begin
			{ Not in tree edit mode }

			{ Ensure Edit | Tree command is unchecked }
			CheckMenuItem (GetMenu(Parent^.HWindow), cm_TreesEdit,
				mf_ByCommand or mf_UnChecked);

			SetEdgeThickness (2);

         { Display info about trees on status line }
         UpdateStatusBar;

         { Inform parent }
			SendMessage (Parent^.HWindow, um_TreeWindow, HWindow, longint (P));
			end;
		UpdateParentMenu;
		end
	else begin
		{ Window is lossing focus }
		SetEdgeThickness (2);
		ResetUndoMenu;

		{ Ensure Edit | Tree command is unchecked }
		CheckMenuItem (GetMenu(Parent^.HWindow), cm_TreesEdit,
				mf_ByCommand or mf_UnChecked);


		if InEditMode then begin
			ShowWindow (PD, sw_Hide);
			{ 30 Apr 93 -- MADD }		
			{ Signal frame window that it should not display the
			  Edit | Tree close message on the status bar }
			SendMessage (Parent^.HWindow, um_TreeEditor, 0, 0);

			end;

		end;

   TWindow.DefWndProc (Msg);
end;

{-----------------------------WMSize---------------------------------------}

{ Recalculate the dimensions of region tree is drawn in. }
procedure TreeWindow.WMSize (var Msg:TMessage);
var
   R: TRect;
begin
   { Essential to avoid spurious repainting of
     "flashed" branch if window is maximized. }
   FlashBranch := NIL;


   MDIChild.WMSize (Msg);

   GetClientRect (ToolBarHWnd, R);

   SetWindowPos(ToolBarHWnd, 0, 0, 0, Msg.LParamLo, R.Bottom,
       swp_NoZOrder);

   MoveToolsDialog;



   { Vital, otherwise if window is maximized and user closes
     it then P is nonsense causing UAE. }
   if (P <> NIL) then
      PlotterCoordinates;
end;


{ *** INTERFACE *** }

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

{ Hook for updating tree coordinates, called if
  user has altered tree activities. }
procedure TreeWindow.UpDate;
begin
   PlotterCoordinates;
   Repaint;
   UpdateStatusBar;
end;

{-----------------------------UpdateParentmenu-----------------------------}

procedure TreeWindow.UpdateParentMenu;
var
	M: HMenu;
	UnCheck,
	On,
	Off : word;

	j:integer;
begin
	On  := mf_ByCommand or mf_Enabled;
	Off := mf_ByCommand or mf_Grayed;
	M   := GetMenu (Parent^.HWindow);

{	if (P^.CurBlock^.lpszInfo <> NIL) then
		EnableMenuItem (M, cm_TreesAbout, On)
	else EnableMenuItem (M, cm_TreesAbout, Off);}

	if (P^.CurBlock^.IsFlag (pr_ALLBINARY)) then begin
		EnableMenuItem (M, cm_NNI, On);
		EnableMenuItem (M, cm_TreesAgreement, On);
		end
	else begin
		EnableMenuItem (M, cm_NNI, Off);
		EnableMenuItem (M, cm_TreesAgreement, Off);
		end;

  { Rooting menu }
  UnCheck := mf_ByCommand or mf_UnChecked;
  CheckMenuItem (M, cm_Unrooted,       UnCheck);
  CheckMenuItem (M, cm_Rooted,         UnCheck);
  CheckMenuItem (M, cm_OutgroupRooted, UnCheck);
  case P^.CurBlock^.GetRoot 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;

  if not P^.CurBlock^.OutgroupOK then
	  EnableMenuItem (M, cm_OutgroupRooted, Off);


  { Ensure quartets is available only if > 3 leaves }
  if (P^.CurBlock^.Leaves < 4) then
     EnableMenuItem (M, cm_Quartets, Off)
  else EnableMenuItem (M, cm_Quartets, On);

  { Gray commands that require > 1 tree,
    the Tree-to-tree popup submenu is
    grayed by Frame window. }
  if (P^.CurBlock^.Trees < 2) then begin
     EnableMenuItem (M, cm_Consensus, Off);
     EnableMenuItem (M, cm_CompareTreeWith, Off);
     EnableMenuItem (M, cm_TreesRemoveDuplicates, Off);
     end
  else begin
     EnableMenuItem (M, cm_Consensus, On);
     EnableMenuItem (M, cm_CompareTreeWith, On);
     EnableMenuItem (M, cm_TreesRemoveDuplicates, On);
     end;

  { Selection makes no sense if < 2 trees }
  if (P^.CurBlock^.TotalTrees < 2) then
     EnableMenuItem (M, cm_TreesSelect, Off)
  else EnableMenuItem (M, cm_TreesSelect, On);

  { Which block are we looking at? }
  if (P^.CurBlock = P^.Blocks[0]) then
     { Disable Map trees popup }
     SendMessage (Parent^.HWindow, um_EnableMapTrees, 0, 0)
  else begin
     { we're looking at a DISTRIBUTION block }
     SendMessage (Parent^.HWindow, um_EnableMapTrees, 1, 0);

     if (P^.Blocks[0]^.Trees = 0) then begin
        { No host trees... }
        EnableMenuItem (M, cm_DataReconcile, Off);
        EnableMenuItem (M, cm_MapOntoAll, Off);
        EnableMenuItem (M, cm_MapPruneEach, Off);
        end
     else begin
        { Host trees, but are they big enough? }
        j := P^.AreasInCommon;
        if (j < 3) then begin
           EnableMenuItem (M, cm_DataReconcile, Off);
           EnableMenuItem (M, cm_MapOntoAll, Off);
           end
        else begin
           EnableMenuItem (M, cm_DataReconcile, On);
           EnableMenuItem (M, cm_MapOntoAll, On);
           end;
        if (j < 4) then
           EnableMenuItem (M, cm_MapPruneEach, Off)
        else EnableMenuItem (M, cm_MapPruneEach, On);
        end;
     end;

end;

{----------------------------CMTreesOutgroup--------------------------------}

{ Let user select a new outgroup. Checks to ensure outgroup
  is valid, informs user if it is not.
}
procedure TreeWindow.CMTreesOutgroup (var Msg:TMessage);
var
   TheDialog : PDialog;
   LB1, LB2  : PMyListBox;
   OG: CLUSTEROBJ;
   DeleteBuffer  : LeafTransfer;
begin
   { Initialize dialog window }
   TheDialog :=New(PTwoBoxDialogOutGrp, Init(@Self, 'OUTGROUP_DIALOG',
                                    HELPID_TREES_OUTGROUP_DIALOG));

   { Allocate dialog's list boxes }
   new (LB1, InitResource(TheDialog, id_NonDeletedLB));
   new (LB2, InitResource(TheDialog, id_DeletedLB));

   { Fill transfer buffer with leaf labels }
   with DeleteBuffer, P^.CurBlock^ do
      CurrentOutGroup (List1Strings, List2Strings);

   { Assign buffer to transfer data }
   TheDialog^.TransferBuffer := @DeleteBuffer;

   if Application^.ExecDialog (TheDialog) = id_OK then begin
      { Process results }
      writeln (newlog);
      writeln (newlog, 'COMMAND: Trees Outgroup');
      writeln (newlog);

      with P^.CurBlock^ do begin
         { Get the outgroup }
         with DeleteBuffer do
            UserOutGroup (List1Strings, List2Strings, OG);

         { Have we a new outgroup? }
         if A.NewOutGroup (OG) then begin
            { Yes... }
            case OG.Cardinality of
               0: begin
                     { No outgroup }
                     A.MakeOutgroup(OG);
                     OutGroupOK := False;
                  end;
               1: begin
                     { Single leaf, must be valid }
                     A.MakeOutgroup(OG);
                     OutGroupOK := True;
                  end;
               else begin
                     { Multileaf outgroup, must check it }
                     Counter := new(PCounterDialog, Init
                          (Parent, 'CHECK_OUTGRP_DIALOG'));
                     Application^.MakeWindow (Counter);
                     SendMessage (Parent^.HWindow, um_Working, 0, 0);

                     if ValidOutgroup (OG) then begin
                        { It's OK }
                        A.MakeOutGroup (OG);
                        OutGroupOK := True;
                        EnableWindow (Parent^.HWindow, True);
                        Counter^.Destroy;
                        end
                     else begin
                        { It's bad, so let user know }
                        OutgroupOK := False;
                        EnableWindow (Parent^.HWindow, True);
                        Counter^.Destroy;
                        BWCCMessageBox (Parent^.HWindow,
                           'Unable to root trees with this outgroup.',
                           'COMPONENT',mb_IconInformation);
                        end;
                    end;
               end; { case }

            { Ensure menu and tree window displays correct information }
            if OutGroupOK then begin
               EnableMenuItem (GetMenu(Parent^.HWindow), cm_OutgroupRooted,
                               mf_Enabled or mf_ByCommand);
               TreeWindow.UpDate;
               end
            else begin
               { Outgroup no longer valid, so unroot the trees. }
               EnableMenuItem (GetMenu(Parent^.HWindow),
                  cm_OutgroupRooted,  mf_Grayed or mf_ByCommand);
               Root (rUNROOTED);
               end;
            end;
         end;
      end;
end;

{----------------------------DeleteRestore----------------------------------}

procedure TreeWindow.DeleteRestore (var Msg:TMessage);
var
   TheDialog     : PDialog;
   LB1, LB2      : PMyListBox;
   NewLeaves     : CLUSTEROBJ;
   NewOutGrp     : CLUSTEROBJ;
   Pruned,
   ChkBinary,
   ChkOutGrp     : Boolean;
   DeleteBuffer  : LeafTransfer;
   OldCursor : HCursor;
begin
   { Initialize dialog window }
   TheDialog :=New(PTwoBoxDialog, Init(@Self, 'DELETE_RESTORE_DIALOG',
                                         HELPID_TREES_PRUNE_REGRAFT_DIALOG));

   { Allocate dialog's list boxes }
   new (LB1, InitResource(TheDialog, id_NonDeletedLB));
   new (LB2, InitResource(TheDialog, id_DeletedLB));

   { Fill transfer buffer with leaf labels }
   with DeleteBuffer do
      P^.CurBlock^.CurrentLeaves (List1Strings, List2Strings);

   { Assign buffer to transfer data }
   TheDialog^.TransferBuffer := @DeleteBuffer;

   if Application^.ExecDialog (TheDialog) = id_OK then begin
      writeln (newlog);
      writeln (newlog, 'COMMAND: Trees Prune or graft leaves');
      writeln (newlog);
      { Process results }
      with DeleteBuffer do
         P^.CurBlock^.UpdateCurrentLeaves (List1Strings,
            List2Strings, NewLeaves);

      { Check how new leaves affects:
        1. Binary status of trees.
        2. Outgroup.}

      with P^.CurBlock^ do begin
         { True if newly choosen leaves are a subset of the
           current leaves. If pruned and trees are currently
           all binary then no need to check for binary trees.}
         Pruned    := A.Pruned (NewLeaves);
         ChkBinary := not (Pruned and IsFlag (pr_AllBinary));

         { Now make new leaves the current leaves }
         A.MakeActiveLeaves (NewLeaves);
         ChkOutGrp := not (A.HavePrunedOutGroup or A.AOutgroup.Empty);

         if ChkOutGrp then
            A.AOutGroup.Intersection (A.ALeaves, NewOutGrp)
         else NewOutGrp.NullSet;