defframeprocexample.dpr

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

program DefFrameProcExample;

uses
    Windows, Messages, SysUtils;

var
  TheMessage: TMsg;
  FrameWindow, ClientWindow, ChildWindow: HWND;

const
  {the ID for the first MDI child window}
  IDCHILDWND = 100;

{$R *.RES}

{this defines the window procedure for our frame window}
function FrameWindowProc(TheFrameWindow: HWnd; TheMessage, WParam,
                         LParam: Longint): Longint; stdcall;
var
    {this is used when creating an MDI client window}
    ClientStruct: TClientCreateStruct;
begin
  case TheMessage of
    {The frame window will be created first. Once it is created, the
     WM_CREATE message is sent to this function, where we create the
     MDI client window}
    WM_CREATE: begin
         {Fill in the appropriate information about the client window}
         ClientStruct.hWindowMenu := 0;
         ClientStruct.idFirstChild := IDCHILDWND;

         {Create the MDI client window}
         ClientWindow := CreateWindowEx(
                          0,                   {no extended styles}
                          'MDICLIENT',         {the registered class name}
                          NIL,                 {no window text}
                          WS_CHILD or          {this is a child window}
                          WS_CLIPCHILDREN or   {clip its child windows}
                          WS_VISIBLE,          {initially visible}
                          0,                   {horizontal position}
                          0,                   {vertical position}
                          0,                   {width}
                          0,                   {height}
                          TheFrameWindow,      {handle of the parent window}
                          0,                   {no menu}
                          hInstance,           {the application instance}
                          @ClientStruct        {additional creation information}
                          );

         {check to see if it was created}
         if ClientWindow = 0 then
              begin
                   MessageBox(0, 'CreateClientWindow failed', nil, MB_OK);
                   Exit;
              end;

         {indicate that the message was handled}
         Result := 1;
    end;
    {upon getting the WM_DESTROY message, we exit the application}
    WM_DESTROY: begin
                   PostQuitMessage(0);
                   Exit;
                end;
  else
    {call the default frame window procedure for all unhandled messages}
    Result := DefFrameProc(TheFrameWindow, ClientWindow, TheMessage,
                           WParam, LParam);
  end;
end;

{this defines the window procedure for our MDI child window}
function MDIChildWindowProc(TheMDIChildWindow: HWnd; TheMessage, WParam,
                            LParam: Longint): Longint; stdcall;
begin
  case TheMessage of
    {upon getting the WM_DESTROY message, we exit the application}
    WM_LBUTTONDOWN: begin
                      SetWindowText(TheMDIChildWindow,PChar('Mouse Button '+
                                    'Clicked at '+IntToStr(LoWord(GetMessagePos
                                    ))+', '+IntToStr(HiWord(GetMessagePos))));

                      {indicate that the message was handled}
                      Result := 1;
                    end;
  else
    {call the default MDI child window procedure for all unhandled messages}
    Result := DefMDIChildProc(TheMDIChildWindow, TheMessage, WParam, LParam);
  end;
end;

{ Register the frame window Class }
function RegisterFrameClass: Boolean;
var
  WindowClass: TWndClass;
begin
  {setup our frame window class}
  WindowClass.Style := CS_HREDRAW or CS_VREDRAW;     {set the class styles}
  WindowClass.lpfnWndProc := @FrameWindowProc;       {point to our frame
                                                      window procedure}
  WindowClass.cbClsExtra := 0;                       {no extra class memory}
  WindowClass.cbWndExtra := 0;                       {no extra window memory}
  WindowClass.hInstance := hInstance;                {the application instance}
  WindowClass.hIcon := LoadIcon(0, IDI_WINLOGO);     {load a predefined logo}
  WindowClass.hCursor := LoadCursor(0, IDC_ARROW);   {load a predefined cursor}
  WindowClass.hbrBackground := COLOR_WINDOW;         {use a predefined color}
  WindowClass.lpszMenuName := nil;                   {no menu}
  WindowClass.lpszClassName := 'FrameClass';         {the registered class name}

  {now that we have our class set up, register it with the system}
  Result := Windows.RegisterClass(WindowClass) <> 0;
