{ Example of program using the units
  wApplication0.pp  and  wWindow0.pp
  This example show how to create control window, like
  edit boxes, buttons, scroller, combo boxes, list boxes

  Similar to tEx014.pp,  with tries to change some colors.
  It took me over one day to understand, and it's very limitted.
  I still didn't undertand some points.

  It is probably not a good example, you can skip it
  without loosing a lot.

  To use the default behaviour, it is quit simple, but
  to change the default colors becomes complicate.

  The object library will simplify all this.

  Later we will show the use of Dialog Boxes.
  --------------------------------------------}
program tEx015;

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

Uses
  Windows
 ,wApplication0
 ,wWindow0
 ,wDebug0;

const  SEVEN = 7;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow0)
  //""""""""""""""""""""""""

  hButton1 : HWND;
  // handle on a button

  hButtonQuit : HWND;
  // handle on quit button

  ahRadioB : array[1..SEVEN] of HWND;
  // SEVEN radio buttons

  hStatic1 : HWND;
  // a static text

   colBack : integer;
   // color of the background of the window.

  constructor Init(strWinTitlePrm:ShortString);

  procedure MenuCreate; virtual;
  // Add a menu to the window

  procedure WinCreate(strWinClass:ShortString); virtual;
  // When creating the window, controls will be added.

  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the menu messages

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

// var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);

// color of the background of the window.
colBack :=-2;  // default (set in this program) = desktop color,
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;
begin
hMenuWin := CreateMenu;

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,100,'&Open debug window');
AppendMenu(hSubmenu,MF_STRING,101,'&1 A debug msg');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String, 200, 'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING, 401, '&Info...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Creates a new window.
// with controls in it.
var
  strLabel    : string[30];
  dwStyleBtn  : longint;
  rRec        : RECT;
  nn          : integer;
//  lColor      : longint;

Begin
inherited WinCreate(strWinClass);

strLabel    :='First button' + #0;  // must add the #0 to send it to window.
dwStyleBtn  :=WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON;

// add a button in the window.
hButton1:=CreateWindow(
     'BUTTON',  // predefined class to create a button
     @strLabel[1],  // text shown on the button
     dwStyleBtn, // style of the button, see CreateWindow,  BS_... styles
     10, 5,  // X, Y position
     150, 25, // width, height
     hWin, // handle on the parent window
     0,    // handle on the menu, there are no menu for this little button window
     System.MainInstance, // instance of the application
     NIL  // address of window creation data, not needed for buttons
     );

// You can set the button identifier as follow, but you are not obliged.
SetWindowLong(hButton1, GWL_ID, 111);

// Creation of a second button
//''''''''''''''''''''''''''''
// Placed at the bottom right.

// Gets the main window size
GetClientRect(hWin, @rRec);

strLabel    :='Quit' + #0;  // must add the #0 to send it to window.
dwStyleBtn  :=WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON; // or BS_OWNERDRAW;

// add a button in the window.
hButtonQuit:=CreateWindow(
     'BUTTON',  // predefined class to create a button
     @strLabel[1],  // text shown on the button
     dwStyleBtn, // style of the button, see CreateWindow,  BS_... styles
     rRec.Right - 120,  // X, Y position  It will be changed in WM_SIZE
     rRec.Bottom - 35,  // be carefull to have the same positions here
     100, 25, // width, height              and in WM_SIZE
     hWin, // handle on the parent window
     0,    // handle on the menu, there are no menu for this little button window
     System.MainInstance, // instance of the application
     NIL  // address of window creation data, not needed for buttons
     );

// You can set the button identifier as follow, but you are not obliged.
SetWindowLong(hButtonQuit, GWL_ID, 121);

// Creation of five radio button
//''''''''''''''''''''''''''''''
// add the SEVEN radio button button in the window.
for nn:=1 to SEVEN do begin
   case nn of
      1 : strLabel:='black' + #0;
      2 : strLabel:='Dgray' + #0;
      3 : strLabel:='gray' + #0;
      4 : strLabel:='Lgray' + #0;
      5 : strLabel:='white' + #0;
      6 : strLabel:='desk' + #0;
      7 : strLabel:='trans' + #0;
      end;

   ahRadioB[nn]:=CreateWindow(
     'BUTTON',  // predefined class to create a button
     @strLabel[1],  // text shown on the button
     WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or WS_TABSTOP,
     70*nn - 60, 35, // X, Y position
     65, 15, // width, height
     hWin, // handle on the parent window
     0,    // handle on the menu, there are no menu for this little button window
     System.MainInstance, // instance of the application
     NIL  // address of window creation data, not needed for buttons
     );

     SetWindowLong(ahRadioB[nn], GWL_ID, 200 + nn);
     end;

