Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки

=== Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки ===
Я сам занимался этой задачей и мое предыдущее письмо к Вам явилось результатом экспериментов над TRichEdit. Поэтому я хочу предложить Вам пример проекта, в котором я связываю поле BLOB таблицы Paradox с компонентом TRichEdit через потоки. Кроме того я использую библиотеку ZLib из стандартного приложения к Delphi 3 CSS. Это позволяет по ходу перекачивания данных в таблицу сжимать текст, а при чтении - распаковывать его чем достигается уменьшение размера .MB-файла, что полезно при большом количестве записей с BLOB-полем.
В заключение хочу сказать несколько слов о библиотеке ZLib.dcu (размер 48496 байт, дата создания 24.03.97г.) которая включена в поставку Delphi 3. При использовании конструктора TDecompressStream почему-то генерировался Default Beep и это очень задерживало выполнение декомпрессии. По счастью в поставку входит и исходный текст ZLib.pas. Я перекомпилировал модуль с помощью тестового примера, также входящего в поставку, при этом указав в настройках проекта не включать отладочную информацию. В результате размер ZLib.dcu стал равным 45681 байт, а сигнал генерироваться перестал.
Теперь о проекте. Он имеет одну форму frmMain. Содержимое файлов проекта привожу ниже. Для работы также необходима таблица Table.db, имеющая структуру:
 Имя поля Тип Размер
 ID +
 BLOBData B 64
