unit wButtonBitMap0;

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

  to facilitate to have a Push Button in a window,
  With a bitmap on it, instead of text.
  ----------------------------------------------------------------}

// 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 wButtonBase0, wControl0, wWindowBase0, wGlobals2, Windows;

type
  PButtonBitMap0 = ^TButtonBitMap0;
  TButtonBitMap0 = object(TButtonBase)
  //""""""""""""""""""""""""""""""""""
//  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

  hBitMap : HBITMAP;
  // BitMap on the button.

  wMsgBitMapDef : word32;
  // Number in the .msg file where the bitmap is defined.

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

  procedure CtrlCreate; virtual;
  // Creates the push button control window
  // Must have a parent object window, if not, nothing happens.
  // It can be easily changed to another kind of button.

//  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
  end; // TButtonBitMap0 = object(TButtonBase)
  TButtonBitMap =  TButtonBitMap0;
  PButtonBitMap = ^TButtonBitMap;

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

Uses wBitMapImage0, wErrors2, wDebug0;

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

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

wWindowType:=GGLCTE_CTRL_ButtonBitMap;

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

// A bitMap button has no label.
strCtrlLabel:='';

hBitMap:=0;
wMsgBitMapDef:=0;
end;  // TButtonBitMap0.Init

destructor  TButtonBitMap0.Done;
//==============================
begin
// Delete the BitMap  if necessary
if (hBitMap <> 0) then DeleteObject(hBitMap);

inherited Done;
end;  // TButtonBitMap0.Done

procedure TButtonBitMap0.CtrlCreate;
//==================================
var wWidthL,wHeightL : word32;
Begin
inherited CtrlCreate;

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

// Get the image from the message file
if (wMsgBitMapDef <> 0) then hBitMap:=LoadImageFromMSG(wMsgBitMapDef, hWin, wWidthL, wHeightL);

// defines the bit map associated with the button.
SendMessage(hWin, BM_SETIMAGE, 0, hBitMap);
End;  // TButtonBitMap0.CtrlCreate

function TButtonBitMap0.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;  // TButtonBitMap0.CtrlWindowProc

End.  // unit wButtonBitMap0;

