cpmdi.pas

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

end;

{-----------------------------WMMenuSelect---------------------------------}

{ Process wm_MenuSelect message sent by Frame window.
  Load appropriate menu help string, and send FW_StatusBarUpDate
  message to frame window.
}
procedure MDIChild.WMMenuSelect (var Msg:TMessage);
var
   TextPtr : PChar;
   TmpStr : array[0..128] of char;
begin
   if (LoWord(Msg.lParam) = $FFFF) then
      { User has released mouse outside menu or pressed escape, so
        reset status bar to the default for the child window. }
      SendMessage (HWindow, fw_ChildStatusBar, 0, 0)
   else begin
      if (HiWord(Msg.lParam) = 0) then
         StrCopy (TmpStr, ' ')
      else begin
         { User has highlighted a menu item }
         case Msg.lParam and (mf_popup or mf_sysmenu) of
            0:
               { wParam is menu item NOT on app's system menu,
                 HiWord(lParam) is handle to popup menu. }
               begin
                  StrCopy (TmpStr, 'Menu');
               end;
            mf_Popup:
               { wParam is handle to pop-up menu }
               begin
                  { Top-level frame window menu item. }
                  StrCopy (TmpStr, 'Popup');
               end;
            mf_sysmenu:
               { wParam is menu item id from system menu }
                  case Msg.wParam of
                     { Load help string from resource file }
                     sc_Close:
                        LoadString (HInstance, sth_Close, TmpStr, MsgLength);
                     sc_Maximize:
                        LoadString (HInstance, sth_Maximize, TmpStr, MsgLength);
                     sc_Minimize:
                        LoadString (HInstance, sth_Minimize, TmpStr, MsgLength);
                     sc_Move:
                        LoadString (HInstance, sth_Move, TmpStr, MsgLength);
                     sc_NextWindow:
                        LoadString (HInstance, sth_NextWindow, TmpStr, MsgLength);
                     sc_Restore:
                        LoadString (HInstance, sth_Restore, TmpStr, MsgLength);
                     sc_Size:
                        LoadString (HInstance, sth_Size, TmpStr, MsgLength);

                     { Separator bar }
                     0 :
                        StrCopy (TmpStr, ' ');

                     end;
            mf_Popup or mf_Sysmenu:
               { wParam is handle to app's sys menu }
               LoadString (HInstance, sth_SystemMenu, TmpStr, MsgLength);
            end; {case }
         end; { then }
      TextPtr := @TmpStr;
      SendMessage (Parent^.HWindow, FW_StatusBarUpDate, 0, longint(TextPtr));
      end;
end;



{ A child specific status bar message. The default is ' Ready'. }
procedure MDIChild.FWChildStatusBar (var Msg:TMessage);
var
   lpszStatusStr: PChar;
begin
   lpszStatusStr := @StatusStr;
   SendMessage (Parent^.HWindow, fw_StatusBarUpdate, 0,
      longint(lpszStatusStr));
end;


{**********************}
{                      }
{ MDIFirstChild object }
{                      }
{**********************}

{-----------------------------WMMenuSelect---------------------------------}

{ Notify parent that first child is active.
  Ensure status bar shows child appropriate message. }
procedure MDIFirstChild.WMMDIActivate (var Msg:TMessage);
begin
   if (Msg.wParam <> 0) then begin
      SendMessage (Parent^.HWindow, um_NewChild, FirstChild, 0);
      SendMessage (HWindow, fw_ChildStatusBar, 0, 0);
      end;
end;

{**********************}
{                      }
{  NewMDIWindow object }
{                      }
{**********************}


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

{ Default settings of status and ribbon bar on, create first
  MDI child window. Necessary to create child before the
  ribbon dialog, otherwise child windows never become
  active. }
constructor NewMDIWindow.Init (ATitle:PCHar; AMenu:HMenu);
begin
   TMDIWindow.Init (ATitle, AMenu);
   StatusBarOn   := True;

   RibbonBarOn   := False;
   TheRibbon     := NIL;

   FirstChildWnd := new(PMDIFirstChild, Init (@Self, 'Log Window'));
   LogClosed     := False;

   StrCopy (StatusBarText, ' Ready');

   StatusLineBitmap := 0;
end;

{-----------------------------DefWndProc-----------------------------------}

{ Override to ensure that Frame window always has
  access to info on currently active MDI child
  (see procedure WMMenuSelect). }
procedure NewMDIWindow.DefWndProc (var Msg:TMessage);
var
   Result: longint;
begin
   if IsWindow (ClientWnd^.HWindow) then begin
      Result            := Sendmessage (ClientWnd^.HWindow, wm_MDIGetActive, 0, 0);
      hMDIActiveChild   := LoWord(Result);
      fMDIChildIsMax    := (HiWord(Result) = 1);
      end;
   TMDIWindow.DefWndProc (Msg);
end;


{ Override this method in descendants to ensure
  the log window is always there. }
procedure NewMDIWindow.RecreateFirstChild;
begin
   FirstChildWnd := new(PMDIFirstChild, Init (@Self, 'Log Window'));
   Application^.MakeWindow (FirstChildWnd);
end;

{ Override CMCloseChildren method by recreating the
  first child window. This ensures that the first
  child (typically the log window) is always visible. }
procedure NewMDIWindow.CMCloseChildren (var Msg:TMessage);
begin
   TMDIWindow.CMCloseChildren (Msg);
   RecreateFirstChild;
end;

{-----------------------------InitChild------------------------------------}

function NewMDIWindow.InitChild:PWindowsObject;
begin
   InitChild := new(PMDIChild, Init(@Self, 'Untitled window'));
end;

{-----------------------------ShowNewRibbon--------------------------------}

{ Display appropriate ribbon }
procedure NewMDIWindow.ShowNewRibbon (NewRibbon:PRibbonDialog);
var
   OldRibbon: PWindowsObject;
begin
   if (NewRibbon <> TheRibbon) then begin
      if RibbonBarOn then
         ShowWindow (TheRibbon^.HWindow, sw_Hide);
      TheRibbon := NewRibbon;
      if RibbonBarOn then
         ShowWindow (TheRibbon^.HWIndow, sw_Show);
      end;
end;

{-----------------------------UMNewChild-----------------------------------}

{ Perform any child specific actions here:


  2. toggle ribbon dialogs (if any).

 }
procedure NewMDIWindow.UMNewChild (var Msg:TMessage);
begin
   if (TheRibbon <> NIL) then
      case Msg.wParam of
         FirstChild : ShowNewRibbon (Ribbon1);
         SecondChild: ShowNewRibbon (Ribbon2);
         end;
end;

{-----------------------------GetStatusBarRect-----------------------------}

{ Return the status bar TRect, use Windows system metrics to
  make bar align with window corner }
procedure NewMDIWindow.GetStatusBarRect (var R:TRect);
begin
   GetClientRect (HWindow, R);
   R.top := R.bottom - GetSystemMetrics (sm_CYSize) -
            GetSystemMetrics (sm_CYBorder);
end;

(*{-----------------------------DrawStatusDivide-----------------------------}

{ Draw horizontal line separating status bar from MDIClient window }
procedure NewMDIWindow.DrawStatusDivide (DC: HDC; var R: TRect);
var
   dwResult : integer;
   OldPen, Pen : HPen;
begin
   dwResult := GetSystemMetrics(sm_CYBorder);
   Pen := CreatePen (ps_solid, dwResult, RGB(0,0,0));
   OldPen := SelectObject (DC, Pen);
   MoveTo (DC, 0, R.top);
   LineTo (DC, R.right, R.top);
   Pen := SelectObject (DC, OldPen);
   DeleteObject (Pen);
end;
*)
{-----------------------------ResizeClientWindow---------------------------}

{ Compute new coordinates for client window }
procedure NewMDIWindow.ResizeClientWindow;
var
   rs, rc: TRect;
begin
   GetClientRect (HWindow, rc);

   if RibbonBarOn then begin
      GetClientRect (TheRibbon^.HWindow, rs);
      rc.top := rc.top + rs.bottom;
      rc.bottom := rc.bottom - rs.bottom;
      end;


   GetStatusBarRect (rs);
   rc.bottom := rc.bottom - (rs.bottom - rs.top);
   MoveWindow (ClientWnd^.HWindow, 0, rc.top, rc.right, rc.bottom, True);
end;

{-----------------------------CreateRibbons--------------------------------}

procedure NewMDIWindow.CreateRibbons;
begin
{$IFDEF RIBBONS}

   Ribbon1 := new (PRibbonDialog, Init (@Self, 'RIBBON'));
   Ribbon1^.Create;
   Ribbon2 := new (PRibbonDialog, Init (@Self, 'RIBBON2'));
   Ribbon2^.Create;
{$ENDIF}
end;

{-----------------------------SetUpWindow----------------------------------}

{ Override in descendants to create the appropriate ribbon dialogs. }
procedure NewMDIWindow.SetUpWindow;
begin
   TMDIWindow.SetUpWindow;
   StatusBarUpDate (' Ready');

   {$IFDEF RIBBONS}
   CreateRibbons;
   TheRibbon := Ribbon1;
   ShowWindow (TheRibbon^.HWindow, sw_Show);
   RibbonBarOn := true;
   SendMessage (HWindow, wm_Size, 0, 0);
   SetFocus (HWindow);
   {$ENDIF}
end;


{-----------------------------CMRibbonShow---------------------------------}

{ Show the ribbon dialog box }
procedure NewMDIWindow.CMRibbonShow (var Msg:TMessage);
var
   R: TRect;
begin
   if not RibbonBarOn then begin
      ShowWindow (TheRibbon^.HWindow, sw_Show);
      RibbonBarOn := true;
      SendMessage (HWindow, wm_Size, 0, 0);
      SetFocus (HWindow);
      end;
end;

{-----------------------------CMRibbonHide---------------------------------}

{ Hide the ribbon dialog box }
procedure NewMDIWindow.CMRibbonHide (var Msg:TMessage);
var
   R: TRect;
begin
   if RibbonBarOn and (TheRibbon <> NIL) then begin
      ShowWindow (TheRibbon^.HWindow, sw_Hide);
      RibbonBarOn := False;
      SendMessage (HWindow, wm_Size, 0, 0);
      end;
end;

{-----------------------------BlastStatusLine------------------------------}

procedure NewMDIWindow.BlastStatusLine(PaintDC: HDC);
var
   r, r2 : TRect;
   MemDC: HDC;
   OldBmp: THandle;

begin
   GetStatusBarRect (R);
	Create3DEffect (PaintDC, R, 1);


(*   if (StatusLineBitMap <> 0) then begin
      GetClientRect (HWindow, r2);
      GetStatusBarRect (r);
      MemDC := CreateCompatibleDC(PaintDC);
      OldBmp := SelectObject(MemDC, StatusLineBitmap);
      with r do
        BitBlt(PaintDC, 0, r2.Bottom - (Bottom - Top), Right,
          Bottom - Top, MemDC, 0, 0, SrcCopy);
      SelectObject(MemDC, OldBmp);
      DeleteDC(MemDC);
      end;
*)

end;

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

{ Paint the status bar }
procedure NewMDIWindow.Paint (PaintDC: HDC; var PaintInfo: TPaintStruct);
begin
   TMDIWindow.Paint (PaintDC, PaintInfo);
   BlastStatusLine (PaintDC);
   DrawStatusBar (PaintDC);
end;

{-----------------------------DrawStatusBar--------------------------------}

{ Write text to the status bar using small ANSI font. }
procedure NewMDIWindow.DrawStatusBar (DC: HDC);
var
  r          : TRect;
  hOld,
  hSmall     : HFont;
  lf         : TLogFont;
  TextHeight : word;
begin
   GetStatusBarRect (r);
   { Get a slightly smaller font than the default }