Search:
 
Principal
Forms / Formulário Redondo / /

PUBLIC oForm
oForm = CreateObject("Tform")
oForm.Visible = .T.
* end of main

DEFINE CLASS Tform As Form
#DEFINE badgeDiameter 500
#DEFINE topMargin 1
#DEFINE leftMargin 2
Width=500
Height=500
AutoCenter=.T.
desktop=.T.
ShowWindow = 2
Picture="fundo.jpg"
hRgn=0

ADD OBJECT lbl As Label WITH Caption="Senha:",;
FontName="Arial", FontSize=9, Bold=.T., BackStyle=0, Alignment=2,;
Forecolor=Rgb(255,255,225), Left=384, Top=214, Width=100, Height=25;

ADD OBJECT txt As TextBox WITH Width=100, Height=24,;
Left=382, Top=230, Forecolor=Rgb(128,128,128),PasswordChar="X"

ADD OBJECT cmd As CommandButton WITH Width=40, Height=25,;
Left=384, Top=265, Caption="Ok", Default=.T.

ADD OBJECT fxform As CommandButton WITH Width=55, Height=25,;
Left=430, Top=265, Caption="Fechar", Default=.T.

PROCEDURE Init
*
DO decl

PROCEDURE Activate
*
IF THIS.hRgn = 0
THIS.RegionOn
ENDIF

PROCEDURE RegionOn
#DEFINE SM_CYSIZE 31
#DEFINE SM_CXFRAME 32
#DEFINE SM_CYFRAME 33
LOCAL hwnd, x0, y0, x1, y1

* calculating position of the region
x0 = GetSystemMetrics(SM_CXFRAME) + leftMargin
y0 = GetSystemMetrics(SM_CYSIZE) +;
GetSystemMetrics(SM_CYFRAME) + topMargin
x1 = x0 + badgeDiameter
y1 = y0 + badgeDiameter

* creating an elliptical region
THIS.hRgn = CreateEllipticRgn (x0, y0, x1, y1)
hwnd = GetFocus()

* applying the region to the form
IF SetWindowRgn(hwnd, THIS.hRgn, 1) = 0
* if failed then release the handle
= DeleteObject (THIS.hRgn)
THIS.hRgn = 0
ENDIF
ENDPROC

PROCEDURE MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
#DEFINE WM_SYSCOMMAND 0x112
#DEFINE WM_LBUTTONUP 0x202
#DEFINE MOUSE_MOVE 0xf012
IF nButton = 1
LOCAL hWindow
hWindow = GetFocus()
= ReleaseCapture()
= SendMessage(hWindow, WM_SYSCOMMAND, MOUSE_MOVE, 0)
= SendMessage(hWindow, WM_LBUTTONUP, 0, 0)
ENDIF

PROCEDURE cmd.Click

WITH thisform
IF EMPTY(.txt.VALUE)
.txt.SETFOCUS
MESSAGEBOX(" Preenchimento obrigatório !",64+0+0,"Atenção")
RETURN .F.
ENDIF
IF .txt.VALUE # '12345'
=MESSAGEBOX('Senha "'+(alltrim(.txt.VALUE))+'" é inválida !',24+0+0,'Atenção')
.txt.SETFOCUS
RETURN .F.
ELSE
Tudo_Ok = .T.
DODEFAULT()
ENDIF
endwith

ThisForm.Release

PROCEDURE fxform.Click
ThisForm.Release

ENDDEFINE

PROCEDURE decl
DECLARE INTEGER GetFocus IN user32
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
DECLARE INTEGER GetSystemMetrics IN user32 INTEGER nIndex
DECLARE INTEGER ReleaseCapture IN user32

DECLARE INTEGER SendMessage IN user32;
INTEGER hWnd, INTEGER Msg,;
INTEGER wParam, INTEGER lParam

DECLARE INTEGER CreateEllipticRgn IN gdi32;
INTEGER nLeftRect, INTEGER nTopRect,;
INTEGER nRightRect, INTEGER nBottomRect

DECLARE INTEGER SetWindowRgn IN user32;
INTEGER hWnd, INTEGER hRgn, INTEGER bRedraw

Autor:Desconhecido
Relacionados
Forms :
- Formulário Transparente
Documento sem título

Rafael Lippert
rafaellippert@gmail.com