unit wButtonCheck0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin

  to facilitate to have a Check Button in a window
  ----------------------------------------------------------------}

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

INTERFACE
//"""""""

Uses wControl0, wWindowBase0, wGlobals2, Windows;

type
  PButtonCheck0 = ^TButtonCheck0;
  TButtonCheck0 = object(TControl)
  //"""""""""""""""""""""""""""""
//  hWin     : HWND;  // Handle on the edit box, got from TWindowBase
//  hParent : HWND;  // Handle on the parent, got from TWindowBase
//  poParent: PWindowBase0;  // Pointer on the parent, got from TWindowBase

  fUseDefaultColors : boolean;
  // = TRUE by default.
  // Defines if the WM_CTLCOLOR... message are handeld by calling 
  // the default procedure or by defining new colors.

  colTextFont : COLORREF;  // = word32
  // if fUseDefaultWMPaint = FALSE, defines the text color
  // = RGB(0,0,0) = Black by default

  colTextBack : COLORREF;  // = word32
  // if fUseDefaultWMPaint = FALSE, defines the text background color
  // = RGB(255,255,255) = White by default

  colTextTransp : word32;
  // if fUseDefaultWMPaint = FALSE, defines the transparency.
  // =  OPAQUE	if you want the  colTextBack  to be used.
  // =  TRANSPARENT  if you doesn't want to change the background color.
  // OPAQUE is the default value.

  colWindowBack : word32;
  // This is the background color of the window, which can be
  // larger than the text background.
  // set it to word32(-1) to let it transparent.
  // It is its default color. In this case the NULL brush is selected.

private
  hBrushCtrl : HBRUSH;
  // to memorise the brush used to fill the background of the control.

  colBrushCtrl : word32;
  // to remember the color of the hBrushCtrl.
  // in order to not delete and create the brush when it is not necessary.

public
  constructor Init(poParentW:PWindowBase0);
  destructor  Done; virtual;

  procedure AutoSize(nLeft,nTop:integer; var nWidth, nHeight:int32); virtual;
  // Computes the sizes automatically, if no sizes where specified.
  // Gives as infor the values of nLeft and nTop
  // Units are pixels

  procedure CtrlCreate; virtual;
  // Create a Check box button control window.
  // It can be easily changed to another kind of button.

  function GetCheckState:integer;
  // return the state of the check box.
  // either 1 or 0, later can be another value.

  procedure UpdateFromVar; virtual;
  // If the value of the linked variable changed, for example in the
  // main program, then calling this procedure will
  // change the content of the control to contain the value of the variable

  procedure CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM); virtual;
  // Handles the window messages sended to the parent of controls
  // Normally, windows doesn't send messages to controls which can
  // be treated easilly be the user.
  // See wControl0.pp for the rest of the comments.

  function CtrlWMCTLCOLOR(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Special case where controls colors can be defines by their parent.
  // The controls can define the colors directly through this call.
  // lPar = handle on the control who wants to be redrawn
  // wPar = Device context used to draw the control.
  // It can be redefined by a descentent. In this case, the
  // inherited method is not called.

  function CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the window messages
  // It is usually overriden
  // A SendMessage(hWin, ...) must never be called from here, since
  // it would be a calling loop

  procedure CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM); virtual;
  // Handle notification messages, see wControl0.pp for doc.
  // Does it before its parent receive the notification.

  end; // TButtonCheck0 = object(TControl)
  TButtonCheck =  TButtonCheck0;
  PButtonCheck = ^TButtonCheck;

IMPLEMENTATION
//""""""""""""

Uses wVariableNumLink2, wErrors2, wDebug0;

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

constructor TButtonCheck0.Init(poParentW:PWindowBase0);
//=====================================================
begin
inherited Init(poParentW);

wWindowType:=GGLCTE_CTRL_ButtonCheck;

strClassName  :='BUTTON';
strCtrlLabel  :='Button 1'; // MUST be redefined in the main application
// strCtrlHint   :='';      // can be redefined in the main application

dwExStyle :=0;  // no extra styles by default, modified in the descendent
dwStyle   :=  WS_VISIBLE or WS_CHILD or WS_TABSTOP or BS_CHECKBOX;

// If the default painting colors should be changed, they can be defined here
fUseDefaultColors  :=TRUE;
colTextFont        :=RGB(0,0,0);
colTextBack        :=RGB(255,255,255);
colTextTransp      :=OPAQUE;
colWindowBack      :=word32(-1);
hBrushCtrl         :=0;  // not defined
colBrushCtrl       :=0;  // brush has no colors, thus doesn't matter.
end;  // TButtonCheck0.Init

destructor  TButtonCheck0.Done;
//=============================
begin
// must free the resource memory
if (hBrushCtrl <> 0) then DeleteObject(hBrushCtrl);
hBrushCtrl:=0;

inherited Done;
end;  // TButtonCheck0.Done

procedure TButtonCheck0.AutoSize(nLeft,nTop:integer; var nWidth,nHeight:int32);
//=============================================================================
// Computes the sizes automatically, if no sizes where specified.
// Gives as infor the values of nLeft and nTop
// Units are pixels
var
  hDCPar      : HDC;
//  rRec        : RECT;  // parent window size
  rSize       : SIZE;
  strS        : string[150];

begin
nLeft:=nLeft; nTop:=nTop; // to avoid hints

// gets the text height and witdth of characters
// Will be used to define default sizes.
hDCPar:=GetDC(hParent);

// get the exact size of the text on the button.
strS:=strCtrlLabel + 'W'; // a bit larger to have place for the checkbox.
GetTextExtentPoint32( hDCPar, @strS[1], length(strS),
                      @rSize);
ReleaseDC(hParent, hDCPar);

