Ir para conteúdo
Fórum Script Brasil

ramon

Membros
  • Total de itens

    1.354
  • Registro em

  • Última visita

Tudo que ramon postou

  1. Vou usar apenas uma coluna pois a ideia é usar a listview para dicionar uma narração de jogo de futebol parecidada com a que tem na globo.com onde a ultima frase adicionada sempre fica no topo da listview e o restante vai descendo entendes? já tentei usar a propiedade sortOrder para lvwDescending mas porem ele ordena somente ate 9 posicoes apos isso ele não ordena pois acho que a decima posicao ele entenda como 1 ou sei la. alguém tem uma solução? Pensei em usar uma listbox que seria o ideal mas porem não tem como adiconar icones dentro de uma lisbox ae não me serve
  2. Tem como eu adicionar um item numa listview que nem numa listbox Ou seja sempre que adiciono um item numa listbox o item vai para o topo já numa listview isto ocorre ao contrario. Existe alguma maneira de inverter esta ordem de adicionar itens numa listview?
  3. ramon

    Ajuda

    Descobri basta fazer isso aqui nota2 = (6 * (peso1 + peso2)) - (nota1 * peso1) nota2 = nota2 / 67 Pode fechar tópico
  4. ramon

    Media ponderada

    Descobri basta fazer isso aqui nota2 = (6 * (peso1 + peso2)) - (nota1 * peso1) nota2 = nota2 / 67 De qualquer forma valeu pela ajuda
  5. ramon

    Media ponderada

    Testei aqui e me retorna uma mensagem com 1,9 sendo que o certo seria 5,6 para me dar a mediafinal acima de 6 Tem alguma coisa errada ali
  6. ramon

    Media ponderada

    não seria bem isso que eu queria Tipo eu sei que eu substituir lá em nota 2 em vez de 5 eu colocar 5,6 eu vou ter media 6 correto então o que eu quero é descobrir quanto eu preciso lá no valor inicial de nota2 para que eu tenha uma media 6 entendeu?
  7. ramon

    Ajuda

    Tenho como obter a media ponderada de duas provas da seguinte forma nota1 = 7 nota2 = 5 peso1 = 33 peso2 = 67 mediaPonderada = (nota1 * peso1 + nota2 * peso2) / (peso1 + peso2) beleza se a mediaponderada ficar abaixo de 6 o aluno tem que fazer uma prova de recuperacao porem preciso informar ao aluno qual o minimo que ele tem que tirar na nota2 para que ele possa ter uma media ponderada 6 Como fazer isso?
  8. Tenho como obter a media ponderada de duas provas da seguinte forma nota1 = 7 nota2 = 5 peso1 = 33 peso2 = 67 mediaPonderada = (nota1 * peso1 + nota2 * peso2) / (peso1 + peso2) beleza se a mediaponderada ficar abaixo de 6 o aluno tem que fazer uma prova de recuperacao porem preciso informar ao aluno qual o minimo que ele tem que tirar na nota2 para que ele possa ter uma media ponderada 6 Como fazer isso?
  9. Sim na matriz eu tenho ela declarada como string e o seu conteudo são nomes e atributos referentes a estes nomes tem como eu jogar todo o conteudoda matriz para uma variavel e depois salvar? mas aí como eu depois iria carregar em ordem} O que você sugeria?
  10. sim mas tem que ser este tamanho mesmo to guardando na verdade uma matriz de 200*22*22 toda ela cheia e o valo total é 677Kb E agora como salvo isso super-rapido
  11. Ok você sabe porque dá overflow nesta linha de codigo n = FreeFile() Open App.Path & "\teste.txt" For Random As #n Len = 677600 Put #n, , matriz Close #n e como posso resolver?
  12. está então se eu n quizer precisão posso colocar um valor maior?
  13. Ok Mas tipo digamos que eu sei que nunca passara de 30 caracters mas as vezes eu posso ter menos tipo 17, 18 etc e eu não definir o tamanho dela mas fazer manualmente o calculo considerando como tamanho maximo 30 havera algum problema? Ou tem que saber exatamente o tamanho de cada dimensão?
  14. Quantos bytes ocupa uma matriz definida como string Como eu posso descobrir? dim matris(10,4,2) as string se fosse definido como byte dim matriz(10,4,2) as byte eu saberia definir já que bastava eu multiplicar (11*5*2)*1byte que é o espaço de armazenamento Mas e a string como eu posso descobrir já que posso ter varios caracteres de diversos tamanho dentro dela? existe alguma funçao?
  15. ramon

    Estrutura

    está o tamanho está errado....então como posso resolver isso? me da um exemplo
  16. ramon

    Estrutura

    Mas da erro de overflow...você sabe porque isso ocrre?
  17. ramon

    Estrutura

    Tipo se meu reclength for de 405800 bytes dá um erro tem como resolver isso? Pois o reclenght permite no maximo 32,767 bytes Aguardo respostas
  18. ramon

    Estrutura

    está mas como eu faço isso?
  19. ramon

    Estrutura

    está mas como eu posso saber o tamanho do registro?
  20. ramon

    Estrutura

    Deu um errro de Bad record lenght
  21. ramon

    Estrutura

    COmo eu faria para salvar uma estrutura que tem arrays? Eu teria que criar um laço ou tem outro jeito de salvar? exemplo Type Estrutura Array1(3) As Integer array2 As Byte End Type Public teste(10) As Estrutura Private Sub Form_Load() teste(1).Array1(1) = 2 teste(2).Array1(1) = 4 teste(3).Array1(1) = 6 End Sub Private Sub Command1_Click() Open App.Path & "\teste.txt" For Output As #1 Print #1, teste Close #1 End Sub só que da erro e eu naõ queria usar um laço
  22. Achei uma maneira aí vai Coloque um SStab no form coloque o codigo no form Private Sub Form_Load() 'função para converter a cor do sstab SetStyle SSTab1.hWnd, cSolidColor 'este ultimo parametro é que define a cor SetSolidColor SSTab1.hWnd, &H40C0& SSTabSubclass SSTab1.hWnd End Sub Agora coloque o codigo abaixo num modulo Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type GRADIENT_RECT UPPERLEFT As Long LOWERRIGHT As Long End Type Private Type TRIVERTEX X As Long Y As Long Red As Integer Green As Integer Blue As Integer Alpha As Integer End Type Private Type RGB R As Integer G As Integer B As Integer End Type Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long Private Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function ValidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long) As Long Private Const GWL_WNDPROC As Long = (-4) Private Const WM_PAINT As Long = &HF Private Const WM_DESTROY As Long = &H2 Private Const WM_TIMER As Long = &H113 Private Const ID_TIMER As Long = &HCBABE Public Enum TabStyle cSolidColor = 0 cPicture = 1 cGradient = 2 cAnimatedGradient = 3 End Enum Public Enum Direction cHorizontal = 0 cVertical = 1 End Enum Private DestDC As Long Private MaskDC As Long Private MemDC As Long Private OrigDC As Long Private MaskPic As Long Private MemPic As Long Private TempPic As Long Private OrigPic As Long Private TempDC As Long Private origBrush As Long Private TempBrush As Long Private origColor As Long Private gColor1 As Long Private gColor2 As Long Private gDir As Long Private gTime As Long Private gFadeFlag As Boolean Private ImageWidth As Long Private ImageHeight As Long Private oldWndProc As Long Private Function GetLngColor(Color As Long) As Long If (Color And &H80000000) Then GetLngColor = GetSysColor(Color And &H7FFFFFFF) Else GetLngColor = Color End If End Function Private Function GetRGBColors(Color As Long) As RGB Dim HexColor As String HexColor = String(6 - Len(Hex(Color)), "0") & Hex(Color) GetRGBColors.R = "&H" & Mid(HexColor, 5, 2) & "00" GetRGBColors.G = "&H" & Mid(HexColor, 3, 2) & "00" GetRGBColors.B = "&H" & Mid(HexColor, 1, 2) & "00" End Function Public Sub SetStyle(ByVal hWnd As Long, ByRef Style As TabStyle) SetProp hWnd, "MyStyle", Style End Sub Public Sub SetFadeTime(ByVal hWnd As Long, ByVal cTime As Long) If cTime > 10 Then cTime = 10 If cTime < 1 Then cTime = 1 SetProp hWnd, "MyFadeTime", cTime End Sub Private Function GetFadeTime(ByVal hWnd As Long) As Long GetFadeTime = GetProp(hWnd, "MyFadeTime") End Function Private Function GetStyleParams(ByVal hWnd As Long) As TabStyle GetStyleParams = GetProp(hWnd, "MyStyle") End Function Public Sub SetGradientDir(ByVal hWnd As Long, ByRef Style As Direction) SetProp hWnd, "MyGradientDir", Style End Sub Private Sub GetGradientDir(ByVal hWnd As Long) gDir = GetProp(hWnd, "MyGradientDir") End Sub Private Sub SetHookInstance(ByVal hWnd As Long) SetProp hWnd, "Hooked", True End Sub Private Function CheckHookInstance(ByVal hWnd As Long) As Boolean CheckHookInstance = GetProp(hWnd, "Hooked") End Function Public Sub SetSolidColor(ByVal hWnd As Long, ByVal Color As Long) SetProp hWnd, "MySolidColor", GetLngColor(Color) End Sub Public Sub SetGradientColor1(ByVal hWnd As Long, ByVal Color As Long) SetProp hWnd, "MyGradientColor1", GetLngColor(Color) End Sub Public Sub SetGradientColor2(ByVal hWnd As Long, ByVal Color As Long) SetProp hWnd, "MyGradientColor2", GetLngColor(Color) End Sub Private Sub GetSolidColor(ByVal hWnd As Long) TempBrush = CreateSolidBrush(GetProp(hWnd, "MySolidColor")) End Sub Private Sub GetGradientColor1(ByVal hWnd As Long) gColor1 = GetProp(hWnd, "MyGradientColor1") End Sub Private Sub GetGradientColor2(ByVal hWnd As Long) gColor2 = GetProp(hWnd, "MyGradientColor2") End Sub Public Sub SetPicture(ByVal hWnd As Long, ByVal Width As Long, ByVal Height As Long, ByRef cPicture As StdPicture) SetProp hWnd, "MyPicture", cPicture.Handle SetProp hWnd, "MyPictureWidth", Width SetProp hWnd, "MyPictureHeight", Height End Sub Private Sub GetPictureParams(ByVal hWnd As Long) TempBrush = CreatePatternBrush(GetProp(hWnd, "MyPicture")) ImageWidth = GetProp(hWnd, "MyPictureWidth") ImageHeight = GetProp(hWnd, "MyPictureHeight") End Sub Public Sub SSTabSubclass(ByVal hWnd As Long) If Not CheckHookInstance(hWnd) Then SetHookInstance hWnd oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf oldSSTabProc) End If End Sub Public Function oldSSTabProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If GetStyleParams(hWnd) = cAnimatedGradient Then KillTimer hWnd, 0 SetTimer hWnd, ID_TIMER, 1, 0 End If oldSSTabProc = NewSSTabProc(hWnd, uMsg, wParam, lParam) End Function Private Function NewSSTabProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long On Error Resume Next Dim m_ItemRect As RECT Dim m_Width As Long Dim m_Height As Long If wMsg = WM_PAINT Then DestDC = GetDC(hWnd) GetWindowRect hWnd, m_ItemRect m_Width = m_ItemRect.Right - m_ItemRect.Left m_Height = m_ItemRect.Bottom - m_ItemRect.Top Select Case GetStyleParams(hWnd) Case cPicture GetPictureParams hWnd Case cSolidColor GetSolidColor hWnd Case cGradient GetGradientColor1 hWnd GetGradientColor2 hWnd GetGradientDir hWnd Case cAnimatedGradient GetGradientDir hWnd Case Else Debug.Print "Invalid Style" End Select CreateNewDCWorkArea m_Width, m_Height Call SelectBitmap CallWindowProc oldWndProc, hWnd, wMsg, OrigDC, lParam Call CreateBackMask(m_Width, m_Height) origBrush = SelectObject(TempDC, TempBrush) If GetStyleParams(hWnd) = cGradient Or GetStyleParams(hWnd) = cAnimatedGradient Then DrawGradient TempDC, 0, 0, m_Width, m_Height, GetRGBColors(gColor1), GetRGBColors(gColor2), gDir Else PatBlt TempDC, 0, 0, m_Width, m_Height, vbPatCopy End If SelectObject TempDC, origBrush Call DOBitBlt(m_Width, m_Height) Call CleanDCs SetBkColor DestDC, origColor ReleaseDC hWnd, DestDC ValidateRect hWnd, 0 ElseIf wMsg = WM_TIMER Then If GetStyleParams(hWnd) <> cAnimatedGradient Then KillTimer hWnd, 0 Exit Function End If If gFadeFlag Then gTime = gTime - GetFadeTime(hWnd) Else gTime = gTime + GetFadeTime(hWnd) End If If gTime > 255 Then gTime = 255 gFadeFlag = Not gFadeFlag ElseIf gTime < 0 Then gTime = 0 gFadeFlag = Not gFadeFlag End If GetGradientColor1 hWnd GetGradientColor2 hWnd gColor1 = ShiftColor(gColor1, gTime) gColor2 = ShiftColor(gColor2, gTime) RedrawWindow hWnd, ByVal 0&, ByVal 0&, &H1 Debug.Print gTime ElseIf wMsg = WM_DESTROY Then KillTimer hWnd, 0 DeleteObject TempBrush SetWindowLong hWnd, GWL_WNDPROC, oldWndProc NewSSTabProc = CallWindowProc(oldWndProc, hWnd, wMsg, wParam, lParam) Else NewSSTabProc = CallWindowProc(oldWndProc, hWnd, wMsg, wParam, lParam) End If End Function Private Sub SelectBitmap() Dim cHandle As Long cHandle = SelectObject(MaskDC, MaskPic) DeleteObject cHandle cHandle = SelectObject(MemDC, MemPic) DeleteObject cHandle cHandle = SelectObject(TempDC, TempPic) DeleteObject cHandle cHandle = SelectObject(OrigDC, OrigPic) DeleteObject cHandle End Sub Private Sub CreateBackMask(ByVal m_Width As Long, ByVal m_Height As Long) origColor = SetBkColor(DestDC, GetSysColor(15)) SetBkColor OrigDC, GetSysColor(15) BitBlt MaskDC, 0, 0, m_Width, m_Height, OrigDC, 0, 0, vbSrcCopy End Sub Private Sub CreateNewDCWorkArea(ByVal m_Width As Long, ByVal m_Height As Long) MaskDC = CreateCompatibleDC(DestDC) MaskPic = CreateBitmap(m_Width, m_Height, 1, 1, ByVal 0&) MemDC = CreateCompatibleDC(DestDC) MemPic = CreateCompatibleBitmap(DestDC, m_Width, m_Height) TempDC = CreateCompatibleDC(DestDC) TempPic = CreateCompatibleBitmap(DestDC, m_Width, m_Height) OrigDC = CreateCompatibleDC(DestDC) OrigPic = CreateCompatibleBitmap(DestDC, m_Width, m_Height) End Sub Private Sub DOBitBlt(ByVal m_Width As Long, ByVal m_Height As Long) BitBlt MemDC, 0, 0, m_Width, m_Height, MaskDC, 0, 0, vbSrcCopy BitBlt MemDC, 0, 0, m_Width, m_Height, OrigDC, 0, 0, vbSrcPaint BitBlt TempDC, 0, 0, m_Width, m_Height, MaskDC, 0, 0, vbMergePaint BitBlt TempDC, 0, 0, m_Width, m_Height, MemDC, 0, 0, vbSrcAnd BitBlt DestDC, 0, 0, m_Width, m_Height, TempDC, 0, 0, vbSrcCopy End Sub Private Sub CleanDCs() DeleteDC TempDC DeleteObject TempPic DeleteDC MaskDC DeleteObject MaskPic DeleteDC MemDC DeleteObject MemPic DeleteDC OrigDC DeleteObject OrigPic DeleteObject TempBrush End Sub Private Sub DrawGradient(cHdc As Long, X As Long, Y As Long, X2 As Long, Y2 As Long, Color1 As RGB, Color2 As RGB, Optional Direction = 1) Dim Vert(1) As TRIVERTEX Dim gRect As GRADIENT_RECT With Vert(0) .X = X .Y = Y .Red = Color1.R .Green = Color1.G .Blue = Color1.B .Alpha = 0& End With With Vert(1) .X = Vert(0).X + X2 .Y = Vert(0).Y + Y2 .Red = Color2.R .Green = Color2.G .Blue = Color2.B .Alpha = 0& End With gRect.UPPERLEFT = 0 gRect.LOWERRIGHT = 1 GradientFillRect cHdc, Vert(0), 2, gRect, 1, Direction End Sub Private Function ShiftColor(ByVal Color As Long, ByVal Value As Long) As Long Dim R As Long Dim G As Long Dim B As Long R = (Color And &HFF) + Value G = ((Color \ &H100) Mod &H100) + Value B = ((Color \ &H10000) Mod &H100) B = B + ((B * Value) \ &HC0) If Value > 0 Then If R > 255 Then R = 255 If G > 255 Then G = 255 If B > 255 Then B = 255 ElseIf Value < 0 Then If R < 0 Then R = 0 If G < 0 Then G = 0 If B < 0 Then B = 0 End If ShiftColor = R + 256& * G + 65536 * B End Function Feito agora você consegue mudar a cor do Sstab falou!
×
×
  • Criar Novo...