lazarus+bgrabitmap制作漂亮的弹窗

使用bgrabitmap的TBCLeaBoard控件。
弹出窗口后，如果鼠标离开弹窗，并点击form1的任意位置（利用OnDeactivate），就会关闭弹窗

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, lazutf8;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses unit2;
{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var p:tpoint;
    myMouse: TMouse;
begin
  p:=ClienttoScreen(point(Button1.Left,Button1.Top+Button1.Height));
  form2.Left:=myMouse.CursorPos.X;
  form2.Top:=p.Y;
  form2.show;
end;

end.

object Form1: TForm1
  Left = 378
  Height = 622
  Top = 36
  Width = 788
  Caption = 'Form1'
  ClientHeight = 622
  ClientWidth = 788
  DesignTimePPI = 144
  object Button1: TButton
    Left = 48
    Height = 38
    Top = 32
    Width = 113
    Caption = '弹出窗口'
    TabOrder = 0
    OnClick = Button1Click
  end
end

 

unit Unit2;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  DBGrids, BCLeaBoard, BCLeaTheme;

type

  { TForm2 }

  TForm2 = class(TForm)
    BCLeaBoard1: TBCLeaBoard;
    Button1: TButton;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    Label1: TLabel;
    procedure FormDeactivate(Sender: TObject);
  private

  public
  end;

var
  Form2: TForm2;

implementation

{$R *.lfm}

{ TForm2 }

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  close;
end;

end.

 

object Form2: TForm2
  Left = 382
  Height = 393
  Top = 250
  Width = 559
  AllowDropFiles = True
  AlphaBlendValue = 100
  BorderStyle = bsNone
  Caption = 'Form2'
  ClientHeight = 393
  ClientWidth = 559
  Color = clInactiveCaption
  DesignTimePPI = 144
  OnDeactivate = FormDeactivate
  object BCLeaBoard1: TBCLeaBoard
    Left = 0
    Height = 393
    Top = 0
    Width = 559
    Align = alClient
    TabOrder = 0
    TabStop = False
    FrameColor = 8421440
    BoardColor = clMoneyGreen
    BackgroundColor = clBtnFace
    object Edit1: TEdit
      Left = 89
      Height = 32
      Top = 104
      Width = 216
      TabOrder = 0
      Text = 'Edit1'
    end
    object Button1: TButton
      Left = 320
      Height = 38
      Top = 101
      Width = 113
      Caption = 'Button1'
      TabOrder = 1
    end
    object Label1: TLabel
      Left = 89
      Height = 24
      Top = 64
      Width = 57
      Caption = 'Label1'
    end
    object DBGrid1: TDBGrid
      Left = 51
      Height = 176
      Top = 152
      Width = 464
      Color = clWindow
      Columns = <>
      TabOrder = 2
    end
  end
end