cpwlog.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.      *
*                                                                  *
*******************************************************************}

{*
   Log window for COMPONENT.

   A scrollable window using OEM_Fixed_Font to display
   the contents of the 32K text buffer implemented in
   CPWBUF.PAS. This window has a keyboard interface,
   and does not respond to the wm_Close message.

   <\b History>

   21 Aug 1991 Written.
   30 Oct 1991 GetClassName added so that icons work properly.
    7 Nov 1991 WMMDIActivate modified so that window is updated
               when activated.
   31 Dec 1991 Log window is now a desc of MDIFirstChild in CPMDI.PAS.
    7 Jan 1992 SetBkMode(PaintDC) added so that if user has a
               nonwhite window client area, text doesn't appear
               as black on white background.
   21 Apr 1992 SetTextColor added so that change Window Text color
               affects window.
*}


{$I cpdir.inc}

unit cpwlog;

interface

uses
   WinTypes,
   WinProcs,
	{$IFDEF BWCC}  { use Borland-style dialogs }
   {$IFDEF VER10} { TPW 1.0 }
   WObjectB,
   BWCC,
	{$ELSE}        { TPW 1.5 } 
   WObjects,
   {$ENDIF}
	{$ELSE}         
   WObjects,
	{$ENDIF}		   {use standard dialogs }
	Strings,
   cpwvars,
   cpwbuf,    { 32K text buffer }
	cpmdi;     { MDI windows }



