cpmdi.pas

来自「生物信息学中的遗传数据分析的delphi源码。」· PAS 代码 · 共 1,094 行 · 第 1/3 页

   hOld := GetStockObject(ANSI_VAR_FONT);             { stock font }
   if (hOld <> 0) then begin
      GetObject( hOld, sizeof(TLogFont), @lf );
      if (lf.lfHeight > 3) then
	lf.lfHeight := lf.lfHeight - 3;
      lf.lfWidth := 0;
      hSmall     := CreateFontIndirect(lf);
      end
   else hSmall := 0;
   if (hSmall <> 0) then
      hOld := SelectObject(DC, hSmall)
   else hOld := 0;
   TextHeight := HiWord(GetTextExtent(DC, StatusBarText,
                   strlen(StatusBarText)));

   { Paint text }
   SetBkMode (DC, Transparent);
   SetTextColor (DC, GetSysColor (color_WindowText));
   TextOut (DC, 1, r.top + ((r.bottom - r.top) - TextHeight) div 2,
            StatusBarText, strlen(StatusBarText));

   if (hSmall <> 0) then begin
      hSmall := SelectObject (DC, hOld);
      DeleteObject (hSmall);
      end;
end;

{-----------------------------WMSize---------------------------------------}

{ Ensure status bar is displayed when user resizes window }
procedure NewMDIWindow.WMSize (var Msg:TMessage);
var
  Bmp: HBitmap;
  DC: HDC;
  DestDC: HDC;
  OldSrc: HBitmap;
  OldDest: HBitmap;
  R1, R2: TRect;
  SrcDC: HDC;
  StatusLineHeight : integer;

begin
   TWindow.WMSize (Msg);
   ResizeClientWindow;

(*   GetClientRect (HWindow, r2);
   GetStatusBarRect (r1);
   StatusLineHeight := r1.bottom - r1.top;

   DC := GetDC(HWindow);
   SrcDC := CreateCompatibleDC(DC);
   DestDC := CreateCompatibleDC(DC);
   ReleaseDC (HWindow, DC);

   { Load and size status line bitmap }

   { Load bitmap }
   Bmp    := LoadBitmap(HInstance, MakeIntResource(bmp_StatusBar));

   { Select it into the source DC }
   OldSrc := SelectObject(SrcDC, Bmp);

   { If a previous status line bitmap exists, delete it }
   if StatusLineBitmap <> 0 then
    DeleteObject(StatusLineBitmap);

   { Create a bitmap with the dimensions of the status bar }
   StatusLineBitmap := CreateCompatibleBitmap(DC,
                          R2.right, r1.bottom - r1.top);
   { Select status bar bitmap }
   OldDest := SelectObject(DestDC, StatusLineBitmap);

   { bit blit left 5 bits of bmp_StatusBar into destination DC }
   BitBlt(DestDC, 0, 0, 5, StatusLineheight, SrcDC, 0, 0, srcCopy);

   { stretch bits 6-20 of bmp_StatusBar to fill main part of bar }
   StretchBlt(DestDC, 5, 0, R2.Right - 5, StatusLineheight,
              SrcDC, 6, 0, 20, StatusLineHeight, srcCopy);

   { bit blit right five bits }
   BitBlt(DestDC, R2.Right - 5, 0, 5, StatusLineHeight, SrcDC, 59, 0, srcCopy);

   { clean up }
   SelectObject(SrcDC, OldSrc);
   SelectObject(DestDC, OldDest);
   DeleteDC(SrcDC);
   DeleteDC(DestDC);
   DeleteObject(Bmp);
*)
end;

{-----------------------------FWStatusBarUpDate----------------------------}

{ Handle a fw_StatusBarUpdate message sent by a child window }
procedure NewMDIWindow.FWStatusBarUpDate (var Msg:TMessage);
begin
   { lParam is a pointer to the string }
   StatusBarUpDate (PChar(Msg.lParam));
end;

{-----------------------------StatusBarUpDate------------------------------}

{ Replace status bar text with s }
procedure NewMDIWindow.StatusBarUpDate (s:PChar);
var
   R  : TRect;
   DC : HDC;
begin
   StrCopy (StatusBarText, s);
   DC := GetDC (HWindow);
   BlastStatusLine (DC);
   DrawStatusBar (DC);
   ReleaseDC (HWindow, DC);
end;

{-----------------------------AppMenuHelpText------------------------------}

{ A hook to allow descendants to insert their own
  application specific help. For now, just return
  the menu item id. }
procedure NewMDIWindow.AppMenuHelpText (Textid:word);
var
   s1 : string;
   A : array[0..10] of char;
begin
   Str (Textid, s1);
   StrPCopy (A, s1);
   StrCopy (StatusBarText, ' Undocumented menu item: ');
   StrCat (StatusBarText, A);


   { General form will be

   case TextID of
      cm_x : LoadString (HInstance, sth_x, StatusBarText, msgLength);
      end;
   }

