Criando uma Splash Screen

Splash Screen é o termo usado para descrever uma imagem que aparece enquanto um programa está sendo carregado. Normalmente elas não ocupam toda a área de trabalho, mas apenas um retângulo próximo do centro da tela. Esse artigo mostra como fazer uma Splash Screen utilizando áreas transparentes de tela.

O artigo trata da utilização da API "SetLayeredWindowAttributes", que faz com que determinadas áreas de uma janela fiquem transparentes. Nesse exemplo, determinei que a cor vermelha de uma imagem deve ficar transparente. A seguir, você encontra algumas imagens de exemplo e como elas ficam no desktop, depois de prontas.

program-id. Imagens.
class-control.
....CallBack is class "callback"
....BitmapData is class "bitmapd"
....Window is class "window"
....Color is class "color".

special-names.
....call-convention 66 is WAPI.

data division.
working-storage section.
77 aCallback object reference value null.
77 aWindow object reference value null.
77 aBitmap object reference value null.
77 aDrawingSurface object reference value null.

77 moved pic s9(09) comp-5 value 51.
77 resized pic s9(09) comp-5 value 52.
77 destroyed pic s9(09) comp-5 value 53.
77 gainedfocus pic s9(09) comp-5 value 56.

01 oldwinproc procedure-pointer.
01 ws-retcode pic s9(09) comp-5 redefines oldwinproc.

77 ws-good-ptr procedure-pointer.
77 ws-bad-ptr procedure-pointer.
77 ws-byte pic 9(02) comp-5.
77 ws-ex-style pic x(4) comp-5.
77 wsFlags pic 9(09) comp-5 value zeros.

77 wsColor object reference value null.
77 wsColorref pic s9(09) comp-5 value zeros.

77 wJanela pic 9(09) comp-5 value zeros.
77 hJanela pic 9(09) comp-5 value zeros.
77 x pic s9(09) comp-5 value zeros.
77 y pic s9(09) comp-5 value zeros.
77 w pic s9(09) comp-5 value zeros.
77 h pic s9(09) comp-5 value zeros.
77 wDesktop pic 9(09) comp-5 value zeros.
77 hDesktop pic 9(09) comp-5 value zeros.

78 WS-EX-LAYERED value h"00080000".
78 LWA-COLORKEY value h"00000001".
78 GWL-EXSTYLE value -20.

78 dialog-system VALUE "DSGRUN".
78 SM-CXSCREEN value 0.
78 SM-CYSCREEN value 1.

01 Display-Error.
...03 Display-Error-No PIC 9(4) comp-5.
...03 Display-Details-1 PIC 9(4) comp-5.
...03 Display-Details-2 PIC 9(4) comp-5.

copy "ds-cntrl.mf".
copy "imagens.cpb".

procedure division.
Main-Process SECTION.
...PERFORM Program-Initialize
...PERFORM Program-Body UNTIL EXIT-FLAG-TRUE
...PERFORM Program-Terminate.

Program-Initialize SECTION.
...INITIALIZE Ds-Control-Block
...INITIALIZE Data-block
...MOVE Data-block-version-no TO Ds-Data-Block-Version-No
...MOVE Version-no TO Ds-Version-No
...MOVE Ds-New-Set TO Ds-Control
...MOVE "Imagens" TO Ds-Set-Name.

Program-Body SECTION.
...PERFORM Call-Dialog-System

...*>-----------------------------------------------------------
...*> Aqui nós lemos uma imagem no formato bmp.

...invoke BitmapData "fromFileZ" using z"dinheiro.bmp"
.................................returning aBitmap



...*>-----------------------------------------------------------
...*> A janela é capturada como um objeto da classe Window e é
...*> redimensionada para o tamanho da imagem lida.

...invoke Window "fromHandle" using winhandle returning aWindow
...invoke aBitmap "getWidth" returning w
...invoke aBitmap "getheight" returning h
...invoke aWindow "scaleXYUp" using w h
...invoke aWindow "setWidthHeight" using w h



