unit Unit1;
{$mode objfpc}{$H+}
interface
uses
{$IFDEF WINDOWS}
windows,
{$ENDIF}
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, FPimage;
type
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
procedure Execute;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{$IFDEF WINDOWS}
function UpdateLayeredWindow(hwnd: HWND; hdcDst: HDC; pptDst: PPoint;
psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: TColor;
pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall; external 'user32';
{$ENDIF}
{ TForm1 }
procedure TForm1.FormShow(Sender: TObject);
begin
Image1.Picture.LoadFromFile('image.bmp');
Execute;
end;
procedure TForm1.Execute;
var
{$IFDEF WINDOWS}
BlendFunction: TBlendFunction;
BitmapSize: TSize;
{$ENDIF}
BitmapPos: TPoint;
exStyle: DWORD;
begin
{$IFDEF WINDOWS}
// Enable window layering
exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
if (exStyle and WS_EX_LAYERED = 0) then
SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);
{$ENDIF}
// Resize form to fit bitmap
ClientWidth := image1.picture.Bitmap.Width;
ClientHeight := image1.picture.Bitmap.Height;
// Position bitmap on form
BitmapPos.x:=0;
BitmapPos.y:=0;
{$IFDEF WINDOWS}
BitmapSize.cx := image1.picture.Bitmap.Width;
BitmapSize.cy := image1.picture.Bitmap.Height;
// Setup alpha blending parameters
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
// ... and action!
UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, image1.picture.Bitmap.Canvas.Handle,
@BitmapPos, 0, @BlendFunction, ULW_ALPHA);
{$ENDIF}
end;
end.
[/object Form1: TForm1
Left = 305
Height = 240
Top = 263
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
OnShow = FormShow
LCLVersion = '1.1'
object Image1: TImage
Left = 0
Height = 240
Top = 0
Width = 320
Align = alClient
end
end]