end;

{-----------------------------MenuHelpText---------------------------------}

{ Display menu help in status bar }
procedure NewMDIWindow.MenuHelpText (Textid:word);
var
   R: TRect;
begin
   { Get appropriate help text }
   case TextId of
      { Application system commands [constants defined in WinTypes] }
      sc_Close          : LoadString (HInstance, sth_AppClose, StatusBarText, MsgLength);
      sc_Maximize       : LoadString (HInstance, sth_AppMaximize, StatusBarText, MsgLength);
      sc_Minimize       : LoadString (HInstance, sth_AppMinimize, StatusBarText, MsgLength);
      sc_Move           : LoadString (HInstance, sth_AppMove, StatusBarText, MsgLength);
      sc_TaskList       : LoadString (HInstance, sth_AppTaskList, StatusBarText, MsgLength);
      sc_Restore        : LoadString (HInstance, sth_AppRestore, StatusBarText, MsgLength);
      sc_Size           : LoadString (HInstance, sth_AppSize, StatusBarText, MsgLength);

      { Standard commands defined in WObjects }
      cm_EditCut        : LoadString (HInstance, sth_EditCut, StatusBarText, MsgLength);
      cm_EditCopy       : LoadString (HInstance, sth_EditCopy, StatusBarText, MsgLength);
      cm_EditPaste      : LoadString (HInstance, sth_EditPaste, StatusBarText, MsgLength);
      cm_EditDelete     : LoadString (HInstance, sth_EditDelete, StatusBarText, MsgLength);
      cm_EditClear      : LoadString (HInstance, sth_EditClear, StatusBarText, MsgLength);
      cm_EditUndo       : LoadString (HInstance, sth_EditUndo, StatusBarText, MsgLength);
      cm_EditFind       : LoadString (HInstance, sth_EditFind, StatusBarText, MsgLength);
      cm_EditReplace    : LoadString (HInstance, sth_EditReplace, StatusBarText, MsgLength);
      cm_EditFindNext   : LoadString (HInstance, sth_EditFindNext, StatusBarText, MsgLength);

      cm_FileNew        : LoadString (HInstance, sth_FileNew, StatusBarText, MsgLength);
      cm_FileOpen       : LoadString (HInstance, sth_FileOpen, StatusBarText, MsgLength);
      cm_MDIFileNew     : LoadString (HInstance, sth_FileNew, StatusBarText, MsgLength);
      cm_MDIFileOpen    : LoadString (HInstance, sth_FileOpen, StatusBarText, MsgLength);
      cm_FileSave       : LoadString (HInstance, sth_FileSave, StatusBarText, MsgLength);
      cm_FileSaveAs     : LoadString (HInstance, sth_FileSaveAs, StatusBarText, MsgLength);
      cm_Exit           : LoadString (HInstance, sth_Exit, StatusBarText, MsgLength);


      cm_CascadeChildren: LoadString (HInstance, sth_Cascade, StatusBarText, MsgLength);
      cm_TileChildren   : LoadString (HInstance, sth_Tile, StatusBarText, MsgLength);
      cm_ArrangeIcons   : LoadString (HInstance, sth_Arrange, StatusBarText, MsgLength);
      cm_CreateChild    : LoadString (HInstance, sth_Create, StatusBarText, MsgLength);
      cm_CloseChildren  : LoadString (HInstance, sth_CloseChildren, StatusBarText, MsgLength);

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

      { Return codes of child windows listed in the menu given by
        ChildPos, constants defined in WObjects. }
      id_Reserved..Pred (nf_First-id_First)
                        : LoadString (HInstance, sth_Activate, StatusBarText, MsgLength);


      { App specific commands to go here }
      else AppMenuHelpText (TextID);
      end;
   StatusBarUpDate (StatusBarText);
end;

{-----------------------------FirstItemInPopup-----------------------------}

{ Return the ID of the first item in a popup menu. }
function NewMDIWindow.FirstItemInPopup (PopupHandle:word):word;
begin
   FirstItemInPopup := GetMenuItemID (PopupHandle, 0);
end;

{-----------------------------AppPopupMenuHelpText--------------------------}

{ Display application specific help for a popup menu.
  Override in descendants }
procedure NewMDIWindow.AppPopupMenuHelpText (ItemID:word);
begin
   case ItemID of
      cm_CreateChild  : StrCopy (StatusBarText, 'Manipulate active windows');
      0               : StrCopy (StatusBarText, 'Second menu');
      else StrCopy (StatusBarText, 'Undocumented popup menu');
      end;
end;

{-----------------------------PopupMenuHelpText----------------------------}

