JIeT4uK писал(а):цикл крутится - нагрузка не больше 20 %
JIeT4uK писал(а):Подскажите как нагрузить процессор.
While st_op = False
r = 46340
r2 = 46340 * 46340
Randomize
x = 1 + CLng(Rnd() * r)
y = 1 + CLng(Rnd() * r)
If (x ^ 2 + y ^ 2) < r ^ 2 Then popal = popal + 1
i = i + 1
pipipi = popal / i * 4
If i = 1000000 Then
i = 1
popal = 1
End If
Wend
while true
Wend
Option Explicit
Public Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Public Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, _
lpThreadId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public flag As Long
Public Sub thread(ByVal unUse As Long)
Do
Loop While GetFlag()
End Sub
Private Function GetFlag() As Long
GetFlag = flag
End Function
Option Explicit
Private Sub cmdRun_Click()
Dim sysInfo As SYSTEM_INFO
Dim thrd As Long
Dim hThread As Long
If flag Then
flag = 0
cmdRun.Caption = "Run"
Exit Sub
End If
GetSystemInfo sysInfo
cmdRun.Caption = "Stop"
flag = 1
For thrd = 0 To sysInfo.dwNumberOrfProcessors - 2
hThread = CreateThread(ByVal 0&, 0, AddressOf thread, ByVal 0&, 0, 0)
CloseHandle hThread
Next
While flag
DoEvents
Wend
End Sub
Private Sub Form_Unload(Cancel As Integer)
If flag Then cmdRun_Click
End Sub
JIeT4uK писал(а):А чем можно видеокарту нагрузить?
Сейчас этот форум просматривают: SemrushBot и гости: 24