cpwtwin2.pas

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

   s : string;
   E : PSpinEdit;
   lpszTitle : PChar;
   xx : longint;
   Button : HWnd;
   r : TRect;

   szBlock : array[0..100] of char;
   lpszBlock : PChar;
  CaptionBarY : integer;
begin
   TWindow.SetupWindow;

   { Create the toolbar at the top of the window }
   GetClientRect (HWindow, r);
   ToolBarHWnd := CreateWindow('rodSpeedBar', nil,
									 WS_CHILD or WS_VISIBLE or ws_ClipSiblings,
                                     0, 0,
                                     r.right, 36,
												 HWindow, 120, HInstance, nil);

   ToolBar := new(PWindowsObject, Init(@Self));
   ToolBar^.HWindow := ToolBarHWnd;

   { text fields }
	Button :=  CreateWindow('static', 'Tree',
									 WS_CHILD or WS_VISIBLE,
                                     8, 8,
                                     35, 24,
												 ToolBarHWnd, 100, HInstance, nil);
	Button :=  CreateWindow('static', 'Block',
									 WS_CHILD or WS_VISIBLE,
                                     150 ,8,
                                     50, 24,
												 ToolBarHWnd, id_BlockName, HInstance, nil);
   { Add a spin button and its edit field }
	E  := new(PSpinEdit, Init (ToolBar, id_TreeNumber,'1',50,6,75,24, 7,
      1, P^.CurBlock^.TotalTrees, 1, id_TreeSpin));
   E^.Create;
   Button := CreateWindow ('Spin2', nil, ws_child or ws_visible or spns_wrap,
       126, 6, 17, 25, ToolBarHWnd, id_TreeSpin, hinstance, nil);
   SendMessage (button, spnm_setrange, 0, makelong(1,P^.CurBlock^.TotalTrees));
   SendMessage (button, spnm_seteditid, id_TreeNumber, 0);
   SendMessage (button, spnm_setcrntvalue, 1, 0);

   { Combo box for tree blocks }
   cbhwnd := CreateWindow('combobox', nil, WS_CHILD or WS_VISIBLE or CBS_DROPDOWNLIST or WS_VSCROLL,
                            200, 6, 160, 200,
                            ToolBarHWnd, id_Block, hInstance, nil);

  with P^ do begin
     if (Blocks[0]^.Trees > 0) then begin
        { We have a TREES block }

        StrCopy (szBlock, 'Trees');
        lpszBlock := @szBlock;
        Sendmessage (cbhwnd, cb_InsertString, 0, longint(lpszBlock));

        for i := 1 to nBlock do begin
           if (StrLen (Blocks[i]^.GetTitle) > 0) then
              StrCopy (szBlock, Blocks[i]^.GetTitle)
           else begin
              Str (i, a);
              StrCopy (szBlock, 'BLOCK ');
              StrCat (szBlock, a);
              end;
           lpszBlock := @szBlock;
           Sendmessage (cbhwnd, cb_InsertString, i, longint(lpszBlock));
           end;
        end
     else begin
        { No trees block }
        for i := 1 to nBlock do begin
           if (StrLen (Blocks[i]^.GetTitle) > 0) then
              StrCopy (szBlock, Blocks[i]^.GetTitle)
           else begin
              Str (i, a);
              StrCopy (szBlock, 'BLOCK ');
              StrCat (szBlock, a);
              end;
           lpszBlock := @szBlock;
           Sendmessage (cbhwnd, cb_InsertString, i-1, longint(lpszBlock));
           end;
        end;
     SendMessage (cbhwnd, cb_SetCurSel, 0, 0);
     end;

  { Toggle blocks }
  if (P^.nBlock = 0) then begin
     ShowWindow (GetDlgItem (ToolBarHWnd, id_Block), sw_Hide);
     ShowWindow (GetDlgItem (ToolBarHWnd, id_BlockName), sw_Hide);
     end;



  { Set window title either to the file name or
    Untitled }
  if (P^.szFileName[0] <> #0) then begin
     StrCopy (a, 'Tree - [');
     StrCat (a, StrLower(P^.szFileName));
     StrCat (a, ']');
     end
  else begin
    XX := UntitledCount;
    wvsprintf (a, 'Tree - [Untitled%d]',XX);
    end;
  SetWindowText (HWindow, a);

  { Tree editor tool box }
  CaptionBarY := GetSystemMetrics (sm_CYCaption) div 2 + 1;
  PD := CreateWindow('rodToolBox', '',
									 ws_Border or ws_Child or ws_ClipSiblings,
                                     0, 0,
                                     96 + GetSystemMetrics (sm_CYBorder),
                                     96 + CaptionBarY +
                                     + GetSystemMetrics (sm_CYBorder),
												 HWindow, 100, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     0, 0 + CaptionBarY,
                                     32, 32,
												 PD, 401, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     32, 0 + CaptionBarY,
                                     32, 32,
												 PD, 402, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     64, 0 + CaptionBarY,
                                     32, 32,
												 PD, 403, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     0, 32 + CaptionBarY,
                                     32, 32,
												 PD, 404, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     32, 32 + CaptionBarY,
                                     32, 32,
												 PD, 405, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     64, 32 + CaptionBarY,
                                     32, 32,
												 PD, 406, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     0, 64 + CaptionBarY,
                                     32, 32,
												 PD, 407, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
			    				 WS_CHILD or WS_VISIBLE,
                                     32, 64 + CaptionBarY,
                                     32, 32,
												 PD, 408, HInstance, nil);
	Button :=  CreateWindow('rodToolBoxButton', nil,
									 WS_CHILD or WS_VISIBLE,
                                     64, 64 + CaptionBarY,
                                     32, 32,
												 PD, 409, HInstance, nil);
   SendMessage (PD, um_SetTool, 401, 0);

  { Compute plotter coordinates }
  PlotterCoordinates;
end;


{-----------------------------PlotterCoordinates---------------------------}

{ Compute size of area tree is to be drawn in. }
procedure TreeWindow.PlotterCoordinates;
var
   R, Rect    : TRect;
   DC      : HDC;
   TM      : TTextMetric;
   s       : array[0..16] of char;
   NewFont,
   OldFont : HFont;
begin
   { Get size of client area }
   GetClientRect (HWindow, Rect);

   GetClientRect (ToolBarHWnd, R);

   { Plotter information }
   with PlotInfo do begin
      Ox     := Rect.left + WinBorder;
      Oy     := Rect.top  + WinBorder + R.bottom;
      wx     := (Rect.right - Rect.left) - 2 * WinBorder;
      hy     := (Rect.bottom - Rect.top) - WinBorder - Oy;
      xLeaf  := wx div 2;

      if (TheTree = NIL) then
         yLeaf  := hy / Pred(P^.CurBlock^.Leaves)
      else yLeaf  := hy / Pred(TheTree^.Treeleaves);
      xLabel := 5;
      hFont  := Trunc (TextScale * yLeaf);
      if (hFont < 1) then
         hFont := Trunc (yLeaf)
      else if (hFont > 20) then
              hFont := 20;
      wLine  := 2;
      lStyle := ps_solid;
      lColor := GetSysColor (color_WindowText);
      end;

(*   {$IFDEF DEBUG}
   with PlotInfo do
      writeln (newlog, 'yLeaf=',yLeaf:12:5, hFont:5, Trunc (TextScale * yLeaf):5);
   {$ENDIF}
*)

   DC := GetDC (HWindow);
   { Calculate required label space }
   NewFont := CreateFont (PlotInfo.hFont, 0, 0, 0, fw_Normal,
                          0, 0, 0, ANSI_CHARSET, Out_Default_Precis,
                          Clip_Default_Precis, Default_Quality,
                          Variable_Pitch or ff_Swiss, 'Modern');
   OldFont        := SelectObject (DC, NewFont);
   GetTextMetrics (DC, TM);
   with TM do
      PlotInfo.yLabel := (tmAscent - tmInternalLeading) div 2
         + tmInternalLeading;
   PlotInfo.xLeaf := PlotInfo.wx - P^.MaxLabelSpace (DC);
   NewFont := SelectObject (DC, OldFont);
   DeleteObject (NewFont);
   ReleaseDC (HWindow, DC);
end;

{-----------------------------Paint----------------------------------------}

{ Override TWindow.Paint to draw the tree }
procedure TreeWindow.Paint (PaintDC: HDC; var PaintInfo:TPaintStruct);
var
   OldPen,
   NewPen   : HPen;
   OldFont,
   NewFont  : HFont;
   T        : TREEOBJ;
   {$IFDEF MACWIN}
   NewBrush,
   OldBrush   : HBrush;
   OldCursor,
   WaitCursor : HCursor;
	{$ENDIF}

   TreeColor:longint;
begin
   {$IFDEF MACWIN}
   { Change cursor. }
   WaitCursor := LoadCursor (0, idc_Wait);
   OldCursor  := SetCursor (WaitCursor);
   {$ENDIF}

   { Set pens, fonts, and text color }
   NewFont := CreateFont (PlotInfo.hFont, 0, 0, 0, fw_Normal,
                          0, 0, 0, ANSI_CHARSET, Out_Default_Precis,
                          Clip_Default_Precis, Default_Quality,
                          Variable_Pitch or ff_Swiss, 'Modern');
   OldFont  := SelectObject (PaintDC, NewFont);
   SetBkMode (PaintDC, Transparent);
   SetTextColor (PaintDC, GetSysColor (color_WindowText));

   { Plot the tree }
   {$IFDEF MACWIN}
   if InEditMode then begin
      with PlotInfo do
         { pen }
         NewPen := CreatePen(lStyle, wLine, 1);
      OldPen   := SelectObject (PaintDC, NewPen);

      { Brush }
      NewBrush := CreateSolidBrush (GetSysColor(color_WindowText));
      OldBrush := SelectObject (PaintDC, NewBrush);
		TheTree^.TreePlot (PaintDC, PlotInfo, P^.CurBlock^.L, tp_Slant);
      NewBrush := SelectObject (PaintDC, OldBrush);
      DeleteObject(NewBrush);
		end
	else begin
		if P^.CurTreeIsActive then
			{ Use black }
			TreeColor := RGB(0,0,0)
		else begin
			TreeColor := RGB(127,127,127);
			SetTextColor (PaintDC, TreeColor);
			end;
		with PlotInfo do
         NewPen := CreatePen(lStyle, wLine, TreeColor);
		OldPen   := SelectObject (PaintDC, NewPen);
		NewBrush := CreateSolidBrush (TreeColor);
      OldBrush := SelectObject (PaintDC, NewBrush);
		P^.PlotCurTree (PaintDC, PlotInfo);
		NewBrush := SelectObject (PaintDC, OldBrush);
      DeleteObject(NewBrush);

      end;
   {$ELSE}
   P^.PlotCurTree (PaintDC, PlotInfo);
   {$ENDIF}

   { Restore old pens, fonts, and text color }
   NewFont := SelectObject(PaintDC,OldPen);
   NewPen := SelectObject(PaintDC,OldFont);
   DeleteObject(NewFont);
   DeleteObject(NewPen);

   { Restore cursor. }
   SetCursor (OldCursor);
end;


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

procedure TreeWindow.GetWindowClass (var AWndClass: TWndClass);
begin
   MDIChild.GetWindowClass (AWndClass);
   AWndClass.hIcon := LoadIcon(HInstance, 'TREEWINDOW_ICON');

   {$IFDEF MACWIN}
   AWndClass.hCursor := 0;         { vital, lets window change its cursor }
   {$ENDIF}
end;

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

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

{-----------------------------CMTreesOrder---------------------------------}

procedure TreeWindow.CMTreesOrder (var Msg:TMessage);
var
   Radio1,
   Radio2,
   Radio3,
   Radio4      : PCheckBox;
   TheDialog   : PTreeOrderDlg;
   OrderBuffer : ORDERTRANSFER;
   Order       : LADDERTYPE;
begin
   with OrderBuffer do begin
      Radio1 := bf_UnChecked;
      Radio2 := bf_UnChecked;
      Radio3 := bf_UnChecked;
      Radio4 := bf_UnChecked;
      case P^.CurBlock^.GetOrder of
         LEFTINDEX : Radio1 := bf_Checked;
         LEFT      : Radio2 := bf_Checked;
         RIGHT     : Radio3 := bf_Checked;
         LLR       : Radio4 := bf_Checked;
         end;
     end; { with OrderBuffer }
   TheDialog := new(PTreeOrderDlg, Init (@Self, 'ORDER_DIALOG',
                HELPID_TREES_ORDER_DIALOG,
                ((P^.CurBlock^.Leaves < 20) and
                 P^.CurBlock^.IsFlag(pr_AllBinary))));
   { Set up data transfer }
   New(Radio1, InitResource(TheDialog, 102));
   New(Radio2, InitResource(TheDialog, 103));
   New(Radio3, InitResource(TheDialog, 104));
   New(Radio4, InitResource(TheDialog, 313));
   TheDialog^.TransferBuffer := @OrderBuffer;
   { Do dialog }
   if Application^.ExecDialog (TheDialog) = id_OK then begin
      { Get data }
      with OrderBuffer do begin
         if (Radio1 and bf_Checked = bf_Checked) then Order := LEFTINDEX;
         if (Radio2 and bf_Checked = bf_Checked) then Order := LEFT;
         if (Radio3 and bf_Checked = bf_Checked) then Order := RIGHT;
         if (Radio4 and bf_Checked = bf_Checked) then Order := LLR;
         end;
      P^.CurBlock^.SetOrder (Order);
      writeln (newlog);
      write (newlog, 'COMMAND: Trees Order ');
      case Order of
         LEFTINDEX: writeln (newlog, 'Input');
         LEFT: writeln (newlog, 'Ladderize left');
         RIGHT: writeln (newlog, 'Ladderize right');
         LLR : writeln (newlog, 'Left light Rooted');
         end;
      writeln (newlog);
      UpDate;
      end;
end;


{----------------------------CMTreesShow-----------------------------------}

procedure TreeWindow.CMTreesShow (var Msg: TMessage);
type
   ShowTreeBuf = record
      Radio1,
      Radio2,
      Check1,
      Check2: word;
      FromTree,
      ToTree: longint;
      end;