// Creation of a static text
//''''''''''''''''''''''''''
strLabel    :='Simple text' + #0;  // must add the #0 to send it to window.
dwStyleBtn  :=WS_VISIBLE or WS_CHILD
              or SS_CENTER     // text centered in his rectangle
//              or SS_OWNERDRAW
//              or SS_WHITERECT // no text, only a white rect.
//              or SS_GRAYRECT
//              or SS_GRAYFRAME
//              or SS_BLACKRECT;
              ;
// add a button in the window.
hStatic1:=CreateWindow(
     'STATIC',  // predefined class to create a button
     @strLabel[1],  // text shown on the button
     dwStyleBtn, // style of the button, see CreateWindow,  BS_... styles
     50, 95,  // X, Y position
     150, 25, // width, height
     hWin, // handle on the parent window
     0,    // handle on the menu, there are no menu for this little button window
     System.MainInstance, // instance of the application
     NIL  // address of window creation data, not needed for buttons
     );

{
// changing the buttons default colors for the whole system
// they remain as defined, when you quit the application.
lColor:=RGB(196,196,196);  // normal for usual windows.
lColor:=RGB(255,255,  0);  // the complete system changes !
SetSysColors(1, COLOR_BTNFACE, lColor);
COLOR_BTNFACE	Button faces.
COLOR_BTNHIGHLIGHT	Highlight area (the top and left edges) of a button.
COLOR_BTNSHADOW	Shadow area (the bottom and right edges) of a button.
COLOR_BTNTEXT	Regular (nongrayed) text in buttons.
COLOR_GRAYTEXT	Disabled (gray) text in buttons. This color is set to 0 if the current display driver does not support a solid gray color.
COLOR_WINDOW	Window backgrounds.
COLOR_WINDOWFRAME	Window frames.
COLOR_WINDOWTEXT	Text in windows.
}

End;  // TMyWindow.WinCreate

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNoticode,  // notification code, from a child window.
  wID,        // identification of the button
  wNrMenu     : word;
  rRec        : RECT;

begin
wNotiCode := HiWord(wPar);
wID       := LoWord(wPar);

if (wNotiCode = BN_CLICKED) then begin
   // a button has been clicked.
   DBW0(1, 'Click on ' + ITS(wID) + '  lPar=' + ITS(lPar));

   if (wID = 111) then
      DBW0(2, 'handle  =' + ITS(lPar) + ' = ' + ITS(hButton1));

   if (wID = 121) then begin
      PostQuitMessage (0); // Tells the application to quit.
      end;

   if (wID >= 201) and (wID <= 200 + SEVEN) then begin
      // A radio button has been pressed.
      // Changes the background color
      case wID of
         201 : colBack:=BLACK_BRUSH;
         202 : colBack:=DKGRAY_BRUSH;
         203 : colBack:=GRAY_BRUSH;
         204 : colBack:=LTGRAY_BRUSH;
         205 : colBack:=WHITE_BRUSH;
         206 : colBack:=-2; // default.
         207 : colBack:=-1; // transparent.
         end; // case

      // ask to redraw the background.
      GetClientRect(hWin, @rRec);
      invalidateRect(hWin, rRec, TRUE);
      end;

   end; // if (wNotiCode = BN_CLICKED) then begin

if (lPar <> 0) then begin
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menu, lPar = 0
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   // these calls to DBW0 can be done from anywhere
   100 : DBW0(0, '');  // just open the debugging window
   101 : DBW0(   1,'1 -> a debugging message');

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,'These controls uses windows to create them.',
                          'Test of some controls',
                     MB_OK Or MB_IconInformation);
   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//=======================================================================================
// All window messages are send here.
var
  rRec        : RECT;
  hDevC       : HDC;
  hBr         : HBRUSH;  // needed to paint
  wID         : word;

Begin
WindowProc := 0; // Default return value when processing a message

