quinta-feira, 8 de janeiro de 2009

Animando uma GS automaticamente

Uma das dificuldades de quem utiliza programas Cobol com uma tela desenhada pelo Dialog System é que no momento de um "animate", as chamadas ao Dialog não podem ser animadas automaticamente. Uma dica para resolver essa questão é mudar a constante padrão da chamada do Dialog System:

78 dialog-system VALUE "DSGRUN".  *> essa é a definição padrão

Mude a linha acima para:

78 dialog-system VALUE "DS".

Tão logo seja feita uma chamada para o Dialog System, o IDE entrará no modo "animate" dentro da GS chamada, automaticamente.


segunda-feira, 17 de novembro de 2008

Que dia é hoje ?

Hoje é dia de conhecer o ACMonthCalendar, o calendário padrão do Windows para ser utilizado diretamente na tela de sua aplicação. O calendário padrão do Windows não vem no pacote oferecido pela Microfocus, se o desenvolvedor deseja utilizá-lo tem que recorrer ao componente DatePicker, que não é um dos mais amigáveis que existe.

O demo da aplicação está disponível no site do Clube Cobol.


Continue colaborando com o NetAlexpress. Com apenas R$ 49,00 (quarenta e nove reais) você recebe os fontes dessa aplicação e ajuda com as pesquisas do blog.


segunda-feira, 22 de setembro de 2008

Listview: de 20 a 40 por cento mais rápido !

Uma das dificuldades que os desenvolvedores sentem ao utilizar o Listview é a demora que existe incluindo uma quantidade razoável de dados em sua estrutura. Utilizando dois métodos simples, o desenvolvedor pode ganhar até 40 por cento do tempo gasto com esse procedimento, tornando assim o Listview mais rápido.

Quando estamos alimentando um Listview com dados, o Windows se encarrega de mostrar visualmente esse procedimento. As linhas e colunas do Listview vão sendo atualizadas, a barra de rolagem é redesenhada proporcionalmente à quantidade de ítens, entre outras coisas. O método "stopRedrawing" indica ao componente que nenhuma atualização visual deve ser feita enquanto os dados forem incluídos. O método "startRedrawing" retorna o componente à sua condição normal.

Localize em seu programa o ponto exatamente anterior à inclusão dos seus dados no Listview e então acrescente a linha abaixo:

invoke umListview "stopRedrawing"

Ao terminar a inclusão de dados em seu Listview, precisamos dizer a ele pra voltar a sua condição normal. Para isso, acrescente a linha abaixo:

invoke umListview "startRedrawing"

Você vai notar que a inclusão dos dados em seu componente será de 20 a 40 por cento mais rápida.

Observação: o fato do Listview não ser atualizado visualmente na inclusão dos dados, pode dar a impressão ao usuário de que o micro está travado, pois nada é mostrado no Listview indicando que ele está sendo "alimentado". Portanto, é interessante que alguma mensagem seja colocada ao usuário comentando sobre essa atualização.


quarta-feira, 17 de setembro de 2008

HA HA.. HU HU ! O treeview é nosso !

Para os desenvolvedores que um dia desejaram ter um Treeview em suas aplicações, esse artigo mostra que a utilização desse componente padrão do Windows não é assim uma tarefa das mais díficeis. Aproveite para colaborar como NetAlexpress adquirindo a classe ACTreeview e coloque um pouco mais de charme às suas aplicações.




Com um programa controlador único, você pode utilizar e controlar diversos componentes "treeview" em uma mesma janela. Além disso, você pode detectar alguns eventos como  um ítem selecionado, um ítem abrindo ou fechando, mudar os ícones, deixar um ítem em negrito, além de outros recursos interessantes.

Baixe agora a versão demo no site do Clube Cobol. Categoria 3 - Códigos fonte e exemplos.

