mkyx Posted April 27 Report Share Posted April 27 Bom dia, fivewinners, Alguém poderia indicar alguns comandos que poderia fazer os mesmos efeitos, resultando a tela abaixo, sem precisar usar os comandos gráficos? Porque usando os comandos gráficos, quando abro a tela umas 10 vezes, as figuras e as cores das janelas ficam tudo preto, perde as cores. Quote Link to comment Share on other sites More sharing options...
mkyx Posted April 27 Author Report Share Posted April 27 para gerar os botoes e as janelas, usei a rotina abaixo. FUNCTION AD_LABEL(LI,CI,LF,CF,cTEXT,nPLCR,nCLRTEXT,nCLRLINE,nCLRFUNDO,oFONT2,odlg2) local hPen,I,nWidth,hOldPen,NP,C,I0 local nHeight := Abs( oFont2:nHeight ) oDlg2:GetDC() nWidth := GetTextWidth( oDlg2:hDC, cText,if(nPLCR="*",oFont1,oFont2) ) if nWidth < 0 nWidth *=-1 endif hPen := CreatePen( 0, 1, nCLRLINE) hOldPen := SelectObject( oDlg2:hDc, hPen ) MoveTo( oDlg2:hDC, CI+5,LI,HPEN ) IF UPPER(nPLCR)="L" LineTo( oDlg2:hDC, CI+8,LI,HPEN ) MoveTo( oDlg2:hDC, CI+8+nWIDTH+1,LI,HPEN ) ELSEIF UPPER(nPLCR)="C" nP:=(CF-CI-nWIDTH)/2 LineTo( oDlg2:hDC, CI+nP,LI,HPEN ) MoveTo( oDlg2:hDC, CI+nP+nWIDTH+1,LI,HPEN ) ELSEIF UPPER(nPLCR)="R" LineTo( oDlg2:hDC, CF-8-nWIDTH-1,LI,HPEN ) MoveTo( oDlg2:hDC, CF-8,LI,HPEN ) ENDIF LineTo( oDlg2:hDC, CF-5,LI,HPEN ) LineTo( oDlg2:hDC, CF-4,LI+1,HPEN ) LineTo( oDlg2:hDC, CF-3,LI+1,HPEN ) LineTo( oDlg2:hDC, CF-2,LI+2,HPEN ) LineTo( oDlg2:hDC, CF-1,LI+3,HPEN ) LineTo( oDlg2:hDC, CF-1,LI+4,HPEN ) LineTo( oDlg2:hDC, CF,LI+5,HPEN ) LineTo( oDlg2:hDC, CF,LF-5,HPEN ) LineTo( oDlg2:hDC, CF-1,LF-4,HPEN ) LineTo( oDlg2:hDC, CF-1,LF-3,HPEN ) LineTo( oDlg2:hDC, CF-2,LF-2,HPEN ) LineTo( oDlg2:hDC, CF-3,LF-1,HPEN ) LineTo( oDlg2:hDC, CF-4,LF-1,HPEN ) LineTo( oDlg2:hDC, CF-5,LF,HPEN ) LineTo( oDlg2:hDC, CI+5,LF,HPEN ) LineTo( oDlg2:hDC, CI+4,LF-1,HPEN ) LineTo( oDlg2:hDC, CI+3,LF-1,HPEN ) LineTo( oDlg2:hDC, CI+2,LF-2,HPEN ) LineTo( oDlg2:hDC, CI+1,LF-3,HPEN ) LineTo( oDlg2:hDC, CI+1,LF-4,HPEN ) LineTo( oDlg2:hDC, CI,LF-5,HPEN ) LineTo( oDlg2:hDC, CI,LI+5,HPEN ) LineTo( oDlg2:hDC, CI+1,LI+4,HPEN ) LineTo( oDlg2:hDC, CI+1,LI+3,HPEN ) LineTo( oDlg2:hDC, CI+2,LI+2,HPEN ) LineTo( oDlg2:hDC, CI+3,LI+1,HPEN ) LineTo( oDlg2:hDC, CI+4,LI+1,HPEN ) LineTo( oDlg2:hDC, CI+5,LI,HPEN ) SelectObject( oDlg2:hDc, hOldPen ) DeleteObject( hPen ) C:=3 I0:=-1 for i=LI+1 TO LF-1 hPen1 := CreatePen( 0, 1, nCLRFUNDO) IF I>=(LF-3) .and. i0<0 C:=1 I0:=1 endif MoveTo( oDlg2:hDC, CI+1+IF(C=0,1,IF(C>0,C,0)),I,HPEN1 ) LineTo( oDlg2:hDC, CF-IF(C=0,1,IF(C>0,C,0)),I,HPEN1 ) C:=C+I0 next IF UPPER(nPLCR)="L" nP:=CI+8 ELSEIF UPPER(nPLCR)="C" nP:=INT((CF-CI-nWIDTH)/2)+CI ELSEIF UPPER(nPLCR)="R" nP:=CF-8-nWIDTH ELSEIF UPPER(nPLCR)="D" nP:=INT((CF-CI-nWIDTH)/2)+CI //+nWIDTH/2 ELSEIF UPPER(nPLCR)="*" nP:=INT((CF-CI-nWIDTH*2.3)/2)+CI ENDIF RText( oDlg2, cTEXT,IF(UPPER(nPLCR)="*",LI,if(UPPER(nPLCR)="D",(((LF-LI)/2)+LI)-(nHeight/2),LI-nHeight/2)), nP, nClrText, oFont2 ) oDlg2:ReleaseDC() RETURN .T. //----------------------------------------------------------------------------// Function RText( oDLG2,cPrompt,Y,X,nClrText2,oFont2) Local hOldFont, nOldMode, nOldClrText,nOldBkMode * oDlg2:GetDC() nOldClrText:=SetTextColor(oDLG2:hDC,nClrText2) nOldBkMode:=SetBkMode(oDLG2:hDC,1) NoldBkMode:=SetbkMode(nrgb(224,226,222),1) hOldFont:=SelectObject(oDLG2:hDC,oFont2:hFont) TextOut(oDLG2:hDC,Y,X,cPrompt,Len(cPrompt)) SelectObject(oDLG2:hDC,hOldFont) SetBkMode(oDLG2:hDC,nOldBkMode) SetTextColor(oDLG2:hDC,nOldClrText) oDlg2:ReleaseDC() Return NIL FUNCTION Textura(oDlgTxt,aCorBar) LOCAL hWnd:=oDlgTxt:hWnd LOCAL aRec:=GetClientRect(hWnd) LOCAL oBrush,nX,nStp:=(aRec[3]-aRec[1])/2 LOCAL nColor1:=aCorBar[1],nColor2:=aCorBar[2] 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) Quote Link to comment Share on other sites More sharing options...
kapiaba Posted April 28 Report Share Posted April 28 Não entendi nada. Regards, saludos. Quote Link to comment Share on other sites More sharing options...
mkyx Posted April 30 Author Report Share Posted April 30 Kapiaba, eu usei os comando gráficos para gerar as janelas e os botões, MOVETO, LINETO. Se eu ficar clicando nos botões pretos, e voltando, umas 10 vezes, as janelas e os botões ficam tudos preto, não entendi o porquê, e estou buscando uma solução usando SAY, BUTTOM, etc, mas, tem que permitir que mudar a cor de fundo dos botôes, mas, parece que não tem jeito de mudar a cor de fundo dos botões, usando button. Quote Link to comment Share on other sites More sharing options...
aferra Posted April 30 Report Share Posted April 30 Dê uma olhada em ..\FWH\samples\BlockChain.prg, talvez goste dessa opção. 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.