// We are going to build a PullDown menu and we are going to assign it
// to our main Window - MODIFICADO EM: 08/10/2025 by Kapiaba.
// This example is the typical way of start building a FiveWin program
#include "FiveWin.ch"
#Define CLR_LGRAY nRGB( 230, 230, 230 )
#Define CLR_LGREEN nRGB( 190, 215, 190 )
#Define CLR_AMARELO nRGB( 255, 255, 000 ) //--> Amarelo Para o Fundo
#Define CLR_WINDOW nRgb( 130, 130, 130 ) // 16 // COR DO WINDOWS DEFINIDA 16 BITS
Static oWnd, lAbertura := .F.
FUNCTION Main()
LOCAL oIco, oBar, oBmp, oPopUp, oPopUp2, oPopUp3, oPopUp4, oPopUp5, oFont
LOCAL oBtn := ARRAY(05)
LOCAL cWidth := 500, cHeight := 500
DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 14
DEFINE ICON oIco FILE "..\icons\fax.ico"
DEFINE WINDOW oWnd FROM 1, 1 TO 22, 75 ;
TITLE "FiveWin sample" ;
MENU BuildMenu() ;
COLOR "B/W" ;
ICON oIco
DEFINE BUTTONBAR oBar _3D SIZE 50, 40 OF oWnd 2007
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\new.bmp" FLAT ;
ACTION Bmp_Rand( cWidth, cHeight ) ;
TOOLTIP "Creates a new document"
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\open.bmp" FLAT ;
ACTION MsgInfo( cGetFile( "*.*", "Select a document to open" ) ) ;
TOOLTIP "Opens a document" WHEN .f.
// Aqui Jairo.
GetnWidthItem( 0.8 ) // Ajusta con un valor < 1, y comprueba 0.8
MENU oPopUp POPUP 2007 COLORS HEIGHT 2.27 FONT oFont
MENUITEM "Cadastro de Clientes" ;
FILENAME "..\bitmaps\16x16\new.bmp" ;
MESSAGE "Cadastro de Clientes - Pesquisas." ;
ACTION MsgInfo( Time() )
SEPARATOR
MENUITEM "Cadastro de Grupos" ;
FILENAME "..\bitmaps\16x16\open.bmp" ;
MESSAGE "Cadastro de Grupos - Textos Auxiliares." ;
ACTION MsgInfo( Time() )
SEPARATOR
MENUITEM "Cadastro de Ferramentas" ;
FILENAME "..\bitmaps\16x16\printer.bmp" ;
MESSAGE OemToAnsi( "Cadastro de Ferramentas da Proposta" ) ;
ACTION MsgInfo( Time() )
SEPARATOR
MENUITEM "Cadastro de Mão de Obra" ;
FILENAME "..\bitmaps\16x16\prop.bmp" ;
MESSAGE OemToAnsi( "Cadastro de MÆo de Obra" ) ;
ACTION MsgInfo( Time() )
SEPARATOR
MENUITEM "Cadastro de Paisagistas" ;
FILENAME "..\bitmaps\16x16\Help.bmp" ;
MESSAGE OemToAnsi( "Cadastro de Paisagistas da Empresa" ) ;
ACTION MsgInfo( Time() )
ENDMENU
// Aqui Jairo.
DEFINE BUTTON oBtn[03] OF oBar ACTION oBtn[03]:ShowPopup() FLAT GROUP ;
FILENAME "..\bitmaps\16x16\floppy.bmp" ;
MESSAGE "Saves this document" ;
TOOLTIP "Saves this document" ;
MENU oPopup
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\printer.bmp" FLAT GROUP ;
ACTION MsgInfo( "Prints this document" ) TOOLTIP "Print this document"
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\prop.bmp" FLAT GROUP ;
ACTION PrinterSetup() TOOLTIP "Setup the printer"
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\HelpInd.bmp" FLAT ;
ACTION MsgInfo( Version() ) TOOLTIP "A multiple lines" + ;
Chr( 13 ) + Chr( 10 ) + "tooltip!" GROUP
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\Help.bmp" FLAT ;
ACTION MsgInfo( "fivewin power!" ) TOOLTIP "fivewin power!"
DEFINE BUTTON OF oBar FILENAME "..\bitmaps\16x16\Exit.bmp" FLAT ;
ACTION oWnd:End() TOOLTIP "Exit this app" GROUP
DEFINE MESSAGE OF oWnd ;
PROMPT FWVERSION + " " + FWCOPYRIGHT ;
NOINSET CENTERED KEYBOARD DATE CLOCK 2007
DEFINE BITMAP oBmp FILENAME "..\bitmaps\fiveback.bmp"
oWnd:bPainted = { | hDC | BmpTiled( hDC, oWnd, oBmp ) }
ACTIVATE WINDOW oWnd ;
VALID MsgYesNo( "Do you want to quit ?" )
oFont:End()
RETURN NIL
FUNCTION BuildMenu()
LOCAL oMenu
MENU oMenu 2007
MENUITEM "Information"
MENU
MENUITEM "&About..." ;
ACTION MsgInfo( FWDESCRIPTION ) ;
FILENAME "..\bitmaps\16x16\info.bmp"
SEPARATOR
MENUITEM "&End..." ;
ACTION oWnd:End() FILENAME "..\bitmaps\16x16\exit.bmp"
ENDMENU
MENUITEM "&Clients"
MENU
MENUITEM "&New..." ;
ACTION ( MsgStop( "New Clients" ),;
oWnd:Say( 5, 5, "New Clients...", "GR+/G" ) ) ;
FILENAME "..\bitmaps\16x16\faces.bmp"
MENUITEM "&Modify..." ACTION MsgInfo( "Modif. Clients" ) ;
FILENAME "..\bitmaps\edit.bmp"
MENUITEM "&Delete..." ACTION MsgAlert( "Del Clients" ) ;
FILENAME "..\bitmaps\16x16\delete.bmp"
SEPARATOR
MENUITEM "&Browse..." ACTION MsgInfo( "Browse Clients" ) ;
FILENAME "..\bitmaps\16x16\browse.bmp"
ENDMENU
MENUITEM "&Utilities"
MENU
MENUITEM "&Calculator..." ACTION WinExec( "Calc" ) ;
FILENAME "..\bitmaps\16x16\calc.bmp"
MENUITEM "&Internet..." ;
ACTION WinExec( "start iexplore www.fivetech.com", 0 ) ;
FILENAME "..\bitmaps\16x16\explorer.bmp"
ENDMENU
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
//----------------------------------------------------------------------------//
// Bmp_Rand.Prg - Criador Autom tico de BitMaps Para o Fundo de Tela.
//-----------------------------------------------------------------------------
//
// Random BMP Para Fundo de Tela(Ventana) em Fivewin.
// C‚sar E. Lozada, Oct. 10-2001 - Original em: www.dbwide.com.ar
// cesarlozada@hotmail.com
// Modificado em: 17/10/2025 - Por Joao Santos - kapiabafwh@gmail.com
//-----------------------------------------------------------------------------
/*
#Include "Fivewin.Ch"
#Define CLR_LGRAY nRGB( 230, 230, 230 )
#Define CLR_LGREEN nRGB( 190, 215, 190 )
#Define CLR_AMARELO nRGB( 255, 255, 000 ) //--> Amarelo Para o Fundo
#Define CLR_WINDOW nRgb( 130, 130, 130 ) // 16 // COR DO WINDOWS DEFINIDA 16 BITS
Static oWnd, lAbertura := .F.
*/
Function Bmp_Rand( cWidth, cHeight )
Local oBrush, oBar, oHand, oIco
Local NN
Local cBmpFile := ( "FUNDOWND.BMP" ) // Nao pode mudar este nome, senao...
// Para Impedir Uma 2¦ Abertura de Janela!!!
IF lAbertura = .F.
lAbertura := .T.
ELSE
MsgInfo( OemToAnsi( "Esta Janela J Est em Uso..." +CRLF+ ;
"Verifique Rodap‚ do Windows." +CRLF+ ;
"Ou Minimize o Programa... " +CRLF+ ;
"Pois Ela Pode Estar Por Tr s" +CRLF+ ;
"do Menu Principal. Verifique!"), ;
"Verifique, Por Favor!" )
RETURN NIL
ENDIF
DEFAULT cWidth := '65'
DEFAULT cHeight := cWidth
DEFINE BRUSH oBrush FILE cBmpFile
DEFINE CURSOR oHand RESOURCE "Dedo"
//DEFINE ICON OICO FILE ".\BRASIL__.BMP"
DEFINE ICON oIco NAME "CASA"
DEFINE WINDOW oWnd ;
FROM 6.70, 5 TO 34, 95 ;
BRUSH oBrush ;
ICON oIco ;
NOZOOM ;
NOSYSMENU ;
BORDER SINGLE ;
TITLE "Criando Fundo Para Janela do Sistema(Brush) - " + ;
"Modelos - Troque o Fundo em: Trocar Fundo da " + ;
"Janela do Sistema"
/*
NO CAPTION ;
NOICONIZE ; // NÆo Quero Icone...
*/
/*
DEFINE BUTTONBAR OBAR ;
_3DLOOK ;
SIZE 70, 26 ;
TOP ;
OF oWnd ;
CURSOR oHand
*/
DEFINE BUTTONBAR OBAR ; // 40,50 Fica Muito Legal
BUTTONSIZE 50, 50 ; // Cawind.prg // 47.50,50
_3DLOOK ; // Imagem na Tela em 3D // _3DLOOK
TOP ;
OF oWnd ;
CURSOR oHand 2007 // ESTA EM C:\SAMPLES\TESTGRAD.PRG
oBar:bRClicked := { || ( NIL ) } // Mouse Direito
oBar:bLClicked := { || ( NIL ) } // Mouse Esquerdo
//oBar:SetColor( CLR_LIGHTGRAY, CLR_LGREEN )
oBar:SetColor( CLR_BLACK, CLR_WINDOW )
oBar:Adjust()
/*
DEFINE BUTTON OF OBAR ;
FILE ".\BROWSE.BMP" ;
MESSAGE ( OemToAnsi( "Criar e Gravar Novo Fundo de Tela" ) ) ;
PROMPT "Criar Fundo" ;
ACTION ( CriaRandBmp( cBmpFile, Val( cWidth ), Val( cHeight ) ) ) ;
CENTER
*/
DEFINE BUTTON OF OBAR RESOURCE "CAIXA3" PROMPT "Fundo" ;
ACTION ( CriaRandBmp( cBmpFile, Val( cWidth ), Val( cHeight ) ) ) ;
MESSAGE ( OemToAnsi( "Criar e Gravar Novo Fundo de Tela" ) ) ;
TOOLTIP "Criar Novo Fundo de Tela Para o Programa" ;
NOBORDER GROUP TOP
/*
DEFINE BUTTON OF OBAR ;
FILE ".\BROWSE.BMP" ;
MESSAGE ( "Saida do Programa" ) ;
PROMPT "&Saida" ;
ACTION ( OWND:END() ) ;
CENTER
*/
DEFINE BUTTON OF OBAR RESOURCE "SAIDA", "SAIR2" PROMPT "Saida" ;
MESSAGE "Saida do Programa" ;
TOOLTIP "Saida do Programa " ;
ACTION ( OWND:END() ) ;
NOBORDER GROUP TOP
SET MESSAGE OF oWnd TO ;
"Criando Fundo Para Janela do Sistema(Brush) - " + ;
"Modelos - Troque o Fundo em: Trocar Fundo da Janela do Sistema" ;
COLOR CLR_HBLUE CENTERED 2007
ACTIVATE WINDOW OWND ;
VALID( PorFalso( @lAbertura ) )
RELEASE ALL
RELEASE BRUSH oBrush
Return Nil
//-----------------------------------------------------------------------------
//
// Random BMP y Random Texture
// C‚sar E. Lozada, Oct. 10-2001
// cesarlozada@hotmail.com
//
//-----------------------------------------------------------------------------
#xTranslate Frac(<n>) => <n>-Int(<n>)
#xTranslate Random() => nRandom(999999)/1000000
//-----------------------------------------------------------------------------
Function CriaRandBmp( cBmpFile, nWidth, nHeight )
Local F, GF2, nBmpSize, nFileSize, oConfirme, nI, nJ, I, J, aData, oDlg, ;
oGet, oGet2
Local nLinhaGet := 25
Local nColunaGet := 06
Local nLinhaBotao := 35
Local nColunaBotao := 59
Local nLinhaSay := 05
Local nColunaSay := 05
Local cBmpGrava := ( " " )
//-------------------Divisao da Dialog--Caixa de Dialogo-----------------------
DEFINE DIALOG oDlg ;
TITLE "Nome do Arquivo BitMap" ;
STYLE nOR( DS_MODALFRAME ) ;
COLORS nRGB( 127, 127, 127 ), nRGB( 255, 215, 0 )
@ nLinhaSay, nColunaSay ;
SAY ( OemToAnsi("Informe Nome da BitMap(Arquivo) " + ;
"Sem a ExtensÆo(.BMP) " ) ) ;
OF oDlg ;
PIXEL ;
COLOR CLR_HRED, nRGB( 255, 215, 0 )
nLinhaSay := nLinhaSay + 10
@ nLinhaSay, nColunaSay ;
SAY ( OemToAnsi("Este Nome ‚ o Default" ) ) OF oDlg ;
PIXEL ;
COLOR CLR_HRED, nRGB( 255, 215, 0 )
@ nLinhaGet, nColunaGet ;
GET oGet VAR cBmpFile OF oDlg ;
SIZE 50, 10 ;
PIXEL ;
COLOR CLR_HRED, CLR_HCYAN ;
VALID !Empty( cBmpFile ) ;
CENTER ;
WHEN( .F. )
@ nLinhaSay, nColunaSay + 97 ;
SAY ( OemToAnsi("Este ‚ o Novo Nome" ) ) OF oDlg ;
PIXEL ;
COLOR CLR_HRED, nRGB( 255, 215, 0 )
@ nLinhaGet, nColunaGet + 97 ;
GET oGet2 VAR cBmpGrava ;
Picture "@K!" OF oDlg ;
SIZE 50, 10 ;
PIXEL ;
COLOR CLR_HRED, CLR_AMARELO ;
VALID !Empty( cBmpGrava ) ;
CENTER
oGet2:cToolTip := ( OemToAnsi( "Informe Nome do" +CRLF+ ;
"Arquivo Sem a" +CRLF+ ;
"ExtensÆo-(.BMP)" ) )
@ nLinhaBotao, nColunaBotao ;
BUTTON oConfirme ;
PROMPT "&Confirme" OF oDlg ;
SIZE 40, 12 ;
PIXEL ;
ACTION ( oDlg:End() ) CANCEL UPDATE
oConfirme:cToolTip := ( OemToAnsi( "ConfirmeÿNomeÿdoÿArquivo.ÿ Vazio," +CRLF+ ;
"NÆo Grava Nada. S¢ Mostra Modelos.") )
ACTIVATE DIALOG oDlg CENTERED
//-------------------Divisao da Gravacao---------------------------------------
DEFAULT nWidth := 65
DEFAULT nHeight := nWidth
nBmpSize := nWidth * ( 3 * nHeight + If( nHeight % 2 = 1, 1, 0 ) )
nFileSize := nBmpSize + 54
// Gravacao do Primeiro Arquivo - Default, ‚ Obrigat¢rio.
F := fCreate( cBmpFile )
fwrite( F, 'BM' )
fWrite( F, n2dword( nFileSize ) ) // filesize
fWrite( F, n2dword( 0 ) ) // reserved
fWrite( F, n2dword( 54 ) ) // offset
fWrite( F, n2dword( 40 ) ) // header len
fWrite( F, n2dword( nWidth ) ) // width
fWrite( F, n2dword( nHeight ) ) // height
fWrite( F, n2dword( 1, .T. ) ) // planes
fWrite( F, n2dword( 24, .T. ) ) // colors
fWrite( F, n2dword( 0 ) ) // compression
fWrite( F, n2dword( nBmpSize ) ) // Size of bmp in bytes
fWrite( F, n2dword( 3780 ) ) // Pixel /meter horz
fWrite( F, n2dword( 3780 ) ) // Pixel /meter vert
fWrite( F, n2dword( 0 ) ) // important colors
fWrite( F, n2dword( 0 ) ) // important colors
// Fim da Gravacao do Primeiro Arquivo
// Gravacao do Segundo Arquivo - ExtensÆo *.BMP ‚ Obrigat¢rio
GF2 := fCreate( cBmpGrava + '.BMP' )
fwrite( GF2, 'BM' )
fWrite( GF2, n2dword( nFileSize ) ) // filesize
fWrite( GF2, n2dword( 0 ) ) // reserved
fWrite( GF2, n2dword( 54 ) ) // offset
fWrite( GF2, n2dword( 40 ) ) // header len
fWrite( GF2, n2dword( nWidth ) ) // width
fWrite( GF2, n2dword( nHeight ) ) // height
fWrite( GF2, n2dword( 1, .T. ) ) // planes
fWrite( GF2, n2dword( 24, .T. ) ) // colors
fWrite( GF2, n2dword( 0 ) ) // compression
fWrite( GF2, n2dword( nBmpSize ) ) // Size of bmp in bytes
fWrite( GF2, n2dword( 3780 ) ) // Pixel /meter horz
fWrite( GF2, n2dword( 3780 ) ) // Pixel /meter vert
fWrite( GF2, n2dword( 0 ) ) // important colors
fWrite( GF2, n2dword( 0 ) ) // important colors
// Fim da Gravacao do Segundo Arquivo
aData := BmpRand( nWidth, nHeight )
nI := Round( nHeight / 2, 0 )
nJ := Round( nWidth / 2, 0 )
// For/Next da Primeira Gravacao Arquivo Default 1
For I := 1 To nHeight
For J := 1 To nWidth
fWrite( F, aData[ If( I <= nI, I, nHeight + 1 - I ), ;
If( J <= nJ, J, nWidth + 1 - J ) ] )
Next
If nHeight % 2 = 1
fWrite( F, chr(0) )
Endif
Next
// For/Next da Segunda Gravacao Arquivo Novo 2
For I := 1 To nHeight
For J := 1 To nWidth
fWrite( GF2, aData[ If( I <= nI, I, nHeight + 1 - I ), ;
If( J <= nJ, J, nWidth + 1 - J ) ] )
Next
If nHeight % 2 = 1
fWrite( GF2, chr(0) )
Endif
Next
fClose( F ) // Fecha o Arquivo Default 1
fClose( GF2 ) // Fecha o Arquivo Novo 2
oWnd:End() // Fecha Janela Aberta, senÆo da Pau na Reapresenta‡Æo
Return( Bmp_Rand() )
//-----------------------------------------------------------------------------
Static Function BmpRand( nWidth, nHeight )
Local I, J, K, iJ
Local C0, C1, C, CC
Local D, dMax
Local nI := Round( nHeight / 2, 0 )
Local nJ := Round( nWidth / 2, 0 )
Local aData := array( nI, nJ )
Local bMetric
K := nRandom(4)
If K = 0
bMetric := { |x,y| sqrt( x^2+y^2 ) }
ElseIf K = 1
bMetric := { |x,y| Abs(x) + Abs(y) }
ElseIf K = 2
bMetric := { |x,y| Max( Abs(x), Abs(y) ) }
ElseIf K = 3
bMetric := { |x,y| Sqrt( Abs(x) * Abs(y) ) }
ElseIf K = 4
bMetric := { |x,y| ( Abs(x) + Abs(y) ) / 2 }
Endif
C0 := { nRandom( 255 ), nRandom( 255 ), nRandom( 255 ) }
C1 := { nRandom( 255 ), nRandom( 255 ), nRandom( 255 ) }
K := 1 + nRandom( 2 ); CC := nRandom( 255 )
dMax := Eval( bMetric, -nI + 1, -nJ + 1 )
For I := -nI + 1 To 0
For J := -nJ + 1 to 0
D := Eval( bMetric, I, J )
C := { C0[1] + Int( D * ( C1[1] - C0[1] ) / dMax ),;
C0[2] + Int( D * ( C1[2] - C0[2]) / dMax ), ;
C0[3] + Int( D * ( C1[3] - C0[3]) / dMax ) }
aData[ I + nI, J + nJ ] := Chr( C[1]) + Chr( C[2]) + Chr( C[3] )
Next
Next
Return aData
//-----------------------------------------------------------------------------
Static Function n2dword( N, lWord )
Local C := ''
DEFAULT lWord := .F.
Do While n>0
C += chr( N % 256 )
N := Int( N / 256 )
Enddo
Return PadR( C, If( lWord, 2, 4 ), Chr( 0 ) )
//-----------------------------------------------------------------------------
Function a2RGB( aBGR )
//
Return aBGR[3] + 256 * ( aBGR[2] + 256 * aBGR[1] )
// -------------------------------------------------------------------
// Fun‡Æo ....: PorFalso( lVariavel )
// Descri‡Æo..: Poe o valor de uma variavel l¢gica como Falso.
// Parametros.: lVariavel -> Variavel l¢gica
// Devolve....: .T. -> para poder Fechar a Janela
// -------------------------------------------------------------------
FUNCTION PorFalso( lVariavel )
lVariavel := .F.
RETURN .T.
// -------------------------------------------------------------------
// FIM DE BMP_RAND.PRG
Regards, saludos.
