Создать балун

[alex_alex_alex1]

Создал форму, выполняющую роль балуна, но она автоматически перехватывает фокус от других программ (потом когда такой мой балун исчезает, то фокус возвращается к той программе, от которой он ушел).
Как сделать так, чтобы форма не захватывала фокус?

[rayanAyar]

Создавать не TForm, а THintWindow.

[alex_alex_alex1]

А если с помощью формы?

Добавлено спустя 1 час 16 минут 57 секунд:
Вот чего нашел http://prodelphi.ucoz.ru/publ/pokazat_p ... e/1-1-0-58
Только теперь не знаю как вывести заголовок жирным, а сам текст обычным шрифтом.
Я делаю так: title:=str1+chr(13)+str0
В итоге у меня получается и заголовок, и сам текст, но хотелось бы разный шрифт.

[rayanAyar]

Можно создать на форме THintWindow компонент:

Код: Выделить всё

...
  TfhList = class(THintWindow)
    listHint: TListBox;
    procedure listHintClick(Sender: TObject);
    procedure listHintMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  public
    procedure FormCreate;
...
procedure TfhList.FormCreate;
begin
  Self.Caption:= '';
  listHint:= TListBox.Create(Self);
  listHint.Parent:= Self;
  listHint.TabStop:= False;
  listHint.Align:= alClient;
  listHint.Font.Name:= 'Liberation sans';
  listHint.Font.Height:= -17;
  listHint.ItemHeight:= 26;
  listHint.OnClick:= @listHintClick;
  listHint.OnMouseMove:= @listHintMouseMove;
end;
...


[Nik]

Создал форму, выполняющую роль балуна, но она автоматически перехватывает фокус от других программ (потом когда такой мой балун исчезает, то фокус возвращается к той программе, от которой он ушел).
Как сделать так, чтобы форма не захватывала фокус?

Тоже использую форму в качестве хинта. Вызываю так:

Код: Выделить всё

if not HintForm.Visible=true then
   begin
    HintForm.Visible:=true;
    MainGrid.SetFocus;
   end     

В моём случае такой хинт только у одного контрола (MainGrid). В принципе, можно придумать и универсальный алгоритм (узнавать контрол в позиции мыши, например).

[alex_alex_alex1]

http://prodelphi.ucoz.ru/publ/pokazat_p ... e/1-1-0-58 - делал как здесь, работает, добавил лишь hnt.Alignment:=taLeftJustify;
только:
- как изменить начертание шрифта чтобы выводились разные по начертанию слова в одном сообщении жирным и обычным шрифтом, можно даже разным цветом.

Добавлено спустя 13 часов 17 минут 53 секунды:
Еще проблема в том, что я прицепил thintwindow на форму. Как сделать так чтобы форма вообще не показывалась? Чего только не делал, но она кратковременно показывается все равно.

[Ism]

В Delphi можно было сделать так

Код: Выделить всё

type
  TForm1 = class(TForm)
    Button1: TButton;
  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;
.....
..
implementation

{$R *.dfm}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle + WS_EX_NOACTIVATE;
end;

Но в Lazarus подобное не работает, так как изза кросплатформенности большинство параметров игнорируется даже если они есть в хелпе

Добавлено спустя 18 часов 54 секунды:
Между прочим на THintForm можно создавать динамически любой компонент, такой как Tedit или TImage.

[alex_alex_alex1]

Спасибо всем, кто принял участие в разработке балуна, особая благодарность Ism, который помогал лично писать и отлаживать код.

Итоговое решение (программа balloon, показывающая всплывающие балуны для иконки в трее, переписанная реализация TtrayIcon.ShowBalloonHint):

Код: Выделить всё

program balloon;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms,unitballoon,Classes;

{$R *.res}

begin
  Application.Initialize;
  if h<>nil then h.ReleaseHandle else h:=THintWindow.Create(Form1);
  Application.CreateForm(TForm1, Form1);
  Form1.Parent:=h;
  Form1.ShowMyBalloonHint (ParamStr(1),ParamStr(2),ParamStr(3),ParamStr(4),ParamStr(5),ParamStr(6),ParamStr(7),ParamStr(8));
  Application.Run;
end.       

Код: Выделить всё

unit unitballoon;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Unix, BaseUnix, Gettext, Menus, StdCtrls, Buttons;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    Label0: TLabel;
    Label_text: TLabel;
    Panel1: TPanel;
    Timer1: TTimer;
    procedure FormClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ShowMyBalloonHint(str0, str1, n, X, Y, AFont,PID_before,picture:string);
    procedure ShowMyHint(var hnt:THintWindow; x0,y0,w0,h0:integer; title: string;font0:integer;str,picture:string);
    Procedure HideMyHint(var hnt:THintWindow);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
   Form1:TForm1;
   f0:text;
   h:THintWindow;

