cpwtplot.pas

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

{$I CPDIR.INC}

(*{$DEFINE PRINT_AREA}*)

(*{$DEFINE LETTERS}*)

unit cpwtplot;

{*

   Tree printing and previewing module.

   15-20 Nov 1991  Written


   To do:
   -----

   Test on other printers to check things like
   non-printing areas on page, etc.

   Problem if printing >1 page, once dialog box disappears,
   window is repainted: this also affects the printing on paper!


    5 Dec 1991 The problem with only the first page printing
               is because NEWFRAME resets the printer DC to
               the system defaults!

   24 Jul 1992 Can now copy a metafile picture of the currently
               displayed page to the Windows Clipboard for pasting
               into other apps.

   10 Aug 1992 Text did not align correctly on trees pasted to clipboard
               because user font was not selected into printer DC
               when calculating font height.

    5 Jan 1993 Support for disk based Metafiles added.
   24 Feb 1993 SetBKMode (hdcPlot, TRANSPARENT) added to ensure
               leaf labels do not overwrite each other if close. 
   16 Mar 1993 Uses CPWMETA2 for better handling of disk-based metafiles.
*}

interface

uses
   WinDos,
   WinTypes,
	WinProcs,
	{$IFDEF BWCC}    	{ use Borland-style dialogs }
   BWCC,
   {$IFDEF VER10}   	{ TPW 1.0 }
   WObjectB,
   StdDlgsB,
   {$ELSE}				{ TPW 1.5}
   WObjects,
   StdDlgs,
	{$ENDIF} {VER10}
	{$ELSE}           { standard dialogs }
	WObjects,
   StdDlgs,
	{$ENDIF} {BWCC}
	Strings,
   cpwvars,
   cpheader,   { Resource constants }
   cputil,
   cpwprint,
   cplabels,
   cptree,
   newprof,
   cpwcontl,
   cpwdlg,
   cpplot,
	gridco,
   {$IFDEF OLDMETA}
   cpwmeta;
   {$ELSE}
   cpwmeta2;
   {$ENDIF}


const
   { line thicknesses in pixels }
   line_thin   = 1;
   line_medium = 2;
   line_thick  = 3;

   SizeDigits  = 3;

type
   { User selected font, line, style, and format characteristics.
     Used within dialog to keep track of user selections. }
   LineFontRec = record
      FHeight  : integer;  { in pts }
      FWeight  : integer;  { fw_xxxx constant }
      FItalic  : integer;  { 0=no, 1=yes }
      FQuality : integer;  { Default_, Draft_, or Proof_Quality }
      FName    : array[0..lf_FaceSize] of char;    { a valid font name }
      LWidth   : integer;  { in pixels, use line_ constants above }
      TStyle   : integer;  { tp_xxxx constant from CPTREE.PAS }
      xTrees,              { trees per x and y dimension }
      yTrees   : integer;
      ShowNumber : Boolean;
      end;

   DIRECTION = (BACKWARDS, FORWARDS);

   { Object to plot trees on a pge, either on screen or on paper.
     This object requires a display context to be assigned
     complete with choosen fonts and line styles. }
   TreePlotter = object
      PlotInfo     : TPlotRec;        { plotter info for a tree plot }
      constructor Init (PPtr: PPROFILE; Ox, Oy,x, y, s:integer); 
      procedure Coordinates (DC:HDC);
      procedure ScreenCoordinates (DC:HDC;WinX, WinY:integer);

      procedure SetDC (DC:HDC);

      procedure Repaginate (x, y:integer);

      procedure PrintTrees (StartTree:integer; IsMetaFile, ShowNumber: Boolean);
      function MorePages (d:DIRECTION):Boolean;
      function NextStartTree (d:DIRECTION):integer;
      procedure SetStyle(TStyle:integer);

      procedure PrintNextPage (ShowNumber:Boolean);{ (DC:HDC)}
      procedure SaveCurTree;
      procedure RestoreCurTree;
      function NumPages:integer;
      private
      CurTree      : integer;         { first tree on page }
      OldCurTree   : integer;
      P            : PPROFILE;  { profile of trees }

      hdcPlot      : HDC;            { display context  }

      xTrees,                         { no. of cols of trees }
      yTrees,                         { no. of rows of trees }
      Pages,                          { pages of trees in profile }
      TreesPerPage : integer;         { trees per page }
      Style,                          { style of tree plot }
      xCell,                          { width of cell on page }
      yCell        : integer;         { height of cell on page }
      xOffset,                        { indents within cell for a tree plot }
      yOffset      :integer;
      CellGapX,
      CellGapY     : integer;

      { These values apply only to screen preview, where the
        "page" is inside a window. }
      xOrigin,                        { indents from page (0,0) }
      yOrigin      : integer;
      function MaxLabelSpace (DC:HDC):word;
      end;



  PLayBuf = ^LayBuf;
  LayBuf = record
     szX,
     szY,
     szXY : array[0..4] of char;
     chk1 : word;
     end;


   PLayoutDlg = ^LayoutDlg;
   LayoutDlg = object(TDialog)
      procedure SetupWindow;virtual;
      procedure MMNewGrid (var Msg:TMessage);
         virtual wm_First + mm_NewGrid;
      end;


   { Trees Print dialog box, with page preview and printing }
   PPVWindow = ^PVWindow;
   PVWindow = object(CPWDialog)
      PaintDC    : HDC;
      P          : PPROFILE;
      TP         : TreePlotter;
      FontSize   : integer;
      x,y,ox,oy  :integer;
      CurTree    :integer;
      LF         : LineFontRec;
      PR         : PrinterRec;
      hdcPrn     : HDC;
      ScreenFont : HFont;
      ScreenPen  : HPen;
      pFonts,
      pSizes     : PStrCollection;
      Portrait : Boolean;
      constructor Init (AParent:PWindowsObject; ATitle:PChar;
                   AHelpID:longint; PPtr: PPROFILE);
      destructor Done;virtual;
      procedure SetUpWindow;virtual;
      procedure WMPaint (var Msg:TMessage);
         virtual wm_First + wm_Paint;
      procedure PaintPage;
      function PtsToScreenPixels(Item:integer):integer;
      procedure RepaintPage;
      { buttons }
      procedure IDPrintAll (var Msg:TMessage);
         virtual id_First + id_PrintAll;
      procedure IDPrintPage (var Msg:TMessage);
         virtual id_First + id_PrintPage;
      procedure IDLastPage (var Msg:TMessage);
         virtual id_First + id_LastPage;
      procedure IDNextPage (var Msg:TMessage);
         virtual id_First + id_NextPage;
      procedure IDLayout (var Msg:TMessage);
         virtual id_First + id_Layout;
      procedure IDStyle (var Msg:TMessage);
         virtual id_First + 311;
      procedure IDFonts (var Msg:TMessage);
         virtual id_First + id_Fonts;

      procedure IDCopy (var Msg:TMessage);
         virtual id_First + id_CopyToClipboard;
      procedure IDWMFFile (var Msg:TMessage);
         virtual id_First + id_WMFFile;
      procedure TreeMetaFile (Disk : Boolean; DiskFileName : PChar);
      procedure IDClose (var Msg : TMessage);
         virtual id_First + 400;
      end;

