** При resize главного окна вызвать
** _debout.setpos()  
OutMessage("111111")  
  OutMessage(DATE())  
  OutMessage(20000.30)  
  OutMessage("444444")  
**************************************************
*-- Class:        _debout (c:\_projects\vfp\clsses2\library\common\_toolbar.vcx)
*-- ParentClass:  _form (c:\_projects\vfp\clsses2\library\common\_base.vcx)
*-- BaseClass:    form
*-- Time Stamp:   06/22/03 06:56:00 PM
*
DEFINE CLASS _toolbutton AS commandbutton
    Tag = ("")
    Height = 22
    Width = 23
    FontName = "MS Sans Serif"
    Caption = ""
    TabStop = .F.
    SpecialEffect = 2
    Name = "_toolbutton"
ENDDEFINE
*
DEFINE CLASS _debout AS form
    Top = 0
    Left = 0
    Height = 150
    Width = 307
    ScrollBars = 0
    DoCreate = .T.
    Caption = "Статистика"
    MinHeight = 50
    MinWidth = 150
    TitleBar = 0
    AlwaysOnTop = .T.
    ccommand = ("")
    Name = "_debout"
    ADD OBJECT cmd AS commandbutton WITH ;
        Top = 1, ;
        Left = 1, ;
        Height = 12, ;
        Width = 13, ;
        FontName = "Marlett", ;
        FontSize = 6, ;
        Caption = "r", ;
        TabStop = .F., ;
        ToolTipText = "Закрыть панель сообщений", ;
        ZOrderSet = 0, ;
        Name = "cmd"
    ADD OBJECT _editbox AS editbox WITH ;
        BorderStyle = 0, ;
        Height = 77, ;
        Left = 15, ;
        ReadOnly = .T., ;
        SpecialEffect = 0, ;
        TabStop = .F., ;
        Top = 1, ;
        Width = 279, ;
        DisabledBackColor = RGB(255,255,255), ;
        ZOrderSet = 2, ;
        Name = "_editbox"
    ADD OBJECT _toolbutton1 AS _toolbutton WITH ;
        Top = 15, ;
        Left = 0, ;
        Height = 60, ;
        Width = 3, ;
        Enabled = .F., ;
        SpecialEffect = 0, ;
        Name = "_toolbutton1"
    PROCEDURE setpos
        IF this.Width <> _screen.Width
            this.Left = 0
            this.Width = _screen.Width
            this._editbox.top = 1
            this._editbox.Width =  this.Width - this._editbox.left - 5
        ENDIF
        IF this.top  <> _screen.Height - this.Height
            this.top  = _screen.Height - this.Height
            this._editbox.Height = this.Height - this._editbox.top - 5
        ENDIF
    ENDPROC
    PROCEDURE clearbox
        this._editbox.Value=""
    ENDPROC
    PROCEDURE savemsg
        LPARAMETERS tcMsg
        LOCAL cMess 
          DO case  
              CASE  vartype(tcMsg)="N"
                  cMess = str(tcMsg)
              CASE  vartype(tcMsg)="L"
                  cMess = IIF(tcMsg,".T." ,".F.")
              CASE  vartype(tcMsg)="D"
                  cMess = DTOC(tcMsg)
              CASE  vartype(tcMsg)="C"
                  cMess = ALLTRIM(tcMsg)
              CASE  vartype(tcMsg)="O"
                  cMess = tcMsg.name
              OTHERWISE
                  cMess = "(вывод не предусмотрен)"
          endcase      
        this._editbox.Value = ALLTRIM(cMess) + CHR(13)+ this._editbox.Value 
    ENDPROC
    PROCEDURE evalcommand
        LOCAL cOldErr
        thisform.cCommand = ALLTRIM(INPUTBOX("Команда","Ввод",thisform.cCommand))
        IF NOT EMPTY(thisform.cCommand)
            cOldErr = ON("error")
            ON ERROR do stopError
            thisform.savemsg(EVALUATE(thisform.cCommand))
            ON ERROR &cOldErr 
        endif
    ENDPROC
    PROCEDURE RightClick
        this.evalcommand()
    ENDPROC
    PROCEDURE Error
        lparameters tnError, tcMethod, tnLine
        local lcErrorMsg, lcCodeLineMsg, lcErrPar, lnItem, laError(1)
        wait clear
        *this.lResult = .F.
        lcErrorMsg = message() + chr(13) + chr(13)
        lcErrorMsg = lcErrorMsg + "Method:    " + tcMethod
        lcCodeLineMsg = message(1)
        if between(tnLine, 1, 10000) and not lcCodeLineMsg="..."
          lcErrorMsg = lcErrorMsg + chr(13) + "Line:         " + alltrim(str(tnLine))
          if not empty(lcCodeLineMsg)
            lcErrorMsg = lcErrorMsg + chr(13) + chr(13) + lcCodeLineMsg
          endif
        endif
        if not empty(ALIAS())
          lcErrorMsg = lcErrorMsg + chr(13) + "Alias " + ALIAS()
        endif
        =messagebox(lcErrorMsg, 16, this.caption)
        *cancel
        *this.Release
    ENDPROC
    PROCEDURE Destroy
        this._editbox.Value=""
        RELEASE debout
        NODEFAULT
    ENDPROC
    PROCEDURE Resize
            this.setpos()
            this._editbox.Height = this.Height - this._editbox.top - 5
    ENDPROC
    PROCEDURE Init
        PUBLIC debout
        debout = this
        this.Height = 60
        this.setpos()
    ENDPROC
    PROCEDURE DblClick
        IF this.Height <> _screen.Height/2
            this.Height =_screen.Height/2
        ELSE
            this.Height =100
        endif    
        this.setpos()
    ENDPROC
    PROCEDURE cmd.Click
        RELEASE thisform
    ENDPROC
    PROCEDURE _editbox.DblClick
        this.Value=""
        this.Parent.Resize()
    ENDPROC
