Codigo-fonte calculadora no Lazarus

Senhor_Unix
Programador
Registrado em: Dec 2009
Posts: 510
Font Size
Pascal Codigo-fonte calculadora no Lazarus

17-02-2012, 16:26
Código:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, MaskEdit, Menus , Unit2, ClipBrd;

type

  { Calculadora }

  { TCalculadora }

  TCalculadora = class(TForm)
    btLimpar: TButton;
    btPorcentagem: TButton;
    btUmPorX: TButton;
    btVirgula: TButton;
    btModulo: TButton;
    btCE: TButton;
    btBackspace: TButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    sqrt: TButton;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    ctrlC: TMenuItem;
    ctrlV: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    numero1: TButton;
    numero0: TButton;
    btDivisao: TButton;
    btMultiplicacao: TButton;
    btSubstracao: TButton;
    btSoma: TButton;
    btIgual: TButton;
    numero2: TButton;
    numero3: TButton;
    numero4: TButton;
    numero5: TButton;
    numero6: TButton;
    numero7: TButton;
    numero8: TButton;
    numero9: TButton;
    visor: TEdit;
    procedure btBackspaceClick(Sender: TObject);
    procedure btCEClick(Sender: TObject);
    procedure btDivisaoClick(Sender: TObject);
    procedure btIgualClick(Sender: TObject);
    procedure btModuloClick(Sender: TObject);
    procedure btMultiplicacaoClick(Sender: TObject);
    procedure btVirgulaClick(Sender: TObject);
    procedure btPorcentagemClick(Sender: TObject);
    procedure btSomaClick(Sender: TObject);
    procedure btSubstracaoClick(Sender: TObject);
    procedure btLimparClick(Sender: TObject);
    procedure btUmPorXClick(Sender: TObject);
    procedure ctrlCClick(Sender: TObject);
    procedure ctrlVClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure MenuItem7Click(Sender: TObject);
    procedure numero0Click(Sender: TObject);
    procedure numero1Click(Sender: TObject);
    procedure numero2Click(Sender: TObject);
    procedure numero3Click(Sender: TObject);
    procedure numero4Click(Sender: TObject);
    procedure numero5Click(Sender: TObject);
    procedure numero6Click(Sender: TObject);
    procedure numero7Click(Sender: TObject);
    procedure numero8Click(Sender: TObject);
    procedure numero9Click(Sender: TObject);
    procedure sqrtClick(Sender: TObject);
    procedure visorChange(Sender: TObject);
    procedure visorKeyPress(Sender: TObject; var Key: char);
    procedure visorKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Calculadora: TCalculadora;


implementation

var
   valor: Real;
   operacao: String;
   varlointeiro: Integer;

function Sobre():String;
begin
   FormSobre.ShowModal;
end;

function Soma(a,b:Real):Real;
begin
     Result := a+b;
end;

function Subtracao(a,b:Real):Real;
begin
     Result := a-b;
end;

function Multiplicacao(a,b:Real):Real;
begin
     Result := a * b;
end;

function Divisao(a,b:Real):Real;
begin
   if(a > 0) and (b > 0) then
     begin
          if(a < b) then
            Result := b/a
          else
            Result := a/b
     end
   else
     Result := 0;
end;

function Raiz(a:Real):Real;
begin
    if (a > 0) then
     Result := sqrt(a)
    else
     Result := 0;
end;

function UmPorX(a:Real):Real;
begin
     if(a > 0) then
        Result := 1/a
     else
        Result := 0;
end;

function Igual(a:String):String;
var total,valorVisor:Real;
begin

  if(a <> '') {and (valor <> 0)} and (operacao <> '') then
  begin

     valorVisor := StrToFloat(a);

     if(operacao = 'soma') then

       begin
        total := Soma(valorVisor,valor);
       end

     else if(operacao = 'subtracao') then

       begin
        total := Subtracao(valor,valorVisor);
       end

     else if(operacao = 'multiplicacao') then

       begin
        total := Multiplicacao(valorVisor,valor);
       end

     else if(operacao = 'divisao') then

       begin
         total := Divisao(valorVisor,valor);
       end

     else if(operacao = 'raiz') then

       begin
         total := Raiz(valor);
       end;

     if(total = 0) then
        Result := '0'
     else
        Result := FloatToStr(total);
  end

  else
      Result := FloatToStr(0);

end;

procedure TCalculadora.numero1Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '1'
   else if (operacao <> '') then
       visor.Text := '1'
   else
       visor.Text := visor.Text + '1';
end;

procedure TCalculadora.numero2Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '2'
   else if (operacao <> '') then
       visor.Text := '2'
   else
       visor.Text := visor.Text + '2';
end;

procedure TCalculadora.numero3Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '3'
   else if (operacao <> '') then
       visor.Text := '3'
   else
       visor.Text := visor.Text + '3';
end;

procedure TCalculadora.numero4Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '4'
   else if (operacao <> '') then
       visor.Text := '4'
   else
       visor.Text := visor.Text + '4';
end;

procedure TCalculadora.numero5Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '5'
   else if (operacao <> '') then
       visor.Text := '5'
   else
       visor.Text := visor.Text + '5';
end;

procedure TCalculadora.numero6Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '6'
   else if (operacao <> '') then
       visor.Text := '6'
   else
       visor.Text := visor.Text + '6';
end;

procedure TCalculadora.numero7Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '7'
   else if (operacao <> '') then
       visor.Text := '7'
   else
       visor.Text := visor.Text + '7';
end;

procedure TCalculadora.numero8Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '8'
   else if (operacao <> '') then
       visor.Text := '8'
   else
       visor.Text := visor.Text + '8';
end;

