PUBLIC oAlert1 As TAlert, oAlert2 As TAlert
 
oAlert1 = CREATEOBJECT("TAlert")
WITH oAlert1
    .Left=100
    .Top=100
    .Width=800
    .Height=500
    .FontName="Impact"
    .FontSize=-92
    .FontBold=.F.
    .ForeColor=0x80ffff
    .alertmessage="FoxPro application requires " +;
        "your immediate attention!"
    .ShowAlert
ENDWITH
 
oAlert2 = CREATEOBJECT("TAlert")
WITH oAlert2
    .Left=100
    .Top=580
    .Width=600
    .Height=200
    .FontName=_screen.FontName
    .FontSize=-32
    .FontBold=.T.
    .ForeColor=0
    .alertmessage="* Type CLEAR ALL in the Command Window " +;
        "to remove this alert."
    .ShowAlert
ENDWITH
* end of main
 
DEFINE CLASS TAlert As Custom
#DEFINE SW_HIDE 0
#DEFINE SW_SHOWNA 8
#DEFINE WS_DISABLED 0x08000000
#DEFINE WS_EX_TOPMOST 8
#DEFINE WS_EX_TRANSPARENT 0x00000020
#DEFINE WS_EX_LAYERED 0x80000
#DEFINE WS_EX_NOACTIVATE 0x8000000
#DEFINE SM_CXSCREEN 0
#DEFINE SM_CYSCREEN 1
#DEFINE SM_CYCAPTION 4
#DEFINE SM_CXFRAME 32
#DEFINE SM_CYFRAME 33
#DEFINE DT_WORDBREAK 16
#DEFINE FW_NORMAL 400
#DEFINE FW_BOLD 700
#DEFINE ANSI_CHARSET 0
#DEFINE OUT_DEVICE_PRECIS 5
#DEFINE OUT_OUTLINE_PRECIS 8
#DEFINE CLIP_STROKE_PRECIS 2
#DEFINE PROOF_QUALITY 2
#DEFINE DEFAULT_PITCH 0
#DEFINE ANTIALIASED_QUALITY 4
#DEFINE LWA_COLORKEY 1
    Left=0
    Top=0
    Width=300
    Height=60
    FontName="Arial"
    FontSize=24
    FontBold=.T.
    ForeColor=0
    alertmessage="Alert!"
    hFont=0
    hWindow=0
 
    ADD OBJECT Timer1 As Timer WITH Interval=1000
 
PROCEDURE Init
    THIS.declare
 
PROCEDURE Destroy
    THIS.ClearAlert
 
PROCEDURE ClearAlert
    THIS.ReleaseFont
    THIS.ReleaseWindow
 
PROCEDURE HideAlert
    = ShowWindowA(THIS.hWindow, SW_HIDE)
    THIS.Timer1.Interval=0
 
PROCEDURE ShowAlert
    THIS.RefreshAlert
    THIS.Timer1.Interval=1000
 
PROCEDURE Timer1.Timer
    THIS.Parent.RefreshAlert
 
PROCEDURE RefreshAlert
    IF THIS.hWindow = 0
        THIS.CreateWindow
        THIS.CreateFont
    ENDIF
 
    = ShowWindowA(THIS.hWindow, SW_SHOWNA)
 
    LOCAL hDC
    hDC = GetDC(THIS.hWindow)
    = SelectObject(hDC, THIS.hFont)
 
    THIS.DrawText(THIS.alertmessage, hDC,;
        3, 3, THIS.Width-10, THIS.Height-10,;
        THIS.ForeColor)
 
    = ReleaseDC(THIS.hWindow, hDC)
 
PROCEDURE DrawText(cMessage, hDC, nLeft, nTop,;
    nWidth, nHeight, nColor)
    LOCAL oRect As RECT
 
    oRect = CREATEOBJECT("RECT",;
        nLeft, nTop, nWidth, nHeight)
 
    = SetBkMode(hDC, 1)  && transparent
    = SetTextColor(hDC, nColor)
    = DrawText(hDC, cMessage,;
        LEN(cMessage), oRect.ToString(), DT_WORDBREAK)
 
PROCEDURE ReleaseWindow
    IF THIS.hWindow <> 0
        = DestroyWindow(THIS.hWindow)
        THIS.hWindow=0
    ENDIF
 
PROCEDURE CreateWindow
    THIS.ReleaseWindow
 
    LOCAL hParent, cClass, nExStyle, nStyle
    hParent = _screen.HWnd
    cClass = THIS.GetWinClass(hParent)
 
    * window styles
    nStyle = WS_DISABLED
    nExStyle = BITOR(WS_EX_TOPMOST, WS_EX_LAYERED,;
        WS_EX_TRANSPARENT, WS_EX_NOACTIVATE)
 
    THIS.hWindow = CreateWindowEx(nExStyle, cClass,;
        "Alert", nStyle, THIS.Left, THIS.Top,;
        THIS.Width, THIS.Height, hParent, 0, 0, 0)
 
    * create region and apply it to the window;
    * this cuts the caption and the frame off the window
    LOCAL nCaptionHeight, nFrameWidth, nFrameHeight,;
        x1, y1, x2, y2, hRgnBase
 
    nCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
    nFrameWidth = GetSystemMetrics(SM_CXFRAME)
    nFrameHeight = GetSystemMetrics(SM_CYFRAME)
 
    x1 = nFrameWidth
    y1 = nFrameHeight+nCaptionHeight
    x2 = THIS.Width-nFrameWidth-1
    y2 = THIS.Height-nFrameHeight-1
 
    hRgnBase = CreateRectRgn(x1, y1, x2, y2)
    = SetWindowRgn(THIS.hWindow, hRgnBase, 1)
    = DeleteObject(hRgnBase)
 
    * set window transparency -- white
    = SetLayeredWindowAttributes(THIS.hWindow,;
        RGB(255,255,255), 0, LWA_COLORKEY)
 