...*>-----------------------------------------------------------
...*> Aqui pegamos a resolução do computador.

...call wapi "GetSystemMetrics" using by value SM-CXSCREEN
............................returning wDesktop
...call wapi "GetSystemMetrics" using by value SM-CYSCREEN
............................returning hDesktop



...*>-----------------------------------------------------------
...*> Aqui nós centralizamos a janela.

...invoke aWindow "getNativeWidthHeight" using wJanela hJanela
...compute x = (wDesktop - wJanela) / 2
...compute y = (hDesktop - hJanela) / 2
...invoke aWindow "scaleXYUp" using x y
...invoke aWindow "setXY" using x y



...*>-----------------------------------------------------------
...*> Abaixo, pegamos a área da janela onde será mostrada a imagem
...*> e colocamos a imagem na linha 0 com a coluna 0.

...invoke aWindow "getdrawingsurface" returning aDrawingsurface
...move 0 to X Y
...invoke aDrawingsurface "DrawBitmapAt" using aBitmap X Y



...*>-----------------------------------------------------------
...*> As linhas seguintes adicionam o atributo padrão do Windows
...*> para aplicar áreas transparentes em janelas. A constante
...*> LWA-COLORKEY indica que apenas a área que possui a cor
...*> especificada ficará transparente. Em nosso exemplo, a cor
...*> vermelha ficará transparente.

...set ws-bad-ptr to entry "MF?637364Rubbish"
...set ws-good-ptr to entry "SetLayeredWindowAttributes"
...if ws-good-ptr = ws-bad-ptr
......exit program *> somente nas versões ME/2000/XP/2003 ou superior
...end-if
...call wapi "GetWindowLongA"
..............using by value winhandle
....................by value GWL-EXSTYLE
....................returning ws-ex-style
...add ws-ex-layered to ws-ex-style
...call wapi "SetWindowLongA"
.............using by value winhandle
...................by value GWL-EXSTYLE
...................by value ws-ex-style
...................returning ws-retcode
...move LWA-COLORKEY to wsFlags
...move 0 to ws-byte
...invoke Color "lightRed" returning wsColor
...invoke wsColor "asColorRef" returning wsColorref
...invoke wsColor "finalize" returning wsColor
...call wapi "SetLayeredWindowAttributes"
.............using by value winhandle
...................by value wsColorref
...................by value ws-byte
...................by value wsFlags
...................returning ws-retcode
...end-call



...*>-----------------------------------------------------------
...*> As linhas a seguir informam à janela que um método deve ser chamado,
...*> sempre que um determinado evento ocorrer. Em nosso exemplo, toda vez
...*> que a janela for movimentada, redimensionada ou ganhar o foco,
...*> a imagem será mostrada novamente.

...invoke Callback "new" using aDrawingsurface
...............................z"DrawBitmapAt"
...............................aBitmap
...............................x
...............................y
...............................returning aCallback
...invoke aWindow "setEvent" using moved aCallback
...invoke aWindow "setEvent" using resized aCallback
...invoke aWindow "setEvent" using gainedfocus aCallback
...invoke aCallback "finalize" returning aCallback
...perform Call-Dialog-System.

Program-Terminate SECTION.
...STOP RUN.

Call-Dialog-System SECTION.
...CALL dialog-system USING Ds-Control-Block,
...Data-Block
...IF NOT Ds-No-Error
......MOVE Ds-System-Error TO Display-error
......DISPLAY "DS ERROR NO: " Display-error-no
......DISPLAY "Error Details(1) : " Display-Details-1
......DISPLAY "Error Details(2) : " Display-Details-2
......PERFORM Program-Terminate
...END-IF.

Você pode fazer o download do fonte desse programa no site do Clube Cobol, com o título "Criando uma Splash Screen".

Observação: esse artigo não tem o objetivo de ensinar os métodos e comandos utilizados. Por isso, alguns dos comandos apresentados não foram detalhadamente explicados.