Bild in Access DB speichern

[Gehstock]

klappt net er speichert einfach nicht vermute das programm weiß nicht in welche spalte hier mal der komplette source mit exe

Delphi-Quellcode:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, DBCtrls, Grids, DBGrids, ExtCtrls, DB, DBTables,
  ADODB, Jpeg, ExtDlgs;

type
  TForm7 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBEdit6: TDBEdit;
    DBNavigator1: TDBNavigator;
    DBEdit8: TDBEdit;
    Label8: TLabel;
    Label12: TLabel;
    DBEdit11: TDBEdit;
    ADOImage: TImage;
    Table1: TADOTable;
    ADOTable1Nr: TAutoIncField;
    ADOTable1Name: TWideStringField;
    ADOTable1Vorname: TWideStringField;
    ADOTable1Strasse: TWideStringField;
    ADOTable1Ort: TWideStringField;
    ADOTable1Termin: TDateField;
    ADOTable1TelefonFest: TWideStringField;
    ADOTable1TelefonMobil: TWideStringField;
    ADOTable1Picture: TBlobField;
    LoadPIC: TButton;
    OpenPicture: TOpenPictureDialog;
    procedure FormCreate(Sender: TObject);
    function JpegStartsInBlob(PicField:TBlobField):integer;
    procedure OpenPic;
    procedure SavePic;
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
    procedure LoadPICClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form7: TForm7;

implementation

{$R *.dfm}

procedure TForm7.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
if Length(DBEdit1.text)> 0 then OpenPic;
 if Button = nbedit then
   begin
    LoadPIC.Visible := True;
   end;
  if Button = nbInsert then
   begin
    LoadPIC.Visible := True;
   end;
  if Button = nbPost then
   begin
    LoadPIC.Visible := false;
    SavePIC;
   end;
end;

procedure TForm7.FormCreate(Sender: TObject);
begin
   Table1.Active := True;
   OpenPic;
end;

function TForm7.JpegStartsInBlob(PicField:TBlobField):integer;
var
 bS     : TADOBlobStream;
 buffer : Word;
 hx     : string;
begin
 Result := -1;
 bS := TADOBlobStream.Create(PicField, bmRead);
 try
  while (Result = -1) and (bS.Position + 1 < bS.Size) do begin
   bS.ReadBuffer(buffer, 1);
   hx:=IntToHex(buffer,2);
   if hx = 'FF' then begin
     bS.ReadBuffer(buffer, 1);
     hx:=IntToHex(buffer,2);
     if hx = 'D8' then Result := bS.Position - 2
     else if hx = 'FF' then bS.Position := bS.Position-1;
   end;//if
  end;//while
 finally
  bS.Free
 end; //try
end;

procedure TForm7.LoadPICClick(Sender: TObject);
{var
  jpg: TJPEGImage;
  bmp: TBitmap;   }
begin
if OpenPicture.execute then
 begin
  AdoImage.Picture.LoadFromFile(OpenPicture.FileName);
end;
end;

procedure TForm7.OpenPic;
var
  bS  : TADOBlobStream;
  Pic : TJpegImage;
begin
  bS := TADOBlobStream.Create(AdoTable1Picture, bmRead);
  try
    bS.Seek(JpegStartsInBlob(AdoTable1Picture), soFromBeginning);
    Pic:=TJpegImage.Create;
    try
     Pic.LoadFromStream(bS);
     ADOImage.Picture.Graphic:=Pic;
    finally
     Pic.Free;
    end;
  finally
    bS.Free
  end;
end;

procedure TForm7.SavePic;
var
  bS  : TADOBlobStream;
  Pic : TJpegImage;
begin
  bS := TADOBlobStream.Create(AdoTable1Picture, bmRead);
  try
    Pic.Assign(AdoImage);
    try
     Pic.SaveToStream(bS);
     bs.Position := 0;
     ADOTable1Picture := TBlobField(Table1.FieldByName('Bild'));
     Table1.Edit;
     ADOTable1Picture.LoadFromStream(bs);
    finally
     Pic.Free;
    end;
  finally
    bS.Free
  end;
end;

end.