Para adquirir a versão com os fontes, basta utilizar o PagSeguro, no menu da esquerda do blog, fazendo uma doação no valor de R$ 49,00 (quarenta e nove reais) para colaborar com o NetAlexpress. Caso prefira, também pode ser feito um depósito bancário. Para isso, escreva para alexandre@ciasoftonline.com.br solicitando os dados para o depósito.

Aguarde o próximo componente: o ACMonthCalendar, um calendário que você vai poder utilizar nas janelas das suas aplicações. Até lá !


quarta-feira, 20 de agosto de 2008

Uma toolbar ao seu alcance

Eu recebo muitos emails de desenvolvedores interessados em utilizar a Toolbar padrão do Windows em suas aplicações. Nesse artigo, mostro como utilizar diversas toolbars em uma mesma janela, com a utilização de um programa controlador único, e sem a necessidade de se vincular ítens de menu aos botões.



Longe da dificuldade dos exemplos do NetExpress, essa demonstração mostra de maneira muito fácil o uso desse componente e também tem o intuito de buscar colaboração entre os leitores desse blog para que eu continue estimulado a escrever os artigos que ajudam a tantos desenvolvedores espalhados por todo o Brasil.

Colabore com o NetAlexpress !!!
Nessa versão de demonstração disponível para download no site do clube cobol não estão inclusos os fontes completos do projeto. Para receber os fontes completos, colabore com o NetAlexpress com R$ 49,00 (quarenta e nove reais) através de depósito bancário. Para maiores informações, envie email para alexandre@ciasoftonline.com.br.

O custo é pequeno justamente para que os desenvolvedores possam colaborar com o blog e também poderem ter acesso aos componentes mais utilizados nas aplicações gráficas, como a Toolbar. Minha intenção é criar novas classes para utilização de novos componentes e disponibilizar aqui no blog. No meu próximo artigo, vou escrever sobre a Treeview.

......$set mfoo
.......program-id. TBDemo.
.......class-control.

........*> Abaixo são definidas as classes utilizadas nesse programa
...........ACTButton is class "actbutton"
...........ACMaskedImageList is class "acmaskedimagelist"
...........ACUtils is class "acutils"
............
.......DATA DIVISION.
.......WORKING-STORAGE SECTION.

.......*> Variáveis usadas nas listas de imagens
.......77 umaLista object reference value null.
.......77 umaListaBmp object reference value null.

.......*> Variáveis usadas para identificar os ícones utilizados
.......77 icoAbrir pic 9(09) comp-5 value zeros.
.......77 icoNovo pic 9(09) comp-5 value zeros.
.......77 icoAlterar pic 9(09) comp-5 value zeros.
.......77 icoExcluir pic 9(09) comp-5 value zeros.
.......77 icoVisualizar pic 9(09) comp-5 value zeros.
.......77 icoGravar pic 9(09) comp-5 value zeros.
.......77 icoCancelar pic 9(09) comp-5 value zeros.
.......77 icoSair pic 9(09) comp-5 value zeros.

.......*> Variáveis usadas para identificar os bitmaps utilizados
.......77 bmp1 pic 9(09) comp-5 value zeros.
.......77 bmp2 pic 9(09) comp-5 value zeros.
.......77 bmp3 pic 9(09) comp-5 value zeros.
.......77 bmp4 pic 9(09) comp-5 value zeros.
.......77 bmp5 pic 9(09) comp-5 value zeros.
.......77 bmp6 pic 9(09) comp-5 value zeros.
.......77 bmp7 pic 9(09) comp-5 value zeros.
.......77 bmp8 pic 9(09) comp-5 value zeros.

.......*> Os botões da toolbar não terão vínculo com um item de menu
.......*> por isso ele será passado sempre com nulo
.......77 umItemNulo object reference value null.

