marcioe Posted June 20, 2016 Report Share Posted June 20, 2016 Olá amigos, boa tarde Tenho as vezes chamados no suporte para resolver este tipo de problema, o usuario escreve no campo ins. Estadual por exemplo, INSENTO no lugar de ISENTO, coloca informaçao errada em determinado campo, Nosso sistema já faz a validação e mostra o erro, mas os usuários dificilmente lê o que esta errado e já ligam. Então gostaria de Saber se teria como na NET eu focar os campos errados de cor diferente, ou destacar eles de alguma forma. Hoje ao Salvar algum Dado nosso sistema faz a Critica do Campo Errado, semelhante ao abaixo. mas se os campos errados ficassem com cor diferente seria mais interesante. Quote Link to comment Share on other sites More sharing options...
kapiaba Posted June 20, 2016 Report Share Posted June 20, 2016 Adapte as suas necessidades: // Compilar // clipper demo // rtlink fi demo // // A propria funcao coloca a picture de acordo com a UF e valida o numero // /* #Include "inkey.ch" // Esta Parte ‚ para Clipper em DOS. //M->ie := Space( 20 ) //M->uf := Space( 02 ) //Clear //@ 10,10 Say "UF: " Get M->uf Picture "!!" //@ 11,10 Say "IE: " Get M->ie When pic_iest() Valid pic_iest( M->uf ) //Read //Inkey( 0 ) */ // Esta Parte ‚ Para FiveWin, Declarar as Variaveis //---------------------Checar a Inscri‡Æo Estadual---------------------------- Function Pic_Iest // Picture Inscri‡Æo Estadual, Valida‡Æo. Parameters cEstado, cInscricaoEstadual Local GetList := {}, Ok := .F., Base, Vpos, Valg, Vsom, Vres, Vdig1, Vdig2,; Vpro, P, D, N, Vbase2, Origem Vbase2 := Base := Origem := "" If Pcount() == 2 .And. GetActive() == Nil For i := 1 To Len( Trim( cInscricaoEstadual ) ) If Asc( Subs( cInscricaoEstadual, i, 1 ) ) < 48 .Or. ; Asc( Subs( cInscricaoEstadual, i, 1 ) ) > 57 Return( cInscricaoEstadual ) EndIf Next If Len( Alltrim( cInscricaoEstadual ) ) == 7 Return( "@R PR 999/9999" ) EndIf Do Case Case cEstado == "MT" Return( "@R 9999999999-9" ) Case cEstado == "DF" Return( "@R 999.99999.999-99" ) Case cEstado == "AC" Return( "@R 99.99.9999-9" ) Case cEstado == "AL" .Or.; cEstado == "AP" .Or.; cEstado == "GO" .Or.; cEstado == "MA" .Or.; cEstado == "MS" .Or.; cEstado == "PI" .Or.; cEstado == "PB" .Or.; cEstado == "AM" .Or.; cEstado == "RO" Return( "@R 99.999.999-9" ) Case cEstado == "CE" .Or.; cEstado == "RR" .Or.; cEstado == "SE" Return( "@R 99999999-9" ) Case cEstado == "MG" Return( "@R 999.999.999/9999" ) Case cEstado == "PA" Return( "@R 99-999999-9" ) Case cEstado == "RJ" Return( "@R 99.999.99-9" ) Case cEstado == "BA" Return( "@R 999999-99" ) Case cEstado == "SC" Return( "@R 999.999.999" ) Case cEstado == "SP" Return( "@R 999.999.999.999" ) Case cEstado == "RS" Return( "@R 999/999999-9" ) Case cEstado == "ES" Return( "@R 999.999.99-9" ) Case cEstado == "TO" Return( "@R 99.99.999999-9" ) Case cEstado == "PE" Return( "@R 99.9.999.9999999-9" ) Case cEstado == "PR" Return( "@R 999.99999-99" ) Case cEstado == "RN" Return( "@R 999.999.99-9" ) Otherwise Return( Space(0) ) EndCase EndIf oGet := GetActive() If ( Pcount() == 0 ) @ oGet:Row(),oGet:Col() Say Space( 17 ) oGet:VarPut( IIf( Trim( oGet:VarGet() ) == "ISENTO(A)", ; Space(15), oGet:VarGet()+Space( 15-Len( oGet:VarGet() ) ) ) ) oGet:Picture := "@!" Return( .T. ) EndIf If Empty( oGet:VarGet() ) oGet:VarPut( "ISENTO(A)" ) oGet:Picture := "@!" @ oGet:Row(), oGet:Col() SAY SPACE(17) Return( .T. ) EndIf cInscricaoEstadual := oGet:VarGet() For Vpos := 1 To Len( Alltrim( cInscricaoEstadual ) ) If SubStr( cInscricaoEstadual, Vpos, 1 ) $ "0123456789" .Or.; SubStr( cInscricaoEstadual, Vpos, 1 ) == "P" .And. cEstado == "SP" Origem += SubStr( cInscricaoEstadual, Vpos, 1 ) EndIf Next Mascara := "99999999999999" If cEstado == "AC" Mascara := "@R 99.99.9999-9" Base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "01" .And. SubStr( Base, 3, 2 ) <> "00" Vsom := 0 For Vpos := 1 To 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 10 - Vpos ) Vsom += Valg Next Vres := Vsom % 11 Vdig1 := Str( If( Vres < 2, 0, 11 - Vres ), 1, 0 ) Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "AL" Mascara := "@R 99.999.999-9" Base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "24" Vsom := 0 For Vpos := 1 To 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 10 - Vpos ) Vsom += Valg Next Vpro := Vsom*10 Vres := Vpro%11 Vdig1 := If( Vres == 10, "0", Str( Vres, 1, 0 ) ) Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "AM" Mascara := "@R 99.999.999-9" Base := Padr( Origem, 9, "0" ) Vsom := 0 For Vpos := 1 to 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 10 - Vpos ) Vsom += Valg Next If Vsom < 11 Vdig1 := Str( 11 - Vsom, 1, 0 ) Else Vres := Vsom%11 Vdig1 := If( Vres < 2, "0", Str( 11 - Vres, 1, 0 ) ) EndIf Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "AP" Mascara := "@R 99.999.999-9" Base := Padr( origem, 9, "0" ) If Left( Base, 2 ) == "03" N := Val( Left( Base, 8 ) ) If N >= 3000001 .And. N <= 3017000 P := 5 D := 0 ElseIf N >= 3017001 .And. N <= 3019022 P := 9 D := 1 ElseIf N >= 3019023 P := 0 D := 0 EndIf Vsom := P For Vpos := 1 To 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 10 - Vpos ) Vsom += Valg Next Vres := Vsom%11 Vdig1 := 11-Vres If Vdig1 == 10 Vdig1 := 0 ElseIf Vdig1 == 11 Vdig1 := D EndIf Vdig1 := Str( Vdig1, 1, 0 ) Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "BA" Mascara := "@R 999999-99" Base := Padr( Origem, 8, "0" ) If Left( Base, 1) $ "0123458" Vsom := 0 For Vpos := 1 To 6 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 8 - Vpos ) Vsom += Valg Next Vres := Vsom%10 Vdig2 := Str( If( Vres == 0, 0, 10 - Vres ), 1, 0 ) Vbase2 := Left( Base, 6 ) + Vdig2 Vsom := 0 For Vpos := 1 To 7 Valg := Val( SubStr( Vbase2, Vpos, 1 ) ) Valg := Valg*( 9 - Vpos ) Vsom += Valg Next Vres := Vsom%10 Vdig1 := Str( If( Vres == 0, 0, 10-Vres ), 1, 0 ) Else vsom:=0 For Vpos :=1 to 6 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg*( 8 - Vpos ) Vsom += Valg Next Vres := Vsom%11 Vdig2 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) Vbase2 := Left( Base, 6 ) + Vdig2 Vsom := 0 For Vpos := 1 To 7 Valg := Val( SubStr( Vbase2, Vpos, 1 ) ) Valg := Valg*( 9 - Vpos ) Vsom += Valg Next Vres := Vsom%11 Vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) EndIf vbase2 := Left( Base, 6 ) + Vdig1 + Vdig2 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "CE" mascara := "@R 99999999-9" base := Padr( Origem, 9, "0" ) vsom := 0 For vpos:=1 to 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg*( 10 - Vpos ) Vsom += Valg Next Vres := Vsom%11 Vdig1 := 11-Vres if Vdig1 > 9 Vdig1 := 0 EndIf Vbase2 := Left( Base, 8 ) + Str( Vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "DF" mascara := "@R 999.99999.999-99" base := Padr( Origem, 13, "0" ) If Left( Base, 3 ) == "073" Vsom := 0 Vmul := {4,3,2,9,8,7,6,5,4,3,2} For Vpos := 1 To 11 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * vmul[vpos] vsom += Valg Next vres := vsom%11 vdig1 := If( Vres < 2, 0, 11-Vres ) vbase2 := Left( Base, 11 ) + Str( Vdig1, 1, 0 ) vsom := 0 vmul := {5,4,3,2,9,8,7,6,5,4,3,2} For vpos:=1 to 12 valg := Val( Substr( Vbase2, Vpos, 1 ) ) valg := Valg * Vmul[Vpos] vsom += Valg Next vres := Vsom%11 vdig2 := If( Vres < 2, 0, 11-Vres ) vbase2 += Str( Vdig2, 1, 0 ) Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "ES" mascara := "@R 999.999.99-9" base := Padr( Origem, 9, "0" ) vsom := 0 For vpos:=1 to 8 Valg := Val( SubStr( Base, Vpos, 1 ) ) Valg := Valg * ( 10 - Vpos ) Vsom += Valg Next Vres := Vsom%11 Vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) Vbase2 := Left( Base, 8) + Vdig1 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "GO" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) $ "10,11,15" Vsom := 0 For Vpos := 1 To 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * ( 10 - Vpos ) vsom += Valg Next Vres := Vsom%11 If vres == 0 vdig1 := "0" ElseIf Vres == 1 n := Val(left(base,8)) vdig1 := If( N >= 10103105 .And. N <= 10119997, "1", "0" ) Else vdig1:=str(11-vres,1,0) EndIf vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "MA" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "12" Vsom := 0 for vpos:=1 to 8 valg:=val(substr(base,vpos,1)) valg:=valg*(10-vpos) vsom+=valg next vres := vsom%11 vdig1 := Str( If( Vres < 2, 0, 11 - Vres ), 1, 0 ) vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "MT" mascara := "@R 9999999999-9" vmul := {3,2,9,8,7,6,5,4,3,2} For Vpos := 1 To 10 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * Vmul[Vpos] vsom += Valg Next vres := vsom%11 vdig1 := If( Vres < 2, 0, 11 - Vres ) vbase2 := Left( Base, 10 ) + Str( Vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "MS" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "28" vsom := 0 For vpos:=1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg*(10-vpos) vsom += Valg Next vres := vsom%11 vdig1 := Str( If( vres < 2, 0, 11-Vres ), 1, 0 ) vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "MG" mascara := "@R 999.999.999/9999" base := Padr( Origem, 13, "0" ) vbase2 := Left( Base, 3 ) + "0" + SubStr( Base, 4, 8 ) n := 2 vsom := "" For Vpos := 1 To 12 valg := Val( SubStr( vbase2, vpos, 1 ) ) n := If( N==2, 1, 2 ) valg := Alltrim( Str( Valg * N, 2, 0 ) ) vsom += VAlg Next n := 0 For Vpos := 1 To Len(Vsom) n += Val( SubStr( Vsom, Vpos, 1 ) ) Next Vsom := N While Right( Str( n, 3, 0), 1 ) <> "0" N++ End Vdig1 := Str( N-Vsom, 1, 0 ) Vbase2 := Left( Base, 11 ) + Vdig1 Vsom := 0 Vmul := {3,2,11,10,9,8,7,6,5,4,3,2} For Vpos := 1 To 12 valg := Val( SubStr( Vbase2, vpos, 1 )) valg := Valg * Vmul[Vpos] vsom += Valg Next vres := Vsom%11 vdig2 := If( Vres < 2, 0, 11-Vres ) vbase2 += Str( vdig2, 1, 0 ) Ok := ( vbase2 == origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "PA" Mascara := "@R 99-999999-9" Base := padr(origem,9,"0") If Left( base, 2 ) == "15" vsom := 0 For vpos := 1 to 8 valg := Val( Substr( Base, Vpos, 1 ) ) valg := Valg * ( 10 - Vpos ) vsom += Valg Next Vres := Vsom%11 Vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == origem) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "PB" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) vsom := 0 For vpos:=1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * ( 10 - Vpos ) vsom += Valg Next Vres := vsom%11 vdig1 := 11-vres If Vdig1 > 9 vdig1 := 0 EndIf vbase2 := Left( Base, 8 ) + Str( Vdig1, 1, 0 ) Ok := ( vbase2 == origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "PE" mascara := "@R 99.9.999.9999999-9" base := Padr( Origem, 14, "0" ) vsom := 0 vmul := {5,4,3,2,1,9,8,7,6,5,4,3,2} For Vpos := 1 To 13 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * Vmul[Vpos] vsom += Valg Next vres := Vsom%11 vdig1 := 11-Vres if( Vdig1 > 9, Vdig1 -= 10, ) Vbase2 := Left( Base, 13 ) + Str( Vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "PI" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) vsom := 0 For vpos := 1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * ( 10-Vpos ) vsom += Valg Next Vres := vsom%11 Vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) Vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "PR" mascara := "@R 999.99999-99" base := Padr( Origem, 10, "0" ) vsom := 0 vmul := {3,2,7,6,5,4,3,2} For Vpos :=1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * Vmul[Vpos] vsom += Valg Next vres := Vsom%11 vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) vbase2 := Left( Base, 8 ) + Vdig1 vsom := 0 vmul := {4,3,2,7,6,5,4,3,2} For Vpos := 1 to 9 valg := Val( SubStr( Vbase2, Vpos, 1 ) ) valg := Valg*Vmul[Vpos] vsom += Valg next vres := Vsom%11 vdig2 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) vbase2 += Vdig2 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "RJ" mascara := "@R 99.999.99-9" base := Padr( Origem, 8, "0" ) vsom := 0 vmul := {2,7,6,5,4,3,2} For Vpos := 1 to 7 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg*Vmul[vpos] vsom += Valg Next vres := Vsom%11 vdig1 := Str( If( Vres < 2, 0, 11-Vres ), 1, 0 ) vbase2 := Left( Base, 7 ) + Vdig1 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "RN" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "20" Vsom := 0 For Vpos := 1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg*(10-vpos) vsom += Valg Next vpro := Vsom*10 vres := Vpro%11 vdig1 := Str( If( Vres > 9, 0, Vres ), 1, 0 ) vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "RO" mascara := "@R 99.999.999-9" base := Padr( Origem, 9, "0" ) vbase2 := SubStr( Base, 4, 5 ) vsom := 0 For Vpos := 1 to 5 valg := Val( SubStr( vbase2, vpos, 1 ) ) valg := valg * ( 7 - Vpos ) vsom += valg Next vres := vsom%11 vdig1 := 11 - Vres If Vdig1 > 9 Vdig1 -= 10 EndIf vbase2 := Left( Base, 8 ) + Str( vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "RR" mascara := "@R 99999999-9" base := Padr( Origem, 9, "0" ) If Left( Base, 2 ) == "24" vsom := 0 For Vpos := 1 to 8 Valg := Val( SubStr( Base, vpos, 1 ) ) Valg := Valg * Vpos Vsom += Valg Next vres := vsom%9 vdig1 := Str( Vres, 1, 0 ) vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "RS" mascara := "@R 999/999999-9" base := Padr( Origem, 10, "0" ) n := Val( Left( Base, 3 ) ) If N > 0 .And. n < 468 vsom := 0 vmul := {2,9,8,7,6,5,4,3,2} For Vpos := 1 to 9 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * Vmul[vpos] vsom += Valg Next vres := vsom%11 vdig1 := 11-vres If Vdig1 > 9 Vdig1 := 0 EndIf vbase2 := Left( Base, 9 ) + Str( Vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "SC" mascara := "@R 999.999.999" base := Padr( Origem, 9, "0" ) vsom := 0 For Vpos := 1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := Valg * ( 10 - Vpos ) vsom += Valg Next vres := Vsom%11 vdig1 := If( Vres < 2, "0", Str( 11-vres, 1, 0 )) vbase2 := Left( Base, 8 ) + Vdig1 Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "SE" mascara := "@R 99999999-9" base := Padr( Origem, 9, "0" ) vsom := 0 For Vpos := 1 to 8 valg := Val( SubStr( Base, Vpos, 1 ) ) valg := valg * ( 10 - vpos ) vsom += valg Next vres := vsom%11 vdig1 := 11-vres If vdig1 > 9 Vdig1 := 0 EndIf vbase2 := Left( Base, 8 ) + Str( vdig1, 1, 0 ) Ok := ( Vbase2 == Origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "SP" If Left( Origem, 1 ) == "P" mascara := "@R !-99999999.9/999" base := Padr( origem, 13, "0" ) vbase2 := SubStr( Base, 2, 8 ) vsom := 0 vmul := {1,3,4,5,6,7,8,10} For Vpos := 1 to 8 valg := Val( SubStr( Vbase2, Vpos, 1 ) ) valg := Valg * Vmul[vpos] vsom += Valg Next Vres := Vsom%11 Vdig1 := Right( Str( Vres, 2, 0 ), 1 ) Vbase2 := Left( Base, 9 ) + Vdig1 + SubStr( Base, 11, 3 ) Else mascara := "@R 999.999.999.999" base := Padr( Origem, 12, "0" ) vsom := 0 vmul := {1,3,4,5,6,7,8,10} For Vpos := 1 To 8 valg := Val( SubStr( Base, vpos, 1 ) ) valg := valg * vmul[vpos] vsom += valg Next vres := vsom%11 vdig1 := Right( Str( vres, 2, 0 ), 1 ) vbase2 := Left( Base, 8 ) + Vdig1 + SubStr( Base, 10, 2 ) vsom := 0 vmul := {3,2,10,9,8,7,6,5,4,3,2} For Vpos := 1 to 11 valg := Val( SubStr( Base, vpos, 1 ) ) valg := valg * vmul[vpos] vsom += valg Next vres := vsom%11 vdig2 := Right( Str( vres, 2, 0 ), 1 ) vbase2 += vdig2 EndIf Ok := ( vbase2 == origem ) If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf ElseIf cEstado == "TO" mascara := "@R 99.99.999999-9" base := Padr( Origem, 11, "0" ) If SubStr( Base, 3, 2 ) $ "01,02,03,99" vbase2 := Left( Base, 2 ) + SubStr( Base, 5, 6 ) vsom := 0 For Vpos := 1 to 8 valg := Val( SubStr( vbase2, vpos, 1 ) ) valg := valg * ( 10 - vpos ) vsom += valg Next Vres := vsom%11 Vdig1 := Str( If( vres < 2, 0, 11 - Vres ), 1, 0 ) Vbase2 := Left( Base, 10 ) + vdig1 Ok := ( vbase2 == origem ) EndIf If Ok oGet:VarPut( vbase2 ) oGet:Picture := mascara EndIf Else Alert( "Unidade Federativa Invalida !" ) EndIf If !Ok .And. LastKey() # K_UP If Empty( vbase2 ) Alert( "Os D¡gitos Identificadores de Cidade e/ou Estado N„o Conferem !" ) Else vbase2 := TransForm( Alltrim( vbase2 ), mascara ) Alert( "Inscri‡„o Inv lida! O Correto Seria " + Vbase2 ) EndIf Return( .F. ) EndIf If Len( Alltrim( oGet:VarGet() ) ) == 7 oGet:VarPut( Alltrim( oGet:VarGet() ) ) oGet:Picture := "@R PR 999/9999" EndIf @ oGet:Row(), oGet:Col() SAY Space( 17 ) Return( .T. ) Quote Link to comment Share on other sites More sharing options...
marcioe Posted June 20, 2016 Author Report Share Posted June 20, 2016 Olá aos amigos, Obrigado Mas o que eu queria era algo parecido com o que acontece em um preenchimento de cadastro via net, ou seja o campo errado fica com cor diferente Seria algo assim. os campos não preenchido ficariam em destaque. Quote Link to comment Share on other sites More sharing options...
Theotokos Posted June 20, 2016 Report Share Posted June 20, 2016 salvo engano, creio que seja: oGet:SetColor( CorTexto, CorFundo ) Quote Link to comment Share on other sites More sharing options...
marcioe Posted June 21, 2016 Author Report Share Posted June 21, 2016 Ficou quase 100% porem imagina assim o usuario escreve errado, dai o sistema destaca o campo errado, blz. 100% Porem ele arruma os dados e grava, o campo não volta a cor natural do get, ficando em vermelho Quote Link to comment Share on other sites More sharing options...
kapiaba Posted June 21, 2016 Report Share Posted June 21, 2016 Só pra brincar com as cores: ************************************************************************* #Include "Fivewin.ch" //----------------------------------------------------------------------- Function Main() Private oSay1, oSay2, oSay3, oSay4, oSay5, oSay6 DEFINE FONT oFONT1 NAME "MS Sans Serif" SIZE 0, -24 Define DIALOG oDlg TITLE "Cores - CLIQUE COM O BOTÃO DIREITO DO MOUSE" ; FROM 0, 0 to 400, 700 PIXEL COLOR 0, 16777215 ACTIVATE DIALOG oDlg ON INIT Inicio() Center Return NIL //---------------------------------------------------------------------------- Function Inicio() @ 20, 22 SAY oSay1 VAR "Cor do Texto:" SIZE 152, 24 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 @ 20, 209 SAY oSay2 VAR "0" SIZE 142, 28 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 @ 20, 371 SAY oSay3 VAR RRGB(0) SIZE 200, 28 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 @ 80, 20 SAY oSay4 VAR "Cor da Janela:" SIZE 175, 33 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 @ 80, 209 SAY oSay5 VAR "0" SIZE 141, 39 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 @ 80, 371 SAY oSay6 VAR RRGB(0) SIZE 200, 39 PIXEL; OF oDlg COLOR 0, 16777215 FONT oFont1 oDlg:bRClicked := {|nRow, nCol| RPopup( nRow, nCol, oDlg, {oSay1, oSAy2, oSay3, oSay4, oSay5, oSay6} ) } Return NIL //--------------------------------------------------------------------------- function RPopup( nRow, nCol, oDlg, aSays ) Local oMenu oMenu := MenuPopUp( oDlg, aSays ) ACTIVATE POPUP oMenu WINDOW oDlg AT nRow, nCol return nil //--------------------------------------------------------------------------- Function MenuPopUp( oDlg, aSays ) Local oMenu Local nClrTxt := oSay1:nClrText Local nClrDlg := oDlg:nClrPane Menu oMenu PopUp MenuItem "Cor do Texto" Action ( nClrTxt := ChooseColor( nClrTxt ), AplicaCores(oDlg, aSays, nClrTxt, nClrDlg) ) MenuItem "Cor da Janela" Action( nClrDlg := ChooseColor( nClrDlg ), AplicaCores(oDlg, aSays, nClrTxt, nClrDlg) ) endmenu Return oMenu //------------------------------------------------------------------------------- Function AplicaCores( oDlg, aSays, nClrTxt, nClrDlg ) Local i, cRgbTxt, cRgbDlg oDlg:SetColor( nClrTxt, nClrDlg ) oDlg:Refresh() for i := 1 to 6 aSays[i]:SetColor( nClrTxt, nClrDlg ) aSays[i]:Refresh() next cRgbTxt := RRGB( nClrTxt ) cRgbDlg := RRGB( nClrDlg ) aSays[2]:SetText( nClrTxt ) aSays[3]:SetText( cRgbTxt ) aSays[5]:SetText( nClrDlg ) aSays[6]:SetText( cRgbDlg ) Return NIL //---------------------------------------------------------------------------- Function RRGB( nCor ) Local cRGB := "{ "+StrZero( nRGBRed( nCor ), 3 )+", "+; StrZero( nRGBGreen( nCor ), 3 )+", "+; StrZero( nRGBBlue( nCor ), 3 )+" }" Return cRGB ************************************************************************* // Ricardo Marques // Brincanco com degrade. **-----------------------------------------------------------------------------------------------------------** ** Pintar o fundo de uma tela( Dlg,Folder,Wnd) ** **-----------------------------------------------------------------------------------------------------------** ** Parametros : oDlg : Onde vai pintar ** ** : Cor1 : Cor incial na parte de cima da tela ** ** : Cor2 : Cor Final na parte de baixo da tela ** ** Exemplo : oDlg[1]:bPainted:={|| PCS_Pinta_Tela(oDlg[1],GetSysColor(15),GetSysColor(16) )} ** **-----------------------------------------------------------------------------------------------------------** FUNCTION PCS_Pinta_Tela(oDlgTxt,aCor1,aCor2) LOCAL hWnd:=oDlgTxt:hWnd LOCAL aRec:=GetClientRect(hWnd) LOCAL oBrush,nX,nStp:=(aRec[3]-aRec[1])/2 LOCAL nColor1:=IF(Empty(aCor1),GetSysColor(15),aCor1) LOCAL nColor2:=IF(Empty(aCor2),GetSysColor(15),aCor2) LOCAL nColorR1:=nRgbRed(nColor1),nColorG1:=nRgbGreen(nColor1),nColorB1:=nRgbBlue(nColor1) LOCAL nColorR2:=nRgbRed(nColor2),nColorG2:=nRgbGreen(nColor2),nColorB2:=nRgbBlue(nColor2) LOCAL nSomaR:=ABS(nColorR2-nColorR1),nSomaG:=ABS(nColorG2-nColorG1),nSomaB:=ABS(nColorB2-nColorB1) nSomaR:=IIF(nSomaR<0,0,(nSomaR/((aRec[3])/2))) nSomaG:=IIF(nSomaG<0,0,(nSomaG/((aRec[3])/2))) nSomaB:=IIF(nSomaB<0,0,(nSomaB/((aRec[3])/2))) oDlgTxt:GetDC() aRec[3]:=0 FOR nX:=1 TO nStp aRec[3]+=2 DEFINE BRUSH oBrush COLOR nRgb(nColorR1,nColorG1,nColorB1) FillRect(oDlgTxt:hDC,aRec,oBrush:hBrush) RELEASE BRUSH oBrush aRec[1]+=2 nColorR1:=IIF(nColorR2>=nColorR1,nColorR1+nSomaR,nColorR1-nSomaR) nColorG1:=IIF(nColorG2>=nColorG1,nColorG1+nSomaG,nColorG1-nSomaG) nColorB1:=IIF(nColorB2>=nColorB1,nColorB1+nSomaB,nColorB1-nSomaB) NEXT oDlgTxt:ReleaseDC() RETURN(NIL) **-----------------------------------------------------------------------------------------------------------** *********************************************************** #include "fivewin.ch" Static nCor1 := 16777215 Static nCor2 := 16777215 //---------------------------------------------------------------------------------------------------------- Function Main() Private oBt1 Define dialog oDlg Title "Teste Degrade - CLIQUE COM O BOTÃO DIREITO DO MOUSE" From 0,0 to 400,600 Pixel Activate Dialog oDlg On Init Inicio() ON PAINT PCS_Pinta_Tela() CENTER Return NIL **-----------------------------------------------------------------------------------------------------------** ** Pintar o fundo de uma tela( Dlg,Folder,Wnd) ** **-----------------------------------------------------------------------------------------------------------** ** Parametros : oDlg : Onde vai pintar ** ** : Cor1 : Cor incial na parte de cima da tela ** ** : Cor2 : Cor Final na parte de baixo da tela ** ** Exemplo : oDlg[1]:bPainted:={|| PCS_Pinta_Tela(oDlg[1],GetSysColor(15),GetSysColor(16) )} ** **-----------------------------------------------------------------------------------------------------------** FUNCTION PCS_Pinta_Tela() LOCAL hWnd:=oDlg:hWnd LOCAL aRec:=GetClientRect(hWnd) LOCAL oBrush,nX,nStp:=(aRec[3]-aRec[1])/2 LOCAL nColorR1:=nRgbRed(nCor1),nColorG1:=nRgbGreen(nCor1),nColorB1:=nRgbBlue(nCor1) LOCAL nColorR2:=nRgbRed(nCor2),nColorG2:=nRgbGreen(nCor2),nColorB2:=nRgbBlue(nCor2) LOCAL nSomaR:=ABS(nColorR2-nColorR1),nSomaG:=ABS(nColorG2-nColorG1),nSomaB:=ABS(nColorB2-nColorB1) nSomaR:=IIF(nSomaR<0,0,(nSomaR/((aRec[3])/2))) nSomaG:=IIF(nSomaG<0,0,(nSomaG/((aRec[3])/2))) nSomaB:=IIF(nSomaB<0,0,(nSomaB/((aRec[3])/2))) oDlg:GetDC() aRec[3]:=0 FOR nX:=1 TO nStp aRec[3]+=2 DEFINE BRUSH oBrush COLOR nRgb(nColorR1,nColorG1,nColorB1) FillRect(oDlg:hDC,aRec,oBrush:hBrush) RELEASE BRUSH oBrush aRec[1]+=2 nColorR1:=IIF(nColorR2>=nColorR1,nColorR1+nSomaR,nColorR1-nSomaR) nColorG1:=IIF(nColorG2>=nColorG1,nColorG1+nSomaG,nColorG1-nSomaG) nColorB1:=IIF(nColorB2>=nColorB1,nColorB1+nSomaB,nColorB1-nSomaB) NEXT oDlg:ReleaseDC() RETURN(NIL) **-----------------------------------------------------------------------------------------------------------** //---------------------------------------------------------------------------- Function Inicio() @ 340, 250 Button "Código da Cores" Size 100,20 Pixel; Action MsgInfo( "1ª COR = "+Str(nCor1)+" - "+RRgb(nCor1)+CRLF+; "2ª COR = "+Str(nCor2)+" - "+RRgb(nCor2) ) oDlg:bRClicked := {|nRow, nCol| RPopup( nRow, nCol) } Return NIL //--------------------------------------------------------------------------- function RPopup( nRow, nCol ) Local oMenu oMenu := MenuPopUp( oDlg ) ACTIVATE POPUP oMenu WINDOW oDlg AT nRow, nCol return nil //--------------------------------------------------------------------------- Function MenuPopUp() Local oMenu Menu oMenu PopUp MenuItem "Primeira Cor" Action ( nCor1 := ChooseColor( nCor1 ), oDlg:Refresh() ) MenuItem "Segunda Cor" Action( nCor2 := ChooseColor( nCor2 ), oDlg:Refresh() ) endmenu Return oMenu //---------------------------------------------------------------------------- Function RRGB( nCor ) Local cRGB := "{ "+StrZero( nRGBRed( nCor ), 3 )+", "+; StrZero( nRGBGreen( nCor ), 3 )+", "+; StrZero( nRGBBlue( nCor ), 3 )+" }" Return cRGB *********************************************************** // Ricardo Marques #include "fivewin.ch" static oWnd static nZoom := 2 static oColor function main() local oTimer DEFINE WINDOW oWnd TITLE "Prueba de ventana" MENU mimenu() DEFINE TIMER oTimer OF oWnd ; INTERVAL 70 ACTION GetColor() oTimer:Activate() ACTIVATE WINDOW oWnd oTimer:DeActivate() return nil function mimenu() local oMenu MENU oMenu MENUITEM "Zoom" MENU MENUITEM "1" ACTION ( nZoom := 1 ) MENUITEM "2" ACTION ( nZoom := 2 ) MENUITEM "3" ACTION ( nZoom := 3 ) MENUITEM "4" ACTION ( nZoom := 4 ) MENUITEM "5" ACTION ( nZoom := 5 ) ENDMENU ENDMENU return oMenu function GetColor() local hDeskTop := GetDC(0) local a := GetCursorPos() local nColor := GetPixel( hDeskTop, a[2], a[1] ) local hDC := oWnd:GetDC() local hPen := CreatePen( PS_SOLID,1,CLR_HRED ) local hOldPen local nTop, nLeft local nWidth, nHeight nTop := 10 nLeft := 100 nWidth := 300 nHeight := 200 SetBkColor( hDC, nColor ) TextOut( hDC, 10, 10, " " ) TextOut( hDC, 25, 10, " " ) TextOut( hDC, 40, 10, " " ) TextOut( hDC, 60, 10, " " + corTOrgb( nColor ) + " " ) Moveto( hDC, nLeft-1, nTop-1) Lineto( hDC, nLeft + nWidth+1, nTop-1 ) Lineto( hDC, nLeft + nWidth+1, nTop+nHeight+1 ) Lineto( hDC, nLeft -1, nTop+nHeight+1 ) Lineto( hDC, nLeft-1, nTop-1) StretchBlt( hDC, nLeft, nTop, nWidth, nHeight, hDeskTop, a[2]-(nWidth/(nZoom*2)), a[1]-(nHeight/(2*nZoom)), nWidth/nZoom, nHeight/nZoom, 13369376 ) hOldPen := SelectObject( hDC, hPen ) Moveto( hDC, nLeft+nWidth/2+1, nTop-1 ) Lineto( hDC, nLeft+nWidth/2+1, nTop+nHeight+1 ) Moveto( hDC, nLeft+1, nTop+nHeight/2+1 ) Lineto( hDC, nLeft+nWidth+1, nTop+nHeight/2+1 ) SelectObject( hDC, hOldPen ) DeleteObject( hPen ) oWnd:ReleaseDC() ReleaseDC( 0, hDeskTop ) return nil ***************** function corTOrgb( Cor1 ) ***************** local Cor2, Cor3 Cor3 := int(Cor1 / 65536) Cor2 := int( ( Cor1 - ( Cor3 * 65536 ) ) / 256 ) Cor1 := Cor1 - ( Cor3 * 65536 ) - ( Cor2 * 256 ) return strzero(Cor1,3) + "," + strzero(Cor2,3) + "," + strzero(Cor3,3) #pragma BEGINDUMP #include "windows.h" #include "hbapi.h" HB_FUNC( STRETCHBLT ) { hb_retl( StretchBlt( (HDC) hb_parnl( 1 ) , hb_parni( 2 ) , hb_parni( 3 ) , hb_parni( 4 ) , hb_parni( 5 ) , (HDC) hb_parnl( 6 ) , hb_parni( 7 ) , hb_parni( 8 ) , hb_parni( 9 ) , hb_parni( 10 ) , (DWORD) hb_parnl( 11 ) ) ) ; } #pragma ENDDUMP Quote Link to comment Share on other sites More sharing options...
Theotokos Posted June 21, 2016 Report Share Posted June 21, 2016 Ficou quase 100% porem imagina assim o usuario escreve errado, dai o sistema destaca o campo errado, blz. 100% Porem ele arruma os dados e grava, o campo não volta a cor natural do get, ficando em vermelho como você esta validando os get´s? e a solução que postei, deu certo? pois apenas citei, mas não deu para testar se isto mesmo... Quote Link to comment Share on other sites More sharing options...
zekasan Posted June 22, 2016 Report Share Posted June 22, 2016 Bom dia Márcio, na rotina de gravação, vc valida o campo, caso ele esteja ok, vc volta a cor original dele. Como o Theotokos disse: oGet:SetColor( CorTexto, CorFundo ) Quote Link to comment Share on other sites More sharing options...
marcioe Posted June 22, 2016 Author Report Share Posted June 22, 2016 Fiz assim, Fiz a troca de cor no campo, quando o usuario escreveu 'INSENTO' ou seja errado, ele foca o campo em vermelho, 100%, dai o usuario troca para 'ISENTO' agora ao gravar o sistema aceitará, e o campo deveria assumir a cor padrão dos outros GETs, branco e preto. (é a cor do windows), pois esse GET de inscrição não tem uma cor especifica. Sei que se ele fosse com a letra de cor eu teria que tratar, mas queria uma outra forma para deixar todos os gets na cor anterior. Sem ter que ficar ir indo um a UM. Agora o cara errou. Quando ele gravar gostaria que ficasse na cor padãso da primeira tela Quote Link to comment Share on other sites More sharing options...
kapiaba Posted June 22, 2016 Report Share Posted June 22, 2016 #Include 'FiveWin.Ch' // By Joao Santos - kapiabafwh@bol.com.br #Define CLR_LGRAY nRGB( 230, 230, 230 ) #Define CLR_LGREEN nRGB( 190, 215, 190 ) #Define CLR_CHOCOLATE nRGB( 238, 118, 33 ) #Define CLR_VERMELHO nRGB( 255, 000, 000 ) //--> Vermelho Para a Letra #Define CLR_AMARELO nRGB( 255, 255, 000 ) //--> Amarelo Para o Fundo #Define CLR_LYELLOW nRGB( 255, 255, 128 ) //--> Amarelo Claro #Define CLR_LWHITE nRGB( 255, 255, 254 ) //--> 16777215 #Define CLR_BOMBOM nRGB( 165, 42, 42 ) //--> Marrom BomBom #Define CLR_MARROM nRGB( 235, 202, 171 ) //--> Marrom Normal #Define CLR_GOLD1 nRGB( 255, 215, 000) //-> Gold1 - Ouro puro ouro, ouro, ouro!!! #Define COR_BRANCA nRGB( 000, 000, 000) #Define COR_PRETA nRGB( 255, 255, 255) FUNCTION Main() LOCAL nCor, oIni LOCAL oDlg LOCAL oGet1, oGet2, oGet3, oGet4 LOCAL cVar1, cVar2, cVar3, cVar4 LOCAL lActive := .f. cVar1 := 0 cVar2 := 0 cVar3 := [ISENTO ] cVar4 := 0 define dialog oDlg title "From Code" pixel size 300,300 TRANSPARENT @ 10,10 get oGet1 var cVar1 bitmap "..\bitmaps\on.bmp" action( msginfo( "With Transparent" ) ) of oDlg pixel size 60,12 @ 40,10 get oGet2 var cVar2 bitmap "..\bitmaps\on.bmp" action( msginfo( "Without Transparent" ) ) of oDlg pixel size 60,12 @ 70,10 get oGet3 var cVar3 bitmap "..\bitmaps\chkyes.bmp" ; VALID( SET_COLOR( oGet3, cVar3, oDlg ) ) ; COLORS COR_PRETA, COR_BRANCA OF oDlg pixel size 120,12 PICTURE "@!" @ 100,10 get oGet4 var cVar4 bitmap "..\bitmaps\chkyes.bmp" ; action( if( lActive,oGet3:disable(),oGet3:enable()), lActive:= !lActive, ; oDlg:update() ) of oDlg pixel size 120,12 oGet1:lBtnTransparent := .t. // transparent button get oGet1 // oGet3:disable() oGet3:lBtnTransparent := .t. // transparent button get oGet3 oGet3:lAdjustBtn := .t. // Button Get Adjust Witdh oGet3 oGet3:lDisColors := .f. // Deactive disable color oGet3:nClrTextDis := CLR_WHITE // Color text disable status oGet3:nClrPaneDis := CLR_BLUE // Color Pane disable status oGet4:lAdjustBtn := .t. activate dialog oDlg centered RETURN NIL //---------------------TROCA A COR EM TEMPO REAL----------------------------// FUNCTION SET_COLOR( oGet3, cVar3, oDlg ) LOCAL oIni, oBrush, oBmp LOCAL nTipo, cStyle, nCor := 0, cFile, cLogo, nRow, nCol, lSelect LOCAL lRet := .T. IF cVar3 = [ISENTO ] oGet3:SetColor( COR_PRETA, COR_BRANCA ) oDlg:Refresh() ELSE // BURRO ERROU ? "Hey Jumento, veja o campo da I.E. puro asno. kkkkkkkkkkkkkkk" lRet := .F. oGet3:SetColor( COR_PRETA, CLR_VERMELHO ) oDlg:Refresh() oGet3:SetFocus() ENDIF RETURN( lRet ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.