и Alias с именем CBDB указывающий на каталог с этой таблицей.
Для упрощения размещения компонентов в форме проделайте следующее:
* Создайте новый проект;
* Скопируйте выделенную красным цветом часть файла Main.dfm в буфер обмена;
* Сделайте активной вновь созданную форму и вставте в нее содержимое буфера;
* Измените свойства самой формы в соответствии с нижеприведенным описанием.
=== Файл Main.dfm: ===
object frmMain: TfrmMain
 Left = 476
 Top = 347
 BorderStyle = bsSingle
 Caption = 'Compressed BLOB'
 ClientHeight = 235
 ClientWidth = 246
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 Position = poScreenCenter
 OnShow = FormShow
 PixelsPerInch = 96
 TextHeight = 13
 object SB1: TSpeedButton
 Left = 1
 Top = 209
 Width = 25
 Height = 25
 Hint = 'Добавить'
 Glyph.Data = {
 76010000424D7601000000000000760000002800000020000000100000000100
 04000000000000010000130B0000130B00001000000000000000000000000000
 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
 33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
 FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
 00F03333F37F773777373330330FFFFFFFF03337FF7F3F3FF3F73339030F0800
 F0F033377F7F737737373339900FFFFFFFF03FF7777F3FF3FFF70999990F00F0
 00007777777F7737777709999990FFF0FF0377777777FF37F3730999999908F0
 F033777777777337F73309999990FFF0033377777777FFF77333099999000000
 3333777777777777333333399033333333333337773333333333333903333333
 3333333773333333333333303333333333333337333333333333}
 NumGlyphs = 2
 ParentShowHint = False
 ShowHint = True
 OnClick = SB1Click
 end
 object SB2: TSpeedButton
 Left = 25
 Top = 209
 Width = 25
 Height = 25
 Hint = 'Удалить'
 Glyph.Data = {
 76010000424D7601000000000000760000002800000020000000100000000100
 0400000000000001000000000000000000001000000000000000000000000000
 8000008000000080800080000000800080008080000080808000C0C0C0000000
 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
 33333333333FFFFFFFFF333333000000000033333377777777773333330FFFFF
 FFF03333337F333333373333330FFFFFFFF03333337F3FF3FFF73333330F00F0
 00F033333F7F773777373333300FFFFFFFF03333F73FFF3FF3F733330C0F0800
 F0F0333F773F337737373330CC0FFFFFFFF033F777FFFFF3FFF7330CCCCC00F0
 00003F777777F737777730CCCCCC0FF0FF03F7777777FF37F3730CCCCCCC08F0
 F03377777777F337F73330CCCCCC0FF0033337777777FFF77333330CCCCC0000
 333333777777777733333330CC3333333333333777333333333333330C333333
 3333333377333333333333333033333333333333373333333333}
 NumGlyphs = 2
 ParentShowHint = False
 ShowHint = True
 OnClick = SB2Click
 end
 object SB3: TSpeedButton
 Left = 49
 Top = 209
 Width = 25
 Height = 25
 Hint = 'Редактировать'
 Glyph.Data = {
 76010000424D7601000000000000760000002800000020000000100000000100
 04000000000000010000120B0000120B00001000000000000000000000000000
 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000000
 000033333377777777773333330FFFFFFFF03FF3FF7FF33F3FF700300000FF0F
 00F077F777773F737737E00BFBFB0FFFFFF07773333F7F3333F7E0BFBF000FFF
 F0F077F3337773F3F737E0FBFBFBF0F00FF077F3333FF7F77F37E0BFBF00000B
 0FF077F3337777737337E0FBFBFBFBF0FFF077F33FFFFFF73337E0BF0000000F
 FFF077FF777777733FF7000BFB00B0FF00F07773FF77373377373330000B0FFF
 FFF03337777373333FF7333330B0FFFF00003333373733FF777733330B0FF00F
 0FF03333737F37737F373330B00FFFFF0F033337F77F33337F733309030FFFFF
 00333377737FFFFF773333303300000003333337337777777333}
 NumGlyphs = 2
 ParentShowHint = False
 ShowHint = True
 OnClick = SB3Click
 end
 object SB4: TSpeedButton
 Left = 73
 Top = 209
 Width = 25
 Height = 25
 Hint = 'Отменить редактирование'
 Glyph.Data = {
 DE010000424DDE01000000000000760000002800000024000000120000000100
 0400000000006801000000000000000000001000000000000000000000000000
 80000080000000808000800000008000800080800000C0C0C000808080000000
 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
 333333333333333333333333000033338833333333333333333F333333333333
 0000333911833333983333333388F333333F3333000033391118333911833333
 38F38F333F88F33300003339111183911118333338F338F3F8338F3300003333
 911118111118333338F3338F833338F3000033333911111111833333338F3338
 3333F8330000333333911111183333333338F333333F83330000333333311111
 8333333333338F3333383333000033333339111183333333333338F333833333
 00003333339111118333333333333833338F3333000033333911181118333333
 33338333338F333300003333911183911183333333383338F338F33300003333
 9118333911183333338F33838F338F33000033333913333391113333338FF833
 38F338F300003333333333333919333333388333338FFF830000333333333333
 3333333333333333333888330000333333333333333333333333333333333333
 0000}
 NumGlyphs = 2
 ParentShowHint = False
 ShowHint = True
 OnClick = SB4Click
 end
 object P1: TPanel
 Left = 0
 Top = 0
 Width = 246
 Height = 206
 BevelInner = bvRaised
 BevelOuter = bvLowered
 BevelWidth = 2
 TabOrder = 0
 object RE: TRichEdit
 Left = 5
 Top = 5
 Width = 236
 Height = 196
 ScrollBars = ssVertical
 TabOrder = 0
 end
 end
 object DBN: TDBNavigator
 Left = 149
 Top = 209
 Width = 96
 Height = 25
 DataSource = DS
 VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
 TabOrder = 1
 end
 object T1: TTable
 Active = True
 DatabaseName = 'CBDB'
 TableName = 'table.db'
 Left = 5
 Top = 5
 object T1ID: TAutoIncField
 FieldName = 'ID'
 Visible = False
 end
 object T1BLOBData: TBlobField
 FieldName = 'BLOBData'
 Visible = False
 BlobType = ftBlob
 Size = 64
 end
 end
 object OD: TOpenDialog
 DefaultExt = 'rtf'
 Filter = 'RTF-файлы|*.rtf|Все файлы|*.*'
 Title = 'Выберите файл'
 Left = 5
 Top = 35
 end
 object DS: TDataSource
 DataSet = T1
 OnDataChange = DSDataChange
 Left = 35
 Top = 5
 end
end
=== Файл Main.pas: ===
unit Main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Db, DBTables, StdCtrls, ComCtrls, ExtCtrls, DBCtrls, Buttons, swDBPanl,
 swRecPos;