{if (wMsg <> WM_MouseMove)   and (wMsg <> WM_NCMouseMove) and
   (wMsg <> WM_MENUSELECT )   and (wMsg <> WM_ENTERIDLE ) and
   (wMsg <> WM_SetCursor)   and (wMsg <> WM_NCHittest) and
//   (wMsg <> WM_SetFocus) and (wMsg <> WM_KillFocus) and
//   (wMsg <> WM_KEYDOWN) and (wMsg <> WM_KEYUP) and
   (wMsg <> WM_Move)        and (wMsg <> WM_NCActivate) then
   DBW0(32, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }

Case wMsg Of
   WM_ERASEBKGND : begin
      if (colBack = -2) then begin
         WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
         exit;
         end;

      if (colBack = -1) then begin
         // If you do not call the inherited proc. then the color will be transparent.
//         WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
         exit;
         end;

      // change the color of the window background
      // It is quite complicate for a simple task !
      hDevC:=HDC(wPar);  // the handle on the device context is given.
      GetClientRect(hWindow, @rRec);

      // you must get a brush to paint.
      hBr:=GetStockObject(colBack);

      FillRect(hDevC, rRec, hBr);

      WindowProc:=1; // <> 0 should be returned if backgroud erased.
      end; // WM_ERASEBKGND

   WM_CTLCOLORBTN  : begin
      // To change the color of a button. But not a push button.
      // But only the push buttons receives this message.
      // So, I don't understand.
//      DBW0(1, 'A button');
      if (lPar <> hButton1) then begin
         WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
         exit;
         end;
      // to change the color of the static control.
      hDevC:=HDC(wPar);

      // You can change the text color and the back colors
      SetTextColor(hDevC, RGB(255,255,196)); // Yellow light
      SetBkColor(hDevC,  RGB(0,0,128)); // blue dark
//      SetBkMode(hDevC, OPAQUE);      // want to see the background color
      SetBkMode(hDevC, TRANSPARENT);  // don't want to see the background color

      // A brush must be send back, Why ?
      WindowProc:=GetStockObject(NULL_BRUSH);
//      WindowProc:=GetCurrentObject(hDevC, OBJ_BRUSH);
      end; // WM_CTLCOLORBTN

   WM_CTLCOLORSTATIC  : begin
      if (lPar = hStatic1) then begin
         // to change the color of the static control.
         hDevC:=HDC(wPar);

         // You can change the text color and the back colors
         SetTextColor(hDevC, RGB(255,255,196)); // Yellow light
         SetBkColor(hDevC,  RGB(0,0,128)); // blue dark
         SetBkMode(hDevC, OPAQUE);      // want to see the background color
//         SetBkMode(hDevC, TRANSPARENT);  // don't want to see the background color

         // A brush must be send back to fill the rest of the static window.
         WindowProc:=GetStockObject(NULL_BRUSH);
         end
      else begin
         // to change the color of the radio buttons.
         hDevC:=HDC(wPar);

         // Gets the ID of the radio box
         wID:=GetWindowLong(lPar, GWL_ID);

         // You can change the text color and the back colors
         case wID of
            201 : SetTextColor(hDevC, RGB(255,255,255));
            202 : SetTextColor(hDevC, RGB(255,255,255));
            203 : SetTextColor(hDevC, RGB(  0,  0,  0));
            204 : SetTextColor(hDevC, RGB(  0,  0,  0));
            205 : SetTextColor(hDevC, RGB(  0,  0,  0));
            206 : SetTextColor(hDevC, RGB(  0,  0,  0));
            207 : SetTextColor(hDevC, RGB(  0,  0,  0));
            end;

         case wID of
           201 : SetBkColor(hDevC,  RGB(  0,  0,  0));
           202 : SetBkColor(hDevC,  RGB( 64, 64, 64));
           203 : SetBkColor(hDevC,  RGB(128,128,128));
           204 : SetBkColor(hDevC,  RGB(192,192,192));
           205 : SetBkColor(hDevC,  RGB(255,255,255));
           206 : SetBkColor(hDevC,  RGB(  0,128, 64));
           207 : SetBkColor(hDevC,  RGB(  0,  0,  0));
           end;

         SetBkMode(hDevC, OPAQUE);      // want to see the background color

         if (wID = 207) then
            SetBkMode(hDevC, TRANSPARENT);  // don't want to see the background color

         // A brush must be send back to fill the rest of the static window.
         WindowProc:=GetStockObject(NULL_BRUSH);
         end;
      end; // WM_CTLCOLORSTATIC

   WM_Command     : WindowProc:=WMCommand(wPar, lPar);
   WM_Size : begin
      // get the size of the button.
      GetClientRect(hWindow, @rRec);

      // Moves the quit button to stay in the bottom right place
      MoveWindow ( hButtonQuit, rRec.Right - 120, rRec.Bottom - 35,
                   100, 25,
                   True // True => redraw the button
                   );
      end;
   else begin // Case wMsg Of
      // Default processing of the messages.
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end; // Case wMsg Of
   End; // Case wMsg Of

End;  // TMyWindow.WindowProc

var
  oApp        : TApplication0;
  poMyMainWin : PMyWindow;

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example015');

// Change the color of the background of the main window.
// to have the desktop color
oApp.WindowClass.hbrBackground :=COLOR_BACKGROUND+1;

// Creation of the main window
new(poMyMainWin, Init('Title of the Example015 (Ex015.pp) Window'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;
oApp.Done;  // The main window object is disposed here.
End.

