unit wStatic0;

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

  to facilitate to have a Static Text in a window or dialog box

  The WM_PAINT message to repaint the text, is handeled by
  the  CtrlWindowProc  by default, to simplify its tratments.
  The default treatment doesn't let you change the text color or
  the text background color or transparency easily.

  ----------------------------------------------------------------}

// 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
  PStatic0 = ^TStatic0;
  TStatic0 = 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

  fUseDefaultWMPaint : boolean;
  // Defines if the WM_PAINT message is handeld as windows does it by default
  // or if it is handeled in the  CtrlWindowProc  method

  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
  // if = -2 (as usuall for dialogs), then it is the same color
  // as the parent background and  colTextTransp  = OPAQUE.

  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.
  // this 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.
  // if = -2 (as usuall for dialogs), then it is the same color
  // as the parent background.

  wFloatLength   : word32;
  wFloatDecimals : word32;
  // default length and number of decimals, when returning a float
  // as a string value.

  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 static control window.
  // It is text by default, but can contain a bitmap

  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 CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM); virtual;
  // Handle notification messages, see wControl0.pp for doc.
  // It is done before the parent receives the message WM_COMMAND or WM_NOTIFY

  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; // TStatic0 = object(TControl)
  TStatic =  TStatic0;
  PStatic = ^TStatic;

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

Uses wVariableNumLink2, wErrors0, wDebug0, Strings;

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

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

wWindowType:=GGLCTE_CTRL_Static;

strClassName  :='STATIC';
strCtrlLabel  :='A static text'; // 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 SS_LEFT or SS_NOTIFY;
            // or WS_TABSTOP should not have tabstop.

fUseDefaultWMPaint :=FALSE;
colTextFont        :=RGB(0,0,0);
colTextBack        :=RGB(255,255,255);
colTextTransp      :=TRANSPARENT;
colWindowBack      :=word32(-1);

wFloatLength   :=15;
wFloatDecimals := 9;
end;  // TStatic0.Init

destructor  TStatic0.Done;
//============================
begin
inherited Done;
end;  // TStatic0.Done

procedure TStatic0.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;
  rSize       : SIZE;
  strS        : string[50];
  vNum        : Float; // to format Float numbers
  nn          : integer;

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);

// For Float numbers have a special length formatting
if (rVarLinkInfo.wVarType = vt_Float) or (rVarLinkInfo.wVarType = vt_FloatS) then begin
   vNum:=9;
   for nn:=3 to wFloatLength - wFloatDecimals do vNum:=vNum * 10;
   strS:=FloatToStr(vNum+0.8888888888888888, wFloatLength, wFloatDecimals);
   GetTextExtentPoint32( hDCPar, @strS[1], length(strS),
                         @rSize);
   end
else begin
   // get the exact size of the text on the button.
   GetTextExtentPoint32( hDCPar, @strCtrlLabel[1], length(strCtrlLabel),
                         @rSize);
   end;

ReleaseDC(hParent, hDCPar);

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

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

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

If (hWin = 0) Then Begin
   // Error has already been reported in CtrlCreate.
   ErrorComment( ERR_TStatic0_StaticCreate_1, 'Error forwarded in TStatic0.StaticCreate');
   ErrorComment( ERR_TStatic0_StaticCreate_1, 'Handle on static control could not be created.');
   exit;  // can't do anything more
   end;

// If the background colors should be the same as the dialog.
if (colTextBack = -2) then begin
   colTextBack :=GetSysColor(COLOR_BTNFACE);
   colTextTransp:=OPAQUE;
   end;

if (colWindowBack = -2) then colWindowBack :=GetSysColor(COLOR_BTNFACE);
End;  // TStatic0.CtrlCreate

procedure TStatic0.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
var
  nHeight     : int32; // Not used
begin
if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Define the content of the static text

   // Get the new label.
   strCtrlLabel:=ValueOf(pVarLink, rVarLinkInfo.wVarType, wFloatLength, wFloatDecimals);

   invalidateRgn(hWin, 0, TRUE); // to repaint all

   // Get the new width of the control, to resize its window
   nXSizePix:=0;
   AutoSize(0,0, nXSizePix, nHeight);
   vXSizeCh  :=0; // Use only the Width size.
   NotifyParentResize(TRUE);
   end;
end;  // TStatic0.UpdateFromVar

procedure TStatic0.CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM);
//======================================================================
// Handles the notification messages that the control sended to
// its parent.
begin
// For the moment (december 2001) this does nothing.

inherited CtrlNotifMessageHandleFirst(wNotif, lPar);
end;  // TStatic0.CtrlNotifMessageHandleFirst

