RibaSoft

Pascal

Instalação ACBr - Atualizado (15/03/2024) POO Configuração do componente ACBrNFe Suspender Evento Temporariamente BufDataSet Traduzir botões Acesso MariaDB com MySQL56Connection Acesso MariaDB com ZConnection e ZQuery da paleta Zeos Acces Limpar Vários Campos ao Mesmo Tempo Colocar imagem da Internet e por no Timage com TFPHTTPClient Consumo API JSON POST com FormPost do TFPHTTPClient Colorir DBGrid Pagar várias parcelas com juros proporcional Carregar Imagem do Banco de Dados Loopings Form Transparente Solução do Cubo Mágico 3X3 Configurações - Atualizado (03/03/2024) Problemas com acentuação Fortes Report Zebrado Fortes Report Formatar Valores

Instalação ACBr

Apps

Torsoise SVN ACBr Trunk 2 Fortes Report CE Firebird 3.0

DLLs

.\DLLs\OpenSSL\1.1.1.10\x86\libcrypto-1_1.dll

.\DLLs\OpenSSL\1.1.1.10\x86\libssl-1_1.dll

.\DLLs\LibXml2\x86\libexslt.dll

.\DLLs\LibXml2\x86\libiconv.dll

.\DLLs\LibXml2\x86\libxml2.dll

.\DLLs\LibXml2\x86\libxslt.dll

Dll de terceiros

..\libmysql.dll - para conexão com sites

Configurações

..\ACBr_Fonts\Fontes\ACBrComum\ACBr.inc

Descomentar:


  {$DEFINE DFE_SEM_XMLSEC}
  {$DEFINE DFE_SEM_CAPICOM}
  {$DEFINE DFE_SEM_MSXML}
  {$DEFINE DFE_SEM_INDY}
  {$DEFINE USE_DELAYED}

Sequência dos Pacotes

.\fortesreport-ce-master\Packages\frce.lpk

.\ACBr\Pacotes\Lazarus\synapse\laz_synapse.lpk

.\ACBr\Pacotes\Lazarus\ACBrComum\ACBrComum.lpk

.\ACBr\Pacotes\Lazarus\ACBrDiversos\ACBrDiversos.lpk

.\ACBr\Pacotes\Lazarus\PCNComum\PCNComum.lpk

.\ACBr\Pacotes\Lazarus\ACBrOpenSSL\ACBrOpenSSL.lpk

.\ACBr\Pacotes\Lazarus\ACBrIntegrador\ACBr_Integrador.lpk

.\ACBr\Pacotes\Lazarus\ACBrTCP\ACBrTCP.lpk

.\ACBr\Pacotes\Lazarus\ACBrSerial\ACBrSerial.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrDFeComum.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrDFeReportRL.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrCTe\ACBr_CTe.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrCTe\DACTE\
Fortes\ACBr_CTe_DACTeRL.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrMDFe\ACBr_MDFe.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrMDFe\DAMDFE\
Fortes\ACBr_MDFe_DAMDFeRL.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrNFe\ACBr_NFe.lpk

.\ACBr\Pacotes\Lazarus\ACBrDFe\ACBrNFe\DANFE\NFe\
Fortes\ACBr_NFe_DanfeRL.lpk

POO

Termos

Abstração: E uma caracteristica da POO que permite passar objetos reais do mundo real para linguagem de programacao.

Polimorfismo: E a capacidade de criar varios metodos com o mesmo nome mas com parametros diferentes;

Encapsulamento: separar o codigo em blocos de codigo.

Métodos

overload; => permitem mesmos metodos com o mesmo nome diferenciando apenas os parametros.

virtual; => permite (sem ser obrigatorio) que a classe herdeira reescreva um metodo criado na classe pai utilizando o override;

override; => usado para adicionar código em um metodo virtual da classe pai na classe filha utilizando o inherited.

virtual; abstract; => pode ser implemantado na classe herdeira com o override, mas nao precisar ser implementado na classe pai.

reintroduce; => utilizado para tirar o warning que avisa que o metodo ja existe na classe pai, dizendo que ele sera reecrito na classe filha ignorando por completo tudo que estiver nesse metodo na classe pai.