type
 TfrmMain = class(TForm)
 T1: TTable;
 T1ID: TAutoIncField;
 T1BLOBData: TBlobField;
 OD: TOpenDialog;
 P1: TPanel;
 SB1: TSpeedButton;
 SB2: TSpeedButton;
 SB3: TSpeedButton;
 SB4: TSpeedButton;
 DS: TDataSource;
 DBN: TDBNavigator;
 procedure SB1Click(Sender: TObject);
 procedure SB2Click(Sender: TObject);
 procedure SB3Click(Sender: TObject);
 procedure SB4Click(Sender: TObject);
 procedure DSDataChange(Sender: TObject; Field: TField);
 procedure FormShow(Sender: TObject);
 private
 EF: boolean;
 procedure SetButtons;
 procedure UpdateEditor;
 procedure StoreFromFile;
 procedure StoreFromEditor;
 public
 { Public declarations }
 end;
var
 frmMain: TfrmMain;
implementation
uses ZLib;
{$R *.DFM}
const
 LID: longint = 0;
procedure TfrmMain.SetButtons;
var
 c1: Boolean;
begin
 c1 := T1.RecordCount > 0;
 SB2.Enabled := not EF and c1;
 SB3.Enabled := not EF and c1;
 SB4.Enabled := EF;
end;
procedure TfrmMain.UpdateEditor;
var
 Buf: TStream;
 ZStream: TCustomZLibStream;
 id: LongInt;
begin
 id := T1ID.AsInteger;
 if (id = LID) and not EF then
 exit
 else
 LID := id;
 Buf := TMemoryStream.Create;
 T1BLOBData.SaveToStream(Buf);
 if Buf.Size > 0 then
 begin
 ZStream := TDecompressionStream.Create(Buf);
 RE.Lines.LoadFromStream(ZStream);
 ZStream.Free;
 end
 else
 RE.Lines.Clear;
 Buf.Free;
end;
procedure TfrmMain.StoreFromFile;
var
 InFile, Buf: TStream;
 ZStream: TCustomZLibStream;
begin
 if not OD.Execute then
 exit;
 T1.AppendRecord([NULL]);
 InFile := TFileStream.Create(OD.FileName, fmOpenRead);
 Buf := TMemoryStream.Create;
 ZStream := TCompressionStream.Create(clMax, Buf);
 ZStream.CopyFrom(InFile, 0);
 ZStream.Free;
 T1.Edit;
 T1BLOBData.LoadFromStream(Buf);
 T1.Post;
 Buf.Free;
 InFile.Free;
 LID := 0;
 UpdateEditor;
end;
procedure TfrmMain.StoreFromEditor;
var
 InStream, Buf: TStream;
 ZStream: TCustomZLibStream;
begin
 InStream := TMemoryStream.Create;
 Buf := TMemoryStream.Create;
 RE.Lines.SaveToStream(InStream);
 ZStream := TCompressionStream.Create(clMax, Buf);
 ZStream.CopyFrom(InStream, 0);
 ZStream.Free;
 T1.Edit;
 T1BLOBData.LoadFromStream(Buf);
 T1.Post;
 UpdateEditor;
end;
procedure TfrmMain.SB1Click(Sender: TObject);
begin
 if EF then
 begin
 StoreFromEditor;
 RE.ReadOnly := true;
 DBN.Enabled := true;
 EF := false;
 SB1.Hint := 'Добавить';
 end
 else
 StoreFromFile;
 SetButtons;
end;
procedure TfrmMain.SB2Click(Sender: TObject);
begin
 if MessageDlg('Удалять запись?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
 then
 begin
 T1.Delete;
 SetButtons;
 end;
end;
procedure TfrmMain.SB3Click(Sender: TObject);
begin
 DBN.Enabled := false;
 EF := true;
 SB1.Hint := 'Внести изменения';
 RE.ReadOnly := false;
 SetButtons;
end;
procedure TfrmMain.SB4Click(Sender: TObject);
begin
 UpdateEditor;
 DBN.Enabled := true;
 EF := false;
 SB1.Hint := 'Добавить';
 RE.ReadOnly := true;
end;
procedure TfrmMain.DSDataChange(Sender: TObject; Field: TField);
begin
 if assigned(frmMain) and Visible and not EF then
 begin
 UpdateEditor;
 SetButtons;
 end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
 EF := false;
 SetButtons;
 DSDataChange(nil, nil);
end;
end.
=== Файл CompBLOB.dpr: ===
program CompBLOB;
uses
 Forms,
 Main in 'Main.pas' {frmMain};
{$R *.RES}
begin
 Application.Initialize;
 Application.CreateForm(TfrmMain, frmMain);
 Application.Run;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 02478