Автор: admin | 14.12.2007 в 2:14 | Рубрики: Базы данных

function GetBlobSize(Field: TBlobField): LongInt;
begin
with TBlobStream.Create(Field, bmRead) do
try
Result := Seek(0, 2);
finally
Free;
end;
end;

- Почему программеры, сисопы и прочий компьютерный люд, всё время пьют пиво или ещё чего покрепче?
- А вы пробовали смотреть на работу чайника за компьютером на трезвую голову?

Извлечение изображения из BLOB-поля таблицы dBASE или Paradox — без первой записи изображения в файл — простейший процесс использования метода Assign для сохранения содержимого BLOB-поля в объекте, имеющим тип TBitmap. Отдельный объект TBitmap или свойство Bitmap объекта Picture, в свою очередь являющегося свойством компонента TIMage, могут служить примером совместимой цели для данной операции.

Вот пример кода, демонстрирующего использование метода Assign для копирования изображения из BLOB-поля в компонент TImage.

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.Assign(Table1Bitmap);
end;

В данном примере, объект Table1Bitmap типа TBLOBField - BLOB-поле таблицы dBASE. Данный TBLOBField-объекты был создан с помощью редактора полей (Fields Editor). Если редактор полей для создания TFields для полей таблицы не используется, получить доступ к полям можно с помощью метода FieldByName или свойства Fields, оба они являются членами компонентов TTable или TQuery. В случае ссылки на BLOB-поле таблицы с помощью одного из приведенных членов, перед использованием метода Assign указатель на поле должен быть прежде приведен к типу объекта TBLOBField. Для примера:

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.Assign(TBLOBField(Table1.Fields[1]));
end;

Изображение, хранящееся в BLOB-поле, может быть скопировано непосредственно в отдельный TBitmap объект. Ниже приведен пример, демонстрирующий создание объекта TBitmap и сохранения в нем изображения из BLOB-поля.

procedure TForm1.Button2Click(Sender: TObject);
var
B: TBitmap;
begin
B := TBitmap.Create;
try
B.Assign(Table1Bitmap);
Image1.Picture.Bitmap.Assign(B);
finally
B.Free;
end;
end;

Автор: Ralph Friedman

Болтают трое молодых программистов о жизни. Двое холостых и один женатый.
- Зря вы говорите, что жениться sux, вот я жене на домашнем компе права админа дал!

Мне нужно записать серию чисел в файл Paradox в blob-поле. Числа получаются из значений компонент, размещенных на форме. Затем мне нужно будет считывать числа из blob-поля и устанавливать согласно им значения компонент. Как мне сделать это?
Читать полностью…

Автор: admin | в 2:14 | Рубрики: Базы данных

Иисyс изменил твою жизнь. Сохранить? (Да/Нет)

В этом примере поле ‘Table1Memo’ это paradox ‘formatted memo’. Оно так же может быть полем blob.

Через TBlobStream содержимое контрола RichEdit можно загружать или сохранять в базу данных:

procedure TForm1.BtnGetClick(Sender: TObject);
var
bs: TBlobStream;
begin
bs := nil;
with Table1 do
try
open;
first;
bs := TBlobStream.Create(table1memo, bmread);
Richedit1.plaintext := false;
Richedit1.Lines.Loadfromstream(bs);
finally
bs.free;
close;
end;
end;

procedure TForm1.BtnPutClick(Sender: TObject);
var
bs: TBlobStream;
begin
bs := nil;
with Table1 do
try
open;
first;
edit;
bs := TBlobStream.Create(table1memo, bmwrite);
Richedit1.plaintext := false;
Richedit1.Lines.Savetostream(bs);
post;
finally
bs.free;
close;
end;
end;

uses vcf1, dbtables;

procedure SaveSpreadsheet(F1Book: TF1Book);
var
BlobStream: TBlobStream;
MyBlob: HGlobal;
pblob: Pointer;
begin
with Datamodule1.Query1 do
begin
Set8087CW($133f);
try
Application.ProcessMessages;
F1Book.SaveWindowInfo;
MyBlob := GlobalAlloc(GMEM_MOVEABLE, 2000);
try
F1Book.WriteToBlob(MyBlob, 0);
pBlob := globalLock(MyBlob);
try
Blobstream := TBlobStream.Create(TBlobField(FieldByName(’QUOTE_BLOB’)),
bmWrite);
try
Blobstream.Write(pBlob^, GlobalSize(myBlob));
finally
Blobstream.Free;
end;
finally
globalUnlock(MyBlob);
end;
F1book.IF1Book_Modified := False;
finally
globalFree(myblob);
end;
finally
Set8087CW(Default8087CW);
Application.ProcessMessages;
end;
end;
end;

//Depending on your Delphi Version ( //D4 und fruhere Versionen brauchen noch:

var
Default8087CW: Word = $1332;

procedure Set8087CW(NewCW: Word);
asm
MOV Default8087CW,AX
FLDCW Default8087CW
end;