Ver Mensaje Individual
  #13  
Antiguo 15-03-2005
Avatar de sierraja
sierraja sierraja is offline
Miembro
 
Registrado: sep 2004
Posts: 281
Reputación: 20
sierraja Va por buen camino
Echarle Lupa

Gracias por su atencion.

Realmente he hecho muchas preguntas y he tratado de realizar cualquier cosa que se me ocurra a mi y otras personas y no he tenido resultados favorables, intentaremos de nuevo. La necesidad que tengo es almacenar en un archivo db.gdb (interbase, campo blob) una imagen proveniente de BMP y/o JPG, pero tengo problemas para pasar una imagen de jpg a bmp y no he podido, al principio del foro esta una rutina pero no me funciona. Recientemente encontré una rutina que te anexo al final, donde lee archivos bmp y jpg y los almacena en un archivo gdb y en un campo blob. Esta rutina la ejecuto en mi computador y me funcionan, es màs, la pego en mi proyecto y funciona, trato de desmembrarla para aplicarla a mi proyecto y no encuentro el momento en que se graba en la base de datos, puede ser por falta de conocimiento del funcionamiento de la funcion o simplemente no la veo. Por tal motivo, me veo en la necesidad de enviarte el fuente y esperando cualquier tipo de ayuda.

Adolfo Sierra
Venezuela

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Jpeg, ExtDlgs, ExtCtrls, Menus, DBCtrls, DB, IBCustomDataSet,
  IBDatabase, StdCtrls, Grids, DBGrids;

type
  TGraphType = (gtBitmap, gtIcon, gtMetafile, gtJpeg);
  TForm1 = class(TForm)
    IBDB: TIBDatabase;
    IBT: TIBTransaction;
    DSImagenes: TDataSource;
    PMImagenes: TPopupMenu;
    Load1: TMenuItem;
    Clear1: TMenuItem;
    ImageFoto: TImage;
    dlgOpenPicture: TOpenPictureDialog;
    DBGrid1: TDBGrid;
    IBDSImagenes: TIBDataSet;
    IBDSImagenesCODIGO: TIntegerField;
    IBDSImagenesNOMBRE: TIBStringField;
    IBDSImagenesFOTO: TBlobField;
    IBDSImagenesFORMATO: TIBStringField;
    Bevel1: TBevel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Load1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure DSImagenesDataChange(Sender: TObject; Field: TField);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //abrir basedatos, transación, tabla
  IBDB.DatabaseName := ExtractFilePath(ExpandFileName(ParamStr(0))) + 'IMAGENES.GDB';
  IBDB.Open;
  IBT.Active := True;
  IBDSImagenes.Open;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //cerrar basedatos
  IBDB.Close;
end;

//cargar imagen (popupmenu en cuadro)
procedure TForm1.Load1Click(Sender: TObject);
var
  m, f: TStream;
  s: string;
begin
  //se abre picturedialog para cargar fichero foto que se coja
  if dlgOpenPicture.Execute then
    begin
      //modo edición
      IBDSImagenes.Edit;
      //stream a partir campo Blob que contendrá la imagen
      m:= IBDSImagenes.CreateBlobStream(IBDSImagenesFOTO, bmWrite);
      //stream para acceder al archivo gráfico
      f:= TFileStream.Create(dlgOpenPicture.filename, fmOpenRead);
      //copiar de un stream a otro
      m.CopyFrom(f, f.Size);
      //coger formato foto y ponerlo en campo correspondiente
      s:= AnsiUpperCase(ExtractFileExt(dlgOpenPicture.FileName));
      if s='.JPEG' then
        s:= '.JPG';
      IBDSImagenesFORMATO.AsString:= Copy(s,2,3);
      IBDSImagenes.Post;
      //destruir streams
      f.Free;
      m.Free;
    end
end;

//borrar imagen (popupmenu en cuadro)
procedure TForm1.Clear1Click(Sender: TObject);
begin
  //borrar imangen (cuadro)
  ImageFoto.Picture.Assign(nil);
  //borrar imagen del campo blob
  if (IBDSImagenes.State <> dsEdit) and (IBDSImagenes.State <> dsInsert) then
    IBDSImagenes.Edit;
  IBDSImagenesFOTO.Assign(nil);
  IBDSImagenes.Post;
end;

//mostrar imagen (evento ondatachange de datasource)
procedure TForm1.DSImagenesDataChange(Sender: TObject; Field: TField);
var
  m: TStream;
begin
if IBDSImagenesFOTO.IsNull then
    //para registros sin imagen poner imagen vacia
    ImageFoto.Picture := nil
  else
    begin
      if IBDSImagenesFORMATO.AsString = 'BMP' then
          //si es formato BMP
          ImageFoto.Picture.Graphic:= TBitmap.Create
      else if IBDSImagenesFORMATO.AsString = 'JPG' then
          //si es formato JPG
          ImageFoto.Picture.Graphic:= TJpegImage.Create
      else
        Exit;
      //copiar los datos desde la tabla con un stream
      m:= IBDSImagenes.CreateBlobStream(IBDSImagenesFOTO, bmRead);
      ImageFoto.Picture.Graphic.LoadFromStream(m);
      m.Free;
    end;
end;

end.

Última edición por roman fecha: 15-03-2005 a las 21:51:17. Razón: agregar etiquetas [delphi] para mayor legibilidad
Responder Con Cita