Function creaFontAmedida( cNameFont, cText , nWidth, oWnd )
Local oFont , nMax := -100
Local nSize , nHeightFont
DEFAULT cNameFont := "Verdana"
DEFAULT cText := "Prueba font a medida"
DEFAULT nWidth := 10
nHeightFont := -1
Do While .t.
DEFINE FONT oFont NAME cNameFont SIZE 0, nHeightFont
nSize := oWnd:GetWidth( cText, oFont )
if nSize > nWidth
oFont:end()
nHeightFont++
DEFINE FONT oFont NAME cNameFont SIZE 0, nHeightFont
nWidth := oWnd:GetWidth( cText, oFont ) // Devuelve por referencia el ancho real del Texto
exit
else
oFont:end()
nHeightFont--
endif
// Sale por error, hay un desbordamiento
if Abs(nMax)<abs(nHeightFont)
exit
endif
//--------------------------------------
Enddo
return oFont
#include 'fivewin.ch'
#define DT_CENTER 0x0001
#define DT_VCENTER 0x0004
Static oWnd
//----------------------------------------------------------------------------//
Function Main()
Local cTexto := 'texto de prueba'
Define Window oWnd
Activate Window oWnd On Paint Texto( cTexto )
Return 0
//----------------------------------------------------------------------------//
Function Texto( cTitulo )
Local hDc := oWnd : GetDC()
Local aRect := GetClientRect( oWnd : hWnd )
Define Font oFont1 Name "Segoe UI" Size 0, -20 Bold
oFont1 : Activate( hDc )
SetTextColor( hDC, CLR_WHITE )
SetBkColor( hDC, RGB( 43, 87, 154 ) )
DrawTextEx( hDC, cTitulo, { 02, 15, 45, aRect[ 4 ] - 50 }, DT_CENTER + DT_VCENTER )
oFont1 : Deactivate( hDC )
oWnd : ReleaseDc()
Return 0
#include 'fivewin.ch'
#define DT_CENTER 0x0001
#define DT_VCENTER 0x0004
Function Main()
Local oDlg
Local nRowPos
Local nColPos
Local oCrsHand
Local lDrag := .f.
Local lInit := .t.
Define Dialog oDlg From 100, 100 To 500, 700 Pixel Style nOr( WS_POPUP ) Color 0, CLR_WHITE Transparent
oDlg : bLClicked := { | nRow, nCol | SetCapture( oDlg : hWnd ), nRowPos := nRow, nColPos := nCol, lDrag := .T., oDlg : oCursor := oCrsHand }
oDlg : bMMoved := { | nRow, nCol | If( lDrag, oDlg : Move( oDlg : nTop + nRow - nRowPos,;
oDlg : nLeft + nCol - nColPos,,, .T. ),) }
oDlg : bLButtonUp := { || lDrag := .f., oDlg : oCursor := nil, ReleaseCapture() }
Activate Dialog oDlg Centered On Paint CabeceraDialogo( oDlg, "Altas alumnos" ) Valid ( .t. )
Return 0
//----------------------------------------------------------------------------//
Function CabeceraDialogo( oDlg, cTitulo )
Local oSay
Local oBmp
Local oFont1
Local hBitmap
Local hDc := oDlg : GetDC()
Local hPen := CreatePen( PS_SOLID, 1, RGB( 43, 87, 154 ) )
Local aRect := GetClientRect( oDlg : hWnd )
Local hBrush := CreateSolidBrush( RGB( 43, 87, 154 ) )
Local hOldPen := SelectObject( hDc, hPen )
Local hOldBrush := SelectObject( hDc, hBrush )
Default cTitulo := ''
Define Font oFont1 Name "Segoe UI" Size 0, -20 Bold
Rectangle( hDC, aRect[ 1 ],;
aRect[ 2 ],;
35,;
aRect[ 4 ] )
Rectangle( hDC, aRect[ 1 ],;
0,;
aRect[ 3 ],;
5 )
Rectangle( hDC, aRect[ 1 ],;
aRect[ 4 ] - 5,;
aRect[ 3 ],;
aRect[ 4 ] )
Rectangle( hDC, aRect[ 4 ] - 5,;
aRect[ 2 ],;
aRect[ 3 ] - 5,;
aRect[ 4 ] )
hBitmap := LoadBitmap( GetResources(), 'cerrar' )
DrawBitmap( hDc, hBitmap, 8, aRect[ 4 ] - 45, 37, 20 )
oFont1 : Activate( hDc )
SetTextColor( hDC, CLR_WHITE )
SetBkColor( hDC, RGB( 43, 87, 154 ) )
DrawTextEx( hDC, cTitulo, { 02, 15, 45, aRect[ 4 ] - 50 }, DT_CENTER + DT_VCENTER )
SelectObject( hDc, hOldPen )
SelectObject( hDc, hOldBrush )
DeleteObject( hPen )
DeleteObject( hBrush )
oFont1 : Deactivate( hDC )
oDlg : ReleaseDc()
oFont1 : End()
Return 0
horacio wrote:Comencé un proyecto nuevo y decidí utilizar una ribbon con estilo 2013 y me di cuenta que los dialogos ordinarios no quedaban bien por eso me puse a trabajar para cambiarles el aspecto. Toda la magia está en el evento Paint y realmente no me fue difícil ya que FW tiene primitivas gráficas para todo. Pero claro, es más trabajo.
Saludos
#include "FiveWin.ch"
MEMVAR VePru,Titulo
FUNCTION Main()
Titulo='Probando un Titulo Centrado'
DEFINE WINDOW VePru FROM 0,0 TO 35,100 TITLE Titulo
ACTIVATE WINDOW VePru ON INIT Centro()
RETU nil
FUNCTION Centro()
LOCAL espacios
espacios=(((VePru:nWidth)/8)-(LEN(Titulo))/2)
VePru:cTITLE := SPACE( espacios ) + Titulo
RETU nil
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 50 guests