#Include "FiveWin.ch"#Include "Directry.ch"#Include "Objects.Ch"#Include "Ord.Ch"#Define COLOR_BTNFACE
15#Define CLR_WINDOW RGB
( 130,
130,
130 ) // 16 // COR DO WINDOWS DEFINIDA 16 BITS#Define CLR_SOFTYELLOW RGB
(255,
251,
225)#Define CLR_MENTA RGB
(221,
255,
238)REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
ANNOUNCE RDDSYS
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto
REQUEST DBFCDX, DBFFPT
STATIC oWnd
// Janela estaticaSTATIC lPermissao := .F.
//-> PermissÆo Para Sair do ProgramaSTATIC lAbertura := .T.
Static oFont, nHFont, cFont, nWFont, cFontH, oBrush
// EXTERNAL DESCENDFUNCTION Main
() LOCAL oBar, oBmp, oIco, oSaida, oHand, cVersao, oOrcam, pVideo
LOCAL oCadGrupo, oCadServico, oCadFerrame, oCadManuten, oPropo, oServices
LOCAL oCadastros, oPopUp, oBtn, oImpressora, oCalend, oCalculad, oOrganiza
LOCAL oCompras, oAprovar, oPopup2
// viewtopic.php?f=3&t=32726&p=192318&hilit=bClrGrad#p192318 LOCAL aPubGrad :=
{ | lInvert |
If( ! lInvert,
{ { 0.50,
16776960,
16777215 }, ;
{ 0.50,
16777215,
16776960 } }, ;
{ { 0.50,
128,
16777215 }, ;
{ 0.50,
16777215,
128 } } ) } LOCAL CFILENAME :=
"PANTALLA.EXE" LOCAL nSCR1, nSCR2
PRIVATE cDirPleno
PUBLIC VSIS, WFILIAL := .F., CUF, WNOMEEMPRESA, cMatriz, cVersaoNota
PUBLIC lFechaJan
// para as MdiChilds PUBLIC aArray, aResolucaoAtual
// para a Resolu‡Æo de tela. PUBLIC lLigaBtnChama := .T., lLigaBtnPropo := .T., lLigaBtnOrca := .T.
PUBLIC lFechaJan, lFechaWin
PUBLIC XNOMEEMP, XENDDIR, XCIDDIR, XBAIDIR, XTELDIR, XEMAILEMP, XSITEEMP
SET CENTURY
ON SET DATE BRITISH
SET EPOCH
TO YEAR( DATE
() ) -
30 SET SOFTSEEK OFF
SET WRAP
ON SETCANCEL
( .F.
) SET CONFIRM OFF
SET DELETED
ON SET ESCAPE OFF
SET EXACT
ON // CONTROLA O :=, = e == SET EXCLUSIVE OFF
SET MULTIPLE OFF
RDDSETDEFAULT
("DBFCDX") // ORDDESCEND( .F. ) IF ISEXERUNNING
( CFILENAME
( HB_ARGV
( 0 ) ) ) MsgInfo( "PANTALLA.exe Já Está Rodando Nesta Máquina",
"PANTALLA.exe") SHOWWINDOW
( FINDWINDOW
( 0,
"PANTALLA" ),
9 ) SETFOREGROUNDWINDOW
( FINDWINDOW
( 0,
"PANTALLA" ) ) RETURN NIL ELSE // msginfo("PANTALLA not running","Opgelet") ENDIF HB_LANGSELECT
( 'PT' ) // Default language is now Portuguese HB_SETCODEPAGE
( "PT850" ) // Mira aqui: // Para Usar é simples : // Resolucao de video By Vagner Wirts // aResolucaoAtual := VMudaVideo(1600,900) aResolucaoAtual := VMudaVideo
(1024,
768) // Mira aqui // AREA DA JANELA - WINDOW pVideo := GetSysMetrics
(0) /* // passei para o ACTIVATE WINDOW para pegar o windows 10 ou nao
IF( pVideo < 1024 ) .OR. ( pVideo > 1024 )
MsgInfo( "Melhor Resoluçao Para o Sistema: 1024 x 768 "+CRLF," Atenção... " )
ENDIF
*/ IF .NOT. FILE
( "CADPARAM.DBF" ) PERDENDO_REDE_SERVIDOR
() RETURN( .F.
) ENDIF IF .NOT. FUSE
("80",
"CADPARAM") MsgStop
( OemToAnsi
( "ATEN€ÇO USUµRIO: " )+CRLF+ ;
OemToAnsi
( "SISTEMAS EM MANUTEN€ÇO... PAR¶METROS." )+CRLF+ ;
OemToAnsi
( "ENQUANTO NÇO SAIREM DA MANUTEN€ÇO, " )+CRLF+ ;
OemToAnsi
( "NENHUM USUµRIO PODERµ ENTRAR NO PLENO. " )+CRLF+ ;
OemToAnsi
( "TECLE <ENTER> PARA SAIR DO PROGRAMA. " ), ;
OemToAnsi
( "SISTEMAS EM MANUTEN€ÇO - PAR¶METROS. " ) ) LIBERA_TUDO
() RETURN NIL ENDIF GOTO
1 cEmpres :=
"AMBIENTY COMERCIO E SERVICOS LTDA - EPP" cNomefanemp :=
"AMBIENTY" xLogr :=
"RUA ANTONIO ANDRE RODRIGUES" xNro :=
"433" xBairro :=
"CHACARA MAFALDA" xMun :=
"SAO PAULO" cUF :=
"SP" cCEP :=
"03372030" cIE :=
"XXXXXXXXXXXX" cTelefone :=
"XXXXXXXX" VSIS := CADPARAM->SERIE
CUF := CADPARAM->UF
WNOMEEMPRESA := CADPARAM->NOME
XFANTASIA := cNomefanemp
XNOMEEMP := cEmpres
XENDDIR := xLogr
XCIDDIR := xMun
XBAIDIR := xBairro
XCGCDIR :=
"CGC" XIEDIR := cIE
XTELDIR := cTelefone
XEMAILEMP :=
"Email" XSITEEMP :=
"www.ambienty.com.br" IF SUBS
(CADPARAM->CGC,
9,
4)=
"0001" cMatriz :=
"MATRIZ" ENDIF lFechaJan := .F.
lFechaWin := .F.
cVersao :=
"2.21 Instal" cVersaoNota := cVersao
// PARA O RMAILAMB.PRG // CRIACAO DOS NOVOS BANCOS DE DADOS AQUI, LOGO NA ENTRADA: //-> Para Criacao de Arquivos, Que Nao Existem MSGMETER
( { | oMeter, oText, oDlg, lEnd | ;
CRIARNOVOS
( oMeter, oText, oDlg, @lEnd
) }, ;
"Por Favor, Espere! Criando Bancos Novos" ) SetBalloon
( .T.
) // Balloon shape required for tooltips SkinButtons
() // Botoes Coloridos nas novas versoes SetGetColorFocus
( CLR_MENTA
) tGet
():
lDisColors := .F.
tGet
():
nClrTextDis := CLR_HBLUE
tGet
():
nClrPaneDis := CLR_SOFTYELLOW
SetResDebug
( .T.
) cDirPleno := GETCURDIR
() // ABERTURA DOS BANCOS ESTA EM: ABERTURA.PRG ABERTURA_DOS_BANCOS
() SETKEY
( VK_F9,
{ | nKey | CALEND
() } ) SETKEY
( VK_F11,
{ | nKey | CALCULAD
() } ) // SETKEY( VK_F12, { | nKey | RELOGIO() } ) nSCR1 := GetSysMetrics
(0) // width nSCR2 := GetSysMetrics
(1) // height // 1 English, 2 Spanish, 3 French, 4 Portugese, 5 German, 6 Italian FWSetLanguage
( 4 ) cFont :=
"Segoe UI Symbol" //"Calibri" cFontH :=
-14 //-10 //-12 //-16 //-18 //-20 IF !IsWin8
() .AND. !IsWindows10
() cFont :=
"Calibri" //"Tahoma" ENDIF DEFINE BITMAP oBmp FILENAME
"Cifrao.Bmp" DEFINE BRUSH oBrush
COLOR 16765090 DEFINE CURSOR oHand
RESOURCE "Dedo" DEFINE ICON oIco
RESOURCE "ICONE01" DEFINE FONT oFont
NAME cFont
SIZE 0, cFontH WEIGHT
300 DEFINE WINDOW oWnd ;
TITLE OemToAnsi
( "PLENOIND: Ambienty Paisagismo - MENU PRINCIPAL - " + ;
"OR€AMENTOS EXTRAS - VersÆo: " + cVersao + ;
" - SRIE: " + VSIS
) MDI ;
MENU BuildMenu
( oWnd
) MENUINFO
2 ICON oIco
BRUSH oBrush
oWnd:
SetFont( oFont
) DEFINE BUTTONBAR OBAR BUTTONSIZE
65,
51 _3DLOOK TOP
OF oWnd
2015 oBar:
bClrGrad :=
{ | lInvert |
If( lInvert, ;
{ { 1/
3, nRGB
( 255,
253,
222 ), nRGB
( 255,
231,
151 ) }, ;
{ 2/
3, nRGB
( 255,
215,
84 ), nRGB
( 255,
233,
162 ) } ;
}, ;
{ { 1/
2, nRGB
( 219,
230,
244 ), nRGB
( 207-50,
221-25,
255 ) }, ;
{ 1/
2, nRGB
( 201-50,
217-25,
255 ), nRGB
( 231,
242,
255 ) } ;
} ) } oBar:
bRClicked :=
{||
NIL } oBar:
nClrText := CLR_BLACK
oBar:
Adjust() DEFINE BUTTON oContato
OF OBAR
RESOURCE "SCULLY" PROMPT "Cadastro" ;
MESSAGE OemToAnsi
( "Cadastrar Cliente Para Proposta" ) ;
ACTION ( CHAMADO
( oWnd, oContato
) ) ;
TOOLTIP OemToAnsi
( "Cadastrar Cliente Para Proposta" ) ;
NOBORDER GROUP
WHEN( lLigaBtnChama
) // BTNRIGHT // BOTTOM -> em cima - melhor embaixo oContato:
oCursor := oHand
// EXEMPLO EM: TEST2007.PRG/TESTGRAD.PRG // HEIGHT = ALTURA MENU oPopUp
POPUP 2015 HEIGHT
2.27 FONT oFont
// assim, fica show() MENUITEM "Cadastro de Grupos" ;
RESOURCE "ESTOQUE01" COLORRIGHT CLR_HBLUE BOLD
MENU MENUITEM "Grupo de Condições de Pagamentos do Orçamento" ;
RESOURCE "ESTOQUE01" ;
ACTION( CADGPPAG
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Grupo de Condições de Pagamentos do Orçamento" SEPARATOR MENUITEM "Grupo de Fornecimento de Plantas" ;
RESOURCE "ESTOQUE02" ;
ACTION( CADGPFOR
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Fornecimento de Plantas/Insumos/Vasos" ) SEPARATOR // OK CRIARDBF.PRG MENUITEM "Grupo de Observação do Fornecimento de Plantas" ;
RESOURCE "ESTOQUE03" ;
ACTION( CADFOROB
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Observa‡Æo do Fornecimento de Plantas/Insumos/Vasos" ) SEPARATOR MENUITEM "Grupo Garantia da Manutenção de Jardim" ;
RESOURCE "ESTOQUE04" ;
ACTION( CADGARAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Garantia da Manuten‡Æo de Jardim" ) SEPARATOR MENUITEM "Grupo Garantia da Recomposição de Plantas" ;
RESOURCE "ESTOQUE05" ;
ACTION( CADGARPL
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Garantia da Recomposi‡Æo Plantas" ) SEPARATOR // OK CRIADBF.PRG MENUITEM "Grupo Responsabilidade da Manutenção de Jardim" ;
RESOURCE "ESTOQUE06" ;
ACTION( RESPONSA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Responsabilidade da Manuten‡Æo de Jardim" ) SEPARATOR MENUITEM "Grupo de Limpeza da Proposta" ;
RESOURCE "ESTOQUE07" ;
ACTION( CADGPLIM
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Limpeza Geral da Proposta" ) SEPARATOR MENUITEM "Grupo de Mão de Obra da Proposta" ;
RESOURCE "ESTOQUE08" ;
ACTION( CADGPMAO
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de MÆo de Obra da Proposta" ) SEPARATOR MENUITEM "Grupo da Manutenção de Jardim" ;
RESOURCE "ESTOQUE09" ;
ACTION( CADGPMAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo do Manuten‡Æo de/do Jardim" ) SEPARATOR MENUITEM "Grupo Necessidades da Proposta" ;
RESOURCE "ESTOQUE10" ;
ACTION( CADNECES
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Necessidades da Proposta" ) SEPARATOR MENUITEM OemToAnsi
( "Grupo de Remo‡Æo e Poda" ) ;
RESOURCE "ESTOQUE11" ;
ACTION( CADGPPOD
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Remo‡Æo e Poda de µrvore" ) SEPARATOR MENUITEM "Grupo de Observação de Remoção e Poda" ;
RESOURCE "ESTOQUE12" ;
ACTION( CADPODOB
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Observa‡Æo de Remo‡Æo e Poda de µrvore" ) SEPARATOR MENUITEM "Grupo de Observação de Remoção e Poda PMSP" ;
RESOURCE "ESTOQUE13" ;
ACTION( PMSPOBS
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Observa‡Æo de Remo‡Æo e Poda de µrvore-PMSP" ) SEPARATOR MENUITEM "Grupo de Recomposição da Proposta" ;
RESOURCE "ESTOQUE14" ;
ACTION( CADGPREC
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Recomposi‡Æo da Proposta" ) SEPARATOR MENUITEM "Grupo de Reforma da Proposta" ;
RESOURCE "ESTOQUE15" ;
ACTION( CADGPREF
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Reforma da Proposta" ) SEPARATOR MENUITEM "Grupo de Serviços da Proposta" ;
RESOURCE "ESTOQUE16" ;
ACTION( CADGRUPO
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Servi‡os da Proposta" ) SEPARATOR MENUITEM "Grupo de Vasos da Proposta" ;
RESOURCE "ESTOQUE17" ;
ACTION( CADGPVAS
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Vasos da Proposta" ) ENDMENU SEPARATOR MENUITEM "Cadastro de Ferramentas" ;
RESOURCE "ESTOQUE25" ;
ACTION( CADFERRA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Ferramentas da Proposta" ) SEPARATOR MENUITEM "Cadastro de Mão de Obra" ;
RESOURCE "ESTOQUE26" ;
ACTION( CADMANUT
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de MÆo de Obra" ) SEPARATOR MENUITEM "Cadastro de Paisagistas" ;
RESOURCE "ESTOQUE27" ;
ACTION( CADPAISA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Paisagistas da Empresa" ) SEPARATOR MENUITEM "Cadastro de Tipos de Serviços" ;
RESOURCE "ESTOQUE28" ;
ACTION( CADORSER
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Tipos de Servi‡os da Proposta" ) ENDMENU DEFINE BUTTON oBtn
OF oBar
ACTION oBtn:
ShowPopup() ;
RESOURCE "FONE03" PROMPT "Dados" NOBORDER GROUP ;
MENU oPopup ;
TOOLTIP OemToAnsi
( "Cadastros Gerais da Proposta" ) ;
MESSAGE OemToAnsi
( "Cadastros Gerais da Proposta" ) oBtn:
oCursor := oHand
DEFINE BUTTON oPropo
OF OBAR
RESOURCE "FOLDER2" PROMPT "Proposta" ;
MESSAGE OemToAnsi
( "Dados Para Contrato e Proposta" ) ;
ACTION( PROPOSTA
( oPropo
) ) ;
TOOLTIP OemToAnsi
( "Dados Para Contrato e Proposta" ) ;
NOBORDER GROUP
WHEN( lLigaBtnPropo
) // BOTTOM -> em cima - melhor embaixo oPropo:
oCursor := oHand
DEFINE BUTTON oOrcam
RESOURCE "DOCTOS1" OF oBar
PROMPT "Orçamento" ;
MESSAGE OemToAnsi
( "Gera‡Æo do Or‡amento" ) ;
ACTION( ORCAMENTO
( oOrcam
) ) ;
TOOLTIP OemToAnsi
( "Gera‡Æo do Or‡amento" ) ;
NOBORDER GROUP
WHEN( lLigaBtnOrca
) // TOP oOrcam:
oCursor := oHand
DEFINE BUTTON oAprovar
RESOURCE "MONEY" OF oBar
PROMPT "Aprovar" ;
MESSAGE OemToAnsi
( "Aprova‡Æo do Pedido/or‡amento" ) ;
ACTION( APROVAR
() ) ;
TOOLTIP OemToAnsi
( "Aprova‡Æo do Pedido/Or‡amento" ) ;
NOBORDER GROUP
// TOP oAprovar:
oCursor := oHand
MENU oPopUp
POPUP 2015 HEIGHT
2.27 FONT oFont
// assim, fica show() MENUITEM "Compras" ;
RESOURCE "ESTOQUE10" COLORRIGHT CLR_HBLUE BOLD
MENU // FABRICANTES/PRODUTORES MENUITEM "Grupo de Fabricantes " ;
RESOURCE "ESTOQUE11" ;
ACTION( CADFABRI
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Grupo de Fabricantes " SEPARATOR MENUITEM "Cadastro de Fabricantes " ;
RESOURCE "ESTOQUE12" ;
ACTION( FABRICAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Cadastro de Fabricantes " SEPARATOR MENUITEM "Pedidos de Compras(Cliente) " ;
RESOURCE "ESTOQUE17" COLORRIGHT CLR_HBLUE BOLD ;
ACTION( COMPRAS
( DeOndeVem :=
[CLIENTES
] ) ) ;
MESSAGE "Manutenção dos Pedidos de Compras "+ ;
"Por Cliente. " //-> ESTA EM C:\GERAL GERAL.EXE - HENNING LEGAL. GOSTEI SEPARATOR MENUITEM "Pedidos de Compras(Fornec.) " ;
RESOURCE "ESTOQUE18" COLORRIGHT CLR_HBLUE BOLD ;
ACTION( COMPRAS
( DeOndeVem :=
[FORNECE
] ) ) ;
MESSAGE "Manutenção dos Pedidos de Compras "+ ;
"Por Fornecedor. " ENDMENU ENDMENU DEFINE BUTTON oCompras
OF oBar
ACTION oCompras:
ShowPopup() ;
RESOURCE "PEPSI" PROMPT "Compras" NOBORDER GROUP ;
MENU oPopup ;
TOOLTIP OemToAnsi
( "Produtos Pendentes Para Comprar" ) ;
MESSAGE OemToAnsi
( "Produtos Pendentes Para Comprar" ) oCompras:
oCursor := oHand
DEFINE BUTTON oCalend
OF OBAR
RESOURCE "XP_CALEND" ;
PROMPT OemToAnsi
( "Calend rio" ) ;
MESSAGE OEMTOANSI
( "¸ Calend rios For Windows:-> " + ;
"Tecla: <F9> Aciona em Todo Sistema " ) ;
TOOLTIP OEMTOANSI
( "¸ Calend rios For Windows... " + CRLF + ;
"Tecla: <F9> Aciona em Todo Sistema " ) ;
ACTION( CALEND
() ) ;
NOBORDER GROUP
// BOTTOM oCalend:
oCursor := oHand
DEFINE BUTTON oCalculad
OF OBAR
RESOURCE "CALCULATOR" ;
PROMPT "Calculadora" ;
MESSAGE OEMTOANSI
( "¸ Calculadora " + ;
"Tecla: <F11> Aciona em Todo Sistema" ) ;
ACTION( CALCULAD
() ) ;
TOOLTIP OEMTOANSI
( "¸ Calculadora " +CRLF+ ;
"Tecla: <F11> Aciona em Todo Sistema" ) ;
NOBORDER GROUP
oCalculad:
oCursor := oHand
DEFINE BUTTON oImpressora
OF OBAR
RESOURCE "IMPRESSORA" ;
PROMPT "Impressora" ;
MESSAGE "Trocar o Modelo da Impressora" ;
ACTION( DefaultPrinter
() ) ;
TOOLTIP
"Trocar o Modelo da Impressora" ;
NOBORDER GROUP
oImpressora:
oCursor := oHand
DEFINE BUTTON oOrganiza
RESOURCE "ORGANIZAR" OF oBar
PROMPT "Indexar" ;
MESSAGE "Indexação dos Bancos de Dados " ;
ACTION( REINDEXA
() ) ;
TOOLTIP
( "Indexação dos Bancos de Dados" ) ;
NOBORDER GROUP
// TOP oOrganiza:
oCursor := oHand
DEFINE BUTTON oSaida
RESOURCE "FECHAR",
"FECHAR2" OF oBar ;
NOBORDER GROUP
PROMPT "Saida" ;
MESSAGE "Sair do Programa" ;
ACTION( oSaida:
Toggle(), ENCERRA
( oWnd
), oSaida:
GoUp() ) ;
TOOLTIP
"Encerrar PlenoInd - Finalizar" oSaida:
oCursor := oHand
SET
MESSAGE OF oWnd
TO "Contato Sistemas: (11) 2941-XXXX / 3569-XXXX Email: kapiabafwh@gmail.com" ;
FONT oFont NOINSET CLOCK DATE KEYBOARD NOBORDER
COLOR CLR_HBLUE, RGB
( 116,
149,
193 ) 2015 ACTIVATE WINDOW oWnd
MAXIMIZED ;
VALID( ENCERRA
( oWnd
) ) ;
ON PAINT( DiagonalGradientFill
( hDC, ;
0,
0, oWnd:
nHeight, oWnd:
nWidth, ;
{ { 0.16, CLR_WHITE, CLR_CYAN
}, ;
{ 0.16, CLR_CYAN, nRGB
( 181,
61,
29 ) }, ;
{ 0.16, nRGB
( 181,
61,
29 ), nRGB
( 250,
157,
52 ) }, ;
{ 0.16, nRGB
( 250,
157,
52 ), nRGB
( 181,
61,
29 ) }, ;
{ 0.16, nRGB
( 181,
61,
29 ), CLR_CYAN
}, ;
{ 0.20, CLR_CYAN, CLR_WHITE
} },.T.
), PINTA
( hDC
) )RETURN NIL// Modifica a Impressora Default do WindowsFUNCTION DefaultPrinter
() // MODIFIQUEI A PRINTER.PRG E FUNCIONA... LOCAL nPrn, nRet
nRet := PrinterSetUp
() nPrn := PrnGetName
() IF( nRet #
0 ) SetDefaultPrinter
( PRNGETNAME
() ) // MUDA O DEFAULT DA IMPRESSORA MsgInfo( OemToAnsi
( "Aten‡Æo Usu rio: " )+CRLF+ ;
OemToAnsi
( "Sua Impressora DEFAULT(PadrÆo) ‚: " )+CRLF+ ;
( "-> " + nPrn
), ;
OemToAnsi
( "Sua Impressora DEFAULT(PadrÆo) ‚... " ) ) sGetDefaultPrinter := GetDefaultPrinter
() // ? PrnStatus( sGetDefaultPrinter ) IF PrnStatus
( sGetDefaultPrinter
) =
4096 // Verifica se SPOOLER esta desligado e tenta liga-lo MsgRun
( sGetDefaultPrinter +
": "+isprint
( GetDefaultPrinter
() ) + ;
" ou Spooler Desligado.",
"Status da Impressora", ;
{|| WinExec
( "NET START SPOOLER",
7 ) } ) ENDIF //? GetPrinter() ELSE MsgInfo( OemToAnsi
( "ATEN€ÇO USUµRIO: " )+CRLF+ ;
OemToAnsi
( "VERIFIQUE SUA IMPRESSORA SE ESTµ LIGADA. " )+CRLF+ ;
OemToAnsi
( "OU SE ESTµ INSTALADA CORRETAMENTE... " )+CRLF+ ;
OemToAnsi
( "TEM ALGUMA COISA ERRADA COM A IMPRESSORA?" )+CRLF+ ;
OemToAnsi
( "SE NÇO ESCOLHEU NENHUMA IMPRESSORA, OK..." )+CRLF+ ;
OemToAnsi
( "TECLE <ENTER> PARA CONTINUAR... " ), ;
OemToAnsi
( "VERIFIQUE SUA IMPRESSORA SE ESTµ LIGADA. " ) ) RETURN( .F.
) ENDIFRETURN NIL// PINTA LETRA NA JANELA(WINDOW)FUNCTION Pinta
( hDC
) LOCAL nColor
LOCAL nLeft :=
80 //290 LOCAL nRight :=
220 LOCAL cTexto :=
"JOAO SANTOS FIVEWIN" LOCAL oFont
LOCAL hFont
LOCAL nLen := LEN
( cTexto
) LOCAL cLetra, n
LOCAL nResHoriz, nResVert
nResHoriz := oWnd:
nHorzRes() // retorna a resolucao horizontal nResVert := oWnd:
nVertRes() // retorna a resolucao vertical IF nResHoriz =
1366 .AND. nResVert =
768 nLeft :=
260 nRight :=
230 ELSEIF nResHoriz =
1360 .AND. nResVert =
768 nLeft :=
210 nRight :=
250 ELSEIF nResHoriz =
1280 .AND. nResVert =
768 nLeft :=
210 nRight :=
250 ELSEIF nResHoriz =
1280 .AND. nResVert =
720 nLeft :=
200 nRight :=
200 ELSEIF nResHoriz =
1024 .AND. nResVert =
768 // Minha Maquina nLeft :=
80 nRight :=
220 ELSE nLeft :=
80 nRight :=
220 ENDIF DEFINE FONT oFont
NAME "Segoe UI Symbol" SIZE 0,
-80 hFont := SelectObject
( hDC, oFont:
hFont ) FOR n :=
1 TO nLen
cLetra :=
substr( cTexto, n,
1 ) nColor := SetTextColor
( hDC, nRandom
( CLR_HGREEN
) ) // COLORS.CH // TextOut( hDC, 10, nLeft, cLetra ) TextOut
( hDC, nRight, nLeft, cLetra
) SetTextColor
( hDC, nColor
) nLeft += GetTextWidth
( hDC, cLetra, oFont
) NEXT SelectObject
( hDC, hFont
) oFont:
ENd()RETURN NILFUNCTION BuildMenu
( oWnd
) LOCAL oMenu, cPdfMachine, cWinLive
cPdfMachine :=
"http://www.pdfmachine.com/genp/download.html" cWinLive :=
"https://pt.vessoft.com/software/windows/download/wlmail" MENU oMenu
2015 HEIGHT
2.8 FONT oFont
MENUITEM "&Cadastro" + SPACE
(3) COLORMENU CLR_HBLUE BOLD ;
WHEN( lLigaBtnChama
) MENU MENUITEM OemToAnsi
("Cadastrar Primeiro Contato Para Proposta" ) ;
RESOURCE "ESTOQUE23" ;
ACTION ( CHAMADO
( oWnd
) ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
("Cadastrar Primeiro Contato Para Proposta" ) ENDMENU MENUITEM "&Dados" COLORMENU CLR_HBLUE BOLD
// + SPACE(09) MENU MENUITEM "Cadastro de Grupos" ;
RESOURCE "ESTOQUE01" COLORRIGHT CLR_HBLUE BOLD
MENU MENUITEM "Grupo de Condições de Pagamentos do Orçamento" ;
RESOURCE "ESTOQUE01" ;
ACTION( CADGPPAG
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Grupo de Condições de Pagamentos do Orçamento" SEPARATOR MENUITEM "Grupo de Fornecimento de Plantas" ;
RESOURCE "ESTOQUE02" ;
ACTION( CADGPFOR
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Fornecimento de Plantas/Insumos/Vasos" ) SEPARATOR MENUITEM "Grupo de Observação do Fornecimento de Plantas" ;
RESOURCE "ESTOQUE03" ;
ACTION( CADFOROB
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Observa‡Æo do Fornecimento de Plantas/Insumos/Vasos" ) SEPARATOR MENUITEM "Grupo Garantia da Manutenção de Jardim" ;
RESOURCE "ESTOQUE04" ;
ACTION( CADGARAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Garantia da Manuten‡Æo de Jardim" ) SEPARATOR MENUITEM "Grupo Garantia da Recomposição de Plantas" ;
RESOURCE "ESTOQUE05" ;
ACTION( CADGARPL
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Garantia da Recomposi‡Æo Plantas" ) SEPARATOR MENUITEM "Grupo Responsabilidade da Manutenção de Jardim" ;
RESOURCE "ESTOQUE06" ;
ACTION( RESPONSA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Responsabilidade da Manuten‡Æo de Jardim" ) SEPARATOR MENUITEM "Grupo de Limpeza da Proposta" ;
RESOURCE "ESTOQUE07" ;
ACTION( CADGPLIM
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Limpeza Geral da Proposta" ) SEPARATOR MENUITEM "Grupo de Mão de Obra da Proposta" ;
RESOURCE "ESTOQUE08" ;
ACTION( CADGPMAO
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de MÆo de Obra da Proposta" ) SEPARATOR MENUITEM "Grupo da Manutenção do Jardim" ;
RESOURCE "ESTOQUE09" ;
ACTION( CADGPMAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Manuten‡Æo de/do Jardim" ) SEPARATOR MENUITEM "Grupo Necessidades da Proposta" ;
RESOURCE "ESTOQUE10" ;
ACTION( CADNECES
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Necessidades da Proposta" ) SEPARATOR MENUITEM OemToAnsi
( "Grupo de Remo‡Æo e Poda" ) ;
RESOURCE "ESTOQUE11" ;
ACTION( CADGPPOD
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Remo‡Æo e Poda de µrvore" ) SEPARATOR MENUITEM "Grupo de Observação de Remoção e Poda" ;
RESOURCE "ESTOQUE12" ;
ACTION( CADPODOB
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Observa‡Æo de Remo‡Æo e Poda de µrvore" ) SEPARATOR MENUITEM "Grupo de Observação de Remoção e Poda PMSP" ;
RESOURCE "ESTOQUE13" ;
ACTION( PMSPOBS
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo da Observa‡Æo de Remo‡Æo e Poda de µrvore-PMSP" ) SEPARATOR MENUITEM "Grupo de Recomposição da Proposta" ;
RESOURCE "ESTOQUE14" ;
ACTION( CADGPREC
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Recomposi‡Æo do Or‡amento" ) SEPARATOR MENUITEM "Grupo de Reforma da Proposta" ;
RESOURCE "ESTOQUE15" ;
ACTION( CADGPREF
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Reforma da Proposta" ) MENUITEM "Grupo de Serviços da Proposta" ;
RESOURCE "ESTOQUE16" ;
ACTION( CADGRUPO
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Servi‡os da Proposta" ) SEPARATOR MENUITEM "Grupo de Vasos da Proposta" ;
RESOURCE "ESTOQUE17" ;
ACTION( CADGPVAS
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Grupo de Vasos da Proposta" ) ENDMENU SEPARATOR MENUITEM "Cadastro de Ferramentas" ;
RESOURCE "ESTOQUE25" ;
ACTION( CADFERRA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Ferramentas da Proposta" ) SEPARATOR MENUITEM "Cadastro de Mão de Obra" ;
RESOURCE "ESTOQUE26" ;
ACTION( CADMANUT
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de MÆo de Obra" ) SEPARATOR MENUITEM "Cadastro de Paisagistas" ;
RESOURCE "ESTOQUE27" ;
ACTION( CADPAISA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Paisagistas da Empresa" ) SEPARATOR MENUITEM "Cadastro de Tipos de Serviços" ;
RESOURCE "ESTOQUE28" ;
ACTION( CADORSER
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Cadastro de Tipos de Servi‡os da Proposta" ) ENDMENU MENUITEM "&Proposta" COLORMENU CLR_HBLUE BOLD ;
WHEN( lLigaBtnPropo
) MENU MENUITEM OemToAnsi
("Dados Para Contrato e Proposta" ) ;
RESOURCE "ESTOQUE24" ;
ACTION ( PROPOSTA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
("Dados Para contrato e Proposta" ) ENDMENU MENUITEM "&Orçamento" COLORMENU CLR_HBLUE BOLD ;
// + SPACE(02) WHEN( lLigaBtnOrca
) MENU MENUITEM "Gerar o Orçamento" ;
RESOURCE "ESTOQUE29" ;
ACTION( ORCAMENTO
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE ( "Gerar o Orçamento" ) // WHEN( .F. ) ENDMENU MENUITEM "A&provar" COLORMENU CLR_HBLUE BOLD
// + SPACE(03) MENU MENUITEM "Aprovar o Orçamento" ;
RESOURCE "ESTOQUE30" ;
ACTION( APROVAR
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Aprova‡Æo do Pedido/or‡amento" ) ENDMENU MENUITEM "Compras" + SPACE
(02) COLORMENU CLR_HBLUE BOLD ;
MESSAGE "Manutenção dos Produtos No Estoque - Pedido de Compras" MENU MENUITEM "Grupo de Fabricantes " ;
RESOURCE "ESTOQUE11" ;
ACTION( CADFABRI
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Grupo de Fabricantes " SEPARATOR MENUITEM "Cadastro de Fabricantes " ;
RESOURCE "ESTOQUE12" ;
ACTION( FABRICAN
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Cadastro de Fabricantes " //-> ESTA EM C:\GERAL GERAL.EXE - HENNING LEGAL. GOSTEI SEPARATOR MENUITEM "Pedidos de Compras(Cliente) " ;
RESOURCE "ESTOQUE16" COLORRIGHT CLR_HBLUE BOLD ;
ACTION( COMPRAS
( DeOndeVem :=
[CLIENTES
] ) ) ;
MESSAGE "Manutenção dos Pedidos de Compras "+ ;
"Por Cliente. " //-> ESTA EM C:\GERAL GERAL.EXE - HENNING LEGAL. GOSTEI SEPARATOR MENUITEM "Pedidos de Compras(Fornec.) " ;
RESOURCE "ESTOQUE17" COLORRIGHT CLR_HBLUE BOLD ;
ACTION( COMPRAS
( DeOndeVem :=
[FORNECE
] ) ) ;
MESSAGE "Manutenção dos Pedidos de Compras "+ ;
"Por Fornecedor. " ENDMENU MENUITEM "&Indexar" COLORMENU CLR_HBLUE BOLD
MENU MENUITEM OemToAnsi
( "Indexa‡Æo dos Bancos de Dados" ) ;
RESOURCE "ESTOQUE20" ;
ACTION( REINDEXA
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Indexa‡Æo dos Bancos de Dados" ) ENDMENU MENUITEM "So&bre" COLORMENU CLR_HBLUE BOLD
MENU MENUITEM "Suporte" ;
RESOURCE "ESTOQUE12" ;
ACTION( ABOUT
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Suporte da Contato Sistemas e Proc. Ltda." SEPARATOR MENUITEM "Configurar" ;
RESOURCE "ESTOQUE13" ;
ACTION( ABOUT
() ) COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Suporte da Contato Sistemas e Proc. Ltda." DISABLED
ENDMENU MENUITEM "&Útil" COLORMENU CLR_HBLUE BOLD
MENU MENUITEM "Agenda" ;
RESOURCE "ESTOQUE13" ;
ACTION ( AGENDA
() ) ;
COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Agenda Simples Opicional" ) SEPARATOR MENUITEM "Baixar PdfMachine" ;
RESOURCE "ESTOQUE14" ;
ACTION ( ShellExecute
(GetActiveWindow
(),
"open",
'"'+cPdfMachine+
'"',
0 ) ) ;
COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Baixar Pdf Machine " +
"Impressora Virtual " + ;
"Para Imprimir Pdf. " +
"NÆo ‚ Gratuito." ) SEPARATOR MENUITEM "Baixar Windows Live Mail" ;
RESOURCE "ESTOQUE15" ;
ACTION ( ShellExecute
(GetActiveWindow
(),
"open",
'"'+cWinLive+
'"',
0 ) ) ;
COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Baixar o Windows Live Mail 2012" ) SEPARATOR MENUITEM "Enviar Email(Suporte)" ;
RESOURCE "ESTOQUE16" ;
ACTION ( RMAIL
() ) ;
COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE OemToAnsi
( "Enviar Email Para o Suporte Direto" ) SEPARATOR MENUITEM "Paint Editor de Imagens" ;
RESOURCE "ESTOQUE17" ;
ACTION ( CHAMA_PAINT
() ) ;
COLORRIGHT CLR_HBLUE BOLD ;
MESSAGE "Use o <Print Screen> Para Salvar" ENDMENU MENUITEM "&Sair" COLORMENU CLR_HRED BOLD
MENU MENUITEM OemToAnsi
( "Sair do Programa" ) ;
RESOURCE "SAIDA16X16" ;
ACTION ( ENCERRA
( oWnd
) ) RIGHTCOLOR CLR_HRED BOLD ;
MESSAGE OemToAnsi
( "Encerrar PlenoInd - Finalizar" ) ENDMENU ENDMENURETURN oMenu
//-> Encerra o ProgramaFUNCTION ENCERRA
( oWnd
) LOCAL lRet, nKey := VK_RETURN, oMsgInter, oQuestao
LOCAL oDlg, oFontSay, IDCor, oSaida, oCancela, oGroup, aGrad
PUBLIC aArray, aResolucaoAtual, WIX01
aGrad :=
{ { 0.30, CLR_CYAN, CLR_HCYAN
},
{ 0.70, CLR_HCYAN, CLR_CYAN
} } DEFINE FONT oFontSay
NAME "Ms Sans Serif" SIZE 0,
-14 BOLD
DEFINE DIALOG oDlg
RESOURCE "DLG_TERMINAR" GRADIENT aGrad
oDlg:
lHelpIcon := .F.
REDEFINE BITMAP oQuestao
ID 121 RESOURCE "F_QUESTAO2" OF oDlg TRANSPARENT
REDEFINE GROUP oGroup
ID 501 OF oDlg
FONT oFontSay
COLOR CLR_HRED TRANSPARENT
REDEFINE SAY ID 401 OF oDlg COLORS CLR_BLACK, CLR_WHITE
UPDATE FONT oFontSay TRANSPARENT
REDEFINE SAY ID 402 OF oDlg COLORS CLR_BLACK, CLR_WHITE
UPDATE FONT oFontSay TRANSPARENT
REDEFINE SAY ID 403 OF oDlg COLORS CLR_HRED, CLR_WHITE
UPDATE FONT oFontSay TRANSPARENT
REDEFINE BUTTON oSaida
ID 301 OF oDlg ;
ACTION( lPermissao := .T., oDlg:
End() ) CANCEL
oSaida:
cToolTip := OemToAnsi
( "Saida - Exit - Finalizar o Programa " ) REDEFINE BUTTON oCancela
ID 302 OF oDlg ;
ACTION( lPermissao := .F., oDlg:
End() ) CANCEL
oCancela:
cToolTip := OemToAnsi
( "Cancelar a Saida - Exit" ) SET
FONT OF oSaida
TO oFontSay
SET
FONT OF oCancela
TO oFontSay
ACTIVATE DIALOG oDlg
CENTERED IF lPermissao
//-> Se for o Botao de Saida... Pimba! SETKEY
( VK_F9,
{ | nKey |
NIL } ) SETKEY
( VK_F11,
{ | nKey |
NIL } ) LIBERA_TUDO
() // FECHA O PROGRAMA NA MEMORIA DEFINITIVAMENTE RETURN NIL ELSE // oFontSay:End() DeleteObject
( oFontSay
) lRet := .F.
//-> Volta ao Menu Principal ENDIFRETURN( lRet
)//-SOBRE O SISTEMA (ABOUT)--------------------------------------------------//FUNCTION ABOUT
() LOCAL oDlgd, iDcor, oFnt, oIco, oSaida, nCor, oIni
DEFINE ICON oIco
NAME "ICONE04" DEFINE FONT oFnt
NAME "Times New Roman" SIZE 0,
-14 BOLD
//18 DEFINE DIALOG oDlgd
RESOURCE "DLG_ABOUT" ;
COLORS CLR_BLACK, CLR_WHITE TRANSPARENT
ICON oIco
oDlgD:
lHelpIcon := .F.
FOR IDCor=
401 to 415 REDEFINE SAY ID iDcor
OF oDlgd
COLOR CLR_HBLUE, CLR_WHITE
UPDATE FONT oFnt
CENTER TRANSPARENT
NEXT IDCor
REDEFINE BUTTON oSaida
ID 301 OF oDlgD
ACTION ( oDlgD:
End() ) CANCEL
SET
FONT OF ODLGD
TO oFnt
ACTIVATE DIALOG oDlgD
CENTERED oFnt:
End()RETURN NIL//--Fecha(close) o Programa DefinitivamenteFUNCTION LIBERA_TUDO
() PUBLIC aArray, aResolucaoAtual
lFechaJan := .F.
lFechaWin := .F.
// Esta em: AQUI MESMO // Isso fará mudar para a nova configuração, lhe retornando um array, // para que qndo sair do sistema retornar para a incial VMudaVideo
(aResolucaoAtual
[1],aResolucaoAtual
[2]) // Vagner Wirts DeleteObject
( oFont
) DeleteObject
( oBrush
) DbCommitAll
() DbUnLockAll
() DbCloseAll
() FreeResources
() Release All
SysRefresh
() HB_GCALL
( .T.
) CLEAR MEMORY
IF FILE
( "checkres.txt" ) FErase
( "checkres.txt" ) ENDIF CheckRes
() PostQuitMessage
( 0 ) QUIT
RETURN NIL/*
SHOWTASKBAR() // Habilita
HIDETASKBAR() // Desabilita
TIRA_X() // Desabilita o X da Janela
PISCA_EXE() // Vai Piscar o Seu EXE na Barra do Windows
*/#pragma BEGINDUMP
#include "windows.h"#include "shlobj.h"#include "hbapi.h"#include "math.h"#include "hbvm.h"#include "hbstack.h"#include "hbapiitm.h"#include "hbapigt.h"HB_FUNC ( SHOWTASKBAR
) //Habilita o botao INICIAR{HWND hWnd = FindWindow
("Shell_TrayWnd",
"");
ShowWindow
( hWnd,
1 );
}HB_FUNC ( HIDETASKBAR
) //Desabilita o botao Iniciar{HWND hWnd = FindWindow
("Shell_TrayWnd",
"");
ShowWindow
( hWnd,
0 );
}HB_FUNC ( PISCA_EXE
) // VAI PISCAR O SEU EXE NA BARRA{HWND Handle = GetForegroundWindow
();
FlashWindow
(Handle,
TRUE);
// VAI PISCAR O SEU EXE NA BARRASleep(300);
// TEMPO DE ESPERA}HB_FUNC ( TIRA_X
) // DESABILITA O X da janela{HMENU MenuH = GetSystemMenu
(GetForegroundWindow
(),
FALSE);
EnableMenuItem
(MenuH,SC_CLOSE,MF_GRAYED
);
}HB_FUNC ( VOLTA_X
) // HABILUTA O X da janela{HMENU MenuH = GetSystemMenu
(GetForegroundWindow
(),
TRUE);
EnableMenuItem
(MenuH,SC_CLOSE,MF_GRAYED
);
}HB_FUNC ( DESABILITA_X
) // Desabilita O X da janela{HMENU MenuH = GetSystemMenu
(GetActiveWindow
(),
FALSE);
EnableMenuItem
(MenuH,SC_CLOSE,MF_GRAYED
);
//DeleteMenu(MenuH,SC_CLOSE,MF_BYCOMMAND);}#pragma ENDDUMP
/*********************************************************
* Função : Funcao em C para mudar a Resolução da Tela se Menor da Necessária para trabalhar
* Data : 13/03/2013 às 12:05:26 por Vagner
* Revisado em : 13/03/2013 às 12:05:35 por Vagner
* Parâmetros :
* iWidthNew - Largura Mínima Necessária
* iHeightNew - Altura Mínima Necessária
**********************************************************/ #Pragma BEGINDUMP
#include <Windows.h>
#include <ShellApi.h>
#include <Wingdi.h>
#include <hbapi.h>
HB_FUNC (VMUDAVIDEO
){ int iWidthNew = hb_parni
(1);
int iHeightNew = hb_parni
(2);
int iWidth,iHeight ;
//Pega a Configuração Atual DEVMODE DeviceMode =
{ 0 };
EnumDisplaySettings
( NULL,
ENUM_CURRENT_SETTINGS,
&DeviceMode
);
iWidth = DeviceMode.dmPelsWidth;
iHeight = DeviceMode.dmPelsHeight;
// if(iWidth < iWidthNew || iHeight < iHeightNew) { //Desculpem eu retirei isso pois só serve para eu, senão vcs não conseguirão retorar o monitor //Muda para a nova Configuração DeviceMode.dmPelsWidth = iWidthNew ;
DeviceMode.dmPelsHeight = iHeightNew;
ChangeDisplaySettings
( &DeviceMode,
0 );
// } hb_reta
( 2 );
hb_storni
( iWidth ,
-1,
1 );
hb_storni
( iHeight,
-1,
2 );
}#pragma ENDDUMP
/*
Para Usar é simples :
aResolucaoAtual := VMudaVideo(1024,768)
Isso fará mudar para a nova configuração, lhe retornando um array, para que qndo sair do sistema retornar para a incial
VMudaVideo(aResolucaoAtual[1],aResolucaoAtual[2])
Abraços,
Vagner Wirts
*///-> FIM DO PROGRAMA