CICA 1993 August/CICA.cdr/unzipped/programr/tp/ribbon/ribbon3.pas

Pascal/Delphi Source File | 1992-08-06 | 6.0 KB | 179 lines

{************************************************}
{                                                }
{   Ribbon.pas                                   }
{   Turbo Pascal for Windows demo program        }
{   by Danny Thorpe                              }
{                                                }
{   This program shows how to set up a non-MDI   }
{   child window in a MDI window.  Why would     }
{   you want to do this?  To implement status    }
{   lines and "ribbon" windows which you want    }
{   to be in the main window, but you don't want }
{   to be cascaded and tiled with the MDI child  }
{   windows, and you don't want to be overlapped }
{   by the MDI child windows.                    }
{                                                }
{   In addition, I have modified it to show how  }
{   to create a button ribbon bar and handle it's}
{   messages. - Rick Sands CIS 70274,103         }
{                                                }
{   Modified Aug. 5, 92                          }
{   Using Windows 3.1's RedrawWindow Function    }
{   I modified this example to eliminate screen  }
{   Blinking when the window is resized. -       }
{   Bob Kitchenham CIS 70334,1112                }
{************************************************}

program MDI;

{$R MDIAPP.RES}    { This res file is in \tpw\owldemos }

uses WObjects, WinTypes, WinProcs, win31;

const
  ID_Test = 1000;
  CM_Test = 1010;

type

  PRibbonWindow = ^TRibbonWindow;
  TRibbonWindow = object(TWindow)
    LastWnd : hWnd;
    btnTest : pButton;
    constructor Init(AParent: PWindowsObject);
    procedure   GetWindowClass(var AWndClass: TWndClass); virtual;
    function    GetClassName : pchar; virtual;
    procedure   idTest(var Msg:tMessage); virtual id_First + id_Test;
    procedure   wmSetFocus(var Msg:tMessage); virtual wm_First + wm_SetFocus;
  end;

  pChildWin = ^tChildWin;
  tChildWin = object(tWindow)
    procedure CMTest(var Msg:tMessage); virtual cm_First+cm_Test;
  end;

  PMyMDIWindow = ^TMyMDIWindow;
  TMyMDIWindow = object(TMDIWindow)
    RibbonWindow : PRibbonWindow;
    constructor Init(ATitle: PChar;  AMenu: HMenu);
    function    CreateChild: PWindowsObject; virtual;
    procedure   WMSize(var Msg: TMessage);  virtual wm_First + wm_Size;
  end;


  { Define a TApplication descendant }
  TMDIApp = object(TApplication)
    procedure InitMainWindow; virtual;
  end;


{************************************************************************}

constructor TRibbonWindow.Init(AParent: PWindowsObject);
begin
  TWindow.Init(AParent, '');              { create the window normally }
  SetFlags(wb_MDIChild, False);           { turn off the MDI flag that TWindow set }
  Attr.Style := ws_Border or ws_Child or ws_Visible;
  btnTest  := new(pButton, Init(@Self, id_Test, '&Test', 0,  0, 70, 28, FALSE));
end;

{ -------------------------------------------------------------------------- }
procedure tRibbonWindow.GetWindowClass(var AWndClass: TWndClass);
  begin
     tWindow.GetWindowClass(AWndClass);
     AWndClass.hbrBackground := Gray_Brush
  end;

{ -------------------------------------------------------------------------- }
function tRibbonWindow.GetClassName : pchar;
  begin
     GetClassName := 'Ribbon';
  end;

{ -------------------------------------------------------------------------- }
procedure tRibbonWindow.wmSetFocus(var Msg:tMessage);
  begin
     messagebeep(0);
  end;

{ -------------------------------------------------------------------------- }
procedure tRibbonWindow.idTest(var Msg:tMessage);
  begin
     { You must set the focus to the main window before sending your
       command!!! }
     SetFocus(Application^.MainWindow^.hWIndow);
     SendMessage(Application^.MainWindow^.hWindow, wm_Command, cm_Test, 0)
  end;


{************************************************************************}
procedure tChildWin.CMTest(var Msg:tMessage);
  begin
     MessageBox(hWindow, 'Message Sent Successfully!', 'Success', mb_OK);
  end;

{************************************************************************}
constructor TMyMDIWindow.Init(ATitle: PChar;  AMenu: HMenu);
begin
  TMDIWindow.Init(ATitle, AMenu);
  RibbonWindow := New(PRibbonWindow, Init(@Self));
end;


procedure TMyMDIWindow.WMSize(var Msg: TMessage);
var
    rcUpdate : TRect;
begin
  getUpdateRect(Hwindow,rcUpdate,False); {Save Update Rectangle for later}

  sendmessage(HWindow,wm_setredraw,0,0); {Disable Redrawing of window}

  TMDIWindow.WMSize(Msg);


  { Always check for nil window pointers and invalid HWindow handles.  Windows can
    send your main window WMSize messages while the child windows are being destroyed,
    which can produce some hard to track down UAEs.  }

    if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
      MoveWindow(ClientWnd^.HWindow, 0, 30, Msg.LParamLo, Msg.LParamHi - 30, True);

    if (RibbonWindow <> nil) and (RibbonWindow^.HWindow <> 0) then
        MoveWindow(RibbonWindow^.HWindow, -1, -1, Msg.LParamLo + 2, 30, True);

  sendmessage(HWindow,wm_setredraw,1,0); {enable Redrawing of window}

  RedrawWindow(Hwindow,@rcUpdate,0,
     RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN); {Redraw Update Rect}

    { The -1 and +2 are to hide the left and right borders of this ribbon window.
      It looks funny with no border at all, but it looks funny with extra thick borders
      on the left and right.  This sets a happy medium.  }
end;


function TMyMDIWindow.CreateChild: PWindowsObject;
  begin
     CreateChild := Application^.MakeWindow(new(pChildWin, Init(@Self, 'A Test Child')));
  end;

{*************************************************************************}

{ Construct the THelloApp's MainWindow object, loading its menu }
procedure TMDIApp.InitMainWindow;
begin
  MainWindow := New(PMyMDIWindow, Init('MDI Conformist',
    LoadMenu(HInstance, 'MDIMenu')));
end;

{ Declare a variable of type TMDIApp}
var
  MDIApp: TMDIApp;

{ Run the MDIApp }
begin
  MDIApp.Init('MDIApp');
  MDIApp.Run;
  MDIApp.Done;
end.