procedure TCalculadora.numero9Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '9'
   else if (operacao <> '') then
       visor.Text := '9'
   else
       visor.Text := visor.Text + '9';
end;

procedure TCalculadora.numero0Click(Sender: TObject);
begin
   if(visor.Text = '0') then
       visor.Text := '0'
   else
       visor.Text := visor.Text + '0';
end;

procedure TCalculadora.visorKeyPress(Sender: TObject; var Key: char);
var valorAux:char;
begin

  if not (Key in [#8,#13,#44,'0'..'9']) then  //backspace, enter, virgula e numeros de zero a nove.
     begin

        beep;
        Key := #0;

     end;

  if (Key in ['0'..'9',',',#8]) then
     begin
       if(visor.Text = '0') then
          begin
            visor.Text := '';
            valorAux := Key;
            Key := valorAux;
          end;
     end;

  if (Key in [#8,#46]) then
    begin
     if(visor.Text = '') then visor.Text := '0';
    end;

end;

procedure TCalculadora.visorKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if(visor.Text = '') then visor.Text := '0';
end;

procedure TCalculadora.btIgualClick(Sender: TObject);
begin
   visor.Text := Igual(visor.Text);
end;

procedure TCalculadora.btModuloClick(Sender: TObject);
begin
  if (visor.Text <> '') and (visor.Text <> '0') then
  begin
    valor := StrToFloat(visor.Text);
    valor := (-valor);

    operacao := '';
    visor.Text := FloatToStr(valor);
  end;
end;

procedure TCalculadora.sqrtClick(Sender: TObject);
begin
  if (visor.Text <> '') then
  begin
    operacao := 'raiz';
    valor := Raiz(StrToFloat(visor.Text));
    visor.Text := FloatToStr(valor);
  end;
end;

procedure TCalculadora.visorChange(Sender: TObject);
begin

end;

procedure TCalculadora.btDivisaoClick(Sender: TObject);
begin

  if (operacao <> '') then visor.Text := Igual(visor.Text);

  if (visor.Text <> '') then
  begin
    valor := StrToFloat(visor.Text);
    operacao := 'divisao';
  end;
end;

procedure TCalculadora.btBackspaceClick(Sender: TObject);
var i,j,tamanho:Integer; valorVisor,aux,aux2:String;
begin
     tamanho := Length(visor.Text);
     valorVisor := visor.Text;
     aux := '';
     aux2 := '';
     j := 0;

     if (tamanho > 0) then
       begin
            for i := tamanho downto 0 do
            begin
             if(valorVisor[i] <> #0) and (j > 0) then
               begin
                 aux := aux + valorVisor[i];
               end;

             j := j + 1;

            end;

            for i:= Length(aux) downto 0 do
            begin
               if(valorVisor[i] <> #0) then
                  begin
                     aux2 := aux2 + aux[i];
                  end;
            end;

       end;

     if(aux2 = '') then
        visor.Text := '0'
     else
        visor.Text := aux2;
end;

procedure TCalculadora.btCEClick(Sender: TObject);
begin
  visor.Text := '0';
end;

procedure TCalculadora.btMultiplicacaoClick(Sender: TObject);
begin

  if (operacao <> '') then visor.Text := Igual(visor.Text);

  if (visor.Text <> '') then
  Begin
    valor := StrToFloat(visor.Text);
    operacao := 'multiplicacao';
  end;
end;

procedure TCalculadora.btVirgulaClick(Sender: TObject);
var posicao:Integer;
begin
   posicao := Pos(',',visor.Text);
   if(posicao = 0) then
      visor.Text := visor.Text + ','
   else
      beep;
end;

procedure TCalculadora.btPorcentagemClick(Sender: TObject);
var valorVisor,total:Real;
begin
  if (visor.Text <> '') and (valor > 0) and (operacao <> '') then
  begin
       valorVisor := StrToFloat(visor.Text);
       total := (valor * valorVisor / 100);
       visor.Text := FloatToStr(total);
  end;
end;

procedure TCalculadora.btSomaClick(Sender: TObject);
begin

  if (operacao <> '') then visor.Text := Igual(visor.Text);

  if (visor.Text <> '') then
  begin
      valor := StrToFloat(visor.Text);
      operacao := 'soma';
  end;
end;

procedure TCalculadora.btSubstracaoClick(Sender: TObject);
begin

  if (operacao <> '') then visor.Text := Igual(visor.Text);

  if (visor.Text <> '') then
  begin
    valor := StrToFloat(visor.Text);
    operacao := 'subtracao';
  end;
end;

procedure TCalculadora.btLimparClick(Sender: TObject);
begin
  visor.Text := '0';
  valor := 0;
  operacao := '';
end;

procedure TCalculadora.btUmPorXClick(Sender: TObject);
begin
  if (visor.Text <> '') then
  begin
    operacao := 'umporx';
    valor := UmPorX(StrToFloat(visor.Text));
    visor.Text := FloatToStr(valor);
  end;
end;

procedure TCalculadora.ctrlCClick(Sender: TObject);
begin
  ClipBoard.AsText := visor.Text;
end;

procedure TCalculadora.ctrlVClick(Sender: TObject);
begin
  visor.Text := ClipBoard.AsText;
end;

procedure TCalculadora.FormCreate(Sender: TObject);
begin

end;

procedure TCalculadora.MenuItem1Click(Sender: TObject);
begin

end;

procedure TCalculadora.MenuItem2Click(Sender: TObject);
begin

end;

procedure TCalculadora.MenuItem7Click(Sender: TObject);
begin
  Sobre();
end;

initialization
  valor := 0;
  {$I unit1.lrs}

end.
Tags: Nenhum(a)
Anterior template Avançar
Unconfigured Ad Widget

Anúncio

Pascal Codigo-fonte calculadora no Lazarus
