Создаем Splash Screen на Delphi

image
Если при загрузке программы, показывается Splash Screen (это небольшое окно с картинкой), то к таким программам пользователи относятся лучше, чем программам, при запуске которых несколько секунд ничего не происходит.
В интернете есть много примеров изготовления Splash Screen-а в Delphi, однако обычно это квадратная форма с натянутой на ней картинкой.
Но у многих программ это не квадратная форма, а красивое окно со сглаженными краями.
Я пытался сделать такое окно с помощью регионов, но края были неровные и смотрелись неказисто.
Выходом стали «Слоистые окна» (LayeredWindow).

Был создан класс TSplash:
Create(Image:TPNGImage) создает экземпляр класса и загружает картинку,
Show показывает Splash, Close скрывает.

Процедура, преобразующая обычное окно в 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 в 32-х разрядный TBitMap, нужный функции UpdateLayeredWindow:
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-ы.
Результат работы:
image

Полный код модуля:
{*******************************************************}
{               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 поверх всех окон или нет.
Share post

Similar posts

Comments 46

    +3
    Ну отлично! Запускаем программу и в ожидании старта втыкаем в этот splash-screen, который висит поверх всех окон. Со стороны программиста очень наивно думать, что его программа всегда будет стартовать за несколько секунд, и в это время юзер не захочет заняться чем-то еще.
      +1
      Для того чтобы окно не было поверх всех достаточно закомментировать 1 строчку:
      formstyle:=fsStayOnTop;
      0
      Вы описали, как сделать красивое окно с некваратными краями. А вот когда его вызывать и закрыть — в событии OnCreate главного окна или сразу после запуска, до создания Application забыли)
        0
        Извиняюсь, создавать надо в OnCreate главного окна и уничтожать после загрузки.
        В примере это показано.
          +4
          Я бы рекомендовал немного по-другому. Процесс загрузки приложения — сложная тема. Методом проб и ошибок я понял, что нужно делать так:

          1. Дизайните Splash Screen, делаете все, что считаете с ним нужным
          2. Весь процесс загрузки выводите в отдельный поток
          3. В OnCreate главной формы пишите:
          procedure TMainForm.FormCreate(Sender: TObject);
          var
            ApplicationLoadTread: TApplicationLoadTread;
          begin
            // exception
            Application.OnException:= ExceptionAction;
            SetErrorMode( SEM_FAILCRITICALERRORS );
          
            // splash init
            SplashForm:= TSplashForm.Create( Application );
            SplashForm.Show;
            SplashForm.Update;
          
            ApplicationLoading:= True;
            ApplicationLoadTread:= TApplicationLoadTread.Create;
            ApplicationLoadTread.FreeOnTerminate:= True;
            ApplicationLoadTread.OnTerminate:= MainForm.OnFormCreateFinished;
            ApplicationLoadTread.InfoLabel:= SplashForm.InfoLabel;
          
            ApplicationLoadTread.Start;
          
            // waiting 'till finished
            while ApplicationLoading do
              Application.HandleMessage;
          
          end;
          


          это запустит тред загрузки и выведет splash screen

          4. Когда тред загрузки отработает он вызывает Callback функицию, наподобии:
          procedure TMainForm.OnFormCreateFinished( Sender: TObject );
          Begin
            ApplicationLoading:= False;
          
            // slash destroy
            SplashForm.Hide;
            SplashForm.Free;
          End;
          
          


          Это всязано с особенностью обработки Windows зависших приложений. Если ваш spash не бует отвечать Windows на «пинги» он будет помечен, как зависший. Тред помогает избежать этого поведения.

          Главное правило при разработке GUI приложения — все действия прячьте в тред. Даже секундные. Так ваше приложение не будет «висеть» по мнению пользователя или ОС.
            0
            Спасибо!
            Буду использовать в будущем.
              +1
              Пожалуйста.

              Еще вам нужно правильно обрабатывать нестандартные ситуации, возникающие во время работы. В Delphi они всегда падают в стандартное окно Access Violation или подобное, что шокирует даже опытного пользователя. Если сделаете вот так, будет намного лучше:

              image
                0
                А еще лучше не изобретать велосипед и сделать хорошо и конечному пользователю и себе, как разработчику, с помощью madExcept'а (или EurekaLog'а), который бесплатен для некоммерческого использования и легко купить тем, кто хочет качественной обратной связи от своих клиентов.

                За счет дизайнера окна можно сформировать аналог вашему (оно, кстати, симпатично очень), а вот функциональность (особенно для поиска проблема) будет на высоте.
                  0
                  Спасибо, это окно отражает суть случившегося коротко и ясно. Долго думали над ним, но работа еще не закончена.

                  Про такие штуки не знал, надо попробовать. Может, правда качественные компоненты.
                    0
                    Это не совсем компоненты, это небольшая инфраструктура (стаб [немного кода и кусок, который автоматически патчится в уже собранный исполняемый файл] + немного (или много) отладочной информации на клиентсайде и опционально приложение для удобства работы с фидбэком).
              0
              С отдельным тредом нужно быть очень осторожным. Если этот тред будет создавать окна, этот же тред должен будет доставать сообщения из очереди и их диспетчеризировать. Возможно Delphi это как-то хендлит, не знаю, но если нет, то вы просто получите мёртвые окна, сообщения для которых не будут приходить в главный тред.
                0
                Да, в Delphi есть класс TThread и вызов Synchronize() который предназначен для этих целей.

                К томуже, какие окна может создавать тред загрузки приложения?
                  0
                  Мало ли какие. Если в приложении сотня окон разных используется, то имеет смысл их посоздавать пока сплеш скрин висит, чтобы они потом показывались быстрее. Так вот если их создавать в другом треде, нужно учитывать эти вещи. Поэтому можно сплешскрин запускать в отдельном треде, а инициализировать приложение в главном, не забывая обрабатывать сообщения из очереди.
                    0
                    Но создание окон занимает моменты, зачем из создавать заранее? К тому же, в Windows Vista/7 показ уже созданного окна выглядит некрасиво — оно резко появляется.

                    У вас есть какие-то тяжеловесные операции в OnCreate окон, которые требуют много времени и не зависят от текущей ситуации в приложении? Как это так?

                    Эти окна в Delphi всего лишь классы, на хуйдой конец, им не нужен Synchronize. Или я не догоняю?
                      0
                      Ну при создании окна могут создаваться какие-то сопутствующие вещи, поэтому не всегда оно занимает моменты. Ну и в любом случае, раз уж мы показываем сплеш и инициализируемся, почему бы не сделать предварительно работы по максимуму? И я не говорю, что так нужно делать всегда, просто предупредил, что если кто-то создаст окно в другом треде, то могут быть нюансы.

                      По поводу Delphi и Synchronize ничего не скажу, я на Delphi не пишу, а про создание окон написал из понимания того, как работают окна в Windows.
                        0
                        Так вещи засуньте в классы, которые и создавайте при загрузке. Потом просто укажите классу окна, что вот, такойто вот объект создан, пользовать его. Проблема эта без примера сложно решается)

                        Да, могут, конечно. И будут баги, это факт. Нужен Synchronize.
                0
                На мой взгляд, вызов Splash'а в контексте создания главной формы приложения — есть «странность» в архитектуре приложения. Было бы разумно начать его показ еще в контексте main'а, а уже потом создавать формы и т.д. Относительно вынесения нагрузки в поток — согласен.
                  0
                  Честно — у меня не получилось с первого раза начать показ splash в main (до создания объекта Application), а закрыть его после окончания работы треда загрузки. Если поковыряете и получится что-то — выложите, это, безусловное, более правильное решение.
                    0
                    Уточните, в чем была проблема?
            –13
            Я вам рекомендую www.microsoft.com/visualstudio/11/ru-ru
              +5
              Простите, а как это всязано с темой топика?
                +7
                Почему все пытаются похоронить Delphi?
                  +10
                  По нашим культурным православным традициям так полагается — хоронить то, что умерло.
                    +1
                    Коллега, скажите, вы писали на Delphi серьезно? Что-то, что выходит за рамки одной формы и перетаскивания кнопочек мышкой на форму?
                      0
                      Лет 7 назад я писал на дельфях клиент-серверное приложение для автоматизации работы типографии. Отдельно запомнилась работа с СУБД и работа с сетью.

                      Попытки написать что-то более-менее приличное на стандартных VCL сетевых компонентах и последующее переписывание на нормальных виндовых событийных апи-сокетах. :)

                      Изначально я лишь посоветовал VS и не слово не говорил про смерть. ;) Заметили? )))
                        0
                        За столько времени многое изменилось. Если есть возможность сделать не на API, а на обертках, это выбор, который некоторым пригодится. Я тоже пользуюсь в Delphi WinAPI иногда, когда этого требует ситуация.

                        Но дальше сказали же про смерть, очевидно, смертью и не пахнет.
                          –3
                          Есть простая метрика, которая подойдет для этого случая. Дельфя — общетематичный язык, без какой-либо узкой специализации. Сравним его с другими распространенными языками.

                          Проведем исследование ввиде викторины.

                          Заходим на spb.hh.ru

                          Запрос — результат
                          javascript — 370
                          java — 332
                          c++ — 366

                          xxx — 31

                          А теперь вопрос залу. Какой мертвый язык скрыт под аббревиатурой xxx? :)))
                            +1
                            Я могу писать на Delphi драйверы, приложения Windows 32/64, CMS (да да, движок сайта).

                            Общетематичный? Вопрос лишь во владении предметом.
                              –1
                              Вот и я о том же. В теории он может все, а развивается по факту лишь при продаже очередным наивным. )
                                +1
                                Это не теория, это возможно, инфа 100% :)

                                Раньше были проблемы, да. После выхода 64битного компилятора я уже с трудом могу сказать, чего же мне не хватает…

                                Вы не думайте, что я только Delphi и знаю. Ровно также, или больше, я знаю C/C++. Разницы, если присмотреться, почти нет. Только Си синтаксис мне напоминает шаманство со своими << | & и прочими, по этому предпочитаю писать and or xor. Личное дело каждого, если конечный продкут идентичен.
                                  0
                                  Я может быть не уловил суть разговора. Вы сравниваете прикладной язык с низкоуровневым?

                                  В таком случае предлагаю добавить к сравнению ассемблер и php.
                                    +1
                                    Теперь я не понимаю. Си — низкоуровневый, Делфи — прикладной? Не соглашусь.

                                    PHP — песня. Не знаю, как кто к нему относится, но сама его суть от меня ускользает. Сделайте ISAPI Extension для IIS или Apache — будет работать быстрее, возможности отладки шире. Если нет разницы, зачем изобретать новый язык?

                                    Асм — бог языков. Но очень уж сложен для программиста. Слишком долго писать, чтобы просто вывести окно на экран…
                                      –3
                                      Вы полностью правы, хотя суждения местами неверные.
                                        +1
                                        Напишите, хотя бы в личку или скайп, чтобы флуд не разводить, что вы об этом думаете. Конструктивная критика всегда хороша.

                                        Я вот так считаю, может, я где-то упускаю что-то.
                                          +1
                                          спасибо, ребят! теперь я узнал максимальную вложенность комментариев ) после 13 все идут в столбик!
                    +1
                    Потому что «на нем программируют мышкой». Самый распространенный миф из-за малого порога вхождения. Никто не задумывается, что Delphi ничем не уступает другим средствам разработки «в глубине», потому что не знает.
                  0
                  Тоже занимался таким делом, правда в Delphi7
                  Если кому вдруг интересно — посмотреть тут: clck.ru/d/1cYIyA8i1Ck0o

                  Пример создания такой красоты в динамике. Предупреждаю — нужна видеокарта с аппаратной поддержкой FBO. Исходники можно посмотреть здесь: sites.google.com/site/boxdemi/
                    0
                    Красиво, но ресурсов жрет…
                      0
                      Делал для красоты, многовато частиц просто, да и на оптимизацию времени не было.

                      p.s. забыл сказать: для завершения красоты — подведите курсор в верхний левый угол.
                        0
                        Уточнение пришло вовремя)
                    0
                    Меня всегда раздражают эти сплэш скрины, кто их вообще придумал?
                      +3
                      Есть приложения, которые стартуют долго. Не 3-5 секунд, а полминуты, например. Правильный сплешскрин кроме показывания красивой картинки ещё показывает прогресс запуска.
                        0
                        Кроме показывания процесса запуска он еще закрывает все окна, как будто если уж я запустил такого монстра, так мне интересно смотреть на его запуск.
                          +1
                          Ну правильно, вместо того, чтобы дизейблить все контролы в приложении, а по окончанию запуска енейблить их назад, проще показать модальный сплешскрин. Всё равно вы до окончания запуска приложения ничего с ним делать не можете, а так хоть на сплеше видно, что происходит и долго ли осталось до окончания инициализации.
                            0
                            До окончания запуска приложения я обычно ни с каким другим приложением делать ничего не могу ибо оно закрывает собой все.
                              +6
                              Так это просто неправильное, плохое приложение. Сплешскрин не должен быть topmost окном, он просто должен быть application modal, этого достаточно.

                    Only users with full accounts can post comments. Log in, please.