.......*> Variáveis usadas para identificar os botões das toolbars
.......77 umBotaoClicado object reference value null.
.......77 umBotaoAbrir object reference value null.
.......77 umBotaoNovo object reference value null.
.......77 umBotaoAlterar object reference value null.
.......77 umBotaoExcluir object reference value null.
.......77 umBotaoVisualizar object reference value null.
.......77 umSeparador object reference value null.
.......77 umBotao1 object reference value null.
.......77 umBotao2 object reference value null.
.......77 umBotao3 object reference value null.
.......77 umBotao4 object reference value null.
.......77 umBotao5 object reference value null.
.......77 umBotao6 object reference value null.
.......77 umBotao7 object reference value null.
.......77 umBotao8 object reference value null.
.......77 umBotaoGravar object reference value null.
.......77 umBotaoCancelar object reference value null.
.......77 umBotaoSair object reference value null.

.......77 icone pic 9(09) comp-5 value zeros.
.......77 w pic 9(09) comp-5 value zeros.
.......77 h pic 9(09) comp-5 value zeros.
.......77 l pic 9(09) comp-5 value zeros.

.......78 dialog-system VALUE "DSGRUN".
.......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 "TBDemo.CPB".
.......COPY "KEYS.CPY".
.......PROCEDURE DIVISION.
.......Main-Process SECTION.
...........PERFORM Program-Initialize
...........PERFORM Program-Body UNTIL funcao = "SAIR"
...........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-Push-Set TO Ds-Control
...........MOVE "TBDemo" TO Ds-Set-Name
............

......*---------------------------------------------------------------*
.......Program-Body SECTION.
...........evaluate FUNCAO
.............when "MONTAR" perform Montar
.............when "BOTAOCLICADO" perform BotaoClicado
...........end-evaluate
...........perform Call-Dialog-System
............

......*---------------------------------------------------------------*
.......Montar section.
........*> Esse é a primeira seção chamada, que cria as listas
........*> de imagens e as toolbars
...........perform MontarListaDeImagens
...........perform MontarToolbar
...........perform MontarToolbarGravar
...........perform MontarToolbarLateral
............

......*-------------------------------------------------------------*
.......MontarListaDeImagens section.
........*> Aqui é criada a primeira lista de imagens, com 16x16 pixeis
...........move 16 to w h
...........invoke ACMaskedImageList "Nova" using w h returning umaLista
...........invoke umaLista "adicionarIcone" using z"abrir16.ico"
..................returning icoAbrir
...........invoke umaLista "adicionarIcone" using z"novo16.ico"
..................returning icoNovo
...........invoke umaLista "adicionarIcone" using z"alter16.ico"
..................returning icoAlterar
...........invoke umaLista "adicionarIcone" using z"exclui16.ico"
..................returning icoExcluir
...........invoke umaLista "adicionarIcone" using z"lupa16.ico"
..................returning icoVisualizar
...........invoke umaLista "adicionarIcone" using z"gravar16.ico"
..................returning icoGravar
...........invoke umaLista "adicionarIcone" using z"cancel16.ico"
..................returning icoCancelar
...........invoke umaLista "adicionarIcone" using z"sair.ico"
..................returning icoSair

........*> Aqui é criada outra lista de imagens, com 128x128 pixeis
...........move 128 to w h
...........invoke ACMaskedImageList "Nova" using w h
..................returning umaListaBmp
...........invoke umaListaBmp "adicionarBitmap" using z"iphone1.bmp"
..................returning bmp1
...........invoke umaListaBmp "adicionarBitmap" using z"iphone2.bmp"
..................returning bmp2
...........invoke umaListaBmp "adicionarBitmap" using z"iphone3.bmp"
..................returning bmp3
...........invoke umaListaBmp "adicionarBitmap" using z"iphone4.bmp"
..................returning bmp4
...........invoke umaListaBmp "adicionarBitmap" using z"iphone5.bmp"
..................returning bmp5
...........invoke umaListaBmp "adicionarBitmap" using z"iphone6.bmp"
..................returning bmp6
...........invoke umaListaBmp "adicionarBitmap" using z"iphone7.bmp"
..................returning bmp7
...........invoke umaListaBmp "adicionarBitmap" using z"iphone8.bmp"
..................returning bmp8
............