class function => cria uma funcao sem a necessidde de instaciar a classe em que ela esta. Obs. Adicionar "static" ao final.

inherited "Metodo"; executa o metodo da classe pai. (o nome do metodo é opcional quando se está dentro do metodo herdado na classe filha)

construtores => utilizado para inicializar variaveis, objetos, etc na criacao da classe(objeto) = constructor Create;

destrutores => e aconselhavel usar o inherited ao final para destrur tudo das clases antecessoras = destructor Destroy;

Visibilidade

strict private => visivel apenas na mesma classe.

private => visivel dentro da propria classe ou de uma classe derivada na mesma unit.

strict protected => visivel apenas pelas herdeiras.

protected => visivel pelas herdeiras e classes da mesma unit.

public => visivel em qualquer lugar.

published => faz aparecer no object inspector.

Parametros de Método

Sem nada = cópia do valor

Var = ponteiro

Out = ponteiro com inicialização (parametro de entrada é ignorado, podendo ser sobrescrito)

Const = cópia do valor sem possibilidade de alteração, isso é uma diretiva a nível de compilação e tem efeito prático só em string, para tipos primitivos isso só não permite a alteração do valor dentro da função, enquanto que pra string isso evita a alocação de uma nova string.

Como Objetos em pascal são sempre ponteiros se pode mudar o objeto mas não o valor base dele.

Configuração do componente ACBrNFe


  //Protocolo de Segurança de Comunicação
  NFC.SSL.SSLType := LT_TLSv1_2; 
  //Gerenciador de Assinatura
  NFC.SSL.SSLXmlSignLib := xsLibXml2; 
  NFC.SSL.Senha := FormCertificado.Senha;
   
  //Certificado A1 (arquivo pfx)
  if (FormCertificado.TipoCertificado = 0) then
  begin
    //Gerenciador de Certificado
    NFC.SSL.SSLCryptLib := cryOpenSSL; 
    //Gerenciador da Comunicação
    NFC.SSL.SSLHttpLib := httpOpenSSL; 
    NFC.SSL.ArquivoPFX := FormCertificado.LocalCertificado;
  end;
   
  //Certificado A3 (do repositório do windows)
  if (FormCertificado.TipoCertificado = 1) then
  begin
    //Gerenciador de Certificado
    NFC.SSL.SSLCryptLib := cryWinCrypt; 
    //Gerenciador da Comunicação
    NFC.SSL.SSLHttpLib := httpWinHttp; 
    NFC.SSL.NumeroSerie := FormCertificado.SerieCerTificado;
    NFC.SSL.CarregarCertificado;
  end;
   
  //Evita Rejeição
  NFE.Configuracoes.Geral.ForcarGerarTagRejeicao938 := fgtSempre; 
  NFE.Configuracoes.Arquivos.PathNFe := FormCertificado.LocalNF;
  NFE.Configuracoes.Arquivos.PathSchemas := FormCertificado.LocalSchemas;
  NFE.Configuracoes.WebServices.Ambiente := Ambiente;
  NFE.Configuracoes.Arquivos.SepararPorModelo := True;
  NFE.Configuracoes.Arquivos.SepararPorMes := True;
  NFE.Configuracoes.Geral.VersaoDF := ve400;
  NFE.DANFE := Danfe;
  NFE.Configuracoes.Geral.ModeloDF := moNFe;
  NFE.Configuracoes.Geral.AtualizarXMLCancelado := True;

Suspender Evento Temporariamente


  var
    auxProc: TNotifyEvent;
  begin
    //Armazena o evento na variável
    auxProc := btnEnter.OnClick;
    //Limpa o Evento
    btnEnter.OnClick:= nil;
    //Restaura o Evento
    btnEnter.onClick := auxProc;
  end;

BufDataSet

Criar campos, ordenação e indice.


  Buf.Clear;
  Buf.FieldDefs.Add('ID', ftInteger);
  Buf.FieldDefs.Add('CPROD', ftString, 30);
  Buf.FieldDefs.Add('XPROD', ftString, 120);
  Buf.FieldDefs.Add('QTD', ftCurrency);
  //Ordenando
  Buf.IndexDefs.Add('ID', 'ID', [ixDescending]);
  Buf.CreateDataset;
  //Indexando
  Buf.IndexName := 'ID';

