Fórum Ajuda para foto no cadastro ! #365287

procedure TCadCli.SpeedButton1Click(Sender: TObject);
var
  DirNomeFoto: string;
  NomeFoto: string;
  procedure ConverteParaJpeg(ACaminhoFoto: string);
  var
    cjBmp: TBitmap;
    cjJpg: TJpegImage;
    strNomeSemExtensao: string;
    AFoto: TImage;
  begin
    AFoto:= TImage.Create(CadCli);
    AFoto.Parent := CadCli;
    AFoto.Visible := False;
    AFoto.Picture.Bitmap.LoadFromFile(ACaminhoFoto + ´.bmp´);

    cjJpg := TJPegImage.Create;
    cjBmp := TBitmap.Create;

    cjBmp.Assign(AFoto.Picture.Bitmap);
    cjJpg.Assign(cjBMP);

    cjJpg.SaveToFile(ACaminhoFoto + ´.jpg´);
    DeleteFile(ACaminhoFoto + ´.bmp´);
    cjJpg.Free;
    cjBmp.Free;
    AFoto.Free;
  end;
begin
  frmCaptura := TfrmCaptura.Create(Self);
  try
    with frmCaptura, camCamera, dm, IBDataSet1 do
    begin
      DirNomeFoto := ExtractFilePath(Application.ExeName) +
        LimpaString(IBDataSet1RG_IE.AsString) + ´.bmp´;

      NomeFoto := ExtractFilePath(DirNomeFoto) +
        Copy(ExtractFileName(DirNomeFoto),1, Length(ExtractFileName(DirNomeFoto))-4);

      FichierImage := ExtractFileName(DirNomeFoto);
      if frmCaptura.ShowModal = mrOk then
      begin
        CaptureImageDisque;
        ConverteParaJpeg(NomeFoto);
        IBDataSet1FOTO.AsString := NomeFoto + ´.jpg´;
        imgFoto.Picture.LoadFromFile(´IBDataSet1FOTO´);
      end;
    end;
  finally
    FreeAndNil(frmCaptura);
  end;
end;

function TCadCli.LimpaString(ATexto: String):String;
var
  I: Integer;
  s: string;
begin
  S := ´´;
  for I := 1 To Length(ATexto) Do
    if (ATexto[I] in [´0´..´9´]) then
      S := S + Copy(ATexto, I, 1);
  Result := S;
end;

procedure TCadCli.DataSource1DataChange(Sender: TObject; Field: TField);
var
  strCaminho: string;
  strRG : string;
begin
  with dm do
  begin
    if not IBDataset1.IsEmpty then
      if FileExists(IBDataset1.FieldByName(´FOTO´).AsString) then
        CadCli.imgFoto.Picture.LoadFromFile(
          IBDataset1.FieldByName(´FOTO´).AsString)
      else
        CadCli.imgFoto.Picture := Nil;
  end;
end;