......*---------------------------------------------------------------*
.......MontarToolbar section.
........*> Nessa seção, adicionamos cada um dos botões das toolbars
...........invoke umaToolbar "lista"
...........invoke umaToolbar "semDivisor"
...........invoke umaToolbar "flat"

...........invoke umaToolbar "setarListaDeImagens" using umaLista
...........invoke umaToolbar "setarListaDeImagensHot" using umaLista

...........invoke umaToolbar "adicionarBotao"
..................using umItemNulo icoNovo
..................returning umBotaoNovo
...........invoke umBotaoNovo "setarTexto"
..................using z" Novo"
...........invoke umBotaoNovo "setarTooltip"
..................using z"Botão Novo..."

...........invoke umaToolbar "adicionarSeparador"

...........invoke umaToolbar "adicionarBotao"
..................using umItemNulo icoAlterar
..................returning umBotaoAlterar
...........invoke umBotaoAlterar "setarTexto"
..................using z" Alterar"
...........invoke umBotaoAlterar "setarTooltip"
..................using z"Botão Alterar..."

...........invoke umaToolbar "adicionarBotao"
..................using umItemNulo icoExcluir
..................returning umBotaoExcluir
...........invoke umBotaoExcluir "setarTexto"
..................using z" Excluir"
...........invoke umBotaoExcluir "setarTooltip"
..................using z"Botão Excluir..."

...........invoke umaToolbar "adicionarBotao"
..................using umItemNulo icoVisualizar
..................returning umBotaoVisualizar
...........invoke umBotaoVisualizar "setarTexto"
..................using z" Visualizar"
...........invoke umBotaoVisualizar "setarTooltip"
..................using z"Botão Visualizar..."

...........
invoke umaToolbar "mostrar"
............

......*---------------------------------------------------------------*
.......MontarToolbarGravar section.
........*> Nessa seção, adicionamos cada um dos botões das toolbars
...........invoke umaToolbarGravar "lista"
...........invoke umaToolbarGravar "semDivisor"

...........invoke umaToolbarGravar "setarListaDeImagens"
..................using umaLista
...........invoke umaToolbarGravar "setarListaDeImagensHot"
..................using umaLista

...........invoke umaToolbarGravar "adicionarBotao"
..................using umItemNulo icoGravar
..................returning umBotaoGravar
...........invoke umBotaoGravar "setarTexto"
..................using z" Gravar"
...........invoke umBotaoGravar "setarTooltip"
..................using z"Botão Gravar..."

...........invoke umaToolbarGravar "adicionarBotao"
..................using umItemNulo icoCancelar
..................returning umBotaoCancelar
...........invoke umBotaoCancelar "setarTexto"
..................using z" Cancelar"
...........invoke umBotaoCancelar "setarTooltip"
..................using z"Botão Cancelar..."

...........invoke umaToolbarGravar "adicionarSeparador"
...........invoke umaToolbarGravar "adicionarBotao"
..................using umItemNulo icoSair
..................returning umBotaoSair
...........invoke umBotaoSair "setarTexto"
..................using z" Sair"
...........invoke umBotaoSair "setarTooltip"
..................using z"Botão Sair..."

...........invoke umaToolbarGravar "mostrar"
............

......*---------------------------------------------------------------*
.......MontarToolbarLateral section.
........*> Nessa seção, adicionamos cada um dos botões das toolbars
...........invoke umaToolbarLateral "semDivisor"
...........invoke umaToolbarLateral "multiplasLinhas"

