problemas con TDBImage

[Nelly]

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:

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]

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]

Para ello yo utilizo un TImage normal, no el de base de datos y actualizo su contenido mendiante 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]

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

Porque no utilizar el componente JvDBImage de la JVCL (http://homepages.borland.com/jedi/jvcl/) que acepta muchos formatos???

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]

Haber si esto te puede ayudar

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]

Eeer diabl...:p:p