Muy bueno Cristobal!!
Muchas gracias por compartirlo
// C:\FWH..\SAMPLES\MENUBLAC.PRG
#Include "Fivewin.ch"
Static oWnd, oFont, oFontMenu
FUNCTION Main()
MyWindow()
RETURN NIL
FUNCTION MyWindow()
LOCAL oBar, oBtn1, oBtn2, oBtn3, oBtn4, oBtn5, oBtn6, oBtn7, oBtn8, oBmp
SetBalloon( .T. )
SkinButtons()
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -16
DEFINE FONT oFontMenu NAME "Segoe UI" SIZE 0, -18
DEFINE WINDOW oWnd MENU MyMenu() STYLE WS_POPUP
oWnd:SetColor( CLR_WHITE, Rgb( 44, 44, 44 ) )
DEFINE BUTTONBAR oBar OF oWnd NOBORDER
WITH OBJECT oBar
oBar:nClrText := CLR_BLACK
oBar:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
oBar:bRClicked := { || NIL }
oBar:bLClicked := { || NIL }
oBar:SetFont( oFont )
oBar:Adjust()
END
DEFINE BUTTON oBtn1 OF oBar FILENAME "..\bitmaps\16x16\new.bmp" FLAT ;
ACTION MsgInfo( "New" ) ;
TOOLTIP "Creates a new document" GROUP
oBtn1:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn2 OF oBar FILENAME "..\bitmaps\16x16\open.bmp" FLAT ;
ACTION MsgInfo( cGetFile( "*.*", "Select a document to open" ) ) ;
TOOLTIP "Opens a document" WHEN .f. GROUP
oBtn2:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn3 OF oBar FILENAME "..\bitmaps\16x16\floppy.bmp" FLAT ;
ACTION MsgInfo( Time() ) TOOLTIP "Saves this document" GROUP
oBtn3:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn4 OF oBar FILENAME "..\bitmaps\16x16\printer.bmp" FLAT ;
ACTION MsgInfo( "Prints this document" ) TOOLTIP "Print this document" ;
GROUP
oBtn4:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn5 OF oBar FILENAME "..\bitmaps\16x16\prop.bmp" FLAT ;
ACTION PrinterSetup() TOOLTIP "Setup the printer" GROUP
oBtn5:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn6 OF oBar FILENAME "..\bitmaps\16x16\HelpInd.bmp" FLAT ;
ACTION MsgInfo( Version() ) TOOLTIP "A multiple lines" + ;
Chr( 13 ) + Chr( 10 ) + "tooltip!" GROUP
oBtn6:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn7 OF oBar FILENAME "..\bitmaps\16x16\Help.bmp" FLAT ;
ACTION MsgInfo( "fivewin power!" ) TOOLTIP "fivewin power!" GROUP
oBtn7:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn8 OF oBar FILENAME "..\bitmaps\16x16\Exit.bmp" FLAT ;
ACTION oWnd:End() TOOLTIP "Exit this app" GROUP
oBtn8:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
SET MESSAGE OF oWnd TO "© Contato Sistemas: (11) 2941-6446 / 3569-6446 " ;
+ "- Skype: joao@pleno.com.br" + " - www.pleno.com.br" FONT oFont ;
NOINSET CLOCK DATE KEYBOARD COLOR CLR_GRAY, Rgb( 44, 44, 44 )
/* // .OR.
DEFINE MESSAGE OF oWnd ;
PROMPT FWVERSION + " " + FWCOPYRIGHT FONT oFont ;
NOINSET CENTERED KEYBOARD DATE CLOCK COLOR CLR_GRAY, Rgb( 44, 44, 44 )
*/
DEFINE BITMAP oBmp FILENAME "..\bitmaps\BACK.bmp" // WOW()!!
oWnd:bPainted = { | hDC | BmpTiled( hDC, oWnd, oBmp ) }
ACTIVATE WINDOW oWnd MAXIMIZED
RETURN NIL
FUNCTION MyMenu()
LOCAL oMenu
MENU oMenu 2013 ;
FONT oFontMenu ;
HEIGHT -2 ;
COLORMENU Rgb( 44, 44, 44 ), CLR_GRAY ;
COLORSELECT CLR_WHITE, CLR_WHITE, Rgb( 100, 100, 100 ) ;
COLORLINEBOTTOM Rgb( 44, 44, 44 )
//MENUITEM FILE "..\bitmaps\VSCode48.png"
MENUITEM FILE "..\bitmaps\PNGS\FiveTech.png"
MENUITEM "Docs"
MENUITEM "Update"
MENUITEM "BLog"
MENUITEM "Api"
MENUITEM "Extensions"
MENUITEM "FAQ"
MENUITEM "Learn"
MENUITEM "Salir" ACTION( oWnd:End() )
ENDMENU
RETURN( oMenu )
STATIC FUNCTION BmpTiled( hDC, oWnd, oBmp )
local nWidth := oWnd:nWidth(), nHeight := oWnd:nHeight()
local nRow := 0, nCol := 0, n
local nBmpWidth := oBmp:nWidth(), nBmpHeight := oBmp:nHeight()
if oBmp:hBitmap == 0
return nil
endif
while nRow < nHeight
nCol = 0
while nCol < nWidth
PalBmpDraw( hDC, nRow, nCol, oBmp:hBitmap )
nCol += nBmpWidth
end
nRow += nBmpHeight
end
RETURN NIL
// FIN / END - kapiabafwh@gmail.com - Joao Santos - Sao Paulo - Brasil.
// C:\FWH..\SAMPLES\MENUBLAC.PRG - Version: 02
#Include "Fivewin.ch"
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
ANNOUNCE RDDSYS // IDEM: ANNOUNCE FPTCDX
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto // Para ListBox
REQUEST DBFCDX, DBFFPT
Static oWnd, oFont, oFontMenu
FUNCTION Main()
MyWindow()
RETURN NIL
FUNCTION MyWindow()
LOCAL oBar, oBtn1, oBtn2, oBtn3, oBtn4, oBtn5, oBtn6, oBtn7, oBtn8, oBmp
LOCAL oMsgItem, oMsgItemMail
HB_GCALL( .F. ) // PARA LIMPAR A MEMORIA .F. -> Somente se tiver lixo.
HB_LANGSELECT( 'PT' ) // Default language is now Portuguese
HB_SETCODEPAGE( "PT850" )
HB_CDPSELECT( "PTISO" )
RDDSETDEFAULT("DBFCDX")
RDDREGISTER( "DBFCDX", 1 ) // RDT_FULL -> 20/10/2022 Joao
SET CENTURY ON
SET DATE BRITISH
SET TIME FORMAT TO "HH:MM:SS"
SET EPOCH TO YEAR( DATE() ) - 30
SET SOFTSEEK OFF
SET WRAP ON
SETCANCEL( .F. )
SET CONFIRM OFF
SET DELETED ON
SET _3DLOOK ON
SET UNIQUE OFF
SET ESCAPE OFF
SET EXACT ON // CONTROLA O :=, = e ==
SET EXCLUSIVE OFF
SET MULTIPLE OFF
SET OPTIMIZE ON
SetBalloon( .T. )
SkinButtons()
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -16
DEFINE FONT oFontMenu NAME "Segoe UI" SIZE 0, -18
// SIN TITLE EN ESTE MODELO.
DEFINE WINDOW oWnd MENU MyMenu() STYLE WS_POPUP
oWnd:SetColor( CLR_WHITE, Rgb( 44, 44, 44 ) )
DEFINE BUTTONBAR oBar OF oWnd NOBORDER
WITH OBJECT oBar
oBar:nClrText := CLR_BLACK
oBar:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
oBar:bRClicked := { || NIL }
oBar:bLClicked := { || NIL }
oBar:SetFont( oFont )
oBar:Adjust()
END
DEFINE BUTTON oBtn1 OF oBar FILENAME "..\bitmaps\16x16\new.bmp" FLAT ;
ACTION MsgInfo( "New" ) ;
TOOLTIP "Creates a new document" GROUP
oBtn1:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn2 OF oBar FILENAME "..\bitmaps\16x16\open.bmp" FLAT ;
ACTION MsgInfo( cGetFile( "*.*", "Select a document to open" ) ) ;
TOOLTIP "Opens a document" WHEN .f. GROUP
oBtn2:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn3 OF oBar FILENAME "..\bitmaps\16x16\floppy.bmp" FLAT ;
ACTION MsgInfo( Time() ) TOOLTIP "Saves this document" GROUP
oBtn3:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn4 OF oBar FILENAME "..\bitmaps\16x16\printer.bmp" FLAT ;
ACTION MsgInfo( "Prints this document" ) TOOLTIP "Print this document" ;
GROUP
oBtn4:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn5 OF oBar FILENAME "..\bitmaps\16x16\prop.bmp" FLAT ;
ACTION PrinterSetup() TOOLTIP "Setup the printer" GROUP
oBtn5:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn6 OF oBar FILENAME "..\bitmaps\16x16\HelpInd.bmp" FLAT ;
ACTION MsgInfo( Version() ) TOOLTIP "A multiple lines" + ;
Chr( 13 ) + Chr( 10 ) + "tooltip!" GROUP
oBtn6:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn7 OF oBar FILENAME "..\bitmaps\16x16\Help.bmp" FLAT ;
ACTION MsgInfo( "fivewin power!" ) TOOLTIP "fivewin power!" GROUP
oBtn7:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
DEFINE BUTTON oBtn8 OF oBar FILENAME "..\bitmaps\16x16\Exit.bmp" FLAT ;
ACTION oWnd:End() TOOLTIP "Exit this app" GROUP
oBtn8:Setcolor( CLR_GRAY, Rgb( 36, 36, 36 ) )
// SET MESSAGE OF oWnd TO "© Contato Sistemas: (11) 2941-6446 / 3569-6446 " ;
// + "- Skype: joao@pleno.com.br" + " - www.pleno.com.br" FONT oFont ;
// NOINSET CLOCK DATE KEYBOARD COLOR CLR_GRAY, Rgb( 44, 44, 44 )
// O:
SET MESSAGE OF oWnd TO "© Contato Sistemas: (11) 2941-6446 / 3569-6446 " ;
+ "- Skype: joao@pleno.com.br" + " - www.pleno.com.br" FONT oFont ;
COLOR CLR_GRAY, Rgb( 44, 44, 44 )
DEFINE MSGITEM oMsgItem OF oWnd:oMsgBar PROMPT "Lock" SIZE 60 ;
BITMAPS "..\bitmaps\16x16\lock.bmp", "..\bitmaps\16x16\unlock.bmp" ;
ACTION ( oMsgItem:lActive := !oMsgItem:lActive, oMsgItem:Paint() )
DEFINE MSGITEM oMsgItemMail OF oWnd:oMsgBar SIZE 24 ;
BITMAPS "..\bitmaps\16x16\MAIL.BMP" ;
TOOLTIP "Check the email" + CRLF + "Get email"
DEFINE MSGITEM OF oWnd:oMsgBar ;
BITMAPS "..\bitmaps\16x16\PRINTER.BMP" ;
ACTION PrinterSetup() ;
TOOLTIP "Setup the printer"
oWnd:oMsgBar:DateOn()
oWnd:oMsgBar:ClockOn()
DEFINE BITMAP oBmp FILENAME "..\bitmaps\BACK.bmp" // WOW()!!
oWnd:bPainted = { | hDC | BmpTiled( hDC, oWnd, oBmp ) }
ACTIVATE WINDOW oWnd MAXIMIZED
oFont:End()
oFontMenu:End()
HB_GCALL( .T. )
RETURN NIL
FUNCTION MyMenu()
LOCAL oMenu
MENU oMenu 2013 ;
FONT oFontMenu ;
HEIGHT -2 ;
COLORMENU Rgb( 44, 44, 44 ), CLR_GRAY ;
COLORSELECT CLR_WHITE, CLR_WHITE, Rgb( 100, 100, 100 ) ;
COLORLINEBOTTOM Rgb( 44, 44, 44 )
//MENUITEM FILE "..\bitmaps\VSCode48.png"
MENUITEM FILE "..\bitmaps\PNGS\FiveTech.png"
MENUITEM "Docs"
MENUITEM "Update"
MENUITEM "BLog"
MENUITEM "Api"
MENUITEM "Extensions"
MENUITEM "FAQ"
MENUITEM "Learn"
MENUITEM "Salir" ACTION( oWnd:End() )
ENDMENU
RETURN( oMenu )
STATIC FUNCTION BmpTiled( hDC, oWnd, oBmp )
local nWidth := oWnd:nWidth(), nHeight := oWnd:nHeight()
local nRow := 0, nCol := 0, n
local nBmpWidth := oBmp:nWidth(), nBmpHeight := oBmp:nHeight()
if oBmp:hBitmap == 0
return nil
endif
while nRow < nHeight
nCol = 0
while nCol < nWidth
PalBmpDraw( hDC, nRow, nCol, oBmp:hBitmap )
nCol += nBmpWidth
end
nRow += nBmpHeight
end
RETURN NIL
// FIN / END - kapiabafwh@gmail.com - Joao Santos - Sao Paulo - Brasil.
cTitle := "MENU PRINCIPAL - Title del Window"
DEFINE WINDOW oWnd MENU MyMenu() TITLE cTitle ;
STYLE nOr( WS_POPUP, WS_VISIBLE, WS_CAPTION, WS_THICKFRAME, ;
WS_SYSMENU, WS_MINIMIZEBOX, WS_MAXIMIZEBOX )
TOTOVIOTTI wrote:Gracias Joäo por tu aporte!!!
Muy valioso!!
Se puede cambiar el Font y Color del Caption de una Window? Intenté de varias formas
pero no obtuve resultados positivos... disculpas...
Gracias
Roberto
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 67 guests