Formularios con esquinas redondas

02/05/2020

 

Autor: Francisco Lorente

Me he encontrado est tema que me ha parecido interesante en el foro de la Comunidad de Visual FoxPro en Español.

En el evento Load del formulario agregar este código para cargar las funciones API:

Declare Long CreateRoundRectRgn In 'gdi32' Long X1, Long Y1, Long X2, Long Y2, Long w, Long h

Declare Long SetWindowRgn In "user32" Long Hwnd, Long hRgn, Integer bRedraw

Y en el evento Init del formulario:

Local m.lnWindowRegion, m.lnResult, m.lnWidthCurvature, m.lnHeightCurvature

m.lnWidthCurvature = 50 && Cambia el factor x de la curvatura de las esquinas

m.lnHeightCurvature = 50 && Cambia el factor y de la curvatura de las esquinas

m.lnWindowRegion = CreateRoundRectRgn(0, 0, Thisform.Width, Thisform.Height, m.lnWidthCurvature, m.lnHeightCurvature)

m.lnResult = SetWindowRgn(Thisform.hwnd, m.lnWindowRegion , .T.)

He probado el código y funciona correctamente. Yo lo veo ideal para utilizar con formularios sin barra de títulos.

Comentario de Zarlu:

Buenas tardes foxeros!

Bueno eso quiere decir que no hay preguntas muertas en el foro... sólo dormidas.

Aunque sea cada que ocurra una pandemia, pero se despierta el tema jajaja

     CreateRoundRectRgn(0,0, Thisform.Width, Thisform.Height, m.lnWidthCurvature, m.lnHeightCurvature)

Los cuatro primero valores son:

  1. Inicio X
  2. Inicio Y
  3. Fin X
  4. Fin Y

Y Entonces para un valor de curvatura de 50:

    Thisform.Width  + 55 &&ángulos izquierdos
    Thisform.Height + 55 &&ángulos superiores
    Thisform.Width  + 55,Thisform.Height + 55 &&angulo superior izquierdo

-55,0 && ángulos derechos

0,-55 && ángulos inferiores

-55,-55 && ángulo inferior derecho

Es decir es aumentar/disminuir el valor de la curvatrura

Adaptando el código del colega para limpiar las variables. Todo puede ir en el INIT.

lcCurva=50 

    Declare Long CreateRoundRectRgn In 'gdi32' Long X1, Long Y1, Long X2, Long Y2, Long w, Long h
    Declare Long SetWindowRgn In "user32" Long Hwnd, Long hRgn, Integer bRedraw
    =SetWindowRgn(Thisform.hwnd, CreateRoundRectRgn(0,0, Thisform.Width, Thisform.Height, lcCurva, lcCurva) , .T.) 
    RELEASE lcCurva,CreateRoundRectRgn, SetWindowRgn

Estuve haciendo pruebas con _Screen.ActiveForm para hacer una función, pero no responde igual. Sigo intentando...

Habría que trabajar con la apariencia por que la curvatura y el redibujado afecta la barra del título.

zarlu

Chetumal, Quintana Roo, México

Nuevo comentario de Zarlu:

Buenas tardes Foxeros!

Aquí les dejo como FUNCTION la rutina que el colega Francisco Lorente compartió.

Debe llamarse desde el GOTFOCUS() del formulario.

      *- Llamar desde el Gotfocus() del formulario: form_curva(50). Valor de la curvatura. Aumentar o disminuir.
      FUNCTION form_curva(pCurva)     
      DECLARE INTEGER GetFocus IN user32
        Declare Long CreateRoundRectRgn In 'gdi32' Long X1, Long Y1, Long X2, Long Y2, Long w, Long h     
        Declare Long SetWindowRgn In "user32" Long Hwnd, Long hRgn, Integer bRedraw     
        =SetWindowRgn(GetFocus(), CreateRoundRectRgn(0,0, _Screen.ActiveForm.Width, _Screen.ActiveForm.Height, pCurva, pCurva) , .T.)
        RELEASE pCurva,GetFocus,CreateRoundRectRgn,SetWindowRgn 
      ENDFUNC

Pueden adaptar los valores conforme a mi mensaje anterior para redondear no todas las esquinas conforme lo deseen

 

 

Este en la Web del programador: https://www.lawebdelprogramador.com/foros/FoxPro-Visual-FoxPro/673730-Formularios-redondos.html

