Dit is uiteindelijk de class, die ik gemaakt heb.
Delphi Code:
unit clPokemon;
interface
uses system.classes, system.sysutils, system.variants, data.db, vcl.stdctrls,
Vcl.Dialogs, Vcl.ExtDlgs, dModule, vcl.dbCtrls, vcl.imaging.pngimage,
clBasis, vcl.extctrls;
type tPokemon = class(tBasis)
fImage : TImage;
private
public
procedure FotoToBlobfield;
procedure ShowPicture;
procedure init(aDs: TDatasource;aImage: TImage);
procedure DoAfterScroll(dataset : tdataset);
destructor Destroy; override;
end;
implementation
{ tPokemon }
destructor tPokemon.Destroy;
begin
fCurrentdataset.active := false;
inherited;
end;
procedure tPokemon.init(aDs: TDatasource;aImage: TImage);
begin
fImage := aImage;
fCurrentdataset := DMModule.pokemons;
aDs.DataSet := fCurrentdataset;
fCurrentdataset.Active := true;
DMModule.pokemons.AfterScroll := DoAfterScroll;
end;
procedure tPokemon.DoAfterScroll(dataset: tdataset);
begin
ShowPicture
end;
procedure tPokemon.ShowPicture;
var BlobStream: TStream;
begin
fImage.Picture := nil;
BlobStream := TMemoryStream.Create;
try
if not DMModule.pokemons.FieldByName('afbeelding').IsNull then
begin
DMModule.pokemons.GetBlob(DMModule.pokemons.FieldByName('afbeelding')).SaveToStream(BlobStream);
Blobstream.Position := 0;
fImage.Picture.loadfromstream(blobstream);
end;
finally
BlobStream.Free;
end;
end;
procedure tPokemon.FotoToBlobfield;
var BlobField: TBlobField;
begin
with TOpenPictureDialog.Create(nil) do
begin
try
if Execute then
begin
if fCurrentdataset.State in [dsBrowse] then
fCurrentdataset.Edit;
BlobField := fCurrentdataset.FieldByName('afbeelding') as TBlobField;
BlobField.LoadFromFile(FileName);
end;
finally
Free;
end;
end;
end;
Het werkt beter dan ik had verwacht.
Ja, ik zal het moeten aanmelden als bug. Maar nooit gedaan bij embarcadero en volgens mij best wel arbeidsintensief (maar anders wordt het nooit aangemeld). Maar voordat dat is opgelost, zal ik toch verder moeten en is mijn oplssing op dit moment het beste wat ik kan verzinnen.
Bookmarks