implementation


const
   Indent     =  10; { page is indented by this amount }
   WindowW    = 550; { window dimensions }
   WindowH    = 380;
   ShadowH    =   5; { height & width of page shadow }
   ShadowOff  =   2; { offset so page border is still visible }
   ShadowInd  =  10; { indent of shadow from left margin }
   MaxPageDim = 330; { maximum dimension of page in pixels }


var
  InchMargin : integer;
  {$IFDEF LETTERS}
  Res : real;
  {$ENDIF}

   procedure LayoutDlg.SetUpWindow;
   var
      s: array[0..4] of char;
      x,
      y: integer;
      p:PChar;
   begin
      TDialog.SetupWindow;

      { Set up grid }
      { Get data from transfer buffer }
      x := atoi (PLayBuf(TransferBuffer)^.szX);
      y := atoi (PLayBuf(TransferBuffer)^.szY);
      { Very important to use PostMessage }
      PostMessage (GetDlgItem (HWindow, id_TreesGrid), mm_SetGrid, x, y);
   end;

   procedure LayoutDlg.MMNewGrid (var Msg:TMessage);
   var
      s : array[0..4] of char;
   begin
      { Handle grid message }
      Str (Msg.wParam, s);
      SetDlgItemText (HWindow, id_xTrees, s);
      Str (Msg.lParam, s);
      SetDlgItemText (HWindow, id_yTrees, s);
      Str (Msg.wParam*Msg.lParam, s);
      SetDlgItemText (HWindow, id_TreesPerPage, s);
   end;




{**********************}
{                      }
{  Utility procedures  }
{                      }
{**********************}

{-----------------------------Makefont-------------------------------------}

{ Create user selected font. }
function MakeFont(Height, Weight, Italic, CharSet, Quality:integer;
                           FontName:PChar):THandle;
var
   lf: TLogFont;
begin
   with lf do begin
      lfHeight         := Height;
      lfWidth          := 0;
      lfEscapement     := 0;
      lfOrientation    := 0;
      lfWeight         := Weight;
      lfItalic         := Italic;
      lfUnderline      := 0;
      lfStrikeOut      := 0;
      lfCharSet        := Charset;
      lfOutPrecision   := Out_Default_Precis;
      lfClipPrecision  := Clip_Default_Precis;
      lfQuality        := Quality;
      lfPitchAndFamily := Variable_Pitch or ff_Swiss;
      StrCopy(@lfFaceName, FontName);
      end;
   MakeFont := CreateFontIndirect (lf);
end;

{-----------------------------MakePen--------------------------------------}

{ Create a pen of specified thickness }
function MakePen (Thickness:integer):THandle;
begin
   MakePen := CreatePen (ps_solid, Thickness, RGB(0,0,0));
end;