Buscar parcial.


  auxBusca := Riba.FormataTexto(EditBusca.Text);
  
  DataSourceDados.DataSet.Filtered := False;
  
  if(auxBusca = EmptyStr)then
    DataSourceDados.DataSet.Filter := EmptyStr
  else
    DataSourceDados.DataSet.Filter := 'CPROD = ''*' + auxBusca+ '*'' OR XPROD = ''*' + auxBusca + '*''';
  
  DataSourceDados.DataSet.Filtered := True;

Inserir Registros


  Buf.Append;
  Buf.FieldByName('QTD').AsCurrency := AQTD;
  Buf.Post;

Alterar Registros


  Buf.Edit;
  Buf.FieldByName('QTD').AsCurrency := AQTD;
  Buf.Post;

Deletar Registros


  Buf.Delete;

Armazenar/Obter dados em disco


  Buf.SaveToFile('.\dados.db');

  Buf.IndexDefs.Add('ID', 'ID', [ixDescending]);
  Buf.LoadFromFile('.\dados.db');

Traduzir botões

Edite o arquivo "C:\lazarus\lcl\lclstrconsts.pas"


  rsMbYes          = '&Sim';
  rsMbNo           = '&Não';
  rsMbOK           = '&OK';
  rsMbCancel       = 'Cancelar';
  rsMbAbort        = 'Abortar';
  rsMbRetry        = '&Retry';
  rsMbIgnore       = '&Ignorar';
  rsMbAll          = '&Todos';
  rsMbNoToAll      = 'Não para Todos';
  rsMbYesToAll     = 'Sim para &Todos';
  rsMbHelp         = '&Ajuda';
  rsMbClose        = '&Fechar';
  rsmbOpen         = '&Abrir';
  rsmbSave         = '&Salvar';
  rsmbUnlock       = '&Desbloquear';
  rsMtWarning      = 'Atenção';
  rsMtError        = 'Erro';
  rsMtInformation  = 'Informação';
  rsMtConfirmation = 'Confirmação';
  rsMtAuthentication = 'Autenticação';
  rsMtCustom       = 'Personalizado';

Outra forma mais simples e que não precisa fazer toda vez que reinstala o Lazarus é declarar Translations em uses colocar a linha abaixo no FormCreate do Form principal.


  TranslateUnitResourceStrings('LclStrConsts', 'C:\lazarus\lcl\languages\lclstrconsts.pt_BR.po');

Acesso MariaDB com MySQL56Connection

Com o componente MySQL56Connection e SQLQuery nativos do Lazarus.


  uses
  mysql56conn, SQLDB;
 
  Conexao := TMySQL56Connection.Create(nil);
  Transaction := TSQLTransaction.Create(nil);
  Query: TSQLQuery.Create(nil);
 
  with Conexao do
  begin
    UserName := 'usuario';
    Password := 'senha';
    DatabaseName := 'nome_banco';
    HostName := 'ip_ou_site';
    Port := 3306;
    Transaction := Transaction;
  end;
 
  Query.DataBase := Conexao;
 
  //Confirmar Transação
  Transaction.Commit;
 
  //Cancelar transação
  Transaction.Rollback;
 
  //Fechar a conexao ao termino
  Conexao.Close(True);
 
  //Dll
  libmysql.dll

Acesso MariaDB com ZConnection e ZQuery da paleta Zeos Acces


  uses
  ZConnection, ZDataset;
 
  Conexao := TZConnection.Create(nil);
  Query := TZQuery.Create(nil);
  Query.Connection := Conexao;
 
  with Conexao do
  begin
    User := 'usuario';
    Password := 'senha';
    Database := 'nome_banco';
    HostName := 'ip_ou_site';
    AutoCommit := False;
    Protocol := 'MariaDB-10';
    Port := 3306;
  end;
 
  //Confirmar Transação
  Conexao.Commit;
 
  //Cancelar transação
  Conexao.Rollback;
 
  //Fechar a conexao ao termino
  Conexao.Connected := False;
 
  //Dll
  libmariadb.dll

