Подморозка интерфейса?!
|
|
zamabuvaraeu | Дата: Суббота, 16.07.2022, 06:59 | Сообщение # 16 |
Подполковник
Группа: Друзья
Сообщений: 149
Статус: Offline
| Вообще в нормальных программа никакие расчёты внутри GUI не производют. Всю бизнес‐логику должна обрабатываться отдельными объектами бизнес‐логики. GUI только дёргает методы бизнес‐логики. У этого антишаблона есть даже специальное название «Магическая кнопка» и отдельная статья в педивикии Магическая кнопка — Википедия (wikipedia.org)
|
|
| |
timurar77 | Дата: Суббота, 16.07.2022, 08:52 | Сообщение # 17 |
Рядовой
Группа: Пользователи
Сообщений: 8
Статус: Offline
| В таймер?! Попробую.
|
|
| |
haav | Дата: Понедельник, 18.07.2022, 09:32 | Сообщение # 18 |
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Статус: Offline
| Цитата timurar77 ( ) В таймер?! Попробую.
Если нормально сделаешь , то ничего залипать не будет:
Код #INCLUDE "windows.bi" #INCLUDE "win/commctrl.bi" Dim msg As MSG Dim As WNDCLASSEX wc Dim As String NameClass="MyClass" dim shared as ulongint iValue , iEndValue Dim As HINSTANCE Hinst=GetModuleHandle(0)
sub thr1(p as any ptr) do iValue +=1 Loop End Sub
Function wndproc(hwnd As HWND, msg As Uinteger,_ wparam As WPARAM, lparam As LPARAM) As Integer Static As HWND edit,button , progress Select Case msg Case WM_CREATE edit=CreateWindowEx(0,"edit","",WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NUMBER,10,10,130,20,hwnd,Cast(HMENU,1),0,0) button=CreateWindowEx(0,"button","ok" ,WS_VISIBLE Or WS_CHILD,130,100,100,20,hwnd,Cast(HMENU,2),0,0) progress = CreateWindowEx(0,"msctls_progress32","",WS_VISIBLE Or WS_CHILD Or PBS_SMOOTH,10,170,200,20,hwnd,Cast(HMENU,3),0,0) Case WM_COMMAND If Loword(wparam)=2 Then Dim As ZString*256 text GetWindowText(Edit,@text,256) iEndValue = valulng(text) settimer(hwnd , 1 , 10 , 0) threadcreate(@thr1) Endif case WM_TIMER if iValue >= iEndValue then killtimer(hwnd ,1) SendMessage(progress,PBM_SETPOS,100,0) messagebox(0 , "OK!!!" , "" , 0) PostQuitMessage(0) else SendMessage(progress,PBM_SETPOS,iValue*100ull\iEndValue,0) EndIf Case WM_DESTROY PostQuitMessage(0) End Select Return DefWindowProc(hwnd,msg,wparam,lparam) End Function With wc .cbSize=SizeOf(WNDCLASSEX) .style=CS_HREDRAW Or CS_VREDRAW .lpfnWndProc=@wndproc .hInstance=Hinst .hIcon=LoadIcon(0,IDI_QUESTION) .hCursor=LoadCursor(0,IDC_ARROW) .hbrBackground=Cast(HBRUSH,COLOR_WINDOW) .lpszClassName=StrPtr(NameClass) .hIconSm=.hIcon End With If RegisterClassEx(@wc)=0 Then Print "Register error, press any key" Sleep End Endif CreateWindowEx(0,NameClass,"Main",_ WS_VISIBLE Or WS_OVERLAPPEDWINDOW,10,10,300,300,0,0,Hinst,0) While GetMessage(@msg,0,0,0) TranslateMessage(@msg) DispatchMessage(@msg) Wend
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |
timurar77 | Дата: Вторник, 19.07.2022, 08:14 | Сообщение # 19 |
Рядовой
Группа: Пользователи
Сообщений: 8
Статус: Offline
| С таймером попробую как нибудь потом. Изучив материал про паттерн и антипаттерн. Проанализировав еще раз весь материал в обсуждении, а также особенно помог материал про прогрессбар. Получился следующий код - вычисления оформил в виде процедуры, данные в процедуру передаю через глобальную переменную, единственно через саму процедуру передаю указатель на окно, вызов процедуры произвожу как отдельного потока. В принципе и все заработало!! Единственно если два раза запустить процесс вычисления, то параллельно будут проводиться два вычисления и рисоваться два прогрессбара в одном месте (использование мьютексов не помогло). Для блокировки повторного запуска вычислений в процедуру добавил деактивацию и активацию кнопки запуска.
Наверно это наиболее оптимальное решение. Ссылка на проект zamorozka3.rar Результат:
Код: Код #Include Once "windows.bi" #Include Once "win/commdlg.bi" #Include Once "win/commctrl.bi" #Include "zamorozka.bi"
Dim Shared dan As LongInt
Declare Function DlgProc(ByVal hWin As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer hInstance=GetModuleHandle(NULL) DialogBoxParam(hInstance, Cast(ZString Ptr,IDD_DLG1), NULL, @DlgProc, NULL) ExitProcess(0) End Sub zs(ByVal hDlg As HWND) Dim As LongInt i, a Dim As Integer tPoz Dim As Double otv Dim buff As ZString*20 EnableWindow(GetDlgItem(hDlg,IDC_BTN2),FALSE) otv=0.5 For i=1 To 100 For a=1 To dan\100 otv=1+otv otv=1/otv Next a tPoz= Int(i)'определяем текущую позицию в процентах SendDlgItemMessage(hDlg,IDC_PGB1,PBM_SETPOS,tPoz,0) Next i buff=Str(otv) SetDlgItemText(hDlg,IDC_EDT2,buff) MessageBox(hDlg,"Готово","ХаХаХа",MB_ICONINFORMATION) SendDlgItemMessage(hDlg,IDC_PGB1,PBM_SETPOS,0,0) SetDlgItemText(hDlg,IDC_EDT2,"") EnableWindow(GetDlgItem(hDlg,IDC_BTN2),TRUE) End Sub Function DlgProc(ByVal hDlg As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Integer Dim As Long id, Event, x, y Dim hBtn As HWND Dim rect As RECT Dim buff As ZString*20 Dim hand As Any Ptr Select Case uMsg Case WM_INITDIALOG ' Case WM_CLOSE EndDialog(hDlg, 0) ' Case WM_COMMAND id=LoWord(wParam) Event=HiWord(wParam) Select Case id Case IDC_BTN2 GetDlgItemText(hDlg,IDC_EDT1,buff,260) dan=Val(buff) hand=ThreadCall zs(hDlg) Case IDC_BTN1 EndDialog(hDlg, 0) ' End Select Case WM_SIZE GetClientRect(hDlg,@rect) hBtn=GetDlgItem(hDlg,IDC_BTN1) x=rect.right-100 y=rect.bottom-35 MoveWindow(hBtn,x,y,97,31,TRUE) ' Case Else Return FALSE ' End Select Return TRUE
End Function
Всем спасибо за участие.Добавлено (28.07.2022, 21:02) --------------------------------------------- В процессе применения описаного примера было установлено, что для вызова вычислительного потока и его взаимодействия с объектами окна лучше использовать "ThreadCreate" чем "ThreadCall" особенно если многоуровневые дочерние и родительские окна. При использовании "ThreadCall" возникли проблемы по передачи дескриптора окна. При использовании "ThreadCreate" проблема сразу исчезла.
Сообщение отредактировал timurar77 - Вторник, 19.07.2022, 08:16 |
|
| |
|