{ Display help text for standard Windows popup menus. }
procedure NewMDIWindow.PopupMenuHelpText (ItemID:word);
begin
   case FirstItemInPopup (ItemID) of
      cm_FileNew      : LoadString (HInstance, sth_File, StatusBarText, MsgLength);
      cm_EditUndo     : LoadString (HInstance, sth_EditU, StatusBarText, MsgLength);
      cm_EditCut      : LoadString (HInstance, sth_EditC, StatusBarText, MsgLength);
      cm_TileChildren : LoadString (HInstance, sth_Window, StatusBarText, MsgLength);
      else AppPopupMenuHelpText (FirstItemInPopup (ItemID));
      end;
   StatusBarUpDate (StatusBarText);
end;

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

{ Show menu selection in status bar. Requires DefWindProc to be
  overridden to provide info on currently active MDI child.

  wm_MenuSelect message has info on both menu handles and
  items. The first popup item is always 0. Code has
  to check for maximized MDI children to insure that it
  correctly handles system menu buttons in the frame window's
  menu bar.

  Menu item ids are the numeric values the menu returns, which
  are those given in the resource files.

             lParam
           ---------
  wParam   lo     hi
  -------------------------------------------------------------------------
           $FFFF   0   User released mouse outside menu, or pressed Esc
                   0   User dragged mouse outside menu

  item id   00   hmenu An item "id" in popup menu "hmenu"
  hmenu     10         Non system popup menu "hmenu"
  item id   01         An item "id" from system popup menu
  hmenu     11         System popup menu "hmenu"
  -------------------------------------------------------------------------
           flags       [also mf_Grayed, etc flags here]
            ||
            |mf_sysmenu
            mf_popup
}
procedure NewMDIWindow.WMMenuSelect (var Msg:TMessage);
begin
   if (LoWord(Msg.lParam) = $FFFF) then
      { User has released mouse outside menu or pressed escape,
        so return status bar to default for the currently active
        child window. }
      SendMessage (hMDIActiveChild, fw_ChildStatusBar, 0, 0)
   else
      if (HiWord(Msg.lParam) = 0) then
         { User has dragged mouse outside menu }
         StatusBarUpDate (' ')
      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
                  if (hMDIActiveChild <> 0) and fMDIChildIsMax then begin
                     { An MDI child exists and is maximized... }
                     if (HiWord(Msg.lParam) = GetSubMenu(GetMenu(HWindow), 0)) then
                        { Menu item is in child's system menu.
                          Set the mf_sysmenu
                          flag and send message to child. }
                        SendMessage (hMDIACtiveChild, wm_MenuSelect,
                                     Msg.wParam, Msg.lParam or mf_sysmenu)
                        else
                           { Frame window popup menu item }
                           MenuHelpText (Msg.wParam);

                     end
                  else
                     { No maximized MDI child, so
                       frame window popup menu item. }
                      MenuHelpText (Msg.wParam);
               end;
            mf_Popup:
               { wParam is handle to pop-up menu, could be a
                 top-level frame menu, or if a child window
                 is maximized, the child's system menu. }
               begin
                  if (hMDIActiveChild <> 0) and fMDIChildIsMax then begin
                     { An MDI child exists and is maximized... }
                     if (Msg.wParam = GetSubMenu(GetMenu(HWindow), 0)) then
                        { If popup menu is first top-level menu then it is
                          the MDI child's system menu. Set the mf_sysmenu
                          flag and send message to child. }
                        SendMessage (hMDIACtiveChild, wm_MenuSelect,
                                     Msg.wParam, Msg.lParam or mf_sysmenu
                                     or mf_popup)
                     else
                        { Top-level frame window menu item. }
                        PopupMenuHelpText (Msg.wParam);
                     end
                  else begin
                     { No maximized MDI child, so top-level frame
                       window menu item. }
                     PopupMenuHelpText (Msg.wParam);
                     end;
               end;
            mf_Sysmenu:
               { wParam is menu item id from system menu }
               MenuHelpText (Msg.wParam);

            mf_Popup or mf_sysmenu:
               { wParam is handle to app's sys menu }
               begin
                  LoadString (HInstance, sth_AppSystemMenu,
                              StatusBarText, MsgLength);
                  StatusBarUpDate (StatusBarText);
               end;
            end; {case }
         end; { else }
end;


procedure NewMDIWindow.UMReady (var Msg:TMessage);
begin
   StatusBarUpdate (' Ready');
end;

procedure NewMDIWindow.UMWorking (var Msg:TMessage);
begin
   StatusBarUpdate (WorkingStr);
end;

procedure NewMDIWindow.ChildStatusBar;
begin
   SendMessage (hMDIActiveChild, fw_ChildStatusBar, 0, 0)
end;

procedure NewMDIWindow.FWLogClosed (var msg:TMessage);
begin
   LogClosed := (Msg.wParam = 1);
end;


end.