Antifreeze. Не хочет создаваться в потоках.

[hemn6vyr]

Нашёл в инете функцию создания всплывающих окошек, маленько поправил и загнал в библиотеку.
Первое окошко появляется, а вот при попытке создания второго выдаёт что нельзя создать больше одного антифриза.

Если использовать просто sleep то наведённый на окошко указатель показывает "зависание" приложения, что не совсем этично :-)

Есть ли какие нибудь компоненты аналоги антифриза?

Unit PopUpThreadUnit;

Interface

  Uses
    System.Classes,
    Vcl.Forms,
    Vcl.StdCtrls,
    Winapi.Windows,
    System.SysUtils,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Dialogs,
    IdAntiFreezeBase,
    Vcl.IdAntiFreeze;

  Type
    PopUpThread = Class(TThread)
      AntiFreeze: TIdAntiFreeze;
      Procedure Execute; Override;
    End;

  Var
    PopUpMessage: String;
    FontColor: TColor;
    Count: Integer;

Implementation

  Procedure PopUpThread.Execute;
    Var
      H, Aw: HWND;
      Rec: TRect;
      NeededTop: Integer;
      HintForm: TForm;
      HintLabel: TLabel;
      Rgn: HRGN;

    Begin
      Try
        AntiFreeze := TIdAntiFreeze.Create(Nil);
        If Count >= 1 Then
          Count := Count + 1
        Else
          Count := 1;
        NameThreadForDebugging('PopUpWindow');
        H := FindWindow('Shell_TrayWnd', Nil);
        If H = 0 Then
          Exit;
        GetWindowRect(H, Rec);
        HintForm := TForm.Create(Nil);
        With HintForm Do
          Begin
            Width := 250;
            Height := 50;
            Color := FontColor;
            BorderStyle := BsNone;
            Rgn := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight, 15, 15);
            SetWindowRgn(Handle, Rgn, True);
            HintLabel := TLabel.Create(Nil);
            With HintLabel Do
              Begin
                Parent := HintForm;
                WordWrap := True;
                Caption := ' ' + Trim(PopUpMessage) + ' ';
                Align := AlClient;
                Layout := TlCenter;
                Alignment := TaCenter;
              End;
            AlphaBlend := True;
            AlphaBlendValue := 220;
            Aw := GetActiveWindow;
            ShowWindow(Handle, SW_SHOWNOACTIVATE);
            SetActiveWindow(Aw);
            Left := Screen.Width - Width;
            Top := Screen.Height - 50;
            NeededTop := Rec.Top - Height * Count;
            While Top > NeededTop Do
              Begin
                Top := Top - 2;
                Repaint;
                Antifreeze.Sleep(15);
                Antifreeze.Process;
              End;
            Antifreeze.Sleep(2500);
            NeededTop := Screen.Width - 20;
            Count := Count - 1;
            While Top < NeededTop Do
              Begin
                Top := Top + 2;
                Repaint;
                Antifreeze.Sleep(15);
                Antifreeze.Process;
              End;
            HintLabel.Free;
            Free;
          End;
      Except
        On Error: Exception Do
          Begin
            ShowMessage('Ошибка: [' + Error.ClassName + '] [' + Error.Message + ']');
          End;
      End;
    End;
End.

[alextrof94]

вроде антифриз только на инди действует, нет? Да и не нужно больше одного. Его так же можно просто в дезайнтайме на форму кинуть из вкладки инди миск.

[hemn6vyr]

Сообщение от alextrof94

вроде антифриз только на инди действует, нет? Да и не нужно больше одного. Его так же можно просто в дезайнтайме на форму кинуть из вкладки инди миск.

Вот он антифриз.

IdAntiFreezeBase,
Vcl.IdAntiFreeze;
==========
AntiFreeze: TIdAntiFreeze;
==========
AntiFreeze := TIdAntiFreeze.Create(Nil);

дезайнтайма не было, форма описана тут

HintForm: TForm;
==========
HintForm := TForm.Create(Nil);
With HintForm Do
  Begin
    Width := 250;
    Height := 50;
    Color := FontColor;
    BorderStyle := BsNone;
    Rgn := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight, 15, 15);
    SetWindowRgn(Handle, Rgn, True);
    HintLabel := TLabel.Create(Nil);

[Stilet]

Есть ли какие нибудь компоненты аналоги антифриза?

Компонентов нет, но есть схемы: То что антифриз должен защищать засосывать в сопроцесс TTHread. Ессно нужно научится работать с этим классом.