type
   PLogWindow = ^LogWindow;
      { Pointer to log window }
   LogWindow = object (MDIFirstChild)
      { Log window object }
      constructor Init (AParent: PWindowsObject; ATitle:PChar);
         { Call ancestor's Init method then compute scroller range based
           on OEM font }
      procedure GetWindowClass (var AWndClass:TWndClass);virtual;
         { Return the window class in <\b AWndClass> and load the window's icon }
      function GetClassName:PChar;virtual;
         { Returns 'LogWindow' }
      procedure Paint (PaintDC: HDC; var PaintInfo: TPaintStruct);virtual;
         { Paint the text in the display buffer }
      procedure WMClose (var Msg: TMessage);
         virtual wm_First + wm_Close;
         { Override WMClose method to ensure user cannot close window }  
      procedure WMDestroy (var Msg: TMessage);
         virtual wm_First + wm_Destroy;
         { Call ancestor's WMDestroy method then send parent the [fw_LogClosed] message }
      function CanClose:Boolean;virtual;
         { Calls the display buffer's CanClose method }
      procedure WMKeyDown (var Msg: TMessage);
         virtual wm_First + wm_KeyDown;
         { Provides a keyboard interface for window }
      procedure WMMDIActivate (var Msg:TMessage);
         virtual wm_First + wm_MDIActivate;
         { Update the window } 
      private
      TextHeight : integer;
      TextWidth  : integer;
      end;


implementation

const
   FONT    = OEM_Fixed_Font;  { ASCII + IBM graphics characters }
   XScroll = LINEBUFFERSIZE;  { scroll horizontally the width of a line }
   YScroll = 0;               { arbitrary start value, updated in cpwbuf }


{-----------------------------Init-----------------------------------------}
   { Initialize window, compute font metrics. }
   constructor LogWindow.Init (AParent:PWindowsObject; ATitle:PChar);
   var
      DC       : HDC;
      SaveFont : HFont;
      Metrics  : TTextMetric;
   begin
      MDIFirstChild.Init (AParent, ATitle);
      Attr.Style := Attr.Style or ws_VScroll or ws_HScroll;

      { Get the height of the text that will be used }
      DC       := GetDC (HWindow);
      SaveFont := SelectObject(DC, GetStockObject (FONT));
      GetTextMetrics (DC, Metrics);
      TextHeight := Metrics.tmHeight + Metrics.tmExternalLeading;
      TextWidth  := Metrics.tmMaxCharWidth;
      SelectObject (DC, SaveFont);
      ReleaseDC (HWindow, DC);

      { Set up the scroller bars }
      Scroller := New(PScroller, Init (@Self, TextWidth, TextHeight,
                                       XScroll, YScroll));
      Scroller^.AutoMode  := False;
      Scroller^.TrackMode := False;
   end;


{-----------------------------GetWindowClass-------------------------------}
   { Extend to load log icon. }
   procedure LogWindow.GetWindowClass (var AWndClass:TWndClass);
   begin
      TWindow.GetWindowClass (AWndClass);
      { Load icon here }
      AWndClass.hIcon := LoadIcon(HInstance, 'LOGWINDOW_ICON');
   end;

{-----------------------------GetClassName---------------------------------}
   function LogWindow.GetClassName:PChar;
   begin
      GetClassName := 'LogWindow';
   end;

{-----------------------------Paint----------------------------------------}
   { Update the window if necessary }
   procedure LogWindow.Paint (PaintDC: HDC; var PaintInfo: TPaintStruct);
   var
      SaveFont: HFont;
   begin
      SaveFont := SelectObject(PaintDC, GetStockObject(FONT));
      SetBkMode (PaintDC, Transparent);
      SetTextColor (PaintDC, GetSysColor (color_WindowText));
      DisplayBuffer.WShowPage (PaintDC, Scroller^.YPos,
        Succ(Scroller^.YPos + Scroller^.YPage));
      SelectObject (PaintDC, SaveFont);
   end;

{-----------------------------WMClose--------------------------------------}
   procedure LogWindow.WMClose (var Msg: TMessage);
   begin
   end;

{-----------------------------WMKeyDown------------------------------------}
   { Provide a keyboard interface }
   procedure LogWindow.WMKeyDown (var Msg: TMessage);
   begin
      case Msg.wParam of
         vk_Home  : SendMessage (HWindow, wm_VScroll, sb_Top,      0);
         vk_End   : SendMessage (HWindow, wm_VScroll, sb_EndScroll,0);
         vk_Prior : SendMessage (HWindow, wm_VScroll, sb_PageUp,   0);
         vk_Next  : SendMessage (HWindow, wm_VScroll, sb_PageDown, 0);
         vk_Up    : SendMessage (HWindow, wm_VScroll, sb_LineUp,   0);
         vk_Down  : SendMessage (HWindow, wm_VScroll, sb_LineDown, 0);
         vk_Left  : SendMessage (HWindow, wm_HScroll, sb_PageUp,   0);
         vk_Right : SendMessage (HWindow, wm_HScroll, sb_PageDown, 0);
         end;
   end;

{-----------------------------WMMDIActivate--------------------------------}
   { If window is being activated, update the display buffer. }
   procedure LogWindow.WMMDIActivate (var Msg: TMessage);
   var
      x:longint;
   begin
      if (Msg.wParam <> 0) then begin
         { Ensure window is updated }
         InvalidateRect (HWindow, NIL, True);
         DisplayBuffer.Update;
         x := DisplayBuffer.BytesInBuffer;
         wvsprintf (StatusStr, ' Ready (%d bytes in buffer)', x);
         SendMessage (HWindow, fw_ChildStatusBar, 0, 0);

         { Notify parent that the active child is a log window }
         SendMessage (Parent^.HWindow, um_DisplayWindow, 0, 0);
         end;
   end;

{-----------------------------CanClose-------------------------------------}
   function LogWindow.CanClose:Boolean;
   begin
      CanClose := DisplayBuffer.CanClear;
   end;


{-----------------------------WMDestroy------------------------------------}
   procedure LogWindow.WMDestroy (var Msg: TMessage);
   var
      H: HWnd;
   begin
      H := Parent^.HWindow;
      TWindow.WMDestroy (Msg);
      SendMessage (H, fw_LogClosed, 1, 0);
   end;


end.