Create a Splash Screen on Delphi

image
If when loading a program, Splash Screen is displayed (this is a small window with a picture), then users are more likely to like such programs than programs that run for a few seconds and nothing happens.
On the Internet there are many examples of making Splash Screen 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 the regions, but the edges were uneven and looked ugly.
The output was “Layered Windows” (LayeredWindow).

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

A procedure that converts a regular window to a LayeredWindow:
procedureTSplash.ToLayeredWindow;var
  BitMap: TBitMap;
  bf: TBlendFunction;
  BitmapSize: TSize;
  BitmapPos: TPoint;
begin// создание правильной битовой карты(32 бит на пиксель, precalc альфа канал)
  BitMap := TBitMap.Create;
  CreatePremultipliedBitmap(Bitmap,FImage);
  // описание BlendFunctionwith bf dobegin
    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,//pptsrc0,
    @bf,
    ULW_ALPHA
  );
  BitMap.Free;
end;


the CreatePremultipliedBitmap procedure converts TPNGImage to the 32-bit TBitMap needed by the UpdateLayeredWindow function:
procedureCreatePremultipliedBitmap(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 := 0to SrcPngImage.Height - 1dobegin
    pAlpha := SrcPngImage.AlphaScanline[y];
    pColor := SrcPngImage.Scanline[y];
    pBmp := DstBitMap.ScanLine[y];
    for x := 0to SrcPngImage.Width - 1dobegin
        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;


An instance of the TPNGImage class is used as the image, which allows you to create translucent Splash Screen-s.
The result of work:
image

Full module code:
{*******************************************************}{               Splash Screen Library   v1.01           }{                                                       }{          Copyright(c) 2006-2012 ErrorSoft             }{                                                       }{    Данная библиотека предназначена для отображения    }{     красивых (прозрачных) SplashScreen-ов в ваших     }{                       программах                      }{                                                       }{  вопросы, отсчеты об ошибках, предложения сюда:       }{                 Enter256@yandex.ru                    }{                                                       }{*******************************************************}unit SplashScreen;
interfaceuses Windows, PNGImage, Forms, Graphics;
type
  TSplashForm = TForm;
  TSplash = classprivate
    FImage: TPNGImage;
    SplashForm: TSplashForm;
    procedureSetImage(value: TPNGImage);procedureToLayeredWindow;publicconstructorCreate;overload;
    constructorCreate(Image: TPNGImage);overload;
    destructorDestroy;procedureShow(StayOnTop: Boolean);procedureClose;property Image: TPNGImage read FImage write SetImage;
  end;
implementationprocedureCreatePremultipliedBitmap(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 := 0to SrcPngImage.Height - 1dobegin
    pAlpha := SrcPngImage.AlphaScanline[y];
    pColor := SrcPngImage.Scanline[y];
    pBmp := DstBitMap.ScanLine[y];
    for x := 0to SrcPngImage.Width - 1dobegin
        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;
constructorTSplash.Create;begin
  SplashForm := TSplashForm.Create(nil);
  FImage := TPNGImage.Create;
end;
constructorTSplash.Create(Image: TPNGImage);begin
  SplashForm := TSplashForm.Create(nil);
  FImage := TPNGImage.Create;
  FImage.Assign(Image);
end;
destructorTSplash.Destroy;begin
  SplashForm.Free;
  FImage.Free
end;
procedureTSplash.SetImage(value: TPNGImage);begin
  FImage.Assign(value);
end;
procedureTSplash.ToLayeredWindow;var
  BitMap: TBitMap;
  bf: TBlendFunction;
  BitmapSize: TSize;
  BitmapPos: TPoint;
begin// создание правильной битовой карты(32 бит на пиксель, precalc альфа канал)
  BitMap := TBitMap.Create;
  CreatePremultipliedBitmap(Bitmap,FImage);
  // описание BlendFunctionwith bf dobegin
    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,//pptsrc0,
    @bf,
    ULW_ALPHA
  );
  BitMap.Free;
end;
procedureTSplash.Show(StayOnTop: Boolean);begin// устанавливаем нужные параметрыwith SplashForm dobegin
    BorderStyle := bsNone;
    Width := FImage.Width;
    Height := FImage.Height;
    Position := poDesktopCenter;
    if StayOnTop then formstyle := fsStayOnTop;
  end;
  // преобразуем в "слоистое" окно
  ToLayeredWindow;
  // показываем
  SplashForm.Show;
end;
procedureTSplash.Close;begin
  SplashForm.Close;
end;
end.



The module is designed for Delphi XE and higher.
You can download the module and usage example here:
TSplash.zip
I hope this module will make your applications more attractive to the user.

UPD: Now when calling Show (StayOnTop: Boolean), you need to tell SplashScreen to be done on top of all windows or not.
Tags:

Also popular now: