На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...
Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.
Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
Страницы: (5) « Первая ... 3 4 [5]  все  ( Перейти к последнему сообщению )  
> TThread.Synchronize
Guru Jin X
Сообщ. #61 ,

    Законченный оптимист
    *******
    Профиль · PM
    Поощрения: 23 Dgm
    Рейтинг (т): 117
    Частично выкладываю что получилось...

    Описание:
    ExpandedWrap disabled
          // Ждать закрытия окна сообщения (нажатия кнопки или срабатывания таймаута).
          // Во время ожидания метод постоянно вызывает Sleep(1), а также функцию/метод Idle, если он(а) задан(а) каждые Period миллисекунд (первый вызов осуществляется сразу).
          // При значении Period = INFINITE вызов Idle выполняется только 1 раз. Если функция/метод вернёт False, цикл ожидания прервётся, а метод вернёт значение MBTR_WAITBREAKED.
          // В остальных случаях возвращает результат, т.е. свойство GetResult (аналогично функциям MessageBoxTimeout, MsgBoxTimeout).
          function Wait(Idle: TMsgBoxTimeoutIdleFunc = nil; Period: DWord = 0): TMsgBoxTimeoutResult; overload;
          function Wait(Idle: TMsgBoxTimeoutIdleMethod; Period: DWord = 0): TMsgBoxTimeoutResult; overload;
       
          // Принудительно закрыть окно сообщения, установив значение результата Res (при указании значения MBTR_DISPLAYING оно будет заменено на MBTR_BREAKED).
          // Результат устанавливается вне зависимости от состояния окна (открыто или закрыто). Если окно сообщения уже закрыто, ничего страшного не произойдёт.
          // ВНИМАНИЕ: Данный метод лишь посылает потоку команду закрыть окно, но не ждёт, когда это реально произойдёт, поэтому нет гарантии, что после завершения метода окно уже будет
          // закрыто (хотя это должно произойти очень быстро). В любом случае можно не опасаться вызывать метод Show/ShowEx сразу после метода Close, т.к. окно будет считаться уже закрытым.
          // Данный метод не вызывает метод Free!
          procedure Close(Res: TMsgBoxTimeoutResult = MBTR_BREAKED);
       
          // Перед уничтожением потока вызвать метод Close и освободить поток.
          destructor Destroy; override;
       
          // Используемый в работе объект потока. Предоставляется на страх и риск программиста (например, для доступа к окну сообщения)!
          // Может быть равен nil, если поток ещё ни разу не запускался. В остальных случаях объект не освобождается, а свойство не обнуляется, даже если окно уже закрыто (в т.ч. методом Close).
          // ВНИМАНИЕ: Уничтожение потока в обход метода TMsgBoxTimeout.Close (например, через TerminateThread) или освобождение объекта Thread (Thread.Free) приведёт к некорректной дальнейшей работе и исключениям!
          property Thread: TThread read FThread;

    Реализация:
    ExpandedWrap disabled
      procedure TMsgBoxTimeoutNotifyThread.Execute;
      var Res: TMsgBoxTimeoutResult;
      begin
        with MsgBox do with FParams do
        begin
          Res := MessageBoxTimeout(hWnd, PChar(Text), PChar(Title), Flags, LangId, Timeout);
          if InterlockedCompareExchange(Pointer(FResult), Pointer(Res), Pointer(MBTR_DISPLAYING)) = Pointer(MBTR_DISPLAYING) then  // Результат будет другим (не MBTR_DISPLAYING), если окно закрыто методом Close
            DoNotify(mbtOnClose)
        end
      end;
       
      function TMsgBoxTimeout.ReadyToShow(Flags: DWord): Boolean;
      begin
        Result := True;
        if FResult = MBTR_DISPLAYING then
          case Flags and MBTF_REACTION_MASK of
            MBTF_WAIT: Wait;
            MBTF_FAIL: Result := False
            else Close
          end
      end;
       
      function TMsgBoxTimeoutNotify.ShowEx(hWnd: THandle; const Text, Title: String; Flags, Timeout: DWord; Ntf: TMsgBoxTimeoutNotifyRec; const Id: String = ''; LangId: Word = 0): Boolean;
      begin
        Result := ReadyToShow(Flags);
        if Result then
        begin
          FreeAndNil(FThread);  // Даже если ShowEx вызван сразу после Close, а поток ещё не успел завершить работу, деструктор TThread подождёт его завершения
          FParams.hWnd := hWnd;
          FParams.Text := Text;
          FParams.Title := Title;
          FParams.Flags := Flags and not MBTF_FLAGS_MASK;
          FParams.Timeout := Timeout;
          FParams.LangId := LangId;
          FId := Id;
          if FId = '' then FId := GenerateId;
          FNotify := Ntf;
          FThread := TMsgBoxTimeoutNotifyThread.Create(True);
          FResult := MBTR_DISPLAYING;
          with TMsgBoxTimeoutNotifyThread(FThread) do
          begin
            MsgBox := Self;
            DoNotify(mbtOnShow);
            Resume
          end
        end
      end;
       
      function TMsgBoxTimeout.Wait(Idle: TMsgBoxTimeoutIdleFunc = nil; Period: DWord = 0): TMsgBoxTimeoutResult;
      var T1, T2: Int64;
      begin
        T1 := 0;
        while FResult = MBTR_DISPLAYING do
        begin
          if @Idle <> nil then
          begin
            T2 := GetTickCount;
            if (T1 = 0) or ((T2-T1 >= Period) and (Period <> INFINITE)) then
            begin
              if not Idle(Self) then
              begin
                Result := MBTR_WAITBREAKED;
                Exit
              end;
              T1 := T2
            end
          end;
          Sleep(1)
        end;
        Result := FResult
      end;
       
      procedure TMsgBoxTimeoutNotify.Close(Res: TMsgBoxTimeoutResult = MBTR_BREAKED);
      begin
        if Res = MBTR_DISPLAYING then Res := MBTR_BREAKED;
        if InterlockedExchange(Integer(FResult), Integer(Res)) = Integer(MBTR_DISPLAYING) then
        begin
          PostThreadMessage(FThread.ThreadID, WM_QUIT, 0, 0);
          DoNotify(mbtOnClose)
        end
      end;
       
      destructor TMsgBoxTimeout.Destroy;
      begin
        Close;
        FThread.Free;  // Если окно уже было закрыто до вызова Close
        inherited
      end;
    0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
    0 пользователей:
    Страницы: (5) « Первая ... 3 4 [5]  все


    Рейтинг@Mail.ru
    [ Script execution time: 0,0282 ]   [ 16 queries used ]   [ Generated: 20.04.24, 02:51 GMT ]  
    Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.