Limpar Vários Campos ao Mesmo Tempo


  for i := 0 to ComponentCount -1 do
    if Components[i] is TEdit then
      TEdit(Components[i]).Clear;
   
  for i := 0 to ComponentCount -1 do
    if Components[i] is TComboBox then
      TComboBox(Components[i]).ItemIndex := -1;

Colocar imagem da Internet e por no Timage com TFPHTTPClient


  //uses fphttpclient;
  procedure TFormSintegra.CarregaImagem;
  var
    auxStream: TMemoryStream;
    auxImagem: TJPEGImage;
    auxClient: TFPHTTPClient;
    auxStatus: Integer;
  begin
    auxClient := TFPHTTPClient.Create(nil);
    auxStream := TMemoryStream.Create;
    try
      auxClient.AllowRedirect := True;
      auxClient.Get('http://www.sintegra.fazenda.pr.gov.br/sintegra/captcha', auxStream);
      auxStatus := auxClient.ResponseStatusCode;
      if (auxStatus = 200) then
      begin
        auxImagem := TJPEGImage.Create;
        try
          auxStream.Position := 0;
          auxImagem.LoadFromStream(auxStream);
          ImageCaptcha.Picture.Assign(auxImagem);
        finally
          FreeAndNil(auxImagem);
        end;
      end
      else
        Riba.Aviso('Erro ao obter o Captcha!');
    finally
      FreeAndNil(auxClient);
      FreeAndNil(auxStream);
    end;
  end;

Consumo API JSON POST com FormPost do TFPHTTPClient


  //USES fphttpclient, fpjson, opensslsockets;
  procedure TForm1.Post;
  var
    auxReq: TStringList;
    auxResposta: TStringStream;
    auxClient: TFPHTTPClient;
    auxJson: TJSONData;
  begin
    auxClient := TFPHTTPClient.Create(nil);
    auxResposta := TStringStream.Create(EmptyStr);
    try
      auxClient.AllowRedirect := True;
      auxClient.AddHeader('Content-Type', 'application/x-www-form-urlencoded');
      auxClient.UserName := 'admin';
      auxClient.Password := 'admin';
   
      auxReq := TStringList.Create;
      try
        auxReq.Add('nome=Ribamar');
        auxReq.Add('idade=43');
        auxReq.Add('altura=1.82');
        auxReq.Add('nascimento=13/06/1979');
   
        auxClient.FormPost('https://ribasoft.com.br/api/teste_post.php', auxReq, auxResposta);
      finally
        FreeAndNil(auxReq);
      end;
   
      auxJson := GetJSON(auxResposta.DataString);
      try
        Riba.Aviso(auxJson.AsString);
      finally
        FreeAndNil(auxJson)
      end;
    finally
      FreeAndNil(auxClient);
      FreeAndNil(auxResposta);
    end;
  end;

Colorir DBGrid


  procedure TFormParcelas.DBGridDadosDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: integer; Column: TColumn; State: TGridDrawState);
  begin
    if(Column.FieldName = 'TOTAL')then
    begin
      DBGridDados.Canvas.Font.Color := clBlack;
   
      if(Column.Field.AsCurrency > 0) then
      begin
        if(State = [gdSelected])or(State = [gdSelected, gdFocused])then
        begin
          DBGridDados.Canvas.Brush.Color := clRed;
          DBGridDados.Canvas.Font.Color := clWhite;
        end
        else
        begin
           DBGridDados.Canvas.Brush.Color := Riba.VermelhoClaro;
           DBGridDados.Canvas.Font.Color := clBlack;
        end;
      end
      else
      begin
        if(State = [gdSelected])or(State = [gdSelected, gdFocused])then
        begin
          DBGridDados.Canvas.Brush.Color := clGreen;
          DBGridDados.Canvas.Font.Color := clWhite;
        end
        else
        begin
          DBGridDados.Canvas.Brush.Color := Riba.VerdeClaro;
          DBGridDados.Canvas.Font.Color := clBlack;
        end;
      end;
   
      DBGridDados.Canvas.FillRect(Rect); //Aplica as mudanças
      DBGridDados.DefaultDrawColumnCell(Rect,DataCol,Column,State); //Redesenha os dados na coluna
    end;
  end;

