unit wStatusLine0;

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

  to facilitate to have a Status line 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 wWindowBase0, wGlobals2, Windows;

const
  MAXP_STATUS_PARTS = 5;

type
  PStatusLine0 = ^TStatusLine0;
  TStatusLine0 = object(TWindowBase)
  //""""""""""""""""""""""""""""""""
//  hWin     : HWND;  // Handle on the status line window, got from TWindowBase
//  hParent : HWND;  // Handle on the parent, got from TWindowBase
//  poParent: PWindowBase0;  // Pointer on the parent, got from TWindowBase

  wNbParts : word32;
  // number of parts in the status line.

  anXPosPix : array[1..MAXP_STATUS_PARTS] of int32;
  avXPosCh  : array[1..MAXP_STATUS_PARTS] of Float;
  avXPosRel : array[1..MAXP_STATUS_PARTS] of Float;
  // positions in Pixels, character width, relative to the whole width.
  // Normally, the sum should give the total width.

  wIDStatus : word32;
  // the Status line identificator

  dwStyle : word32;
  // The style at creation of the status line.

  wHeight : word32;
  // Height of the status line.

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

  procedure SetStatusText(wPart:word32; strText:ShortString); virtual;
  // nPart = 1 is the first. nPart = 2 is the second. etc.
  // Put some text in a part of the status line.

  function GetStatusText(wPart:word32):ShortString; virtual;
  // nPart = 0 is the first. nPart = 1 is the second. etc.
  // Get the text in the info line

  procedure ComputePartPos; virtual;
  // Computes and set the positions of the parts in the status line

  procedure StatusCreate; virtual;
  // Create a status line

  procedure NotifyParentResize(fRedraw:boolean); virtual;
  // When the parent is resized (with WM_SIZE usually),
  // he must call this method to allow the control to be
  // at the right place and size

  procedure WMFromParent(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM); virtual;
  // Messages sent from a parent to all its children.

  end; // TStatusLine0 = object(TWindowBase)
  TStatusLine =  TStatusLine0;
  PStatusLine = ^TStatusLine;

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

Uses wErrors0, wDebug0;

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

constructor TStatusLine0.Init(poParentW:PWindowBase0);
//====================================================
var nn : integer;
begin
inherited Init(poParentW);

wWindowType:=GGLCTE_STATUSLINE;

// add the control to the parent's child list.
if (poParent <> NIL) then poParent^.AddChildObjectWindow(@Self);

// Just to be initialised
for nn:=1 to MAXP_STATUS_PARTS do begin
   anXPosPix[nn] :=0;
   avXPosCh[nn] :=nn / Float(MAXP_STATUS_PARTS);
   avXPosRel[nn] :=0;
   end;

wNbParts :=2;
avXPosRel[1]:= 1.0; // the end of the line
avXPosCh[1] :=-10;  // minus 10 character width

avXPosRel[2]:= 1.0; // the end of the line

wIDStatus :=1357; // the Status line identificator, any number

dwStyle :=WS_CHILD or WS_VISIBLE;

wHeight:=0;
end;  // TStatusLine0.Init

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

Procedure TStatusLine0.SetStatusText(wPart:word32; strText:ShortString);
//======================================================================
// nPart = 1 is the first. nPart = 2 is the second. etc.
begin
if (wNbParts > MAXP_STATUS_PARTS) then wNbParts:=MAXP_STATUS_PARTS;
if (wPart > wNbParts) then wPart:=wNbParts;
if (wPart < 1) then wPart:=1;

strText[length(strText)+1]:=#0;
SendMessage(hWin, SB_SETTEXT, wPart-1, LongInt(@strText[1]));
end;  // TStatusLine0.SetStatusText

function TStatusLine0.GetStatusText(wPart:word32):ShortString;
//============================================================
// nPart = 0 is the first. nPart = 1 is the second. etc.
// Get the text in the info line
var
  strS        : ShortString;
  nLen        : int32;
begin
if (wNbParts > MAXP_STATUS_PARTS) then wNbParts:=MAXP_STATUS_PARTS;
if (wPart > wNbParts) then wPart:=wNbParts;
if (wPart < 1) then wPart:=1;