end;

{ Register the child window Class }
function RegisterChildClass: Boolean;
var
  WindowClass: TWndClass;
begin
  {setup our child window class}
  WindowClass.Style := CS_HREDRAW or CS_VREDRAW;     {set the class styles}
  WindowClass.lpfnWndProc := @MDIChildWindowProc;    {point to the default MDI
                                                      child window procedure}
  WindowClass.cbClsExtra := 0;                       {no extra class memory}
  WindowClass.cbWndExtra := 0;                       {no extra window memory}
  WindowClass.hInstance := hInstance;                {the application instance}
  WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION); {load a predefined logo}
  WindowClass.hCursor := LoadCursor(0, IDC_ARROW);   {load a predefined cursor}
  WindowClass.hbrBackground := COLOR_WINDOW;         {use a predefined color}
  WindowClass.lpszMenuName := nil;                   {no menu}
  WindowClass.lpszClassName := 'ChildClass';         {the registered class name}

  {now that we have our class set up, register it with the system}
  Result := Windows.RegisterClass(WindowClass) <> 0;
end;

{this begins the main program}
begin
  {Register our frame class first}
  if not RegisterFrameClass then
  begin
    MessageBox(0,'RegisterFrameClass failed',nil,MB_OK);
    Exit;
  end;

  {Create the frame window based on our frame class}
  FrameWindow := CreateWindowEx(
                              0,                     {no extended styles}
                              'FrameClass',          {the registered class name}
                              'DefFrameProc Example',{the title bar text}
                               WS_OVERLAPPEDWINDOW {a normal window style}
                               or WS_CLIPCHILDREN, {clips all child windows}
                               CW_USEDEFAULT,      {default horizontal position}
                               CW_USEDEFAULT,      {default vertical position}
                               CW_USEDEFAULT,      {default width}
                               CW_USEDEFAULT,      {default height}
                               0,                  {handle of the parent window}
                               0,                  {no menu}
                               hInstance,          {the application instance}
                               nil                 {no additional information}
                               );

  {If our frame window was created successfully, show it}
  if FrameWindow <> 0 then
  begin
    ShowWindow(FrameWindow, SW_SHOWNORMAL);
    UpdateWindow(FrameWindow);
  end
  else
  begin
    MessageBox(0, 'CreateFrameWindow failed', nil, MB_OK);
    Exit;
  end;

  {Register the child window class}
  if not RegisterChildClass then
  begin
    MessageBox(0, 'RegisterChildClass failed', nil, MB_OK);
    Exit;
  end;

  {Create the MDI child window}
  ChildWindow := CreateMDIWindow('ChildClass',    {the registered class name}
                                 'Child Window',  {the title bar text}
                                 WS_VISIBLE,      {initially visible}
                                 CW_USEDEFAULT,   {default horizontal position}
                                 CW_USEDEFAULT,   {default vertical position}
                                 CW_USEDEFAULT,   {default width}
                                 CW_USEDEFAULT,   {default height}
                                 ClientWindow,    {handle of the parent window}
                                 hInstance,       {the application instance}
                                 0                {no application defined value}
                                 );

  {check to see if it was created}
  if ChildWindow <> 0 then
  begin
    ShowWindow(ChildWindow, SW_SHOWNORMAL);
    UpdateWindow(ChildWindow);
  end
  else
  begin
    MessageBox(0,'CreateChildWindow failed',nil,mb_ok);
    Exit;
  end;

  {the standard message loop}
  while GetMessage(TheMessage,0,0,0) do
  begin
    TranslateMessage(TheMessage);
    DispatchMessage(TheMessage);
  end;
end.