problemas con TDBImage

Nelly · #1 24-11-2005

Estoy utilizando el siguiente codigo para insertar fotografias en mi base de datos(Firebird), pero no acepta el formato jpg en el TDBImage que estoy utilizando, marca un error ya que solo acepta BMPs, existe otra manera de que muestre el formato que deseo guardar en la base de datos. Utilizo el siguiente codigo:

Código:

if((qryMiembros.Active) and (not qryMiembros.IsEmpty))
	   then begin
		  qryInsFoto.ParamByName('cve_rnm').AsString:=
		  qryMiembros.FieldByName('cve_rnm').AsString;
		 if OpenPictureDialog1.Execute then begin
			qryInsFoto.ParamByName('foto').LoadFromFile(OpenPictureDialog1.FileName,ftBlob);
			qryInsFoto.ExecSQL;
			qryFotos.Active:=false;
			qryFotos.ParamByName('cve_rnm').AsString:=
			qryMiembros.FieldByName('cve_rnm').AsString;
			qryFotos.Active:=true;
		 end;
	  end;

Si me podrian ayudar se los agradeceria mucho

PINO72 · #2 24-11-2005

Hola!

Yo tambien tuve algunos problemas con el paso de la variable imagen a la base de datos, aunque yo utilizo IB 7.1. Después de algunas vueltas y tirando por la vía rápida, utilicé el Clipboard para salvar en memoria la imagen y descargarla en el campo en cuestión. Con los métodos CopyFromClipBoard y PasteFromClipBoard el contenido de la imagen pasa al campo de tipo blob sin generarte ningún error.

Espero haberte dado una buena pista.

Saludos

mazinger · #3 24-11-2005

Para ello yo utilizo un TImage normal, no el de base de datos y actualizo su contenido mendiante código:

Código:

 
procedure TfrPeliculas.aCargarCaratulaExecute(Sender: TObject);
var 
  Jpeg:TJpegImage;
  Corriente:TMemoryStream;
begin
  If Not dmPeliculas.tbPeliculasCaratula.IsNull Then Begin
	Jpeg:=TJpegImage.create;
	Corriente:=TMemoryStream.create;
	try
	   dmPeliculas.tbPeliculasCaratula.SaveToStream(Corriente);
	   Corriente.Seek(0,soFromBeginning);
	   Jpeg.LoadFromStream(Corriente);
	   Image1.Picture.Assign(Jpeg);
	finally
	   Corriente.Free;
	   Jpeg.Free;
	end; 
  End;
end;

Delfino · #4 24-11-2005

Cita:

pero no acepta el formato jpg en el TDBImage que estoy utilizando

Porque no utilizar el componente JvDBImage de la JVCL que acepta muchos formatos???

Cita:

Con los métodos CopyFromClipBoard y PasteFromClipBoard el contenido de la imagen pasa al campo de tipo blob sin generarte ningún error

Si pero los copia como bmp no como jpg..

rastafarey · #5 24-11-2005

Haber si esto te puede ayudar

Código Delphi [-]unit noudbct;

{$R-}

interface

uses
  Windows, SysUtils, Messages, Classes, Controls, Forms, Graphics,
  Menus, StdCtrls, ExtCtrls, Mask, Buttons, ComCtrls, Db, dbctrls;