Formulario redondo 

             SET LIBRARY TO SYS(2004)+"foxtools.fll" ADDITIVE             
             fcnVentanaActiva = regfn("GetActiveWindow","","I") && Función para encontrar el Handle de la ventana activa 
             *En este caso es la ventana principal de VFP 
             *Pueden utilizar "FindWindow" para obtener el handle de la ventana que uds quieran 
             fcnRgnEliptica = regfn("CreateEllipticRgn","IIII","I") && función para crear la region elíptica 
             fcnColocaRegion = regfn("SetWindowRgn","III","I")      && Función para colocar la región en la ventana
                                                                    && con el handle obtenido 
             hWndActiva = Callfn(fcnVentanActiva)                   &&Obtenemos el handle de la ventana activa 
  
             IF hWndActiva <> 0 THEN                                && Si se encontró el handle 
               mRGN = callfn(FcnRgnEliptica,0,0,THISFORM.WIDTH,THISFORM.HEIGHT) &&Generamos la región
                *Pueden modificar los parámetros para colocar la región donde uds quieran y hacerla más o menos ancha 
               IF mRGN <> 0 THEN && Si se creó la región 
                 mSalida = callfn(fcnColocaRegion,hWndActiva,mRGN,1)    &&Colocamos la región en la ventana de la 
                 * que obtuvimos en handle 
                 IF mSalida <> 0 then 
                   WAIT WIND "FUNCIÓN EXITOSA" 
                 ENDIF 
             
               ENDIF 
             ENDIF 
             
             Function GetHwndForm 
             LParameter toForm 
             Local lcCaption 
             lcCaption = toForm.Caption 
             toForm.Caption = Sys(3) 
             
             If not "FOXTOOLS" $ Upper( Set("Library") ) 
               Set Library to (Home()+"\FoxTools.Fll") Additive 
             Endif 
             
             Local lnHWND 
             lnHWND = _WhToHwnd( _WFindTitl(toForm.Caption) ) 
             toForm.Caption = m.lcCaption 
             
             Return m.lnHWND

 

 

FoxPress – Octubre 2003

https://www.fpress.com/revista/Num1003/art.htm

 

Un formulario circular

Por Por Anatoliy Mogylevets

http://www.news2news.com/vfp                                                            

En Visual FoxPro no estás limitado a formularios rectangulares, puedes hacer elipses, polígonos o combinaciones de ambos.

Basado en las funciones del Win32 GDI el código que se muestra a continuación crea un formulario redondo en tres simples pasos:

  1. -    Crea un formulario rectangular normal con algunos controles como: Label, TextBox, CommandButton.
  2. -    Establece el fondo del formulario mediante un gráfico que sea circular.
  3. -    Corta todo en el formulario excepto la parte que contiene el gráfico.

Si ejecutas el código verás lo siguiente:

que aunque no lo parezca es un formulario redondo. El código para ejecutar este ejemplo te lo pongo a continuación.

PUBLIC oForm

oForm = CreateObject("Tform")

oForm.Visible = .T.

 

DEFINE CLASS Tform As Form

#DEFINE badgeDiameter 264

#DEFINE topMargin 4

#DEFINE leftMargin 2

  Width=300

  Height=350

  AutoCenter=.T.

  Picture="badge1.bmp"

  hRgn=0

   

  ADD OBJECT lbl As Label WITH Caption="Your ID:",;

  FontName="Arial", FontSize=14, Bold=.T., BackStyle=0, Alignment=2,;

  Forecolor=Rgb(255,255,225), Left=82, Top=105, Width=100, Height=25

 

  ADD OBJECT txt As TextBox WITH Width=100, Height=24,;

  Left=82, Top=130, PasswordChar="*"

 

  ADD OBJECT cmd As CommandButton WITH Width=60, Height=25,;

  Left=104, Top=165, Caption="Ok", 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

         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

 

Si le pones un gráfico en la propiedad picture, te saldría el gráfico seleccionado, pero ten en cuenta que debe ser redondo (en este caso).

 

Vea también

 

 

Referencias

Artículo original: Se ha extraido del foro de la Comunidad de Visual FoxPro en Español
https://mail.google.com/mail/u/0/?pli=1#inbox/FMfcgxwHNCwJWWkCQtpXpCXfxGdvlhXx
Autor: Francisco Lorente

 

 

 

 
error: Contenido protegido