{**********************}
{                      }
{  TreePlotter object  }
{                      }
{**********************}

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

   constructor TreePlotter.Init(PPtr: PPROFILE;
                                Ox,         { indent from x origin }
                                Oy,         { indent from y origin }
                                x,          { no. of cols of trees }
                                y,          { no. of rows of trees }
                                s:integer); { style of tree plot   }
   begin
      P             := PPtr;
      xTrees        := x;
      yTrees        := y;
      TreesPerPage  := xTrees * yTrees;
      Pages         := Pred(PPtr^.CurBlock^.TotalTrees) div TreesPerPage + 1;
      Style         := s;
      { Indents (if any) from (0,0) }
      yOrigin := Oy;
      xOrigin := Ox;
      CurTree := 1;
   end;

{-----------------------------SetDC----------------------------------------}

   { DC must be a valid device context, with font and linesize
     already assigned. }
   procedure TreePlotter.SetDC (DC:HDC);
   begin
      hdcPlot := DC;
      { 24 February 1993 }
      SetBKMode (hdcPlot, TRANSPARENT); 
   end;


   procedure TreePLotter.SetStyle (TStyle:integer);
   begin
      Style := TStyle;
   end;

   procedure TreePlotter.Repaginate(
                                x,          { no. of cols of trees }
                                y:integer); { no. of rows of trees }
   begin
      xTrees        := x;
      yTrees        := y;
      TreesPerPage  := xTrees * yTrees;
      Pages         := Pred (P^.CurBlock^.TotalTrees) div TreesPerPage + 1;
      CurTree := 1;
   end;


{-----------------------------MaxLabelSpace--------------------------------}

   { Return the width of the largest label in the profile
     in pixels using the currently selected font. }
   function TreePlotter.MaxLabelSpace (DC: HDC):word;
   var
      i:integer;
      s:string;
      MaxL, ThisL : word;
      Buf : array[0..20] of char;
   begin
      MaxL := 0;
      with P^.CurBlock^ do
         for i := 1 to OriginalLeaves do
            if (A.IsActive (i)) then begin
               { ensure there is a space before label }
               s := 'X' + L.ReturnLabel (i);
               StrPCopy (Buf, s);
               ThisL := LoWord (GetTextExtent (DC, Buf, StrLen(Buf)));
               if (ThisL > MaxL) then
                  MaxL := ThisL;
               end;
      MaxLabelSpace := MaxL;
   end;

{-----------------------------Coordinates----------------------------------}

   { Compute page sizes and plotter cell invariants common
     to all cells for printing to paper. }
   procedure TreePlotter.Coordinates;
   var
      xPage, yPage: integer;
      tm :TTextMetric;
      i : integer;
      TmpFont: HFont;
   begin
      with PlotInfo do begin
         InchMarginX := InchMargin;
         InchMarginY := InchMargin;
         end;

      { Size of page in pixels }
      xPage := GetDeviceCaps (DC, HorzRes);
      yPage := GetDeviceCaps (DC, VertRes);

      { Space between each cell in pixels }
      if (yTrees > 1) then
         CellGapY := (PlotInfo.InchMarginX{ * 2}) div Pred (yTrees)
      else CellGapY := 0;
      if (xTrees > 1) then
         CellGapX := (PlotInfo.InchMarginY{ * 2}) div Pred (xTrees)
      else CellGapX := 0;


      { Size of cell in pixels. Allow for left and
        right paper margins, and let total space between
        tree cells to sum to one half Margin width.  }
      xCell := (xPage - 2 * PlotInfo.InchMarginX - (CellGapX * Pred(xTrees)))
               div xTrees;
      yCell := (yPage - 2 * PlotInfo.InchMarginY - (CellGapY * Pred(yTrees)))
               div yTrees;


      { No offset for paper }
      YOffSet := 0;
      XOffSet := 0;


     { Plotter info }
      with PlotInfo do begin
         wx     := xCell;         { width of printing cell }
         hy     := yCell;
         xLeaf  := wx - MaxlabelSpace (DC);
         yLeaf  := hy / Pred (P^.CurBlock^.Leaves);
         xLabel := LoWord(GetTextExtent(DC, 'X',1));
         end;

      GetTextMetrics (DC, tm);
      with tm do
         PlotInfo.yLabel :=
          (tmAscent - tmInternalLeading) div 2 + tmInternalLeading;
   end;

{-----------------------------ScreenCoordinates----------------------------}

   { Compute page sizes and plotter cell invariants common
    to all cells for drawing page preview on screen. }
   procedure TreePlotter.ScreenCoordinates (DC:HDC;WinX, WinY:integer);
   var
      xPage, yPage: integer;
      tm :TTextMetric;
      i : integer;
   begin
      xPage := WinX;
      yPage := WinY;

      { margins in screen pixels }
      PlotInfo.InchMarginX := xOrigin - INDENT;
      PlotInfo.InchMarginY := yOrigin - INDENT;

{      xCell := (xPage - PlotInfo.InchMarginX) div xTrees;
      yCell := (yPage - PlotInfo.InchMarginY) div yTrees;}

      { Space between each cell in pixels }
      if (yTrees > 1) then
         CellGapY := ({2 * }PlotInfo.InchMarginX)  div Pred (yTrees)
      else CellGapY := 0;
      if (xTrees > 1) then
         CellGapX := ({2 * }PlotInfo.InchMarginY) div Pred (xTrees)