Het is gelukt: De code:
Code:
unit popup;
interface
uses FMX.Forms, FMX.Types, FMX.StdCtrls, System.Classes, System.Types, FMX.Objects, FMX.Graphics, system.UITypes, System.SysUtils, System.Threading
;
type
TTimedPopup = class
private
Form : TForm;
lTb: TLabel;
lImg: TImage;
left, top: integer;
height, width: integer;
tekst :string;
procedure ShowReal;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
procedure SetPositionSize(pHight:integer; pWidth:integer; pLeft:integer=-1; pTop:integer=-1) ;
procedure SetLabel( pLabel :String) ;
procedure Show;
end;
procedure doen(AOwner: TComponent; pHight:integer; pWidth:integer; pLabel:string; pLeft:integer=-1; pTop:integer=-1);
implementation
//uses FMX.DialogService.Sync;
procedure doen(AOwner: TComponent; pHight:integer; pWidth:integer; pLabel:string; pLeft:integer=-1; pTop:integer=-1);
var ff : TTimedPopup;
begin
ff := TTimedPopup.Create(AOwner);
try
ff.SetPositionSize( pHight, pWidth, pLeft, pTop);
ff.SetLabel(pLabel);
ff.show;
finally
ff.free
end;
end;
constructor TTimedPopup.Create(AOwner: TComponent);
var lR : tRect;
iX: Integer;
iY: Integer;
// xBitmapData: TBitmapData;
begin
Form := tForm.CreateNew(AOwner);
SetPositionSize(50,180);
tekst := 'label';
lTb := TLabel.Create(AOwner);
lImg := TImage.Create(AOwner);
end;
procedure ImgInitP(xImg:TImage; xCl:TAlphaColor);
begin
// xImg.Bitmap := TBitmap.Create;
xImg.Bitmap.SetSize(Round(xImg.Width), Round(xImg.Height));
xImg.Bitmap.Canvas.Fill.Color := xCl;
xImg.Bitmap.Canvas.BeginScene;
try
xImg.Bitmap.Canvas.FillRect(TRectF.Create(xImg.ClipRect),4,4, AllCorners ,1);
finally
xImg.Bitmap.Canvas.EndScene;
end;
end;
procedure TTimedPopup.SetPositionSize(pHight:integer; pWidth:integer; pLeft:integer=-1; pTop:integer=-1) ;
begin
Height := pHight;
Width := pWidth;
{$IFDEF MSWINDOWS }
left := pLeft;
top := pTop;
if pLeft <0 then
left := round((Screen.ActiveForm.Width-Width)/2)+Screen.ActiveForm.Left;
if pTop <0 then
top := round((screen.ActiveForm.Height-height)/2) + Screen.ActiveForm.Top;
form.Left := left; form.Top := top;
form.Width := Width; form.Height := Height;
Form.BorderStyle:= TFmxFormBorderStyle.None;
// TDialogServiceSync.ShowMessage (Screen.ActiveForm.left.ToString+' '+Screen.ActiveForm.Top.ToString);
{$ENDIF}
Form.Transparency := true;
end;
procedure TTimedPopup.SetLabel( pLabel :String) ;
begin
tekst := pLabel;
end;
procedure TTimedPopup.show;
begin
lImg.Width := Width;
lImg.Height := Height;
lImg.Parent := form;
lImg.Align := TAlignLayout.Center;
lTb.Parent := lImg;
ImgInitP(lImg,TAlphaColors.Lightgrey);
//
// form.Position:= TFormPosition.Designed;
// Form.Kind := TBrushKind.Bitmap ;
lTb.Text := tekst;
lTb.StyledSettings:=lTb.StyledSettings -[TStyledSetting.ssFamily,TStyledSetting.ssSize] ;
lTb.Font.Size := 20;
lTb.Align := TAlignLayout.Center;
lTb.TextSettings.HorzAlign := TTextAlign.Center ;
showReal;
end;
procedure tTimedPopup.ShowReal;
var lTasksAction : array of ITask;
begin
lImg.Opacity:= 1;
//TDialogServiceSync.ShowMessage (form.left.ToString+' '+form.Top.ToString);
form.Show;
Setlength (lTasksAction ,1);
lTb.Text := tekst;
lTasksAction[0] := TTask.Create( procedure
var i: integer;
begin
sleep(150);
for i := 1 to 10 do
begin
sleep(20);
TThread.Queue(nil, procedure
begin
lImg.Opacity:= lImg.Opacity - 0.1;
end);
end;
TThread.Queue(nil, procedure
begin
lTb.Free;
lTb := nil;
end);
end );
lTasksAction[0].Start;
while Assigned(lTb) do //wachten
Application.ProcessMessages;
Form.Close();
end;
destructor TTimedPopup.Destroy;
begin
lImg.Free;
form.Free;
inherited Destroy;
end;
end.
Bookmarks