nLen:=SendMessage(hWin, SB_GETTEXT, wPart-1, LongInt(@strS[1]));
strS[0]:=char(LoWord(nLen));
GetStatusText:=strS;
end;  // TStatusLine0.GetStatusText

procedure TStatusLine0.ComputePartPos;
//====================================
// Computes and set the positions of the parts in the status line
var
  alEdges     : array[1..MAXP_STATUS_PARTS] of LongInt;
  rRec        : TRect;
  tm          : TEXTMETRIC;  // for the text width and height
  hDCPar      : HDC;
  vXPos       : Float;
  nn,
  nParWidth   : int32;

Begin
if (hParent <> 0) then begin
   // Get the size of the parent window, to define the position
   // of the separation in the Status line
   GetClientRect(hParent, @rRec);

   // gets the text height and witdth
   hDCPar:=GetDC(hParent);
   GetTextMetrics(hDCPar, @tm);

   ReleaseDC(hParent, hDCPar);
   end
else begin
   // not normal to come here.
   rRec.Left:=0;   rRec.Top:=0;   rRec.Right:=0;   rRec.Bottom:=0;
   tm.tmAveCharWidth := 7; // default value
   end;

nParWidth  := rRec.Right  - rRec.Left;

// securities.
if (wNbParts > MAXP_STATUS_PARTS) then wNbParts:=MAXP_STATUS_PARTS;

for nn:=1 to wNbParts do begin
   vXPos  :=anXPosPix[nn]  + avXPosCh[nn] * tm.tmAveCharWidth
                           + avXPosRel[nn]  * nParWidth;

   // No overflow testing !
   alEdges[nn] := Round(vXPos);
   end;

SendMessage(hWin, SB_SETPARTS, wNbParts, LongInt(@alEdges));
end;  // TStatusLine0.ComputePartPos

procedure TStatusLine0.StatusCreate;
//==================================
var
  rRec        : RECT;
Begin
if (poParent = NIL) or (poParent = @Self) then begin
   // If no parent then the main window is the parent and the
   // control becomes a popup window.
   poParent:=gglpoMainWindowCopy;

   // add the control to the parent's child list.
   if (poParent <> NIL) then poParent^.AddChildObjectWindow(@Self);
   end;

if (poParent = NIL) or (poParent^.hWin = 0) then begin
   ErrorWrite( ERR_TStatusLine0_StatusCreate_1, 'in TStatusLine0.CtrlCreate');
   ErrorComment( ERR_TStatusLine0_StatusCreate_1, 'Status lines must have a valid parent.');
   ErrorComment( ERR_TStatusLine0_StatusCreate_1, 'Parent pointer = ' + IntToStr(word32(poParent), 0));
   if (poParent <> NIL) then
      ErrorComment( ERR_TStatusLine0_StatusCreate_1, 'Parent handle  = ' + IntToStr(poParent^.hWin, 0));
   exit;  // can't do anything more
   end;

hParent :=poParent^.hWin; // both are always the same

// Create the status line.
// The default text, can be changed with
// SetStatusText(nPart:Integer; strText:ShortString)
hWin := CreateStatusWindow( dwStyle, 'Unsaved', hParent, wIDStatus);

if (hWin = 0) then exit;  // not normal

// Sets the positions of the parts
ComputePartPos;

GetWindowRect(hWin, rRec);
wHeight:=rRec.Bottom - rRec.Top;
End;  // TStatusLine0.StatusCreate

procedure TStatusLine0.NotifyParentResize(fRedraw:boolean);
//======================================================
// When the parent is resized (with WM_SIZE usually),
// he must call this method to allow the control to be
// at the right place and size
Var
  rRec        : TRect;

Begin
GetClientRect(hParent, @rRec);
MoveWindow (hWin,0, rRec.Bottom - int32(wHeight), rRec.Right, rRec.Bottom, fRedraw);

// Define the position of the separation in the Status line
ComputePartPos;
end;  // TStatusLine0.NotifyParentResize

procedure TStatusLine0.WMFromParent(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
//=====================================================================================
// Messages sent from a parent to all its children.
begin
hWindow:=hWindow; wMsg:=wMsg; wPar:=wPar; lPar:=lPar; // to avoid Hints

NotifyParentResize(TRUE);
end;  // TStatusLine0.WMFromParent

End.  // unit wStatusLine0;

