elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Estamos en la red social de Mastodon


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  * [ Source ] CLSFrameLimiter.cls (Frecuencia)
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: * [ Source ] CLSFrameLimiter.cls (Frecuencia)  (Leído 2,081 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
* [ Source ] CLSFrameLimiter.cls (Frecuencia)
« en: 3 Diciembre 2009, 17:21 pm »

Este codigo es especialmente para los juegos o lo que este dentro de un Do/While o similar (Juegos, o Cantroles DIbUJAdOS, o sencillamente procesos en un Do/While por decir alguno).


En un Modulo Tipo Clase:

CLSFrameLimiter.cls

Código
  1.  
  2. ''   /////////////////////////////////////////////////////////////
  3. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  4. '   //                                                         //
  5. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  6. '   //                                                         //
  7. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  8. '   // no se eliminen los creditos originales de este codigo   //
  9. '   // No importando que sea modificado/editado o engrandesido //
  10. '   // o achicado, si es en base a este codigo                 //
  11. '   /////////////////////////////////////////////////////////////
  12.  
  13. Option Explicit
  14.  
  15. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
  16. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
  17.  
  18. Private m_CurFrequency As Currency
  19. Private m_HasCounter As Boolean
  20. Private m_FrameStart As Currency
  21. Private m_FrameEnd As Currency
  22. Private m_CurTime As Currency
  23. Private m_Delay As Currency
  24. Private m_LastSecond As Long
  25. Private m_LastSecondCount As Long
  26. Private m_FrameCount As Long
  27.  
  28. Private Sub Class_Initialize()
  29.    m_HasCounter = QueryPerformanceFrequency(m_CurFrequency)
  30.    m_CurFrequency = m_CurFrequency * 10000
  31. End Sub
  32.  
  33. Public Function GetFPS() As Long
  34.    GetFPS = m_LastSecondCount
  35. End Function
  36.  
  37. Public Sub LimitFrames(ByVal nFPS As Integer)
  38.    If Second(Now) <> m_LastSecond Then
  39.        m_LastSecond = Second(Now)
  40.        m_LastSecondCount = m_FrameCount
  41.        m_FrameCount = 0
  42.    End If
  43.    m_FrameCount = m_FrameCount + 1
  44.    QueryPerformanceCounter m_FrameEnd
  45.    '   //  m_Delay = ((1000 / nFPS) * m_CurFrequency / 10000000) - (m_FrameEnd - m_FrameStart)
  46.    m_Delay = ((1 / nFPS) * m_CurFrequency / 10000) - (m_FrameEnd - m_FrameStart)
  47.    Do
  48.        DoEvents
  49.        QueryPerformanceCounter m_CurTime
  50.    Loop Until (m_CurTime - m_FrameEnd) >= m_Delay
  51.  
  52.    QueryPerformanceCounter m_FrameStart
  53. End Sub
  54.  

Forma de USO

Código
  1.  
  2. Dim FrameLimit                      As New CLSFrameLimiter
  3. Dim NoSalir                         as boolean
  4.  
  5. Private Sub Form_Click()
  6.    NoSalir=not NoSalir
  7. End Sub
  8.  
  9. Private Sub Form_Load()
  10.    NoSalir = false
  11.    show
  12.    While NoSalir
  13.        '   //  No es nesesario DoEvents, Sleep() o waitMessage() {En algun caso es usado NO?}
  14.        Call FrameLimit.LimitFrames(40)
  15.        caption = FrameLimit.GetFPS
  16.    Wend
  17. End Sub
  18.  
  19.  



Ejemplo Demostrativo:

Código
  1. Option Explicit
  2.  
  3. 'Used to just grab framerates.
  4. Private Declare Function GetTickCount Lib "kernel32" () As Long
  5. Dim NoSalir                         As Boolean
  6. Dim FrameLimit                      As New CLSFrameLimiter
  7.  
  8. Private Sub Form_Click()
  9.    NoSalir = Not NoSalir
  10.    Call PruebaFrameSecunds
  11. End Sub
  12.  
  13. Private Sub PruebaFrameSecunds()
  14. Dim lngCount                        As Long
  15. Dim lngFPS                          As Long
  16. Dim lngTick                         As Long
  17. Dim okFPS                           As Long
  18.    While NoSalir
  19.        '   //  No es nesesario DoEvents, Sleep() o waitMessage() {En algun caso es usado NO?}
  20.        Call FrameLimit.LimitFrames(40)
  21.        Cls
  22.        lngFPS = lngFPS + 1
  23.        If lngTick < GetBetterTick Then
  24.            okFPS = lngFPS
  25.            lngTick = GetBetterTick + 1000
  26.            lngFPS = 0
  27.        End If
  28.        Print "Frames por calculo: " & CStr(okFPS)
  29.        Print "Frames por la Funcion: " & FrameLimit.GetFPS
  30.    Wend
  31. End Sub
  32.  
  33. Private Function GetBetterTick() As Long
  34.    Static LastTime As Long
  35.    If LastTime >= 0 And GetTickCount < 0 Then LastTime = GetTickCount
  36.    If LastTime <= 0 And GetTickCount > 0 Then LastTime = GetTickCount
  37.    GetBetterTick = GetTickCount - LastTime
  38. End Function
  39.  
  40. Private Sub Form_Load()
  41.    AutoRedraw = True
  42. End Sub
  43.  

Dulces Lunas!¡.


« Última modificación: 6 Diciembre 2009, 12:04 pm por ░▒▓BlackZeroҖ▓▒░ Toy Aburrido y sin Que hacer » En línea

The Dark Shadow is my passion.
MCKSys Argentina
Moderador Global
***
Desconectado Desconectado

Mensajes: 5.250


Diviértete crackeando, que para eso estamos!


Ver Perfil
Re: [source] Limitar Frame Por Segundo (frecuencia)
« Respuesta #1 en: 4 Diciembre 2009, 00:47 am »

Muy Bueno!!

Gracias por compartir  :)



En línea

MCKSys Argentina

"Si piensas que algo está bien sólo porque todo el mundo lo cree, no estás pensando."

ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [source] Limitar Frame Por Segundo (frecuencia)
« Respuesta #2 en: 4 Diciembre 2009, 19:35 pm »

Esta bueno Black!
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Source] The Golden Bug (Análisis de Frecuencia) « 1 2 »
Programación Visual Basic
Spider-Net 11 13,639 Último mensaje 22 Febrero 2012, 14:34 pm
por 79137913
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines