Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Связать поле 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 указывающий на каталог с этой таблицей.

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

  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
.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com