Static oWnd, lAbertura := .F.
Code: Select all
// 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: 15/03/2004 - Por JoÆo Santos - karinhannah@ubbi.com.br
// Incorporar ao RKM e LNK fazer chamada no Menu Principal
//-----------------------------------------------------------------------------
#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 ( Click(), OWND:END() ) ;
CENTER
*/
DEFINE BUTTON OF OBAR RESOURCE "SAIDA", "SAIR2" PROMPT "Saida" ;
MESSAGE "Saida do Programa" ;
TOOLTIP "Saida do Programa " ;
ACTION ( Click(), 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