PROCEDURE ReleaseFont
    IF THIS.hFont <> 0
        = DeleteObject(THIS.hFont)
        THIS.hFont=0
    ENDIF
 
PROCEDURE CreateFont
    THIS.ReleaseFont
    THIS.hFont = CreateFont(THIS.FontSize, 0, 0, 0,;
        IIF(THIS.FontBold, FW_BOLD, FW_NORMAL), 0,0,0,;
        ANSI_CHARSET, OUT_DEVICE_PRECIS, CLIP_STROKE_PRECIS,;
        PROOF_QUALITY, DEFAULT_PITCH, THIS.FontName)
 
PROTECTED PROCEDURE GetWinClass(hParent)
    LOCAL cClass, nSize
    cClass = REPLICATE(CHR(0), 250)
    nSize = RealGetWindowClass(hParent, @cClass , Len(cClass ))
RETURN STRTRAN(SUBSTR(cClass, 1, nSize), Chr(0),"")
 
PROTECTED PROCEDURE declare
    DECLARE INTEGER DestroyWindow IN user32 INTEGER hWindow
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObject
    DECLARE INTEGER SetTextColor IN gdi32 INTEGER hdc, INTEGER crColor
    DECLARE INTEGER GetDC IN user32 INTEGER hWindow
    DECLARE INTEGER ReleaseDC IN user32 INTEGER hWindow, INTEGER hdc
    DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex
 
    DECLARE INTEGER RealGetWindowClass IN user32;
        INTEGER hWindow, STRING @pszType, INTEGER cchType
 
    DECLARE INTEGER ShowWindow IN user32 AS ShowWindowA;
        INTEGER hWindow, INTEGER nCmdShow
 
    DECLARE INTEGER CreateWindowEx IN user32;
        INTEGER dwExStyle, STRING lpClassName, STRING lpWindowName,;
        INTEGER dwStyle, INTEGER x, INTEGER y,;
        INTEGER nWidth, INTEGER nHeight, INTEGER hWndParent,;
        INTEGER hMenu, INTEGER hInstance, INTEGER lpParam
 
    DECLARE INTEGER SetLayeredWindowAttributes IN user32;
        INTEGER hwnd, INTEGER crKey,;
        SHORT bAlpha, INTEGER dwFlags
 
    DECLARE INTEGER CreateFont IN gdi32;
        INTEGER nHeight, INTEGER nWidth, INTEGER nEscapement,;
        INTEGER nOrientation, INTEGER fnWeight, INTEGER fdwItalic,;
        INTEGER fdwUnderline, INTEGER fdwStrikeOut, INTEGER fdwCharSet,;
        INTEGER fdwOutputPrec, INTEGER fdwClipPrec, INTEGER fdwQuality,;
        INTEGER fdwPitchAndFamily, STRING lpszFace
 
    DECLARE INTEGER CreateRectRgn IN gdi32; 
        INTEGER nLeftRect, INTEGER nTopRect,;
        INTEGER nRightRect, INTEGER nBottomRect 
 
    DECLARE INTEGER SetWindowRgn IN user32;
        INTEGER hWindow, INTEGER hRgn, SHORT bRedraw
 
    DECLARE INTEGER DrawText IN user32;
        INTEGER hDC, STRING lpString, INTEGER nCount,;
        STRING lpRect, INTEGER uFormat
 
    DECLARE INTEGER SetBkMode IN gdi32;
        INTEGER hdc, INTEGER iBkMode
 
ENDDEFINE
 
DEFINE CLASS RECT As Custom
    left=0
    top=0
    width=0
    height=0
 
PROCEDURE Init(nLeft, nTop, nWidth, nHeight)
    THIS.left=m.nLeft
    THIS.top=m.nTop
    THIS.width=m.nWidth
    THIS.height=m.nHeight
 
FUNCTION ToString As String
RETURN num2dword(THIS.left) +;
    num2dword(THIS.top) +;
    num2dword(THIS.left+THIS.width-1) +;
    num2dword(THIS.top+THIS.height-1)
 
ENDDEFINE
 
FUNCTION num2dword(lnValue)
#DEFINE m0 0x0000100
#DEFINE m1 0x0010000
#DEFINE m2 0x1000000
    IF lnValue < 0
        lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2) / m1)
    b1 = Int((lnValue - b3*m2 - b2*m1) / m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)