implementation
{ TForm1 }

procedure TForm1.FormClick(Sender: TObject);
begin
   HideMyHint(h);
   halt;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
     x,code,i:integer;
     s:string;
begin
     //проверка корректности переданных параметров
     If ParamCount<>8 then
             begin
                Application.MessageBox('ParamCount must be 8.','Error!',0);
               halt;
             end;
     for i:=3 to 7 do
               begin
                 Val(ParamStr(i),x,code);
                 if code<>0 then
                              begin
                                 s:='ParamStr('+IntToStr(i)+') must be value.';
                                 Application.MessageBox(PChar(s),'Error!',0);
                                 halt;
                              end;
               end;
end;

procedure TForm1.ShowMyHint(var hnt:THintWindow; x0,y0,w0,h0:integer; title: string;font0:integer;str,picture:string);
var
  i:integer;
begin
     Form1.Font.Size:=font0;
     Form1.Font.Color:=clBlack;
     label0.Caption:=str;
     Label_text.Caption:=title;
     label0.Font.Style:=[fsBold];
     Panel1.BorderSpacing.Around:=1;

     If picture='' then Image1.Visible:=false;
     If picture<>'' then If FileExists(picture) then Image1.Picture.LoadFromFile(picture)  else Image1.Visible:=false;
     Image1.Height:=font0*5;
     Image1.Width:=font0*5;

     Form1.Align:=alClient;
     hnt.ActivateHint(rect(x0,y0,x0+w0,y0+h0),'');

     for i:=0 to Form1.ComponentCount-2 do
     begin
     if pos(Form1.Components[i].Name,'Timer')<>0 then continue;
     (Form1.Components[i] as TControl).OnClick:=Form1.OnClick;
     end;
   end;

   Procedure TForm1.HideMyHint(var hnt:THintWindow);
   begin
     if hnt<>nil then hnt.ReleaseHandle;
   end;

   procedure TForm1.Timer1Timer(Sender: TObject);
   begin
     HideMyHint(h);
     halt;
   end;

   procedure TForm1.ShowMyBalloonHint (str0, str1, n, X, Y, AFont,PID_before,picture:string);
   {- выводимое сообщение,
   - заголовок сообщения,
   - время, в течение которого сообщение отображается на экране (миллисекунды),
   - координата X окна сообщения,
   - координата Y окна сообщения,
   - размер шрифта сообщения,
   - PID предыдущего сообщения или 0 (если 0, то balloon не будет дожидаться окончания вывода предыдущего сообщения, или если 0, то это выводится только первое сообщение),
   - рисунок с путем к нему.}
   var
      str:string;
      pid:Tpid;
      yes_balloon:boolean;
      A,B:integer;
   begin
       pid:=FpGetpid;
       If PID_before<>'0' then
       repeat
            yes_balloon:=false;
             popen(f0,'ps -e | grep balloon|awk '+chr(39)+'{print $1$5}'+chr(39),'R');
             while not eof(f0) do
                              begin
                                readln(f0,str);
                                if str<>'' then if str<>IntToStr(pid) then if str=PID_before then yes_balloon:=true;
                              end;
             pclose(f0);
             sleep(200);
      until not yes_balloon;
      If StrToInt(Y)>(Screen.Height div 2) then B:=StrToInt(Y)-12*StrToInt(AFont);
      If StrToInt(Y)<=(Screen.Height div 2) then B:=StrToInt(Y)+22;
      If StrToInt(X)>(Screen.Width div 2) then A:=StrToInt(X)-35*StrToInt(AFont);
      If StrToInt(X)<=(Screen.Width div 2) then A:=StrToInt(X)+22;
      ShowMyHint(h,A,B,35*StrToInt(AFont),12*StrToInt(AFont),str0,StrToInt(AFont),str1,picture);
      Timer1.Interval:=StrToInt(n);
      Timer1.Enabled:=true;
   end;

   initialization

   {$R *.lfm}

   end.

balloon.tar.gz

[Brainenjii]

А можно скриншот ещё? ^_^

[alex_alex_alex1]

Здесь интересен сам факт того, что любую форму можно превратить в хинт, баллун, при этом фокус не будет перехватываться от других, выполняющихся в ОС приложений, можно пользоваться всеми преимуществами формы - разный шрифт, разный цвет шрифта, можно использовать картинки и т. д.

d4.jpeg

d5.jpeg

[Ism]

А еще если добавить градиент...

TImage.Canvas.GradientFill (rect( 0,0,Width,Height),clyellow, clwhite,gdHorizontal); и только на событии OnPaint формы