プログラムの読み込み時にスプラッシュスクリーンが表示される場合（これは画像のある小さなウィンドウです）、ユーザーは数秒間実行されるプログラムよりもこのようなプログラムを好む傾向があり、何も起こりません。
インターネットでは、Delphiでスプラッシュスクリーンを作成する多くの例がありますが、通常は正方形の形状に絵が描かれています。
しかし、多くのプログラムでは、これは正方形ではなく、滑らかなエッジを持つ美しいウィンドウです。
領域の助けを借りてそのようなウィンドウを作成しようとしましたが、エッジが不均一でandいように見えました。
出力は「Layered Windows」（LayeredWindow）でした。
TSplashクラスが作成されました：
Create（画像：TPNGImage）は、クラスのインスタンスを作成し、画像を読み込みます。
ショーは、スプラッシュ、クローズ非表示を示しています。
通常のウィンドウを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;
CreatePremultipliedBitmapプロシージャは、TPNGImageをUpdateLayeredWindow関数で必要な32ビットTBitMapに変換します。
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;
TPNGImageクラスのインスタンスが画像として使用されるため、半透明のスプラッシュスクリーンを作成できます。
仕事の結果：
完全なモジュールコード：
{*******************************************************} { 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.
このモジュールは、Delphi XE以降向けに設計されています。
モジュールと使用例をこちらからダウンロードしてください。
TSplash.zip
このモジュールがあなたのアプリケーションをユーザーにとってより魅力的にすることを願っています。
UPD： Show（StayOnTop：Boolean）を呼び出すとき、SplashScreenをすべてのウィンドウの上で行うかどうかを指示する必要があります。