Geekly Articles each Day
📜 ⬆️ ⬇️

Create Splash Screen on Delphi

image
If when loading a program, a Splash Screen is displayed (this is a small window with a picture), then users treat such programs better than programs that, if they are started, nothing happens for a few seconds.
There are many examples of Splash Screen manufacturing on the Internet in Delphi, but usually it is a square shape with a picture stretched over it.
But for many programs this is not a square shape, but a beautiful window with smooth edges.
I tried to make such a window with the help of regions, but the edges were uneven and looked awkward.
The output is “Layered Windows” (LayeredWindow).

The TSplash class has been created:
Create (Image: TPNGImage) creates an instance of the class and loads the image,
Show shows Splash, Close hides.

The procedure that converts a regular window to LayeredWindow:
procedure TSplash.ToLayeredWindow; var BitMap: TBitMap; bf: TBlendFunction; BitmapSize: TSize; BitmapPos: TPoint; begin //    (32   , precalc  ) BitMap := TBitMap.Create; CreatePremultipliedBitmap(Bitmap,FImage); //  BlendFunction with bf do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; AlphaFormat := AC_SRC_ALPHA; SourceConstantAlpha := 255; end; //   BitMap BitmapSize.cx := Bitmap.Width; BitmapSize.cy := Bitmap.Height; //   BitMap BitmapPos.X := 0; BitmapPos.Y := 0; //    SetWindowLong(SplashForm.Handle, GWL_EXSTYLE, GetWindowLong(SplashForm.Handle, GWL_EXSTYLE) + WS_EX_LAYERED); //      UpdateLayeredWindow( SplashForm.Handle, 0, nil,//pos @BitmapSize,//size bitmap.Canvas.Handle,//src @BitmapPos,//pptsrc 0, @bf, ULW_ALPHA ); BitMap.Free; end;


The CreatePremultipliedBitmap procedure converts a TPNGImage to a 32-bit TBitMap required by the UpdateLayeredWindow function:
 procedure CreatePremultipliedBitmap(DstBitMap: TBitmap; SrcPngImage: TPNGImage); type TRGBTripleArray = ARRAY[Word] of TRGBTriple; pRGBTripleArray = ^TRGBTripleArray; TRGBAArray = array[Word] of TRGBQuad; PRGBAArray = ^TRGBAArray; var x, y: Integer; TripleAlpha: Double; pColor: pRGBTripleArray; pAlpha: pbytearray; pBmp: pRGBAArray; begin DstBitMap.Height := SrcPngImage.Height; DstBitMap.Width := SrcPngImage.Width; DstBitMap.PixelFormat := pf32bit; for y := 0 to SrcPngImage.Height - 1 do begin pAlpha := SrcPngImage.AlphaScanline[y]; pColor := SrcPngImage.Scanline[y]; pBmp := DstBitMap.ScanLine[y]; for x := 0 to SrcPngImage.Width - 1 do begin pBmp[x].rgbReserved := pAlpha[x]; //     TripleAlpha := pBmp[x].rgbReserved / 255; pBmp[x].rgbBlue := byte(trunc(pColor[x].rgbtBlue * TripleAlpha)); pBmp[x].rgbGreen := byte(trunc(pColor[x].rgbtGreen * TripleAlpha)); pBmp[x].rgbRed := byte(trunc(pColor[x].rgbtRed * TripleAlpha)); end; end; end;

')
As an image, an instance of the class TPNGImage is used, which allows you to create translucent Splash Screens.
Result of work:
image

Full module code:
 {*******************************************************} { Splash Screen Library v1.01 } { } { Copyright(c) 2006-2012 ErrorSoft } { } {      } {  () SplashScreen-   } {  } { } { ,   ,  : } { Enter256@yandex.ru } { } {*******************************************************} unit SplashScreen; interface uses Windows, PNGImage, Forms, Graphics; type TSplashForm = TForm; TSplash = class private FImage: TPNGImage; SplashForm: TSplashForm; procedure SetImage(value: TPNGImage); procedure ToLayeredWindow; public constructor Create; overload; constructor Create(Image: TPNGImage); overload; destructor Destroy; procedure Show(StayOnTop: Boolean); procedure Close; property Image: TPNGImage read FImage write SetImage; end; implementation procedure CreatePremultipliedBitmap(DstBitMap: TBitmap; SrcPngImage: TPNGImage); type TRGBTripleArray = ARRAY[Word] of TRGBTriple; pRGBTripleArray = ^TRGBTripleArray; TRGBAArray = array[Word] of TRGBQuad; PRGBAArray = ^TRGBAArray; var x, y: Integer; TripleAlpha: Double; pColor: pRGBTripleArray; pAlpha: pbytearray; pBmp: pRGBAArray; begin DstBitMap.Height := SrcPngImage.Height; DstBitMap.Width := SrcPngImage.Width; DstBitMap.PixelFormat := pf32bit; for y := 0 to SrcPngImage.Height - 1 do begin pAlpha := SrcPngImage.AlphaScanline[y]; pColor := SrcPngImage.Scanline[y]; pBmp := DstBitMap.ScanLine[y]; for x := 0 to SrcPngImage.Width - 1 do begin pBmp[x].rgbReserved := pAlpha[x]; //     TripleAlpha := pBmp[x].rgbReserved / 255; pBmp[x].rgbBlue := byte(trunc(pColor[x].rgbtBlue * TripleAlpha)); pBmp[x].rgbGreen := byte(trunc(pColor[x].rgbtGreen * TripleAlpha)); pBmp[x].rgbRed := byte(trunc(pColor[x].rgbtRed * TripleAlpha)); end; end; end; constructor TSplash.Create; begin SplashForm := TSplashForm.Create(nil); FImage := TPNGImage.Create; end; constructor TSplash.Create(Image: TPNGImage); begin SplashForm := TSplashForm.Create(nil); FImage := TPNGImage.Create; FImage.Assign(Image); end; destructor TSplash.Destroy; begin SplashForm.Free; FImage.Free end; procedure TSplash.SetImage(value: TPNGImage); begin FImage.Assign(value); end; procedure TSplash.ToLayeredWindow; var BitMap: TBitMap; bf: TBlendFunction; BitmapSize: TSize; BitmapPos: TPoint; begin //    (32   , precalc  ) BitMap := TBitMap.Create; CreatePremultipliedBitmap(Bitmap,FImage); //  BlendFunction with bf do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; AlphaFormat := AC_SRC_ALPHA; SourceConstantAlpha := 255; end; //   BitMap BitmapSize.cx := Bitmap.Width; BitmapSize.cy := Bitmap.Height; //   BitMap BitmapPos.X := 0; BitmapPos.Y := 0; //    SetWindowLong(SplashForm.Handle, GWL_EXSTYLE, GetWindowLong(SplashForm.Handle, GWL_EXSTYLE) + WS_EX_LAYERED); //      UpdateLayeredWindow( SplashForm.Handle, 0, nil,//pos @BitmapSize,//size bitmap.Canvas.Handle,//src @BitmapPos,//pptsrc 0, @bf, ULW_ALPHA ); BitMap.Free; end; procedure TSplash.Show(StayOnTop: Boolean); begin //    with SplashForm do begin BorderStyle := bsNone; Width := FImage.Width; Height := FImage.Height; Position := poDesktopCenter; if StayOnTop then formstyle := fsStayOnTop; end; //   ""  ToLayeredWindow; //  SplashForm.Show; end; procedure TSplash.Close; begin SplashForm.Close; end; end.



The module is designed for Delphi XE and above.
Download the module and an example of use here:
TSplash.zip
I hope this module will make your applications more attractive to the user.

UPD: Now when you call Show (StayOnTop: Boolean), you need to specify whether SplashScreen over all windows or not.

Source: https://habr.com/ru/post/146101/

More articles:


All Articles