ENDDEFINE
*
*-- EndDefine: _debout
**************************************************
*******************************************************************
FUNCTION OutMessage
  LPARAMETERS cMsg
  LOCAL cMess
 
  DO case  
      CASE  vartype(cMsg)="N"
          cMess = str(cMsg)
      CASE  vartype(cMsg)="L"
          cMess = IIF(cMsg,".T." ,".F.")
      CASE  vartype(cMsg)="D"
          cMess = DTOC(cMsg)
      OTHERWISE
          cMess = cMsg
  endcase      
  IF TYPE("debout") ="O"  AND NOT ISNULL(debout)
  ELSE
     CREATEOBJECT("_debout")
     debout.show()
  ENDIF
  _screen.LockScreen = .t.
  debout.SaveMsg(cMess)
  _screen.LockScreen = .f.
ENDFUNC

publ oRtbr
     oRtbr                        = CreateObject('rtbr')    
     oRtbr.Visible                =.t.
defi class rtbr as ToolBar
     Caption                      ='Все будет хорошо...'
     ResizedNow                   =.f.
 add object cnt as Container with                    ;
     Width                        = 200             ,;
     Height                       = 100             ,;
     BackColor                    = rgb(255,255,255),;
     BorderWidth                  = 0               ,;
     Name                         ='cnt'
proc cnt.MouseMove   
lPar nButton,;
     nShift ,;
     nXCoord,;
     nYCoord
  if!This.Parent.Docked
  if nButton = 1     .and.;
     This.Height > 20.and.;
     This.Width  > 20.and.;
     This.Parent.ResizedNow
     This.Height                  = nYCoord
     This.Width                   = nXCoord
else
     This.Height                  = iif(This.Height <=20,21,This.Height)
     This.Width                   = iif(This.Width  <=20,21,This.Width )
     This.Parent.ResizedNow       =.f.
endi
  do case
case This.Height - nYCoord <= 10.and.;
     This.Width  - nXCoord <= 10
     This.MousePointer            = 8
  if nButton = 1     .and.;
     This.Height > 20.and.;
     This.Width  > 20
     This.Parent.ResizedNow       =.t.
     This.Height                  = nYCoord
     This.Width                   = nXCoord
endi
case.f.
case.f.
case.f.
othe
     This.MousePointer            = 0
endc  
endi
endproc
proc cnt.MouseUp
lPar nButton,;
     nShift ,;
     nXCoord,;
     nYCoord
     This.Parent.ResizedNow       =.f.
endproc
enddefi

DECL INTEGER UpdateWindow IN User32 INTEGER
PUBL goTbr
goTbr=CREATEO('Tbr')
goTbr.Visible=.T.
DEFI CLAS Tbr AS ToolBar
  Sizable=.F.
  ADD OBJE Cnt AS Container
  Cnt.ResizedNow=.F.
PROC Cnt.MouseMove   
LPAR tnBtn,tnSca,tnXC,tnYC
WITH This
.ResizedNow = tnBtn=1 and .Height>20 and .Width>20 and ;
.ResizedNow and .Move(0,0,MAX(tnXC,21),MAX(tnYC,21))
.MousePointer = IIF(.Height-tnYC<=20 and .Width-tnXC<=20,8,0)
=UpdateWindow(.Parent.hWnd),_Screen.Draw()
ENDW      && This
ENDPROC   && MouseMove
PROC Cnt.MouseDown
LPAR tnBtn,tnSca,tnXC,tnYC
     This.ResizedNow=.T.
ENDPROC   && Cnt.MouseDown
PROC Cnt.MouseUp
LPAR tnBtn,tnSca,tnXC,tnYC
     This.ResizedNow=.F.
ENDPROC   && Cnt.MouseUp
ENDDEFINE && Tbr