Pagar várias parcelas com juros proporcional


  DataSourceDados.DataSet.First;
  while not DataSourceDados.DataSet.EOF do
  begin
    auxSelecionado := DataSourceDados.DataSet.FieldByName('SELECIONADO').AsBoolean;
    auxID_Parcela := DataSourceDados.DataSet.FieldByName('ID').AsInteger;
    auxJuros := DataSourceDados.DataSet.FieldByName('JUROS').AsCurrency;
    auxValor := DataSourceDados.DataSet.FieldByName('RESTANTE').AsCurrency;
   
    if (auxSelecionado) then
    begin
      auxValorPago -= (auxValor + auxJuros);
   
      if (auxValorPago < 0) then
      begin
        //auxProporcaoJuros e auxProporcaoValor do tipo Float para maior precisão
        auxProporcaoJuros := auxJuros / (auxValor + auxJuros);
        auxProporcaoValor := auxValor / (auxValor + auxJuros);
        auxJuros += Riba.Arredonda(auxValorPago * auxProporcaoJuros);
        auxValor += Riba.Arredonda(auxValorPago * auxProporcaoValor);
      end;
   
      if (auxValor < 0) then
        Break;
   
      auxPag.Iserir(integer(auxTipoPag), ID_Servico, auxID_Parcela, auxValor, auxJuros);
    end;
   
    DataSourceDados.DataSet.Next;
  end;

Carregar Imagem do Banco de Dados


  procedure TForm1.CarregaFoto;
  var
    Imagem: TJPEGImage;
    MemoriaStream: TMemoryStream;
  begin
    try
      Imagem := TJPEGImage.Create;
      MemoriaStream := TMemoryStream.Create;
   
      TBlobField(DataModulo.Query.FieldByName('FOTO')).SaveToStream(MemoriaStream);
   
      if (MemoriaStream.Size > 0) then
      begin
        MemoriaStream.Position := 0;
        Imagem.LoadFromStream(MemoriaStream);
        ImageFoto.Picture.Assign(Imagem);
      end
      else
      begin
        ImageFoto.Picture.Assign(nil);
      end;
   
    finally
      Imagem.Free;
      MemoriaStream.Free;
    end;
  end;

Loopings

Existem três estruturas de looping: while, repeat e for.

while: É a estrutura de looping mais simples e flexível. O bloco de instruções é repetido enquanto a condição especificada for verdadeira.

repeat: O bloco de instruções é repetido enquanto a condição especificada for falsa.

for: É a estrutura de looping mais comum e é usada quando o número de interações é conhecido antes do tempo.

O loop pode ser interrompido usando a instrução "break" e o controle pode ser passado para a próxima iteração usando a instrução "continue", essas instruções são úteis para controlar o fluxo de um loop e podem ser usadas em qualquer uma das estruturas de looping.

Form Transparente

Para deixar uma Form transparente você pode usar as propriedades "Self.AlphaBlend := True;" e "Self.AlphaBlendValue := 125;", onde o valor de transparência vai de 255 totalmente visível à 0 totalmente invisível.

Para se recortar uma imagem deixando o fundo invisível porem com a imagem visível, deve-se criar uma imagem em .bmp (bitmap) em preto e branco onde o preto será recortado.

E usar os código abaixo.


  procedure TFormSplash.FormCreate(Sender: TObject);
  var
    Imagem: TBitmap;
  begin
    Self.BorderStyle := bsNone;
    Self.BorderIcons := [];
    Self.FormStyle := fsSplash;
   
    Imagem := TBitmap.Create;
    try
      ImageListFundoRecorte.GetBitmap(0, Imagem);
      ImageListFundoRecorte.GetBitmap(1, Image1.Picture.Bitmap);
      //Usar quando for carregar o TBitmap de uma arquivo.
      //Imagem.Monochrome := True; 
      Self.Canvas.Draw(0, 0, Imagem);
      Imagem.Height := Self.Height;
      Imagem.Width := Self.Width;
      SetShape(Imagem);
    finally
      FreeAndNil(Imagem);
    end;
  end;

Solução do Cubo Mágico 3X3

1º - Coloque a cruz branca na primeira camada alinhadas com os meios da segunda camada e deixe sempre o centro branco virado para baixo exceto no 6º passo.

2º - Arrume as pontas brancas.

3º - Meios laterais da segunda camada.

Posições Iniciais:

D, C, D’, C’ ou D’, C’, D, C

Finalizando da mesma forma que se arruma as pontas brancas.

4º - Cruz Amarela no Topo

Posições Iniciais:

F, D, C, D’, C’, F’

5º - Topo Amarelo

Posições iniciais:

Se Cruz ponta esquerda com amarelo virado para esquerda.

Demais casos ponta esquerda com amarelo virado pra frente.

Ou peixinho apontado para ponta esquerda.

D, C, D’, C, D, C, C, D’

6º - Duas Pontas

Posições Iniciais:

Face de qualquer cor para baixo.

Com face amarela para frente.

D, C’

D, B, B = L invertido

D’, C

D, B, B = L invertido

D, D

Resultado.

7º - Passo: Final

Posições Iniciais:

Para tráz

Caso não tenha uma face completa para deixar virada para tráz, pode colocar qualquer face e executar a sequencia a seguir até que haja uma face completa para se colocar para tráz.

Quando se tiver uma face completa para tráz apenas uma sequencia bastará para finalizar o cubo.

F, F = Deixando o meio diferente para baixo

C’ ou C = Para alinhar o meio de cima com o meio do centro

M = Colocar o meio Mara cima

C, C

M’ = Colocar o meio para baixo e finalizar com

C,F,F

Configurações

IDE

Ambiente > Inicialização da IDE > Abrir o último projeto = False
Ambiente > Cópia de Segurança = Sem arquivo de segurança
Ambiente > Nomeação > Salvar como > Sem renomeação automática = True
Ambiente > Inicialização da IDE > Nomeação > Sugerir nome padrão do novo arquivo em minúsculo = False
Editor > Exibir > Margem direita visíve = 120
Editor > Exibir > Indicadores de Correspondências > Contorno = True
Configurações "JCF" > Corrigir > Interrupções de Linha > Tamanho máximo de linha = 130
Ferramentas de Código > Geral > Saltar diretamente para o corpo do método = True
Ferramentas de Código > Separação de linhas > Comprimento Máximo de linha = 130
Ferramentas de Código > Separação de linhas > Não dividir linha na frente de > Símbolo = True
Depurador > Fechar janela assembler automaticamente após código não encontrado = True

Projeto

Opções do Projeto > Aplicação > Nível de Execução = Requer Administrador
Opções do Projeto > Miscelânea > Atualizar a delcaração "Application.Title" no unidade principal = False
Opções do Projeto > Miscelânea > Atualizar a delcaração "Application.Scaled" no unidade principal = False
Opções do Compilador > Depeuração > Gerar informações para o depurador = True
Opções do Compilador > Depeuração > Usar a unidade Heaptcr (-gh) = True

Problemas com acentuação

No Fortes converter...

RLPreviewForm.pas para UTF-8
RLConsts para ANSI

Nos demais problemas com UTF8 declarar em uses LConvEncoding e manter sempre os arquivos codificados em UTF8.

Arquivos do ACBr e outros para compatibilidade DELPHI, usam seus arquivos em CP1252, geralmente se usando a função "UTF8ToCP1252" da lib LConvEncoding, geralmente revolve todos os problemas.

Fortes Report Zebrado


  procedure TFormReportBalanco.RLBandLinhasBeforePrint(Sender: TObject);
  begin
    if RLBandLinhas.Color = clwhite then
      RLBandLinhas.Color := cl3dlight
    else
      RLBandLinhas.Color := clwhite;
  end;

Fortes Report Formatar Valores


  procedure TFormReportBalanco.RLDBTextQTDBeforePrint(Sender: TObject; var AText: string; var PrintIt: Boolean);
  begin
    if(PrintIt)then
      AText := Riba.FormataValor(AText, 0, True);
  end;