type

  { TDBImage }

  TDBImage2 = class(TCustomControl)
  private
    FDataLink: TFieldDataLink;
    FPicture: TPicture;
    FBorderStyle: TBorderStyle;
    FAutoDisplay: Boolean;
    FStretch: Boolean;
    FCenter: Boolean;
    FPictureLoaded: Boolean;
    FQuickDraw: Boolean;
    procedure DataChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetAutoDisplay(Value: Boolean);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetCenter(Value: Boolean);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetPicture(Value: TPicture);
    procedure SetReadOnly(Value: Boolean);
    procedure SetStretch(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMCopy(var Message: TMessage); message WM_COPY;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function GetPalette: HPALETTE; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Paint; override;
    procedure PictureChanged(Sender: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    procedure LoadPicture; virtual;
    procedure PasteFromClipboard;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    property Field: TField read GetField;
    property Picture: TPicture read FPicture write SetPicture;
  published
    property Align;
    property Anchors;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Center: Boolean read FCenter write SetCenter default True;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor default False;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
    property ShowHint;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
  Clipbrd, DBConsts, Dialogs;

{ TDBImage2 }

constructor TDBImage2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  if not NewStyleControls then
    ControlStyle := ControlStyle + [csFramed];
  Width := 105;
  Height := 105;
  TabStop := True;
  ParentColor := False;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FBorderStyle := bsSingle;
  FAutoDisplay := True;
  FCenter := True;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FQuickDraw := True;
end;

destructor TDBImage2.Destroy;
begin
  FPicture.Free;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

function TDBImage2.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TDBImage2.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

function TDBImage2.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TDBImage2.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TDBImage2.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TDBImage2.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TDBImage2.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TDBImage2.GetPalette: HPALETTE;
begin
  Result := 0;
  if FPicture.Graphic is TBitmap then
    Result := TBitmap(FPicture.Graphic).Palette;
end;

procedure TDBImage2.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then
      LoadPicture;
  end;
end;

procedure TDBImage2.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TDBImage2.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
    FCenter := Value;
    Invalidate;
  end;
end;

procedure TDBImage2.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TDBImage2.SetStretch(Value: Boolean);
begin
  if FStretch <> Value then
  begin
    FStretch := Value;
    Invalidate;
  end;
end;

procedure TDBImage2.Paint;
var
  Size: TSize;
  R: TRect;
  S: string;
  DrawPict: TPicture;
  Form: TCustomForm;
  Pal: HPalette;
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := Color;
    if FPictureLoaded or (csPaintCopy in ControlState) then
    begin
      DrawPict := TPicture.Create;
      Pal := 0;
      try
        if (csPaintCopy in ControlState) and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then
        begin
          DrawPict.Assign(FDataLink.Field);
          if DrawPict.Graphic is TBitmap then
            DrawPict.Bitmap.IgnorePalette := QuickDraw;
        end
        else
        begin
          DrawPict.Assign(Picture);
          if Focused and (DrawPict.Graphic <> nil) and (DrawPict.Graphic.Palette <> 0) then
          begin { Control has focus, so realize the bitmap palette in foreground }
            Pal := SelectPalette(Handle, DrawPict.Graphic.Palette, False);
            RealizePalette(Handle);
          end;
        end;
        if Stretch then
          if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then
            FillRect(ClientRect)
          else
            StretchDraw(ClientRect, DrawPict.Graphic)
        else
        begin
          SetRect(R, 0, 0, DrawPict.Width, DrawPict.Height);
          if Center then
            OffsetRect(R, (ClientWidth - DrawPict.Width) div 2, (ClientHeight - DrawPict.Height) div 2);
          StretchDraw(R, DrawPict.Graphic);
          ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
          FillRect(ClientRect);
          SelectClipRgn(Handle, 0);
        end;
      finally
        if Pal <> 0 then
          SelectPalette(Handle, Pal, True);
        DrawPict.Free;
      end;
    end
    else
    begin
      Font := Self.Font;
      if FDataLink.Field <> nil then
        S := FDataLink.Field.DisplayLabel
      else
        S := Name;
      S := '(' + S + ')';
      Size := TextExtent(S);
      R := ClientRect;
      TextRect(R, (R.Right - Size.cx) div 2, (R.Bottom - Size.cy) div 2, S);
    end;
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.ActiveControl = Self) and not (csDesigning in ComponentState) and
      not (csPaintCopy in ControlState) then
    begin
      Brush.Color := clWindowFrame;
      FrameRect(ClientRect);
    end;
  end;
end;

procedure TDBImage2.PictureChanged(Sender: TObject);
begin
  if FPictureLoaded then
    FDataLink.Modified;
  FPictureLoaded := True;
  Invalidate;
end;

procedure TDBImage2.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
    DataSource := nil;
end;

procedure TDBImage2.LoadPicture;
begin
  if not FPictureLoaded and (not Assigned(FDataLink.Field) or FDataLink.Field.IsBlob) then
    Picture.Assign(FDataLink.Field);
end;

procedure TDBImage2.DataChange(Sender: TObject);
begin
  Picture.Graphic := nil;
  FPictureLoaded := False;
  if FAutoDisplay then
    LoadPicture;
end;

procedure TDBImage2.UpdateData(Sender: TObject);
begin
  if Picture.Graphic is TBitmap then
    FDataLink.Field.Assign(Picture.Graphic)
  else
    FDataLink.Field.Clear;
end;

procedure TDBImage2.CopyToClipboard;
begin
  if Picture.Graphic <> nil then
    Clipboard.Assign(Picture);
end;

procedure TDBImage2.CutToClipboard;
begin
  if Picture.Graphic <> nil then
    if FDataLink.Edit then
    begin
      CopyToClipboard;
      Picture.Graphic := nil;
    end;
end;

procedure TDBImage2.PasteFromClipboard;
begin
  if Clipboard.HasFormat(CF_BITMAP) and FDataLink.Edit then
    Picture.Bitmap.Assign(Clipboard);
end;

procedure TDBImage2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if FBorderStyle = bsSingle then
      if NewStyleControls and Ctl3D then
        ExStyle := ExStyle or WS_EX_CLIENTEDGE
      else
        Style := Style or WS_BORDER;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

procedure TDBImage2.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_INSERT:
      if ssShift in Shift then
        PasteFromClipBoard
      else if ssCtrl in Shift then
        CopyToClipBoard;
    VK_DELETE:
      if ssShift in Shift then
        CutToClipBoard;
  end;
end;

procedure TDBImage2.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    ^X: CutToClipBoard;
    ^C: CopyToClipBoard;
    ^V: PasteFromClipBoard;
    #13: LoadPicture;
    #27: FDataLink.Reset;
  end;
end;

procedure TDBImage2.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TDBImage2.CMEnter(var Message: TCMEnter);
begin
  Invalidate; { Draw the focus marker }
  inherited;
end;

procedure TDBImage2.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  Invalidate; { Erase the focus marker }
  inherited;
end;

procedure TDBImage2.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if not FPictureLoaded then
    Invalidate;
end;

procedure TDBImage2.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if TabStop and CanFocus then
    SetFocus;
  inherited;
end;

procedure TDBImage2.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  LoadPicture;
  inherited;
end;

procedure TDBImage2.WMCut(var Message: TMessage);
begin
  CutToClipboard;
end;

procedure TDBImage2.WMCopy(var Message: TMessage);
begin
  CopyToClipboard;
end;

procedure TDBImage2.WMPaste(var Message: TMessage);
begin
  PasteFromClipboard;
end;

procedure TDBImage2.WMSize(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

function TDBImage2.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TDBImage2.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and FDataLink.UpdateAction(Action);
end;

end.

end.

vtdeleon · #6 24-11-2005

Eeer diabl...