cpwtwin2.pas

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

{*******************************************************************
*                                                                  *
*  COMPONENT for MS DOS and Windows source code.                   *
*                                                                  *
*  (c) 1992, Roderic D. M. Page                                    *
*                                                                  *
*  Language: Turbo Pascal (Pascal with object-oriented extensions) *
*  Compiler: Turbo Pascal 6.0 (MS DOS)                             *
*            Turbo Pascal for Windows 1.0 (WINDOWS)                *
*                                                                  *
*  Notes:    Program interface is currently Windows specific.      *
*                                                                  *
*******************************************************************}

{*
   New tree window



   10 Aug 1992 Untitled windows now are numbered to so that profile
               compare with command correctly picks different windows
               if both are untitled.

	 3 Oct 1992 New tool box added.
	16 Nov 1992 Now uses cm_FileSave and cm_FileSaveAs to save trees.
	 3 Dec 1992 Inactive trees drawn in gray.
   21 Dec 1992 Resources now bound using Resource Workshop as I kept
               getting spurious Error 164: Duplicate resource identifier
               messages.
   31 Dec 1992 Bug in .Consensus fixed. If Adams and cluster consensus trees
               were both being computed and saved for unrooted trees then
               disk file contained mixed rooted and unrooted trees as
               Adams tree was always rooted (this lead to another bug
               being found in the error trapping in NEWPROF.PAS.
    7 Jan 1993 Tool box improved.
    8 Jan 1993 Trees About dialog box now uses ANSI fixed font to match
               editor.
               Tree window displays the number of trees on the status bar.
*}

{$I CPDIR.INC}


{$DEFINE MACWIN}

{$IFDEF MACWIN}
(*{$R MACWIN.RES}*) { Bound using Resource Workshop }
{$ENDIF}

unit cpwtwin2;

interface

uses
   WinTypes,
   WinProcs,
   WinDos,
   {$IFDEF BWCC}   { use Borland-style dialogs }
   BWCC,
   {$IFDEF VER10}
   WObjectB,
   StdDlgsB,
   {$ELSE}
   WObjects,
   StdDlgs,
   {$ENDIF} {VER 10}
   {$ELSE}          { use standard dialogs }
   WObjects,
   StdDlgs,
   {$ENDIF}
   Strings,
   spinco,
   cperror,
   cpvars,
   cpwvars,
   cpheader,   { Resource constants }
   cplex,
   cpwbuf,
   cputil,
   cphist,
   cpplot,
   cpset,
   cptree,
   cpwrite,
   cpenc,
   cpactive,
   cplabels,
   cpwdlg,
   cpwcontl,
   cpwdial,
   cpwcdial,
   cptable,
   cpagree,
   cpnni,
   cpcon,
   newprof,
   cpmdi,
   {$IFDEF MACWIN}
   cpwco,
   cpwtbx,
   {$ENDIF}
	cpwtplot;


const
{   id_TreeNumber = 104;
   id_TreeSpin   = 103;
   id_Block      = 102;}

   id_BlockName  = 105;

{   id_Shade      = 106;}

   { Messages }
   um_TreeWindow    = wm_User + 2;
   um_DataWindow    = wm_User + 7;
   um_CanCompare    = wm_User + 12;
   um_IsComparable  = wm_User + 13;
{   um_NewBlock      = wm_User + 15;}
   um_EnableT2T     = wm_User + 16;
   um_TreeEditor    = wm_User + 17;
   um_EnableMapTrees= wm_User + 18;

   WinBorder = 30; { border around tree drawing }
   TextScale = 0.8;

   {$IFDEF MACWIN}
   um_EditorTree   = wm_User + 102;
   um_SetTree      = wm_User + 103;
   um_GetTree      = wm_User + 104;
   um_EditorClosed = wm_User + 105;
   {$ENDIF}



type
   PTreeWindow = ^TreeWindow;
   {Pointer to Tree window object}
   TreeWindow = object (MDIChild)
      {Tree window object}
      P             : PPROFILE; {Profile of trees}
      PlotInfo      : TPlotRec; {}
      MyLogFont     : TLogFont; {Font}
      ToolBar       : PWindowsObject; {}
      ToolBarhWnd   : HWnd;
      cbhWnd        : HWnd;

      ValidOutgroup : Boolean;
      IsComparable  : Boolean;

      {$IFDEF MACWIN}
      InEditMode        : Boolean;
      CurrentCursor     : HCursor;
      Mode              : integer;
      PD : HWnd;

      FlashOn,
      ButtonDown        : Boolean;
      BranchAnc,
      PrunedFrom,
      InvisibleTree,
      FlashBranch,
      BranchFrom,
      BranchTo          : NODE_PTR;
      HighlightColor    : longint;
      TheTree,
      OldTree           : DRAW_TREEOBJ_PTR;
      Modified          : Boolean;
      DragDC            : HDC;
      x, y, x1, y1      : integer;
      WasNotBinary      : Boolean;
      HadGoodOutgroup   : Boolean;

      TreeExpanded      : Boolean;

      {$ENDIF}


      constructor Init(AParent: PWindowsObject; ATitle: PChar;
			    AProfile:PPROFILE);
      destructor Done;virtual;

      { Counter display dialog }
      procedure OpenDisplayBox (Title: PChar);
      procedure CleanUpDisplayBox;

      {---ObjectWindows---}
      function CanClose:Boolean;virtual;
      function GetClassName:PChar;virtual;
      procedure GetWindowClass (var AWndClass: TWndClass);virtual;
      procedure Paint (PaintDC: HDC; var PaintInfo:TPaintStruct);virtual;
      procedure SetupWindow;virtual;

      {---Windows---}
      procedure WMMDIActivate (var Msg:TMessage);
         virtual wm_First + wm_MDIActivate;
      procedure WMSize (var Msg:TMessage);
         virtual wm_First+ wm_Size;

      {---Interface---}
      procedure PlotterCoordinates;
      procedure ResetUndoMenu;
      procedure Repaint;
      procedure Update;
      procedure UpDateParentMenu;
      procedure UpdateStatusBar;

      procedure UMNewValue (var Msg:TMessage);
         virtual wm_First + um_NewValue;
      procedure UMNewBlock (var Msg:TMessage);
         virtual wm_First + um_NewBlock;

      {---Trees commands---}
      procedure CMTreesConsensus (var Msg: TMessage);
         virtual cm_First + cm_Consensus;
      procedure Consensus (ConTrees: word; ConfileName:PChar);
      procedure CMTreesShow (var Msg: TMessage);
         virtual cm_First + cm_ShowTrees;
      procedure CMTreesPrint (var Msg: TMessage);
         virtual cm_First + cm_PrintTrees;
      procedure CMTreesRemoveDuplicates (var Msg:TMessage);
         virtual cm_First + cm_TreesREmoveDuplicates;
      procedure CMTreesRoot (var Msg:TMessage);
         virtual cm_First + cm_Rooted;
      procedure CMTreesUnRoot (var Msg:TMessage);
         virtual cm_First + cm_UnRooted;
      procedure CMTreesOutgroupRoot (var Msg:TMessage);
         virtual cm_First + cm_OutgroupRooted;
      procedure Root (NewRoot: ROOTTYPE);
      procedure CMTreesOrder (var Msg: TMessage);
         virtual cm_First + cm_TreeOrder;
      procedure CMNNI (var Msg:TMessage);
         virtual cm_First + cm_NNI;
      procedure CMPartitions (var Msg:TMessage);
         virtual cm_First + cm_Partitions;
      procedure CMTreesAgreement (var Msg:TMessage);
         virtual cm_First + cm_TreesAgreement;
      procedure CMTriplets (var Msg:TMessage);
         virtual cm_First + cm_Triplets;
      procedure CMQuartets (var Msg:TMessage);
         virtual cm_First + cm_Quartets;
      procedure TreeToTree (Measure:word; ShowHist:Boolean);
      procedure DeleteRestore (var Msg:TMessage);
         virtual cm_First + cm_DeleteRestore;
      procedure CMTreesOutgroup (var Msg:TMessage);
         virtual cm_First + cm_DefineOutgroup;
      procedure CMTreesStatistics (var Msg: TMessage);
         virtual cm_First + cm_TreeInfo;
      procedure CMTreesSave (var Msg: TMessage);
         virtual cm_First + cm_SaveTrees;
      procedure CMTreesSelect      (var Msg: TMessage);
         virtual cm_First + cm_TreesSelect;
      procedure CompareTreeWith (var Msg: TMessage);
         virtual cm_First + cm_CompareTreeWith;

      procedure CMTreesAbout (var Msg: TMessage);
         virtual cm_First + cm_TreesAbout;


      {---Profile commands---}
      procedure CMFileSave (var Msg:TMessage);
         virtual cm_First + cm_FileSave;
      procedure CMFileSaveAs (var Msg:TMessage);
         virtual cm_First + cm_FileSaveAs;

      {$IFDEF MACWIN}
      procedure RepaintBranch (DC:HDC; Brush: HBrush; Node:NODE_PTR);
      procedure WMCreate(var Msg: TMessage);
         virtual wm_First + wm_Create;
      procedure SetMode (NewMode:integer);
      procedure UMNewMode (var Msg:TMessage);
         virtual wm_First + um_NewMode;
      procedure CMTreesEdit (var Msg: TMessage);
        virtual cm_First + cm_TreesEdit;
      procedure WMLButtonDown(var Msg: TMessage);
        virtual wm_First + wm_LButtonDown;
      procedure WMLButtonUp(var Msg: TMessage);
        virtual wm_First + wm_LButtonUp;
      procedure WMMouseMove(var Msg: TMessage);
        virtual wm_First + wm_MouseMove;
      procedure CMTreeUndo (var Msg:TMessage);
         virtual cm_First + cm_EditUndo;
      procedure SetUpUndo;
      procedure RepaintSubTree (SubTree:NODE_PTR);
      procedure SaveEditedTree;
      procedure MoveToolsDialog;
      {$ENDIF}

      procedure UMCanCompare (var Msg: TMessage);
         virtual wm_First + um_CanCompare;
      procedure UMIsComparable (var Msg: TMessage);
         virtual wm_First + um_IsComparable;


      { FIT }
      procedure CMDataReconcile (var Msg:TMessage);
         virtual cm_First + cm_DataReconcile;
      procedure CMMapOnAllTrees (var Msg:TMessage);
         virtual cm_First + cm_MapOntoAll;
      procedure CMMapPruneEach (var Msg:TMessage);
         virtual cm_First + cm_MapPruneEach;
      procedure CMDataSearch (var Msg:TMessage);
         virtual cm_First + cm_DataSearch;
      procedure CMMapOptions (var Msg:TMessage);
         virtual cm_First + cm_MapOptions;


      function SaveAs:Boolean;
      procedure Save (ToNEXUS: Boolean);

      end;


implementation


{-----------------------------Init-----------------------------------------}

{ Set attributes and construct child controls }
constructor TreeWindow.Init(AParent: PWindowsObject; ATitle: PChar;
			    AProfile:PPROFILE);
begin
   MDIChild.Init(AParent, ATitle);
   Attr.Style    := ws_ClipChildren or ws_ClipSiblings
                    or ws_Child or ws_SysMenu;
   P              := AProfile;
   ValidOutgroup  := False;
   {$IFDEF MACWIN}
   InEditMode     := False;
   Mode           := cm_MOVE;
   FlashOn        := True;
   ButtonDown     := False;
   FlashBranch    := NIL;
   HighLightColor := RGB(255,000,000);
   TheTree        := NIL;
   Modified       := False;
   TreeExpanded   := False;
  {$ENDIF}
end;

{-----------------------------Done-----------------------------------------}

destructor TreeWindow.Done;
begin
   Dispose (P, Done);
   P := NIL;
   MDIChild.Done;
end;


{-----------------------------Repaint--------------------------------------}
procedure TreeWindow.Repaint;
var
   R1, R2: TRect;
begin
   GetClientRect (HWindow, R1);
   GetClientRect (ToolBarHWnd, R2);
   R1.Top := R1.Top + R2.top + R2.Bottom + 2;
   InvalidateRect (HWindow, @R1, True);
end;

{-----------------------------UMNewValue-----------------------------------}

procedure TreeWindow.UMNewValue (var Msg:TMessage);
var
   R1, R2: TRect;
   TreeNum : integer;
begin
   TreeNum := Msg.wParam;
   if (TreeNum <> P^.GetCurTreeNum) then begin
      P^.SetCurTreeNum (TreeNum);
      Repaint;
      end;
end;

{-----------------------------UMNewBlock-----------------------------------}

procedure TreeWindow.UMNewBlock (var Msg:TMessage);
var
   H: HWnd;
begin
   if (P^.Blocks[0]^.Trees <> 0) then
      { 0 is TREES block }
      P^.SetCurBlock (Msg.wParam)
   else P^.SetCurBlock (Succ(Msg.wParam));

   { Update tool bar }
   H := GetDlgItem (ToolBarhWnd, id_TreeNumber);
   SendMessage (H, um_AdjustRange, 1, P^.CurBlock^.TotalTrees);
   SendMessage (H, um_SetValue, P^.CurBlock^.CurTree, 0);

   { Update display }
   Update;
   UpdateParentMenu;
end;

{-----------------------------SetupWindow----------------------------------}

procedure TreeWindow.SetupWindow;
var
   a, d: array[0..80] of char;
   i : integer;