function TStatic0.CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//==============================================================================================
// Handles the notification messages that the control sended to
// its parent.
var
  rRec        : RECT;
  hDevC       : HDC;
  ps          : paintstruct;
  wFormat     : word32;
  hBr         : HBRUSH;  // needed to paint
  rLogBr      : LOGBRUSH;

begin
// For the moment (december 2001) this does nothing.
{ 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)); }

if (wMsg = WM_CONTEXTMENU) then begin
   // here a contextual menu could be opened.

   end;

if (wMsg = WM_ERASEBKGND) and (not fUseDefaultWMPaint) and
   (colWindowBack <> word32(-1))  then begin
   // fill the background with the wanted background color

   // gets a device context to draw dext
   hDevC:=wPar;

   // must create a brush with the wanted color, to fill the backgroundd
   rLogBr.lbStyle :=BS_Solid;
   rLogBr.lbColor :=colWindowBack;
   rLogBr.lbHatch :=HS_VERTICAL;
   hBr:=CreateBrushIndirect(rLogBr);

   // get the region to be filled
   GetClientRect(hWindow, @rRec);

   FillRect(hDevC, rRec, hBr);

   // must delete the brush to free Windows resources.
   DeleteObject(hBr);

   CtrlWindowProc:=1; // background erased
   exit;
   end; // if (wMsg = WM_ERASEBKGND) and (not fUseDefaultWMPaint) and

if (not fUseDefaultWMPaint) and (wMsg = WM_PAINT) then begin
   // gets a device context to draw dext
   hDevC:=BeginPaint(hWindow, @ps);
   SetTextColor(hDevC, colTextFont);
   SetBkColor(hDevC, colTextBack);
   SetBkMode(hDevC, colTextTransp);

   GetClientRect(hWindow, @rRec);

   // formatting options
   wFormat:=0;

   // center horizontally and vertically
   if ((dwStyle and SS_CENTER) <> 0) then wFormat:=wFormat or DT_CENTER or DT_VCENTER;
   if ((dwStyle and SS_LEFT)   <> 0) then wFormat:=wFormat or DT_LEFT;
   if ((dwStyle and SS_RIGHT)  <> 0) then wFormat:=wFormat or DT_RIGHT;

   // not treated
//   if ((dwStyle and SS_NOPREFIX) <> 0) then wFormat:=wFormat or ???
//   if ((dwStyle and ???)  <> 0) then wFormat:=wFormat or DT_SINGLELINE;

   // draws the text.
   DrawText( hDevC, @strCtrlLabel[1], length(strCtrlLabel), @rRec, wFormat);

   EndPaint(hWindow, ps);
   CtrlWindowProc:=0; // painted.
   exit;
   end; // if (not fUseDefaultWMPaint) and (wMsg = WM_PAINT) then begin

if (not fUseDefaultWMPaint) and (wMsg = WM_SETTEXT) then begin
   // gets a device context to draw dext
   hDevC:=GetDC(hWindow);
   SetTextColor(hDevC, colTextFont);
   SetBkColor(hDevC, colTextBack);
   SetBkMode(hDevC, colTextTransp);

   // Copy the text in the label ..
   StrCopy( @strCtrlLabel[1], PCHAR(lPar));
   strCtrlLabel[0]:=char(StrLen(PChar(lPar)));

   GetClientRect(hWindow, @rRec);

   // formatting options
   wFormat:=0;

   // center horizontally and vertically
   if ((dwStyle and SS_CENTER) <> 0) then wFormat:=wFormat or DT_CENTER or DT_VCENTER;
   if ((dwStyle and SS_LEFT)   <> 0) then wFormat:=wFormat or DT_LEFT;
   if ((dwStyle and SS_RIGHT)  <> 0) then wFormat:=wFormat or DT_RIGHT;

   // not treated
//   if ((dwStyle and SS_NOPREFIX) <> 0) then wFormat:=wFormat or ???
//   if ((dwStyle and ???)  <> 0) then wFormat:=wFormat or DT_SINGLELINE;

   // draws the text.
   DrawText( hDevC, @strCtrlLabel[1], length(strCtrlLabel), @rRec, wFormat);

   // must close the DC
   ReleaseDC(hWindow, hDevC);

   CtrlWindowProc:=1; // painted.
   exit;
   end; // if (not fUseDefaultWMPaint) and (wMsg = WM_SETTEXT) then begin

CtrlWindowProc:=inherited CtrlWindowProc(hWindow, wMsg, wPar, lPar);
end;  // TStatic0.CtrlWindowProc

End.  // unit wStatic0;