// Exact character width plus
if (nWidth < rSize.cx) then nWidth:=rSize.cx;

// Exact character height
if (nHeight < rSize.cy) then nHeight:=rSize.cy;
end;  // TButtonCheck0.AutoSize

procedure TButtonCheck0.CtrlCreate;
//===================================
Begin
inherited CtrlCreate;

If (hWin = 0) Then Begin
   // Error has already been reported in CtrlCreate.
   ErrorWriteMSG(2001216001);
   exit;  // can't do anything more
   end;

if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Define the content of the edit box
   if (ValueOf(pVarLink, rVarLinkInfo.wVarType) <> '0') then
      SendMessage(hWin , BM_SETCHECK, 1, 0);

   end; // if (pVarLink <> NIL) then begin

End;  // TButtonCheck0.CtrlCreate

function TButtonCheck0.GetCheckState:integer;
//===========================================
// return the state of the check box.
// either 1 or 0, later can be another value.
begin
GetCheckState:=SendMessage(hWin , BM_GETCHECK, 0, 0);
end;  // TButtonCheck0.GetCheckState

procedure TButtonCheck0.UpdateFromVar;
//====================================
// If the value of the linked variable changed, for example in the
// main program, then calling this procedure will
// change the content of the control to contain the value of the variable
begin
if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Define the content of the edit box
   if (ValueOf(pVarLink, rVarLinkInfo.wVarType) <> '0') then
        SendMessage(hWin , BM_SETCHECK, 1, 0)
   else SendMessage(hWin , BM_SETCHECK, 0, 0);
   end; // if (pVarLink <> NIL) then begin
end;  // TButtonCheck0.UpdateFromVar

procedure TButtonCheck0.CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM);
//===================================================================
var wRep : word;
begin
lPar   :=lPar; // to remove a Hint

//DBW0(8192, DBNotifToStr(wNotif) + ITS(lPar));

if (wNotif = BN_CLICKED) then begin
   // Update the content of the linked variable.
   if (pVarLink <> NIL) then begin
      wRep:=UpdateVarLink; // wRep = 4 if not accepted.

      // Notify the grand parent, i.e. the window owning the dialog box usually,
      // that the content of the the associated of the edit box changed
      // Notify only if the variable really changed its value.
      if (wRep <> 4) and (wRep <> 3) then begin
         if    (poGrParent <> NIL) then poGrParent^.CtrlVarUpdate(@Self, pVarLink)
         else if (poParent <> NIL) then poParent^.CtrlVarUpdate(@Self, pVarLink);
         end;
      end;

   // Notify its grand parent or parent. After having changed the associated variable
   if      (poGrParent <> NIL) then poGrParent^.ButtonClicked(@Self, wCtrlID)
   else if (poParent   <> NIL) then poParent^.ButtonClicked(@Self, wCtrlID);
   end;
// inherited ... not usefull, since the parent does nothing.

end;  // TButtonCheck0.CtrlNotifMessageHandle

function TButtonCheck0.CtrlWMCTLCOLOR(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//===========================================================================================
// Special case where controls colors can be defines by their parent.
// The controls can define the colors directly through this call.
// lPar = handle on the control who wants to be redrawn
// wPar = Device context used to draw the control.
// hWindow = parent window.
var
    hDevC       : HDC;

begin
hWindow:=hWindow; lPar:=lPar; // to remove hints
// By default, used default message handler, either in a window
// or in a dialog box.
CtrlWMCTLCOLOR := 0;

if fUseDefaultColors then exit;

if (wMsg = WM_CTLCOLORSTATIC) then begin
   // the button is beeing redrawn.
   // The device context has been coded in wPar, standard Windows
   hDevC:=HDC(wPar);

   // You can change the text color and the back colors
   SetTextColor(hDevC, colTextFont);
   SetBkColor(hDevC,  colTextBack);
   SetBkMode(hDevC, colTextTransp);  // OPAQUE or TRANSPARENT

   if (colWindowBack = word32(-1)) then begin
      CtrlWMCTLCOLOR:=GetStockObject(NULL_BRUSH);
      exit;
      end;

   if (hBrushCtrl = 0) or (colWindowBack <> colBrushCtrl) then begin
      if (hBrushCtrl <> 0) then DeleteObject(hBrushCtrl); // must free the resource memory

      // create a new brush for the control background color.
      // Don't forget to delete this Brush in the destructor.
      hBrushCtrl:=CreateSolidBrush(colWindowBack);

      colBrushCtrl:=colWindowBack; // remember the brush color
      end;

   // A brush must be send back to fill the rest of the static window.
   CtrlWMCTLCOLOR:=hBrushCtrl;
   end;
end;  // TButtonCheck0.CtrlWMCTLCOLOR

procedure TButtonCheck0.CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM);
//============================================================================
// Handles the notification messages that the control sended to
// its parent.
var
  nn          : integer; // state of the button

begin
inherited CtrlNotifMessageHandleFirst(wNotif, lPar); // For the moment (december 2001) this does nothing.

if (wNotif = 0) then begin
   // Gets the actual state.
   nn:=SendMessage(hWin , BM_GETCHECK, 0, 0);

   // changes its state
   if (nn = 0) then nn:=1 else nn:=0;
   SendMessage(hWin, BM_SETCHECK, nn, 0);
   end;

end;  // TButtonCheck0.CtrlNotifMessageHandleFirst

function TButtonCheck0.CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//==============================================================================================
// Handles the notification messages that the control sended to
// its parent.
begin
CtrlWindowProc:=inherited CtrlWindowProc(hWindow, wMsg, wPar, lPar);
end;  // TButtonCheck0.CtrlWindowProc

End.  // unit wButtonCheck0;

