Delphi World - Связать поле BLOB таблицы Paradox с компонентом TRichEdit через потоки
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Связать поле 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 указывающий на каталог с этой таблицей.

Для упрощения размещения компонентов в форме проделайте следующее:

  1. Создайте новый проэкт;
  2. Скопируйте выделенную красным цветом часть файла Main.dfm в буфер обмена;
  3. Сделайте активной вновь созданную форму и вставте в нее содержимое буфера;
  4. Измените свойства самой формы в соответствии с нижеприведенным описанием.

// Файл 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования