Olá, Comunidade!

Vocês devem ter notado que o site ficou um período fora do ar (do dia 26 até o dia 30 de maio de 2024).

Consegui recuperar tudo, e ainda fiz um UPGRADE no servidor! Agora estamos em um servidor dedicado no BRASIL!
Isso vai fazer com que o acesso fique mais rápido (espero 🙏)

Já arrumei os principais bugs que aparecem em uma atualização!
Mas, se você encontrar alguma coisa diferente, que não funciona direito, me envie uma MP avisando que eu arranjo um tempo pra arrumar!

Vamos crescer essa comunidade juntos 🥰

Grande abraço a todos,
Prof. Caju

ALGORITMOS E IMPLEMENTAÇÕESTodos os código fontes dos meus programas no Delphi/Lazarus(Delphi 7 para Linux)

Implementação de equações dentro da computação, programação e algoritmos.

Moderador: [ Moderadores TTB ]

Avatar do usuário

Autor do Tópico
EinsteinGenio
Elite
Mensagens: 213
Registrado em: 23 Set 2020, 21:23
Última visita: 16-05-23
Fev 2023 14 23:02

Todos os código fontes dos meus programas no Delphi/Lazarus(Delphi 7 para Linux)

Mensagem não lida por EinsteinGenio »

Visualizador de imagem:

Coloque um OpenPictureDialog no Form e digite o código abaixo no botão:Não se esqueça de adicionar um TImage para ver a imagem.

Código:

Código: Selecionar todos

if OpenPictureDialog1.Execute then
 
Image1.Picture.LoadFromFile(OpenPictureDialog1.Filename);
Editor de texto:

Código: Selecionar todos

Novo
   
    Memo1.Clear;
    Memo1.SetFocus;
   
    -----------------------------------------
    Abrir
   
    if openDialog1.Execute then
    begin
    memo1.Lines.LoadFromFile(OpenDialog1.Filename);
    memo1.setfocus;
    end;
   
    -----------------------------------------
   
    Botão Salvar
   
    if save.execute then
    begin
    memo1.Lines.SaveToFile(save.Filename);
    end;
   
    -----------------------------------------
    Copiar
    Memo1.CopytoClipBoard;
   
    -----------------------------------------
    Colar
   
    Memo1.PasteFromClipboard; ;
   
    -----------------------------------------
    Recortar
   
    Memo1.CutToClipBoard
   
    -----------------------------------------
    Fonte
   
    FontDialog1.Font:=Memo1.Font;
    if FontDialog1.Execute then
    begin
    Memo1.Font:= FontDialog1.Font;
    Memo1.SetFocus;
    end;
Gerador de senha:

Código: Selecionar todos

var
 
i:integer;
 
const
 
str='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ@!#$%&*';
 
max=14;
 
begin
 
Edit1.Text:='';
 
for i:=1 to max do
 
begin
 
Edit1.Text:=Edit1.Text+str[random(length(str))+1];
 
end;
Cronômetro:

Código: Selecionar todos

unit Unit1;
   
    {$mode objfpc}{$H+}
   
    interface
   
    uses
      Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
      ExtCtrls;
   
    type
   
      { TForm1 }
   
      TForm1 = class(TForm)
        Cronometrar: TBitBtn;
        Parar: TBitBtn;
        Edit1: TEdit;
        Timer1: TTimer;
        procedure CronometrarClick(Sender: TObject);
        procedure PararClick(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
      private
   
      public
   
      end;
   
    var
      Form1: TForm1;
      HoraInicial:TDateTime;
   
    implementation
   
    {$R *.lfm}
   
    { TForm1 }
   
    procedure TForm1.CronometrarClick(Sender: TObject);
    begin
     HoraInicial := Now;
     Timer1.Enabled := True;
    end;
   
    procedure TForm1.PararClick(Sender: TObject);
    begin
     HoraInicial := Now;
     Timer1.Enabled := False;
    end;
   
    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
      Edit1.Text := FormatDateTime('hh:mm:ss',Now-HoraInicial);
    end;
   
    end.
Criptografador(Conceito de criptografia em Delphi/Lazarus(Delphi 7 para Linux):

Código: Selecionar todos

unit Unit1;
   
    {$mode objfpc}{$H+}
   
    interface
   
    uses
   
      Classes, SysUtils, FileUtil, Forms,
   
    Controls, Graphics, Dialogs, StdCtrls;
   
    type
   
      { TForm1 }
   
      TForm1 = class(TForm)
   
        Button1: TButton;
   
        Button2: TButton;
   
        edtcriptografado: TEdit;
   
        edttexto: TEdit;
   
        edtdescriptografado: TEdit;
   
        edtkey: TEdit;
   
        Label1: TLabel;
   
        Label2: TLabel;
   
        Label3: TLabel;
   
        Label4: TLabel;
   
        procedure Button1Click(Sender: TObject);
   
        procedure Button2Click(Sender: TObject);
   
        procedure FormCreate(Sender: TObject);
   
      private
   
       function criptografar(const key, texto:String):String;
   
       function descriptografar(const key, texto:String):String;
   
      public
   
      end;
   
    var
   
      Form1: TForm1;
   
    implementation
   
   
    {$R *.lfm}
   
   
    { TForm1 }
   
   
    procedure TForm1.Button1Click(Sender: TObject);
   
    begin
   
     edtcriptografado.Text:=criptografar(edtkey.Text,edttexto.Text);
   
    end;
   
    procedure TForm1.Button2Click(Sender: TObject);
   
    begin
   
     edtdescriptografado.Text:=descriptografar(edtkey.Text,
   
    edtcriptografado.Text);
   
    end;
   
    function TForm1.criptografar(const key, texto: String): String;
   
    var
   
      I: Integer;
   
      C: Byte;
   
    begin
   
      Result := '';
   
      for I := 1 to Length(texto) do begin
   
        if Length(Key) > 0 then
   
          C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(texto[I])
   
        else
   
          C := Byte(texto[I]);
   
        Result := Result + AnsiLowerCase(IntToHex(C, 2));
   
      end;
   
   
    end;
   
   
    function TForm1.descriptografar(const key, texto: String): String;
   
    var
   
      I: Integer;
   
      C: Char;
   
   
    begin
   
      Result := '';
   
      for I := 0 to Length(texto) div 2 - 1 do begin
   
        C := Chr(StrToIntDef('$' + Copy(texto, (I * 2) + 1, 2), Ord(' ')));
   
        if Length(Key) > 0 then
   
          C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
   
        Result := Result + C;
   
      end;
   
    end;
   
   
    end.
Calculadora Empresarial(Fórmulas de logística)

Código: Selecionar todos

 procedure TForm1.CalcularCicloDoProcessoClick(Sender: TObject);
    var n1,n2,resultado:real; //declaração de variáveis do tipo real(aceita numero inteiro e com vírgula)
    begin
    n1:=StrToFloat(TempoTrabalhadoEmHoras.Text);// converte n1(numero1) para numero flutuante
    n2:=StrToFloat(NumeroDeProdutosBons.Text);//converte n2(numero2)para numero flutuante
    resultado:=n1/n2; //Dividi a variável n1(numero1) e n2(numero2
    ResultadoDoCicloDoProcesso.Text:=FloatToStr(resultado);//mostra o resultado convertendo numero flutuante(Float) para texto(String)
    procedure TForm1.CalcularTaxaDeProducaoClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(TempoTrabalhado.Text);
    n2:=StrToFloat(NumeroDeProdutosBons.Text);
    resultado:=n2/n1;
    ResultadoTaxaDeProducao.Text:=FloatToStr(resultado);
   
    procedure TForm1.CalcularTaxaDeProducaoPorRecursoClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(TaxaDeProducao.Text);
    n2:=StrToFloat(NumeroDeFuncionarios.Text);
    resultado:=n1/n2;
    ResultadoTaxaDeProducaoPorRecurso.Text:=FloatToStr(resultado);
   
    procedure TForm1.CalcularGiroDeEstoqueClick(Sender: TObject);
    var n1,n2,n3,resultado:real;
    begin
    n1:=StrToFloat(NumeroDeProdutosBons.Text);
    n2:=StrToFloat(TotalDeMateriais.Text);
    n3:=StrToFloat(TotalDeProdutos.Text);
    resultado:=n1*12/n2/n3;
    ResultadoDoGiroDoEstoque.Text:=FloatToStr(resultado);
   
    procedure TForm1.CalcularFaltaDeQualidadeClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(NumeroDeProdutosComDefeitos.Text);
    n2:=StrToFloat(TotalProduzido.Text);
    resultado:=n1/n2;
    ResultadoDaFaltaDeQualidade.Text:=FloatToStr(resultado);
   
   
    procedure TForm1.SairClick(Sender: TObject);
    begin
    Form1.Close;
   
    procedure TForm1.CalcularCPVClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(NumeroDeProdutosBons.Text);
    n2:=StrToFloat(ValorUnitario.Text);
    resultado:=n1*n2;
    ResultadoCPV.Text:=FloatToStr(resultado);
   
    procedure TForm1.CalcularCustoDaFaltaDeQualidadeClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(NumeroDeProdutosComDefeitos.Text);
    n2:=StrToFloat(ValorUnitario.Text);
    resultado:=n1*n2;
    ResultadoDoCustoDaFaltaDeQualidade.Text:=FloatToStr(resultado);
    Botão Apagar:
    TempoTrabalhado.Text:='';
    TempoTrabalhadoEmHoras.Text:='';
    NumeroDeProdutosBons.Text:='';
    resultadoDoCicloDoProcesso.Text:='';
    TaxaDeProducao.Text:='';
    ResultadoTaxaDeProducao.Text:='';
    NumeroDeFuncionarios.Text:='';
    ResultadoTaxaDeProducaoPorRecurso.Text:='';
    TotalDeMateriais.Text:='';
    TotalDeProdutos.Text:='';
    ResultadoDoGiroDoEstoque.Text:='';
    NumeroDeProdutosComDefeitos.Text:='';
    TotalProduzido.Text:='';
    ResultadoDaFaltaDeQualidade.Text:='';
    ResultadoCPV.Text:='';
    ResultadoDoCustoDaFaltaDeQualidade.Text:='';
   
    Form1. close; //Fecha o Form
   
    procedure TForm2.CalcularCustoDeCarregarEstoqueClick(Sender: TObject);
    var n1,n2,n3,resultado:real;
    begin
    n1:=StrToFloat(EstoqueDeProducaoEmProcesso.Text);
    n2:=StrToFloat(ValorUnitario.Text);
    n3:=StrToFloat(TaxaDeJuros.Text);
    resultado:=n1*n2*n3;
    ResultadoDoCustoDeCarregarEstoque.Text:=FloatToStr(resultado);
   
   
    end;
   
    procedure TForm2.CalcularCustoFixoClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(SalarioDoColaborador.Text);
    n2:=StrToFloat(DespesasGerais.Text);
    resultado:=n1+n2;
    ResultadoDoCustoFixo.Text:=FloatToStr(resultado);
   
    end;
   
    procedure TForm2.CalcularCustoTotalClick(Sender: TObject);
    var n1,n2,n3,n4,resultado:real;
    begin
    n1:=StrToFloat(CPV.Text);
    n2:=StrToFloat(CustoDaQualidade.Text);
    n3:=StrToFloat(CustoDoEstoque.Text);
    n4:=StrToFloat(CustoFixo.Text);
    resultado:=n1+n2+n3+n4;
    CustoTotal.Text:=FloatToStr(resultado);
   
    end;
   
    procedure TForm2.CalcularCustoUnitarioClick(Sender: TObject);
    var n1,n2,resultado:real;
    begin
    n1:=StrToFloat(CustoTotal.Text);
    n2:=StrToFloat(NumeroDeProdutosBons.Text);
    resultado:=n1/n2;
    ResultadoDoCustoUnitario.Text:=FloatToStr(resultado);
   
   
    end;
   
    procedure TForm2.SairClick(Sender: TObject);
    begin
    Form2.Close;// Fecha o Form2
    end;
   
    procedure TForm2.ApagarClick(Sender: TObject);
    begin
    EstoqueDeProducaoEmProcesso.Text:='';
    ValorUnitario.Text:='';
    TaxaDeJuros.Text:='';
    ResultadoDoCustoDeCarregarEstoque.Text:='';
    SalarioDoColaborador.Text:='';
    DespesasGerais.Text:='';
    ResultadoDoCustoFixo.Text:='';
    CPV.Text:='';
    CustoDaQualidade.Text:='';
    CustodoEstoque.Text:='';
    CustoFixo.Text:='';
    CustoTotal.Text:='';
    NumeroDeProdutosBons.Text:='';
    ResultadoDoCustoUnitario.Text:='';
    end;
Calculadora de decimo terceiro salário:

Código: Selecionar todos

unit Unit1;

    {$mode objfpc}{$H+}


    interface

    uses


     Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;


    type



     { TForm1 }


     TForm1 = class(TForm)


     Calcular: TButton;


     Apagar: TButton;


     Edit1: TEdit;


     Edit2: TEdit;


     Edit3: TEdit;


     Sair: TButton;


     procedure ApagarClick(Sender: TObject);


     procedure CalcularClick(Sender: TObject);


     procedure SairClick(Sender: TObject);


     private


     { private declarations }


     public


     { public declarations }


     end;


    var


     Form1: TForm1;


   


    implementation


   


    { TForm1 }


   


    procedure TForm1.CalcularClick(Sender: TObject);


    var n1,n2,resultado:real;//n1(numero1),n2(numero2),resultado(resultado do calculo)


    begin


    n1:=StrToFloat(Edit1.text);


    n2:=StrToFloat(Edit2.text);


    resultado:=n1*n2/12;


    Edit3.text:=FloatToStr(resultado);


   


    end;


   


    procedure TForm1.SairClick(Sender: TObject);


    begin


     Form1.Close;


    end;


   


    procedure TForm1.ApagarClick(Sender: TObject);


    begin


     Edit1.text:='';


     Edit2.text:='';


     Edit3.Text:='';


    end;


   


    initialization


     {$I unit1.lrs}


   


    end.
Calculadora completa com porcentagem:

Código: Selecionar todos

unit UnitCalculadora;
   
    {$mode objfpc}{$H+}
   
    interface
   
    uses
      Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
      Menus;
   
    type
   
      { TForm1 }
   
      TForm1 = class(TForm)
        BtnDivisao: TButton;
        BtnMultiplicacao: TButton;
        BtnSete: TButton;
        BtnOito: TButton;
        BtnNove: TButton;
        BtnC: TButton;
        BtnQuatro: TButton;
        BtnCinco: TButton;
        BtnSeis: TButton;
        BtnDois: TButton;
        BtnTres: TButton;
        BtnSubtracao: TButton;
        BtnAdicao: TButton;
        BtnUm: TButton;
        BtnPonto: TButton;
        BtnIgual: TButton;
        BtnPorcentagem: TButton;
        BtnZero: TButton;
        Edit1: TEdit;
        Label1: TLabel;
        MainMenu1: TMainMenu;
        MenuItem1: TMenuItem;
        MenuItem2: TMenuItem;
        Panel1: TPanel;
        procedure BtnAdicaoClick(Sender: TObject);
        procedure BtnCClick(Sender: TObject);
        procedure BtnCincoClick(Sender: TObject);
        procedure BtnDivisaoClick(Sender: TObject);
        procedure BtnDoisClick(Sender: TObject);
        procedure BtnIgualClick(Sender: TObject);
        procedure BtnMultiplicacaoClick(Sender: TObject);
        procedure BtnNoveClick(Sender: TObject);
        procedure BtnOitoClick(Sender: TObject);
        procedure BtnPorcentagemClick(Sender: TObject);
        procedure BtnQuatroClick(Sender: TObject);
        procedure BtnSeisClick(Sender: TObject);
        procedure BtnSeteClick(Sender: TObject);
        procedure BtnSubtracaoClick(Sender: TObject);
        procedure BtnTresClick(Sender: TObject);
        procedure BtnUmClick(Sender: TObject);
        procedure BtnPontoClick(Sender: TObject);
        procedure BtnZeroClick(Sender: TObject);
      private
   
      public
   
      end;
   
    var
      Form1: TForm1;
      valor1, valor2, porcentagem:real;
      tipoconta:string;
   
    implementation
   
    {$R *.lfm}
   
    { TForm1 }
   
    procedure TForm1.BtnAdicaoClick(Sender: TObject);
    begin
        tipoconta:='Adição';
          valor1:=strtofloat(Edit1.text);
          Edit1.Text:='';
          Label1.Caption:='+';
    end;
   
    procedure TForm1.BtnCClick(Sender: TObject);
    begin
      Edit1.text:='';
      valor1:=0;
      valor2:=0;
      tipoconta:='';
      Label1.Caption:='';
    end;
   
    procedure TForm1.BtnCincoClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'5';
    end;
   
    procedure TForm1.BtnDivisaoClick(Sender: TObject);
    begin
         tipoconta:='Divisão';
          valor1:=strtofloat(Edit1.text);
          Edit1.Text:='';
          Label1.Caption:='/';
    end;
   
    procedure TForm1.BtnDoisClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'2';
    end;
   
    procedure TForm1.BtnIgualClick(Sender: TObject);
    begin
    if tipoconta = 'Adição' then
          begin
          valor2:=StrToFloat(edit1.text);
          edit1.text:=FloatToStr(valor1+valor2);
   
        end;
   
        if tipoconta = 'Subtração' then
        begin
          valor2:=StrToFloat(edit1.text);
          edit1.text:=FloatToStr(valor1-valor2);
   
        end;
   
        if tipoconta = 'Divisão' then
        begin
          valor2:=StrToFloat(edit1.text);
          edit1.text:=FloatToStr(valor1/valor2);
   
        end;
        if tipoconta= 'Multiplicação' then
        begin
          valor2:=StrToFloat(Edit1.Text);
          Edit1.Text:=FloatToStr(Valor1 * Valor2);
        end;
   
    end;
   
    procedure TForm1.BtnMultiplicacaoClick(Sender: TObject);
    begin
         tipoconta:='Multiplicação';
          valor1:=strtofloat(Edit1.text);
          Edit1.Text:='';
          Label1.Caption:='X';
    end;
   
    procedure TForm1.BtnNoveClick(Sender: TObject);
    begin
          Edit1.text:=Edit1.text+'9';
    end;
   
    procedure TForm1.BtnOitoClick(Sender: TObject);
    begin
        Edit1.text:=Edit1.text+'8';
    end;
   
    procedure TForm1.BtnPorcentagemClick(Sender: TObject);
    var resultado:real;
   
       begin
   
        if tipoconta ='Multiplicação' then
        begin
   
         valor2:=strtofloat(edit1.text);
         resultado:=valor1*valor2/100;
         Edit1.text:=FloatToStr(resultado);
         Label1.Caption:='%';
         end;
           if tipoconta = 'Adição' then
       begin
          porcentagem:=strtofloat(edit1.text);
          porcentagem:=porcentagem/100;
          porcentagem:=porcentagem*valor1;
          edit1.text:=floattostr(valor1+porcentagem);
   
       end;
       if tipoconta = 'Subtração' then
       begin
          porcentagem:=strtofloat(edit1.text);
          porcentagem:=porcentagem/100;
          porcentagem:=porcentagem*valor1;
          edit1.text:=floattostr(valor1-porcentagem);
   
   
           end;
        if tipoconta = 'Divisão' then
       begin
          porcentagem:=strtofloat(edit1.text);
          porcentagem:=porcentagem/100;
          porcentagem:=porcentagem*valor1;
          edit1.text:=floattostr(valor1/porcentagem);
    end;
   
    end;
   
    procedure TForm1.BtnQuatroClick(Sender: TObject);
    begin
       Edit1.text:=Edit1.text+'4';
    end;
   
    procedure TForm1.BtnSeisClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'6';
    end;
   
    procedure TForm1.BtnSeteClick(Sender: TObject);
    begin
         Edit1.text:=Edit1.text+'7';
    end;
   
    procedure TForm1.BtnSubtracaoClick(Sender: TObject);
    begin
       tipoconta:='Subtração';
          valor1:=strtofloat(Edit1.text);
          Edit1.Text:='';
          Label1.Caption:='-';
    end;
   
    procedure TForm1.BtnTresClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'3';
    end;
   
    procedure TForm1.BtnUmClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'1';
    end;
   
    procedure TForm1.BtnPontoClick(Sender: TObject);
    begin
       Edit1.text:=Edit1.text+'.';
    end;
   
    procedure TForm1.BtnZeroClick(Sender: TObject);
    begin
      Edit1.text:=Edit1.text+'0';
    end;
   
    end.

A solidão faz mentes brilhantes,pelo simples fato de que a solidão te faz pensar.
O Gênio pensa fora do senso comum,porque o senso comum é o pensamento do povo.
Quando a ciência entra em um beco sem saída,surge o Gênio para solucionar o problema.
Responder
  • Tópicos Semelhantes
    Respostas
    Exibições
    Última mensagem

Voltar para “ALGORITMOS E IMPLEMENTAÇÕES”