Como fazer um slideshow em AdvPL

Hoje trago para vocês como criar um “Slideshow de imagens” em AdvPL.

Me perguntaram uma vez se era possível fazer com o AdvPL puro (sem utilizar javascript ou outras integrações), e sim é possível.

Para fazer isso, temos que ter uma pasta com a lista de imagens, e a partir disso, ao iniciar a nossa função, percorremos todos os arquivos do tipo imagem da pasta e armazenamos em um Array (no caso você pode também armazenar em uma tabela temporária).

A partir disso, teremos uma dialog com a foto, e dois botões de controle, ao clicar para direita, incrementamos uma posição do array, e ao clicar para esquerda, decrementamos uma posição.

Caso passe dos limites do array, nós zeramos as posições. Abaixo um print da tela desenvolvida:

Exemplo da tela com slider de imagens

E abaixo o código fonte desenvolvido:

//Bibliotecas
#Include "Totvs.ch"

/*/{Protheus.doc} User Function zSlider
Exemplo de Slideshow em AdvPL
@type  Function
@author Atilio
@since  21/06/2020
@version version
@param cDirFile, Character, Diretorio com arquivos que serao carregados
@example u_zSlider("C:\Users\daniel.atilio\Desktop\imagens")
/*/

User Function zSlider(cDirFiles)
    Local aArea := GetArea()
    //Fontes
    Local cFontUti    := "Tahoma"
    Local oFontAno    := TFont():New(cFontUti,,-38)
    Local oFontSub    := TFont():New(cFontUti,,-20)
    Local oFontSubN   := TFont():New(cFontUti,,-20,,.T.)
    Local oFontBtn    := TFont():New(cFontUti,,-14)
    Default cDirFiles := ""
    Private cDirect   := Alltrim(cDirFiles)
    Private aImgs     := {}
    Private nImgAtu   := 0
    //Janela e componentes
    Private oDlgCom
    Private oGetImg
    Private cGetImg := ""
    Private oBmpFoto
    //Tamanho da janela
	Private	nJanLarg := 800
	Private	nJanAltu := 600

    //Somente se tiver imagens a exibir
    If ! Empty(cDirect) .And. ExistDir(cDirect)
        //Tratativa para adicionar uma barra no final
        If SubStr(cDirect, Len(cDirect), 1) != '\'
            cDirect += "\"
        EndIf

        //Carregando as imagens
        FWMsgRun(, {|oSay| fBuscaImg(oSay) }, "Processando", "Buscando imagens da pasta")

        //Se tiver imagens
        If Len(aImgs) > 0
            nImgAtu := 1
            cGetImg := cDirect + aImgs[nImgAtu]

            //Criando a janela
            DEFINE MSDIALOG oDlgCom TITLE "Slideshow" FROM 000, 000  TO nJanAltu, nJanLarg COLORS 0, 16777215 PIXEL
                //Labels gerais
                @ 004, 003 SAY "TI"                                             SIZE 200, 030 FONT oFontAno  OF oDlgCom COLORS RGB(149,179,215) PIXEL
                @ 004, 040 SAY "Exemplo de Slideshow"                           SIZE 200, 030 FONT oFontSub  OF oDlgCom COLORS RGB(031,073,125) PIXEL
                @ 014, 040 SAY cValToChar(Len(aImgs)) + " imagens encontradas"  SIZE 200, 030 FONT oFontSubN OF oDlgCom COLORS RGB(031,073,125) PIXEL

                //Botão de Sair
                @ 006, (nJanLarg/2-001)-(0052*01) BUTTON oBtnSai    PROMPT "Sair"             SIZE 050, 018 OF oDlgCom ACTION (oDlgCom:End())                                 FONT oFontBtn PIXEL

                //Botões de navegação
                @ (nJanAltu/4), 003                     BUTTON oBtnEsq    PROMPT "<-"       SIZE 030, 018 OF oDlgCom ACTION (fChangeImg(-1))                                FONT oFontBtn PIXEL
                @ (nJanAltu/4), (nJanLarg/2-003)-(0030) BUTTON oBtnDir    PROMPT "->"       SIZE 030, 018 OF oDlgCom ACTION (fChangeImg(1))                                 FONT oFontBtn PIXEL

                //Get com a informação da imagem atual
                @ (nJanAltu/2) - 16, 003  MSGET oGetImg VAR cGetImg SIZE (nJanLarg/2)-3, 013 OF oDlgForm COLORS 0, 16777215 READONLY PIXEL

                //Imagem atual
                @ 027, 024 BITMAP oBmpFoto                    SIZE (nJanLarg/2)-42, (nJanAltu/2)-48 OF oDlgForm ADJUST              PIXEL
                oBmpFoto:Load(, cGetImg)
				oBmpFoto:Refresh()
            ACTIVATE MsDialog oDlgCom CENTERED
        Else
            MsgStop("Não foi encontrado imagens nesse diretório!", "Atenção")
        EndIf
    Else
        MsgStop("Diretório não existe ou inválido!", "Atenção")
    EndIf

    RestArea(aArea)
Return

Static Function fBuscaImg(oSay)
    Local aExtensoes := {"jpg", "png", "bmp"}
    Local nExtAtu
    Local aFiles
    Local cCamFull
    Local nFileAtu

    //Percorrendo as extensoes
    For nExtAtu := 1 To Len(aExtensoes)
        oSay:SetText("Analisando extensão - " + aExtensoes[nExtAtu])

        //Definindo o diretorio full e colocando tudo no array de arquivos
        cCamFull := cDirect + "*." + aExtensoes[nExtAtu]
        aFiles := {}
        aDir(cCamFull, aFiles)
        
        //Percorrendo todos os arquivos e adicionando no nosso array de imagens
        For nFileAtu := 1 To Len(aFiles)
            oSay:SetText("Analisando extensão - " + aExtensoes[nExtAtu] + ", arquivo " + cValToChar(nFileAtu) + " de " + cValToChar(Len(aFiles)))
            aAdd(aImgs, aFiles[nFileAtu])
        Next
    Next
Return

Static Function fChangeImg(nNewPos)
    //Decrementa uma imagem
    If nNewPos == -1
        nImgAtu--

    //Incrementa uma imagem
    ElseIf nNewPos == 1
        nImgAtu++
    EndIf

    //Se a imagem atual passou da ultima, vai para a primeira
    If nImgAtu > Len(aImgs)
        nImgAtu := 1

    //Se for menor ou igual a zero, vai para a última
    ElseIf nImgAtu <= 0
        nImgAtu := Len(aImgs)
    EndIf

    //Atualiza o get
    cGetImg := cDirect + aImgs[nImgAtu]
    oGetImg:Refresh()

    //Atualiza a imagem
    oBmpFoto:Load(, cGetImg)
	oBmpFoto:Refresh()
Return

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

Deixe uma resposta