...........invoke umaToolbarLateral "setarListaDeImagens"
..................using umaListaBmp
...........invoke umaToolbarGravar "setarListaDeImagensHot"
..................using umaListaBmp

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp1
..................returning umBotao1
...........invoke umBotao1 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp2
..................returning umBotao2
...........invoke umBotao2 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp3
..................returning umBotao3
...........invoke umBotao3 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp4
..................returning umBotao4
...........invoke umBotao4 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp5
..................returning umBotao5
...........invoke umBotao5 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp6
..................returning umBotao6
...........invoke umBotao6 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp7
..................returning umBotao7
...........invoke umBotao7 "BotaoCheckGroup"

...........invoke umaToolbarLateral "adicionarBotao"
..................using umItemNulo bmp8
..................returning umBotao8
...........invoke umBotao8 "BotaoCheckGroup"

...........invoke umaToolbarLateral "mostrar"
...........move 4 to l
...........invoke umaToolbarLateral "setarLinhas" using l
............

......*---------------------------------------------------------------*
.......BotaoClicado section.
........*> Quando um botão é clicado, ele é informado para a classe
........*> ACUtils que retorna através do método abaixo, o botão que
........*> foi clicado
...........invoke ACUtils "botaoDaToolbarClicado"
..................returning umBotaoClicado
...........evaluate umBotaoClicado
.............when umBotaoNovo display "Botão novo clicado..."
.............when umBotaoAlterar display "Botão alterar clicado..."
.............when umBotaoExcluir display "Botão excluir clicado..."
.............when umBotaoVisualizar display "Botão visualizar clicado..."

.............when umBotao1 display "Botão calendário clicado..."
.............when umBotao2 display "Botão som clicado..."
.............when umBotao3 display "Botão telefone clicado..."
.............when umBotao4 display "Botão música clicado..."
.............when umBotao5 display "Botão email clicado..."
.............when umBotao6 display "Botão texto clicado..."
.............when umBotao7 display "Botão configuração clicado..."
.............when umBotao8 display "Botão sms clicado..."

.............when umBotaoGravar display "Botão gravar clicado..."
.............when umBotaoCancelar display "Botão cancelar clicado..."
.............when umBotaoSair display "Botão sair clicado..."
...........end-evaluate
............

......*---------------------------------------------------------------*
.......Call-Dialog-System SECTION.
...........CALL dialog-system USING Ds-Control-lock,
....................................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
............

......*---------------------------------------------------------------*
.......Program-Terminate SECTION.
........*> Ao final, as listas de imagens devem ser finalizadas
...........invoke umaLista "deepFinalize" returning umaLista
...........invoke umaListaBmp "deepFinalize" returning umaListaBmp
...........stop run
............





Ao terminar de escrever esse artigo, eu comentava com um amigo sobre o assunto e ele me alertava sobre o fato de alguns mais "espertinhos" resolverem colaborar em grupo com o blog. Por exemplo, dividir simbólicos quarenta e nove reais entre quatro ou mais pessoas e depois os fontes serem distribuídos entre todos. Seria realmente lamentável se o fato ocorresse, até porque a colaboração que peço é apenas um incentivo às minhas pesquisas. Não penso em ficar rico escrevendo artigos para o NetAlexpress. O prazer em ver os amigos desenvolvedores evoluindo com a ferramenta é muito maior do que qualquer quantia em dinheiro. O NetAlexpress surgiu para ajudar a todos os desenvolvedores. E vai continuar da mesma forma. Aos "mais espertos", caso eles apareçam, apenas o meu lamento.

segunda-feira, 28 de julho de 2008

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.



sexta-feira, 25 de julho de 2008

Um toque de arte (parte 3)

Incrível como as telas que mostram as interfaces dos sistemas feitos nos mais diversos compiladores COBOL fizeram sucesso. É o post com maior número de acessos do ano no blog. Aproveitem para apreciar mais algumas interfaces enviadas pelos nossos amigos desenvolvedores.



NetCobol - Interface enviada por Paulo Viana, de Brumado - BA




NetExpress - Interface enviada por Alexandre Cortez, de Santos - SP