Einzelnen Beitrag anzeigen

Volker Z.

Registriert seit: 3. Dez 2012
Ort: Augsburg, Bayern, Süddeutschland
419 Beiträge
 
Delphi XE4 Ultimate
 
#10

AW: Bilder über client dataset in eine Db speichern

  Alt 8. Apr 2013, 01:37
Hallo,

also, wenn Du nur die Bilddaten speichern möchstest (und Dir das ursprüngliche Format egal ist), dann kannst Du mal folgedes versuchen:

Delphi-Quellcode:
uses
  jpeg;

function LoadBitmap (const Filename : string) : TBitmap;
begin
  Result := TBitmap.Create;
  try
    Result.LoadFromFile (Filename)
  except
    FreeAndNil (Result)
    // raise an exception or whatever you wanna do
  end
end;

function LoadIcon (const Filename : string) : TBitmap;
var
  i : TIcon;
begin
  i := TIcon.Create;
  try
    Result := nil;
    try
      i.LoadFromFile (Filename);
      Result := TBitmap.Create;
      with Result do
        begin
          Height := i.Height;
          Width := i.Width;
          Canvas.Draw (0, 0, i)
        end
    except
      // raise an exception or whatever you wanna do
    end
  finally
    FreeAndNil (i)
  end
end;

function LoadJPEG (const Filename : string) : TBitmap;
var
  i : TJPEGImage;
begin
  i := TJPEGImage.Create;
  try
    Result := nil;
    try
      i.LoadFromFile (Filename);

      Result := TBitmap.Create;
      Result.Assign (i);
    except
      // raise an exception or whatever you wanna do
    end
  finally
    FreeAndNil (i)
  end
end;

function LoadGraphic (const Filename : string) : TBitmap;
var
  s : string;
begin
  s := LowerCase (ExtractFileExt (Filename));
  if Pos ('.', s) = 1 then
    Delete (s, 1, 1)
  else
    s := '';
  
  if s = 'then
    raise Exception.Create ('File extention of the given filename ought not to be empty');

  if s = 'bmpthen
    begin
      Result := LoadBitmap (Filename);
      Exit
    end;

  if (s = 'jpg') or (s = 'jpeg') then
    begin
      Result := LoadJPEG (Filename);
      Exit
    end;

  if s = 'icothen
    begin
      Result := LoadIcon (Filename);
      Exit
    end;

  // weitere Grafikformate abklopfen und entsprechende Funktionen schreiben
  // falls es keine gültige Dateierweiterung gibt
  // raise an exception or whatever you wanna do
  // or
  Result := nil
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  b : TBitmap;
begin
  if OpenPictureDialog1.Execute then
    try
      b := LoadGraphic (OpenpictureDialog1.FileName);

      ClientDataSet1.Append;
      ClientDataSet1.FieldByName ('Passbild').Assign (b);
      ClientDataSet1.Post;
    finally
      FreeAndNil (b)
    end;
end;
Gruß
Volker Zeller
  Mit Zitat antworten Zitat