![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Подружить TDBImage и jpeg. Как лучше всего? [D7, access]
DVM © (2007-05-31 11:15:00)Пока ничего не приходит в голову как заменить TDBImage на обычный TImage и грузить данные из BLOB поля в него.
Есть еще варианты?
DVM (2007-05-31 16:36:00) [1]
> кстати в аксесс ты можеш встретится не только с просто картинкой,
> а с обьектом у которого есть префикс указывающий чем эту
> картинку открывать
Не я не встречусь. Я в базу картинки сам и кладу программой на делфи.
Напрямую в акцесс базу открывать никто не будет.
DVM (2007-05-31 16:33:00) [2]
> я о JEDI компонентах
Я изо всех сил стараюсь не использовать сторонние компоненты. Даже свои стараюсь не применять. А джеди вообще монстр из монстров.
Виталий Панасенко (2007-05-31 15:12:00) [3]А чем "халява" не угодила ? я о JEDI компонентах
PEAKTOP(banned) (2007-05-31 14:49:00) [4]> TDBImage = class(TxcDBImage); //фокус
Ага, а потом ловим ошибки периода компиляции по всему юниту и зависимым юнитам о несовместимости классов TDBImage и TDBImage. А по законам Мерфи это произойдет ровно через полгода, когда проект разрастется, отработает и закроется, и все участники забудут, где-что-прикручено. :)
sniknik (2007-05-31 14:10:00) [5]> Но все равно пригодится.
легко, даже если не хочется делать свой компонент, инсталировать в дельфи (ну или может нельзя как у нас), пользуясь "типа стандартным" TDBImage... (на форме его размещать)
делаешь объявления до формы,
type
TxcDBImage = class(TDBImage) //это как дополнение к коду в [2]
procedure LoadPicture;
procedure Paint;
end;
TDBImage = class(TxcDBImage); //фокус
TForm1 = class(TFopm)
DBImage1: TDBImage; //положенный на форму "стандартный" вернее уже нестандартный компонент
...
все, теперь "стандартный" будет понимать jpeg.
кстати в аксесс ты можеш встретится не только с просто картинкой, а с обьектом у которого есть префикс указывающий чем эту картинку открывать...
можеш сделать такую, открыть таблицу в аксессе так чтобы аксесс занимал пол экрана. во второй половине окно проводника, найди в проводнике любую картинку/документ и перетаскивай в поле таблицы (должно быть типа обьект OLE, т.е. того же в какой рисунки сохраняешь), посмотри что будет.
DVM (2007-05-31 13:26:00) [6]
> PEAKTOP(banned)
Спасибо, я пока по-простому решил через обычный TImage. Но все равно пригодится.
PEAKTOP(banned) (2007-05-31 12:39:00) [7]Идем в модуль DBCtrls.pas, копируем класс TDBImage (декларацию и методы и implementation) и всталяем в новый модуль, обзывая как-нибудь по другому, например TxcDBImage. Далее переопределяем методы
.......
implementation
uses
........, Jpeg, PngImage1, .......;
..............
procedure TxcDBImage.LoadPicture;
var
Jpeg :TJpegImage;
Png :TPngImage;
Strm :TMemoryStream;
Buff :array[0..9]of Byte;
begin
if((not FPictureLoaded)and(Assigned(FDataLink.Field)))then
if(FDataLink.Field.IsBlob)then
begin
Strm := TMemoryStream.Create;
TBlobField(FDataLink.Field).SaveToStream(Strm);
Strm.Seek(0, soFromBeginning);
Strm.Read(Buff, SizeOf(Buff));
Strm.Seek(0, soFromBeginning);
if((Buff[0]=$FF)and(Buff[1]=$D8)and(Buff[2]=$FF)and(Buff[3]=$E0)and(Buff[4]=$00) and
(Buff[5]=$10)and(Buff[6]=$4A)and(Buff[7]=$46)and(Buff[8]=$49)and(Buff[9]=$46))th en
begin
Jpeg := TJpegImage.Create;
Jpeg.LoadFromStream(Strm);
Jpeg.DIBNeeded;
FPicture.Bitmap.Assign(Jpeg);
Jpeg.Free;
end
else
begin
if((Buff[0]=$89)and(Buff[1]=$50)and(Buff[2]=$4E)and(Buff[3]=$47)and(Buff[4]=$0D) and
(Buff[5]=$0A)and(Buff[6]=$1A)and(Buff[7]=$0A)and(Buff[8]=$00)and(Buff[9]=$00))th en
begin
Png := TPngImage.Create;
Png.LoadFromStream(Strm);
FPicture.Bitmap.Assign(Png);
Png.Free;
end
else
FPicture.Assign(FDataLink.Field);
end;
Strm.Free;
if(Assigned(FAfterPictureLoaded))then
FAfterPictureLoaded(Self);
end;
end;
procedure TxcDBImage.Paint;
var
Size: TSize;
R: TRect;
S: string;
DrawPict: TPicture;
Form: TCustomForm;
Pal: HPalette;
Jpeg :TJpegImage;
Png :TPngImage;
Strm :TMemoryStream;
Buff :array[0..9]of Byte;
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
Strm := TMemoryStream.Create;
TBlobField(FDataLink.Field).SaveToStream(Strm);
Strm.Seek(0, soFromBeginning);
Strm.Read(Buff, SizeOf(Buff));
Strm.Seek(0, soFromBeginning);
if((Buff[0]=$FF)and(Buff[1]=$D8)and(Buff[2]=$FF)and(Buff[3]=$E0)and(Buff[4]=$00) and
(Buff[5]=$10)and(Buff[6]=$4A)and(Buff[7]=$46)and(Buff[8]=$49)and(Buff[9]=$46))th en
begin
Jpeg := TJpegImage.Create;
Jpeg.LoadFromStream(Strm);
Jpeg.DIBNeeded;
DrawPict.Bitmap.Assign(Jpeg);
Jpeg.Free;
end
else
begin
if((Buff[0]=$89)and(Buff[1]=$50)and(Buff[2]=$4E)and(Buff[3]=$47)and(Buff[4]=$0D) and
(Buff[5]=$0A)and(Buff[6]=$1A)and(Buff[7]=$0A)and(Buff[8]=$00)and(Buff[9]=$00))th en
begin
Png := TPngImage.Create;
Png.LoadFromStream(Strm);
DrawPict.Bitmap.Assign(Png);
Png.Free;
end
else
DrawPict.Assign(FDataLink.Field);
end;
Strm.Free;
if DrawPict.Graphic is TBitmap then
DrawPict.Bitmap.IgnorePalette := QuickDraw;
end
.............
end
После этого TxcDBImage поддерживает PNG, JPEG. Можно еще GIF до кучи привязать. Мне просто было лень.
З.Ы. Библиотека JPEG - стандартная от Бормана, библиотеку PNG взял от компонента THTMLViewer, если нет, можно просто убить эту часть из исходника.
clickmaker (2007-05-31 11:27:00) [8]как вариант, написать наследника, переопределить CreateHandle и грузить через TJpegImage