FreeBasic
Главная
Вход
Регистрация
Пятница, 07.10.2022, 21:30Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 2 из 2
  • «
  • 1
  • 2
Форум » Freebasic » Вопросы по языку FreeBasic » Подморозка интерфейса?!
Подморозка интерфейса?!
zamabuvaraeuДата: Суббота, 16.07.2022, 06:59 | Сообщение # 16
Подполковник
Группа: Друзья
Сообщений: 116
Репутация: 1
Статус: Offline
Вообще в нормальных программа никакие расчёты внутри GUI не производют.
Всю бизнес‐логику должна обрабатываться отдельными объектами бизнес‐логики. GUI только дёргает методы бизнес‐логики.
У этого антишаблона есть даже специальное название «Магическая кнопка» и отдельная статья в педивикии
Магическая кнопка — Википедия (wikipedia.org)
 
timurar77Дата: Суббота, 16.07.2022, 08:52 | Сообщение # 17
Рядовой
Группа: Пользователи
Сообщений: 8
Репутация: 0
Статус: Offline
В таймер?! Попробую.
 
haavДата: Понедельник, 18.07.2022, 09:32 | Сообщение # 18
Генералиссимус
Группа: Администраторы
Сообщений: 1289
Репутация: 46
Статус: 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
Репутация: 0
Статус: 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
 
Форум » Freebasic » Вопросы по языку FreeBasic » Подморозка интерфейса?!
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск: