Советы по Delphi
         

Имитация события MouseOff


Кто-нибудь знает, как отловить момент, когда мышь покидает область визуального компонента? Есть какой-нибудь эквивалент событию MouseMoveOff? Моя задача - сделать компонент невидимым, как только мышь покинет его область (возможно после события MouseDown, поскольку MouseUp еще не наступило).

В обработчике события tComponent.mousemove установите логический флажок, а в обработчике контейнера компонента MouseMove проверяйте этот флаг, если он равен True, "виртуальное" событие произошло и требует вашей обработки.

Успехов,
RAM [000670]



Назначение события во время выполнения программы


Вот процедура, назначающая событие компонента обработчику события другого (или того же самого) компонента, где во время выполнения программа само событие и его обработчик заданы в виде строки. В случае неверных имен события или его обработчика процедура возбуждает исключительную ситуацию. Вы можете "очищать" событие, передавая компоненту NIL с обработчиком или нулевое имя самого обработчика.

Для демонстрации того, как это можно использовать, я включил в пример пару маленьких событий для кнопок. Во время работы, вы могли бы потестировать это с парой областей редактирования, имеющих другой тип и другие имена обработчиков.

Почуствуйте мощь RTTI (runtime type information)!

    procedure SetEvent( ComponentWithEvent  : TComponent ; const Event          : string ;

ComponentWithHandler : TComponent ; const Handler        : string ) ;
var PropInfo : PPropInfo ; Method   : TMethod ;
begin PropInfo := GetPropInfo( ComponentWithEvent.ClassInfo, Event ) ; if PropInfo = NIL then Raise Exception.CreateFmt( 'Событие %s не найдено в классе %s', [ Event, ComponentWithEvent.ClassName ] ) ; Method.Code := NIL ; if Assigned( ComponentWithHandler ) and ( Handler <> '' ) then begin Method.Code := ComponentWithHandler.MethodAddress( Handler ) ; if Method.Code = nil then Raise Exception.CreateFmt( 'Класс %s не имеет метода с именем %s', [ ComponentWithHandler.ClassName, Handler ] ) ; end ; Method.Data := ComponentWithHandler ; SetMethodProp( ComponentWithEvent, PropInfo, Method ) ; end ;
{ примеры, показывающие как использовать SetEvent } procedure TForm1.SetBtnClick(Sender: TObject); begin SetEvent( MenuItem, 'OnClick', Self, 'Test1Click' ) ; end;
procedure TForm1.ClearBtnClick(Sender: TObject); begin SetEvent( MenuItem, 'OnClick', NIL, '' ) ; end;

- Mike Scott [000763]



Создание события во время выполнения приложения


на примере переопределения события в Memo:

    memo.onchange:=memo1Change;

procedure TForm1.Memo1Change(Sender: TObject);
begin
panel1.caption:='Содержимое было изменено'; end;
[000059]



Динамическое создание полей I


Как во время работы приложения динамически создавать поля в наборе данных?

    var
I: Integer; Field: TField; begin
{ Поля можно добавлять только к неактивному набору данных. } Table1.Active := False;
{ Распределяем определенные поля если набор данных еще не был активным. } Table1.FieldDefs.Update;
{ Создаем все поля из определений и добавляем к набору данных. } for I := 0 to Table1.FieldDefs.Count - 1 do begin { Вот где мы действительно сообщаем набору данных о необходимости создания поля. } { Поле "назначается", но нам нужно не это, нам нужна просто ссылка на новое поле. } Field := Table1.FieldDefs[I].CreateField(Table1); end;
{ Вот пример того, как вы можете добавить дополнительные, вычисленные поля } Field := TStringField.Create(Table1); Field.FieldName := 'Total'; Field.Calculated := True; Field.DataSet := Table1;
{ Теперь мы можем увидеть наши поля. } Table1.Active := True;

Надеюсь это поможет.
Marco Romanini (SysOp)
Delphi Tech Support [000416]



Динамическое создание полей II


Как мне определить на лету другое поле подобно команде "Define" в редакторе полей (Fields Editor)? (Калькулируемое поле, другими словами?)

Следующий код создаст полный набор 'default' TField для TTable и добавит затем калькулируемое поле:

    procedure TForm1.Button1Click(Sender: TObject); var f : TField; i : integer; begin Table1.Close; for i := 0 to Table1.FieldDefs.Count - 1 do Table1.FieldDefs.Items[i].CreateField(Table1); f := TStringField.Create(Table1); f.Name := 'Table1CalcField'; f.FieldName := 'CalcField'; f.DisplayLabel := 'CalcField'; f.Calculated := True; f.DataSet := Table1; Table1.Open; end;

...следующий пример создаст два новых TField в TTable, 'базируясь' на TField, определенных в режиме редактирования. Одно из новых полей калькулируемое, другое нет:

    procedure TForm1.Button1Click(Sender: TObject); var f1, f2 : TField; begin Table1.Close; f1 := TStringField.Create(Table1); f1.Name := 'Table1CalcField'; f1.FieldName := 'CalcField'; f1.DisplayLabel := 'CalcField'; f1.Calculated := True; f1.DataSet := Table1; f2 := TFloatField.Create(Table1); f2.Name := 'Table1Population'; f2.FieldName := 'Population'; f2.DisplayLabel := 'Population'; f2.DataSet := Table1; Table1.Open; end;

Eryk [000702]



Динамическое создание таблицы и полей во время выполнения программы


Delphi в режиме разработки позволяет быстро добавлять и настраивать в вашем проекте компоненты для работы с базами данных, но есть ситуации, когда вам нужно создавать и конфигурировать объекты во время выполнения программы. Например, во время выполнения программы вам может понадобиться добавить колонку с вычисляемым полем (используя алгоритмы пользователя). Поэтому вопрос: как, не используя среды разработки, Инспектора Объектов и редактора TFields, создавать и сконфигурировать TField и другие компоненты для связки данных?

В следующем примере показано динамическое создание TTable, таблицы базы данных в связке с TTable, TFieldDefs, TFields, вычисляемых полей и подключение обработчика для события OnCalc.

Для начала выберите пункт New Application меню File. Будет создан новый проект с пустой формой, на которой мы и будет создавать на лету наши компоненты.

В секцию interface вашего модуля формы добавьте, как показано ниже, объявление обработчика события OnCalcFields и поля TaxAmount. Позже мы создадим TTable и назначим этот обработчик событию TTable OnCalcFields, который позволит при чтении каждой записи вызывать событие OnCalcFields, которое, в свою очередь, выполнит нашу процедуру TaxAmountCalc.

    type
TForm1 = class(TForm) procedure TaxAmountCalc(DataSet: TDataset); private TaxAmount: TFloatField; end;

В секции implementation создайте обработчик события OnCalc как показано ниже:

    procedure TForm1.TaxAmountCalc(DataSet: TDataset);
begin
Dataset['TaxAmount'] := Dataset['ItemsTotal'] * (Dataset['TaxRate'] / 100); end;

Создайте обработчик формы OnCreate как показано ниже (для получения дополнительной информации о создании обработчиков событий обратитесь к Delphi Users Guide, Chapter 4 "Working With Code").

    procedure TForm1.FormCreate(Sender: TObject);
var
MyTable: TTable; MyDataSource: TDataSource; MyGrid: TDBGrid; begin

{ Создаем компонент TTable -- связанная таблица базы данных будет создана ниже. } MyTable := TTable.Create(Self); with MyTable do begin
{ Определяем основную базу данных и таблицу. Примечание: Test.DB пока не существует. } DatabaseName := 'DBDemos'; TableName := 'Test.DB';
{ Назначаем TaxAmountCalc обработчиком события, чтобы использовать его при наступлении события OnCalcFields в MyTable. } OnCalcFields := TaxAmountCalc;
{ Создаем и добавляем определения полей к массиву TTable FieldDefs, затем создаем TField с использованием информации из определения поля. } with FieldDefs do begin Add('ItemsTotal', ftCurrency, 0, false); FieldDefs[0].CreateField(MyTable); Add('TaxRate', ftFloat, 0, false); FieldDefs[1].CreateField(MyTable); TFloatField(Fields[1]).DisplayFormat := '##.0%';
{ Создаем вычисляемое TField, назначаем свойства, и добавляем поле к массиву определений MyTable. } TaxAmount := TFloatField.Create(MyTable); with TaxAmount do begin FieldName := 'TaxAmount'; Calculated := True; Currency := True; DataSet := MyTable; Name := MyTable.Name + FieldName; MyTable.FieldDefs.Add(Name, ftFloat, 0, false); end; end;
{ Создаем в базе данных новую таблицу, используя в качестве основы MyTable. } MyTable.CreateTable; end;
{ Создаем компонент TDataSource и назначаем его MyTable. } MyDataSource := TDataSource.Create(Self); MyDataSource.DataSet := MyTable;
{ Создаем табличную сетку, отображаем на форме, и назначаем MyDataSource для получения доступа к данным из MyTable. } MyGrid := TDBGrid.Create(Self); with MyGrid do begin Parent := Self; Align := alClient; DataSource := MyDataSource; end;
{ Запускаем нашу конструкцию! } MyTable.Active := True; Caption := 'Новая таблица ' + MyTable.TableName; end;

Ниже приведен полный исходный код проекта:

    unit gridcalc;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, DB, DBTables, StdCtrls;
type
TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure TaxAmountCalc(DataSet: TDataset); private TaxAmount: TFloatField; end;
var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.TaxAmountCalc(DataSet: TDataset);
begin
Dataset['TaxAmount'] := Dataset['ItemsTotal'] * (Dataset['TaxRate'] / 100); end;

procedure TForm1.FormCreate(Sender: TObject);
var
MyTable: TTable; MyDataSource: TDataSource; MyGrid: TDBGrid; begin
MyTable := TTable.Create(Self);
with MyTable do begin DatabaseName := 'DBDemos'; TableName := 'Test.DB'; OnCalcFields := TaxAmountCalc;
with FieldDefs do begin Add('ItemsTotal', ftCurrency, 0, false); FieldDefs[0].CreateField(MyTable); Add('TaxRate', ftFloat, 0, false); FieldDefs[1].CreateField(MyTable); TFloatField(Fields[1]).DisplayFormat := '##.0%'; TaxAmount := TFloatField.Create(MyTable);
with TaxAmount do begin FieldName := 'TaxAmount'; Calculated := True; Currency := True; DataSet := MyTable; Name := MyTable.Name + FieldName; MyTable.FieldDefs.Add(Name, ftFloat, 0, false); end; end; MyTable.CreateTable; end;
MyDataSource := TDataSource.Create(Self); MyDataSource.DataSet := MyTable; MyGrid := TDBGrid.Create(Self);
with MyGrid do begin Parent := Self; Align := alClient; DataSource := MyDataSource; end;
MyTable.Active := True; Caption := 'Новая таблица ' + MyTable.TableName; end;

end.

[001269]



Формат файла ASCII-схемы


В файле asciidrv.txt насчет последнего числа в строке схемы поля говорится:

"* Offset - Number of characters from the beginning of the line that the field begins. Used for FIXED format only." (Offset - количество символов он начала линии до начала поля. Используется только для фиксированного формата.).

С тех пор, как мой файл имеет переменный (Variable) формат, я задал в каждой строке смещение, равное нулю. После некоторых попыток, чтобы заставить это работать, я следал следующие изменения:

    [discs]
filetype = varying
charset = ascii
delimiter = "
separator = ,
field1 = id,char,10,0,1
field2 = title,char,30,0,2
field3 = artist,char,30,0,3
...
field36 = song30,char,50,0,36

После более произвольных изменений это стало таким:

    [discs]
filetype = varying
charset = ascii
delimiter = "
separator = ,
field1 = id,char,10,0,10
field2 = title,char,30,0,20
field3 = artist,char,30,0,30
...
field36 = song30,char,50,0,360

и внезапно все заработало! Для поля, которое игнорируется форматом файла, "Offset" несомненно дало огромный эффект. [000343]



Функции редактора полей во время выполнения программы


Возможен ли вызов функций редактора полей (Fields Editor) во время выполнения программы?

Да. Если вы определили поля во время разработки приложения, то во время выполнения можно менять их свойства (например, Size).

Например, следующий код изменяет каждый размер поля TField.Size так, чтобы соответствовать фактическому размеру поля открываемого набора данных:

    procedure SetupFieldsAndOpenDataset(DataSet: TDataSet) ; var FieldNum, DefNum: Integer ; begin with DataSet do begin if Active then Close ; FieldDefs.Update ; {набор данных должен быть закрыт} {ищем каждое предопределенное TField в DataSet.FieldDefs:} for FieldNum := FieldCount - 1 downto 0 do with Fields[FieldNum] do begin DefNum := FieldDefs.IndexOf(FieldName) ; if DefNum < 0 then raise Exception.CreateFmt( 'Поле "%s" не найдено в наборе данных "%s"', [FieldName, Dataset.Name]) ; {устанавливаем свойство size:} Size := FieldDefs[DefNum].Size ; end ; Open ; end ; end ;

- Lindsay Reichmann [001006]



Как создать БД в кодировке CP1251?


Nomadic отвечает:

Вот такая конструкция проходит на DB2 2.1.2/NT и UDB5/NT... CREATE DATABASE Efes2 USING CODESET 1251 TERRITORY RU COLLATE USING IDENTITY; [001345]



Кросс-таблица через pivot-таблицу


Мне нужна помощь по реализации запроса кросс-таблицы в Delphi. У кого-нибудь имеется соответствующий опыт?

Использовать pivot-таблицу должен все тот-же общий механизм (относительно к любой базе данных SQL).

Предположим, что у нас есть данные продаж в таблице с полями Store, Product, Month, Sales, и вам необходимо отображать данные по продуктам за каждый месяц. (Примем, что поле 'month' для простоты имеет значения 1..12.)

Оригинальные данные примера: Store Product Month Sales #1 Toys 1 100 #2 Toys 1 68 #1 Toys 2 150 #1 Books 1 75 ... Желаемый отчет должен выглядеть похожим на этот: Product January February March ..... Toys 168 150 Books 75 ..... Установите pivot-таблицу с именем tblPivot и 12 строками: pvtMonth pvtJan pvtFeb pvtMar pvtApr .... 1 1 0 0 0 .... 2 0 1 0 0 3 0 0 1 0 4 0 0 0 1 ..... Теперь запрос, выполненный в виде: select Product, January=sum(Sales*pvtJan), February=sum(Sales*pvtFeb), March=sum(Sales*pvtMar), April=sum(Sales*pvtApr),... where Month = pvtMonth group by Product даст вам информацию, опубликованную выше.

Поскольку pivot-таблица имеет только 12 строк, большинство SQL-движков сохранят результат в кэшовой памяти, так что скорость выполнения запроса весьма велика.

- John Crowley [000766]



Проблема с AddIndex


Я использую таблицу paradox на своей локальной машине.

Я использую следующие команды:

    Table.DatabaseName := 'ABC';
Table.TableName := 'TEST';
Table.CreateTable;
Table.AddIndex('Primary','ID',[ixPrimary]); (работает как часы)
Table.AddIndex('Number_IDX','NUMBER',[ixUnique]); (здесь я получаю ошибку времени выполнения)

ID - LongInt поле
NUMBER - поле типа char[15] [001321]



Производная TIntegerField


Я думал о производной, новом варианте компонента TIntegerfield, но я не могу понять как мне его получить во время разработки, ведь он не устанавливается в палитру компонентов.

Это то, что вы хотите. Создайте следующий молуль:

MICRON.PAS:

    unit micron;
interface
uses DB, DBTables, Classes;
type
TMicronField = class(TIntegerField) public function IsValidChar(Ch: Char): Boolean; override; end;
procedure Register;
implementation
function TMicronField.IsValidChar(Ch: Char): Boolean; begin Result := Ch in ['+', '-', '0'..'9','.']; end;
procedure Register; begin RegisterFields([TMicronField]); end;
end.

Поместите данный модуль в ваш каталог lib и добавьте это поле, используя диалог установки компонент. Затем, используя "DataSet designer", свяжите TMicronField с нужными вам полями, после чего вы увидите, что список типов полей включает теперь "Micron". (для отображения полей на новый тип поля, сначала вам необходимо удалить все TIntegerFields).

Другое решение, более простое (но так-же работающее), заключается в изменении исходного кода DBTables и простой замене существующей функции IsValidChar на TIntegerField.

- Mark Edington [001015]



Создание db-файла во время работы приложения


    uses DB, DBTables, StdCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
tSource, TDest: TTable; begin TSource := TTable.create(self); with TSource do begin DatabaseName := 'dbdemos'; TableName := 'customer.db'; open; end; TDest := TTable.create(self); with TDest do begin DatabaseName := 'dbdemos'; TableName := 'MyNewTbl.db'; FieldDefs.Assign(TSource.FieldDefs); IndexDefs.Assign(TSource.IndexDefs); CreateTable; end; TSource.close; end;
[000027]



Создание кросс-таблицы


Вы можете создать их в DBD как QBE-шки. Пользуясь компонентом TQBE для загрузки одной из библиотек, вы можете непосредственно использовать QBE-шки в вашем Delphi-приложении.

В следующем примере предполагается, что каждый служащий каждый день сообщает оператору о своем месторасположении. Код определяет начало трудовой недели с понедельника плюс еще четыре рабочих дня с показом соответствующей даты. Строки с 1 по 5 в QBE1.QBE (нулевая описательная) в нижеприведенной процедуре заменяются кодом. Результат всего этого в том, что строка (если имеется) для каждого человека отображается в колонке установленного результата и значение 'X' включается если только запись существует. Для создания агрегатной таблицы можно было бы подсчитывать результаты.

Текст в QBE1.QBE :

CALLIN.DB | StaffNo | Date | | _join1 | 3/10/95 | | _join2 | 3/11/95 | | _join3 | 3/12/95 | | _join4 | 3/13/95 | | _join5 | 3/14/95 | XTAB.DB | StaffNo |Mon |Tue |Wed |Thu |Fri | | _join1 |changeto X| | | | | | _join2 | |changeto X| | | | | _join3 | | |changeto X| | | | _join4 | | | |changeto X| | | _join5 | | | | |changeto X|

    procedure TCallInReport.ButtonSelectClick(Sender: TObject); begin

TableXTab.active := false ; if EditWeekOf.Text = '' then begin messageBeep( 0 ) ; messageDlg( 'Для выбора записи необходима дата.', mtInformation, [mbOK], 0 ); exit ; end ;
Screen.Cursor := crHourGlass ;
dtWeekOf    := StrToDate( EditWeekOf.Text ) ; dtStartDate := dtWeekOf - DayOfWeek( dtWeekOf ) + 2 ;
TableXTab.active      := false ; TableXTab.EmptyTable ; TableXTab.active      := true ;
{ Замените строки 1 - 5 в QBE1.QBE реальными датами } QBE1.QBE.Strings[ 1 ] := '  | _join1  | ' + DateToStr( dtStartDate )      + ' | ' ; QBE1.QBE.Strings[ 2 ] := '  | _join2  | ' + DateToStr( dtStartDate  + 1 ) + ' | ' ; QBE1.QBE.Strings[ 3 ] := '  | _join3  | ' + DateToStr( dtStartDate  + 2 ) + ' | ' ; QBE1.QBE.Strings[ 4 ] := '  | _join4  | ' + DateToStr( dtStartDate  + 3 ) + ' | ' ; QBE1.QBE.Strings[ 5 ] := '  | _join5  | ' + DateToStr( dtStartDate  + 4 ) + ' | ' ;
try QBE1.active := true ; except on E: EDataBaseError do begin if E.Message = 'Ошибка создания дескриптора курсора' then { Ничего не делайте. Делая TQBE активной, мы пытаемся создать курсор. Это вызывает исключительную ситуацию, которую мы должны перехватить. Пока я не нашел способа как отделаться от исключения. } else begin Screen.Cursor := crDefault ; raise ; end ; end; else Screen.Cursor := crDefault ; raise ; end; TableXTab.refresh ; Screen.Cursor     := crDefault ; TableXTab.active  := true ;
end;

Michael Lant [000484]



Создание новой таблицы на основе структуры другой таблицы


На ум сразу приходит операция присваивания значения свойству (стоящему с левой стороны от ':='), при которой Delphi в своих недрах вызывает метод 'write' и передает ему в виде единственного параметра все то, что находится в правой части выражения. Если свойство не имеет метода write, оно предназначено только для чтения. Вот определение свойства FieldDefs объекта TDataSet в файле DB.PAS:

    property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;

Как вы можете видеть, у него есть метод write. Следовательно, код:

    Destination.FieldDefs := Source.FieldDefs;

в действительности делает такую операцию:

    Destination.SetFieldDefs(Source.FieldDefs);

(за исключением того, что вы не можете использовать эту строку, поскольку SetFieldDefs определен в секции Private.)

Вот определение свойства IndexDefs объекта TTable в файле DBTABLES.PAS file:

    property IndexDefs: TIndexDefs read FIndexDefs;

В этом случае метод write отсутствует, поэтому свойство имеет атрибут только для чтения. Тем не менее, для самого объекта TIndexDefs существует метод Assign. Следовательно, следующий код должен работать:

    Source.IndexDefs.Update;
Destination.IndexDefs.Assign(Source.IndexDefs);

Перед вызовом Assign для Source.IndexDefs вызывайте метод Update, чтобы быть уверенным в том, что вы получите то, что хотите.

Метод SetFieldDefs является процедурой с одной строкой кода, в которой вызывается метод FieldDefs Assign.

Также можно проверить, определен ли реально индекс, и, если нет, то при вызове IndexDefs.Assign вы можете получить исключение типа "List Index Out Of Bounds" (или что-то типа этого). Например, так:

    if Source.IndexDefs.Count > 0 then...

Вам нужно будет это сделать, поскольку метод TIndexDefs.Assign не проверяет это перед копированием индекс-информации. Также вам нет необходимости вызывать Clear до работы с IndexDefs, поскольку метод Assign сделает это и без вашего участия. [001235]



Создание таблицы с автоинкрементальным полем


Допустим у вас имеется форма с кнопкой. Щелчок на кнопке с помощью DbiCreateTable должен создать таблицу Paradox с автоинкрементальным (приращиваемым) полем.

    unit Autoinc;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DBTables, DB, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, DbiTypes, DbiErrs, DBIProcs; const
szTblName = 'CR8PXTBL'; { Имя создаваемой таблицы. } szTblType = szPARADOX;  { Используемый тип таблицы. }
{ При создании таблицы используется полное описание поля }
const
fldDes: array[0..1] of FLDDesc = ( ( { Поле 1 - AUTOINC } iFldNum:      1;            { Номер поля } szName:       'AUTOINC';    { Имя поля } iFldType:     fldINT32;     { Тип поля } iSubType:     fldstAUTOINC; { Подтип поля } iUnits1:      0;            { Размер поля } iUnits2:      0;            { Десятичный порядок следования ( 0 ) } iOffset:      0;            { Смещение в записи     ( 0 ) } iLen:         0;            { Длина в байтах        ( 0 ) } iNullOffset:  0;            { Для Null-битов        ( 0 ) } efldvVchk:    fldvNOCHECKS; { Проверка корректности ( 0 ) } efldrRights:  fldrREADWRITE { Права } ), ( { Поле 2 - ALPHA } iFldNum:      2; szName:       'ALPHA'; iFldType:     fldZSTRING; iSubType:     fldUNKNOWN; iUnits1:      10; iUnits2:     0; iOffset:      0; iLen:         0; iNullOffset:  0; efldvVchk:    fldvNOCHECKS; efldrRights:  fldrREADWRITE )    );
type
TForm1 = class(TForm) Button1: TButton; Database1: TDatabase; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Var
TblDesc: CRTblDesc; uNumFields: Integer; Rslt : DbiResult; ErrorString : Array[0..dbiMaxMsgLen] of Char; begin
FillChar(TblDesc, sizeof(CRTblDesc), #0); lStrCpy(TblDesc.szTblName, szTblName); lStrCpy(TblDesc.szTblType, szTblType); uNumFields := trunc(sizeof(fldDes) / sizeof (fldDes[0])); TblDesc.iFldCount := uNumFields; TblDesc.pfldDesc := @fldDes;
Rslt := DbiCreateTable(Database1.Handle, TRUE, TblDesc); If Rslt <> dbiErr_None then begin DbiGetErrorString(Rslt, ErrorString); MessageDlg(StrPas(ErrorString),mtWarning,[mbOk],0); end;
end;

end.

[000463]



Создание/удаление полей во время выполнения программы


TField-компоненты (или, точнее, потомки компонента TField с соответствующим типом поля) могут создаваться во время проектирования программы с помощью Fields Editor (редактора полей). Fields Editor вызывается двойным щелчком на иконке компонента TTable или TQuery. Но потомки TField могут быть созданы и удалены и в режиме выполнения программы.

Потомки компонента TField (такие как, например, TStringField, TIntegerField и др.) создаются методом Create для того типа потомка TField, который подходит к соответствующему полю набора данных. Другими словами, для поля строкового типа текущего набора данных необходимо вызвать метод Create класса TStringField, являющегося потомком TField. Методу Create необходим один параметр - владелец потомка TField, расположенный на TForm. После создания компонента наследника TField для того, чтобы новый экземпляр объекта мог установить связь с необходимым полем набора данных, необходимо установить несколько ключевых свойств. Вот их список:

FieldName: имя поля в таблице Name: уникальный идентификатор компонента-потомка TField. Index: позиция компонента-потомка TField в массиве TFields (свойство Fields компонента TTable или TQuery, с которым будет связан TField). DataSet: компонент TTable или TQuery, с которым будет связан TField. Приведенный ниже код демонстрирует способ создания TStringField. TForm названа Form1 (здесь ссылка на переменную Self), активный набор данных TQuery имеет имя Query1 и поле, для которого создается компонент TStringField, расположено в таблице dBASE с именем CO_NAME. Новый потомок TField будет вторым TField в свойстве-массиве Fields компонента Query1. Имейте в виду, что набор данных, связанный с новым потомком TField (в нашем случае Query1), перед добавлением TField должен быть закрыт, а после добавления вновь открыт.

    procedure TForm1.Button2Click(Sender: TOObject);
var
T: TStringField; begin
Query1.Close; T := TStringField.Create(Self); T.FieldName := 'CO_NAME'; T.Name := Query1.Name + T.FieldName; T.Index := Query1.FieldCount; T.DataSet := Query1; Query1.FieldDefs.UpDate; Query1.Open; end;

Вышеприведенный пример создает новый TStringField с именем Query1CO_NAME.

Для удаления существующего потомка TField достаточно вызова метода Free данного компонента. В примере, приведенном ниже, метод TForm FindComponent используется для получения указателя на компонент TStringField с именем Query1CO_NAME. Возвращаемая функцией FindComponent величина в случае успешного завершения будет иметь тип TComponent или nil в противном случае. Возвращаемое значение может использоваться для того, чтобы определить, действительно ли существует компонент до того, как будет применен метод Free.

    procedure TForm1.Button1Click(Sender: TObject);
var
TC: TComponent; begin
TC := FindComponent('Query1CO_NAME'); if not (TC = nil) then begin Query1.Close;
TC.Free; Query1.Open; end; end;

Как и при создании TField, набор данных, связанный с потомком TField и активный в настоящий момент, перед вызовом данного метода должен быть закрыт и впоследствии вновь активирован. [000532]



Создание уникального ID для новой записи


Существует несколько способов задавать в таблице уникальный ID. Вы можете использовать поле с автоприращением

Этот метод не очень надежен. Если ваша таблица каким-то образом испортится, и вам понадобиться ее пересобрать, автоинкрементальные поля будут перенумерованы. Хотя это легкий способ для ситуации, когда вы не ссылаетесь на id таблицы в других таблицах, но это не очень мудрое решение в других случаях.

Вы можете использовать ID-таблицу

Если у вас имеется приложение, где нескольким таблицам необходимы уникальные ID, создайте ID-таблицу с двумя полями: Table Name A (первичный ключ) Last Id N В методе BeforePost таблицы, которой необходим уникальный ID, делайте примерно так:

    TableBeforePost(Sender: TObject)
var
Id: Integer; begin
with TTable(Sender) do begin {проверяем, существует ли ID для этой записи} if Field[0].AsInteger=0  then begin {ищем имя таблицы в ID-Таблице} IDTable.FindKey[Name] {извлекаем последний Id - подразумеваем блокировку записи} Id := IDTable.FieldByName['Last Id'].AsInteger; Inc(Id); {записываем новый Id в ID-таблицу - подразумеваем разблокировку таблицы} IDTable.FieldByName['Last Id'].AsInteger := Id; IDTable.Post; {записываем извлеченный ID в вашу таблицу} Field[0].AsInteger := Id; end; end; end;

end;

Если вы поместите этот код в обработчик события таблицы BeforePost, вы убедитесь в том, что все ID будут последовательными (без "дырок"). Недостаток: если пользовать во время попытки добавления новой записи вдруг передумает, вы будете иметь запись с заполненным только полем ID.

В случае, если вы решили воспользоваться данным способом (последовательные ID), поместите приведенный выше код в обработчик события таблицы OnNewRecord.

Вы можете использовать ID-файл

Используйте те же принципы, что и в предыдущем способе, но вместо ID-таблицы используется ID-Файл. Это дает преимущество за счет более высокой скорости работы, но в многопользовательской среде вы должны сами заботиться о блокировке записей. [001254]



Создание уникального табличного индекса


Вот что пишет Галимарзанов Фанис:

Очень часто требуется решить проблему уникальности индекса для таблиц - не всегда можно дополнять ключ меткой времени. Для этого можно использовать метод TTable.OnPostError.
При создании таблицы добавляем поле Ax типа ftInteger или ftSmallInt, которое будет замыкать ключевые поля. К примеру, необходимо создать таблицу платежей абонентов, в которой могут существовать несколько платежей, проведенных в один день. abKod : код абонента, входит в первичный ключ Data : дата платежа, входит в первичный ключ Ax : дополнительное поле, входит в первичный ключ и замыкает его TypeOpl : тип оплаты Summ : сумма платежа В примере уникальность ключа можно обеспечить за счет поля Data, но это достигается за счет включения кода вида

    taOplData.Value:=taOplData.Value+Time;

т.к. оператор обычно вводит только день, месяц и год, остальное - по умолчанию.

В нашем случае при попытке записи не уникального ключа возбуждается исключение и программа переходит на обработку этого исключения

    Const
eKeyViol = 9729;  // код ошибки BDE - нарушение уникальности записи

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError;
var Action: TDataAction); begin
if (E is EDBEngineError) then // здесь обычный код распознавания кода ошибки
if (E as EDBEngineError).Errors[0].Errorcode = eKeyViol then  begin DataSet.FieldByName('Ax').Value:=DataSet.FieldByName('Ax').Value+1; // Увеличиваем значение поля Ax и повторяем попытку Post
Action:=daRetry; // повторить операцию сохранения end; end;

Этот метод я применяю во всех приложениях. Кстати - для начинающих, пишем код метода OnPostError только для одной таблицы, для остальных. имеющих поле Ах, - с помощью инспектора свойств-событий назначаем для события OnPostError ссылку на метод первой таблицы, для которой мы писали код. [000792]



Таблицы в памяти


Вот пример InMemoryTable. Свободен для использования, модификации и всего остального. Ну и как в отношении других вещей: я не даю никаких гарантий. Я не несу никакой ответственности за ущерб, который может причинить код. Позвольте, я повторю это:

ВНИМАНИЕ! ДАННЫЙ КОД НЕ ПРЕДУСМАТРИВАЕТ НИКАКИХ ГАРАНТИЙ!

ИСПОЛЬЗУЙТЕ ЕГО НА СВОЙ СТРАХ И РИСК - ВЫ ЕДИНСТВЕННЫЙ ЧЕЛОВЕК, ОТВЕТСТВЕННЫЙ ЗА ЛЮБОЙ УЩЕРБ, КОТОРЫЙ МОЖЕТ ПОВЛЕЧЬ ЗА СОБОЙ ИСПОЛЬЗОВАНИЕ ДАННОГО КОДА - - Я ВАС ПРЕДУПРЕДИЛ!

Благодарю Steve Garland <72700.2407@compuserve.com> за предоставленную помощь. Он создал свой собственный "in-memory" табличный компонент, который послужил мне толчком для написания сего кода.

InMemory-таблицы являются характеристикой Borland Database Engine (BDE). InMemory-таблицы создаются в RAM и удаляются при их закрытии. Работают они значительно быстрее и очень полезны в случае, если вам нужны быстрые операции в небольших таблицах. Данный пример использует вызов функции BDE DbiCreateInMemoryTable. Данный объект должен работать наподобии простой регулярной таблицы, за исключением того, что InMemory-таблицы не поддерживают некоторые характеристики (типа проверка целостности, вторичные индексы и BLOB-поля), и в настоящее время данный код не содержит механизма обработки ошибок. Вероятно, вы получите ошибку при попытке создания memo-поля. Если у вас есть любые замечания, шлите их по адресу grisha@mira.com.

    unit Inmem;

interface

uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;

type TInMemoryTable = class(TTable)
private hCursor: hDBICur; procedure EncodeFieldDesc(var FieldDesc: FLDDesc; const Name: string; DataType: TFieldType; Size: Word); function CreateHandle: HDBICur; override; public procedure CreateTable; end;
implementation

{ Эта функция виртуальная, так что я смог перекрыть ее. В оригинальном VCL-коде для TTable эта функция реально открывает таблицу, но, поскольку мы уже имеем дескриптор таблицы, то мы просто возвращаем его }

function TInMemoryTable.CreateHandle;
begin
Result := hCursor; end;

{ Эта функция получена ее простым копированием из исходного кода VCL. Я должен был это сделать, поскольку это было объявлено в секции private компонента TTable, поэтому отсюда у меня не было к этому досупа. }

procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
const Name: string; DataType: TFieldType; Size: Word); const
TypeMap: array[TFieldType] of Byte = ( fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL, fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES, fldVARBYTES, fldBLOB, fldBLOB, fldBLOB); begin
with FieldDesc do begin AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1); iFldType := TypeMap[DataType]; case DataType of ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic: iUnits1 := Size; ftBCD: begin iUnits1 := 32; iUnits2 := Size; end; end; case DataType of ftCurrency: iSubType := fldstMONEY; ftBlob: iSubType := fldstBINARY; ftMemo: iSubType := fldstMEMO; ftGraphic: iSubType := fldstGRAPHIC; end; end; end;

{ Вот кухня, где все это происходит. Я скопировал эту функцию из исходников VCL и затем изменил ее для использования DbiCreateInMemoryTable вместо DbiCreateTable. Поскольку InMemory-таблицы не поддерживают индексы, я удалил весь соответствующий код. }

procedure TInMemoryTable.CreateTable;
var
I: Integer; pFieldDesc: pFLDDesc; szTblName: DBITBLNAME; iFields: Word; Dogs: pfldDesc; begin
CheckInactive; if FieldDefs.Count = 0 then for I := 0 to FieldCount - 1 do with Fields[I] do if not Calculated then FieldDefs.Add(FieldName, DataType, Size, Required); pFieldDesc := nil; SetDBFlag(dbfTable, True); try AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1); iFields := FieldDefs.Count; pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc)); for I := 0 to FieldDefs.Count - 1 do with FieldDefs[I] do begin EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name, DataType, Size); end; { тип драйвера nil, т.к. поля логические } Check(DbiTranslateRecordStructure(nil, iFields, pFieldDesc, nil, nil, pFieldDesc)); { здесь hCursor получает свое значение } Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc, hCursor));
finally if pFieldDesc <> nil then FreeMem(pFieldDesc, iFields * SizeOf(FLDDesc));
SetDBFlag(dbfTable, False); end; end;

end.

{Данный код взят из файлов помощи Ллойда!}

[001370]




Начиная с Delphi2 в модуле SysUtils определена функция DayOfWeek(Date: TDateTime): Integer.

Тип TDateTime в Delphi1 определён как Double, дата это целая часть определяющая количество дней прошедших с 01.01.0001, дробная часть содержит время.

    (*******************************************************************************
Функция возвращает номер дня недели от 0 - Воскресенье до 6 - Суббота *******************************************************************************)
function DayOfWeek(Date:TDateTime):Integer;
begin
Result:=Trunc(Date) mod 7; end;

(*******************************************************************************
Функция возвращает название дня недели *******************************************************************************)
function NameDayOfWeek(Date:TDateTime):String;
const
DayNames:array[0..6] of String[11]=('Воскресенье', 'Понедельник', 'Вторник', 'Среда', 'Четверг', 'Пятница', 'Суббота'); begin
Result:=DayNames[DayOfWeek(Date)]; end;
С уважением Бахтинов Андрей [001603]


Частичный показ DateTime


При отображении TDateTimeField в DBGrid с форматированием hh:mm (для показа только времени), любая попытка изменения времени приводит (при передаче данных) к ошибке примерно такого содержания: "'07:00 is not a valid DateTime" (07:00 - неверный DateTime). Я хотел бы посылать данные приблизительно в таком виде "trunc(oldDateTimevalue)+strtoTime(displaytext)"

Следующий обработчик события TDateTimeField OnSetText не слишком элегантен, но он работает!

    procedure TForm1.Table1Date1SetText(Sender: TField; const Text: String); var d: TDateTime; t: string; begin t := Text; with Sender as TDateTimeField do begin if IsNull then d := SysUtils.Date else d := AsDateTime; AsDateTime := StrToDateTime(Copy(DateToStr(d),1,8)+' '+t); end; end;

Здесь мы исходим из предположения, что у вас имеется маска редактирования, допускающая формат hh:mm или hh:mm:ss.

- Mike Orriss [000868]



Число текущей недели


Здесь включены 2 вспомогательные функции, необходимые для работы вашей функции. Одна проверяет високосный год, другая возвращает число дней месяца (с проверкой високосного года), третья, ту, что вы хотели, возвращает текущую неделю года.

    {***************************************************************************}
function kcIsLeapYear( nYear: Integer ): Boolean;
begin
Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0)); end;

{***************************************************************************}
function kcMonthDays( nMonth, nYear: Integer ): Integer;
const
DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysPerMonth[nMonth]; if (nMonth = 2) and kcIsLeapYear(nYear) then Inc(Result); end;

{***************************************************************************}
function kcWeekOfYear( dDate: TDateTime ): Integer;
var
X, nDayCount: Integer; nMonth, nDay, nYear: Word; begin

nDayCount := 0;
deCodeDate( dDate, nYear, nMonth, nDay );
For X := 1 to ( nMonth - 1 ) do nDayCount := nDayCount + kcMonthDays( X, nYear );
nDayCount := nDayCount + nDay;
Result := ( ( nDayCount div 7 ) + 1 );
end;

[001410]



Даты и недели


У меня есть программа, которая делает примерно то, что вы хотите. Она сообщает для даты текущую неделю и день недели. Вам необходимо лишь реализовать вычисление предела для дат недели. Кроме того, формат в этом коде для дат задан в виде "06/25/1996".

Вы должны создать форму с именем "Forma", компонентом TEdit с именем "Edit1", четырьмя метками и кнопкой с именем "GetWeekBtn". Убедитесь в том, что обработчиком события формы OnCreate является метод FormCreate.

Надеюсь, что помог вам.

    unit Forma;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForma1 = class(TForm) Edit1: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; GetWeekBtn: TButton; Label4: TLabel; procedure GetWeekBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } Function HowManyDays(pYear,pMonth,pDay:word):integer; public { Public declarations } end; var
Forma1: TForma1;
implementation

{$R *.DFM}
Uses Inifiles;

procedure TForma1.FormCreate(Sender: TObject);
var       WinIni:TInifile;
begin
WinIni:=TIniFile.Create('WIN.INI'); WinIni.WriteString('intl','sShortDate','MM/dd/yyyy'); WinIni.Free; end;

Function TForma1.HowManyDays(pYear,pMonth,pDay:word):integer;
var      Sum:integer;
pYearAux:word; begin
Sum:=0; if pMonth>1  then Sum:=Sum+31; if pMonth>2  then Sum:=Sum+28; if pMonth>3  then Sum:=Sum+31; if pMonth>4  then Sum:=Sum+30; if pMonth>5  then Sum:=Sum+31; if pMonth>6  then Sum:=Sum+30; if pMonth>7  then Sum:=Sum+31; if pMonth>8  then Sum:=Sum+31; if pMonth>9  then Sum:=Sum+30; if pMonth>10 then Sum:=Sum+31; if pMonth>11 then Sum:=Sum+30;
Sum:=Sum + pDay; if ((pYear - (pYear div 4)*4)=3D0) and (pMonth>2)then inc(Sum);
HowManyDays:=Sum; end;   { HowManyDays }
procedure TForma1.GetWeekBtnClick(Sender: TObject);
var
ADate: TDateTime; EditAux:String; Week,year,month,day:Word; begin
EditAux:=Edit1.Text; ADate := StrToDate(EditAux); Label1.Caption := DateToStr(ADate); DecodeDate(Adate,Year,Month,Day);
Case DayOfWeek(ADate) of 1: Label4.Caption:='Воскресенье'; 2: Label4.Caption:='Понедельник'; 3: Label4.Caption:='Вторник'; 4: Label4.Caption:='Среда'; 5: Label4.Caption:='Четверг'; 6: Label4.Caption:='Пятница'; 7: Label4.Caption:='Суббота'; end Week:=(HowManyDays(year,month,day) div 7) +1;
Label3.Caption:='Неделя No. '+IntToStr(Week); end;

end.

[001401]



Дни недели


Кто-нибудь пробовал написать функцию, возвращающую для определенной даты день недели?

Моя функция как раз этим и занимается.

    unit datefunc;

interface
function checkdate (date : string) :boolean;
function Date2julian (date : string) : longint;
function Julian2date (julian : longint) : string;
function DayOfTheWeek (date : string) :string;
function idag : string;

implementation
uses
sysutils;
function idag () : string;
{Получает текущую дату и возвращает ее в формате YYYYMMDD для использования
другими функциями данного молуля.}
var
Year, Month, Day: Word; begin DecodeDate(Now, Year, Month, Day); result := IntToStr(year)+ IntToStr(Month) +IntToStr(day); end;

function Date2julian (date : string) : longint;
{Получает дату в формате YYYYMMDD.
Если у вас другой формат,
в первую очередь преобразуйте его.}
var
month,day,year:integer; ta,tb,tc : longint; begin
month := strtoint(copy(date,5,2)); day := strtoint(copy(date,7,2)); year := strtoint(copy(date,1,4)); if month > 2 then month := month - 3 else begin month := month + 9; year := year - 1; end; ta := 146097 * (year div 100) div 4; tb := 1461 * (year MOD 100) div 4; tc := (153 * month + 2) div 5 + day + 1721119; result := ta + tb + tc end;

function mdy2date (month, day, year : integer) : string;
var
y,m,d : string; begin
y := '000'+inttostr(year); y := copy(y,length(y)-3,4); m := '0'+inttostr(month); m := copy(m,length(m)-1,2); d := '0'+inttostr(day); d := copy(d,length(d)-1,2); result := y+m+d;
end;

function Julian2date (julian : longint) : string;
{Получает значение и возвращает дату в формате YYYYMMDD}
var
x,y,d,m : longint; month,day,year : integer; begin
x := 4 * julian - 6884477; y := (x div 146097) * 100; d := (x MOD 146097) div 4; x := 4 * d + 3; y := (x div 1461) + y; d := (x MOD 1461) div 4 + 1; x := 5 * d - 3; m := x div 153 + 1; d := (x MOD 153) div 5 + 1; if m < 11 then month := m + 2 else month := m - 10; day := d; year := y + m div 11; result := mdy2date(month, day, year); end;

function checkdate (date : string) :boolean;
{Дата должна быть в формате YYYYMMDD.}
var
julian : longint; test : string; begin
{Сначала преобразовываем строку в юлианский формат даты.
Это позволит получить необходимое значение.}
julian := Date2julian(date);
{Затем преобразовываем полученную величину в дату.
Это всегда будет правильной датой. Для проверки делаем обратное преобразование.
Результат проверки передаем как выходной параметр функции.}
test := Julian2date(julian);

if date = test then
result := true else
result := false; end;

function DayOfTheWeek (date : string) :string;
{Получаем дату в формате YYYYMMDD
и возвращаем день недели.}
var
julian : longint; begin
julian := (Date2julian(date)) MOD 7;
case julian of 0 : result := 'Понедельник'; 1 : result := 'Вторник'; 2 : result := 'Среда'; 3 : result := 'Четверг'; 4 : result := 'Пятница'; 5 : result := 'Суббота'; 6 : result := 'Воскресенье'; end; end;

end.
[000010]



Добавление даты и времени в компонент Memo


    { Следующий код вставляет значение даты/времени в memo-поле. }

Var
s : string ; begin
s :=  DateToStr( Date ) + ' ' + TimeToStr( Time ) + '  :' ; Memo1.Lines.Insert( 0,  s ) ; Memo1.SetFocus ; Memo1.SelStart := Length( s ) ; Memo1.SelLength := 0 ;

[001390]



Формат даты


У меня есть неотложная задача: в настоящее время я разрабатываю проект, где я должен проверять достоверность введенных дат с применением маски __/__/____, например 12/12/1997.

Некоторое время назад я делал простой шифратор/дешифратор дат, проверяющий достоверность даты. Код приведен ниже.

    function CheckDateFormat(SDate:string):string;
var
IDateChar:string; x,y:integer; begin
IDateChar:='.,\/'; for y:=1 to length(IDateChar) do begin x:=pos(IDateChar[y],SDate); while x>0 do begin Delete(SDate,x,1); Insert('-',SDate,x); x:=pos(IDateChar[y],SDate); end; end; CheckDateFormat:=SDate; end;

function DateEncode(SDate:string):longint;
var
year,month,day:longint; wy,wm,wd:longint; Dummy:TDateTime; Check:integer; begin
DateEncode:=-1; SDate:=CheckDateFormat(SDate); Val(Copy(SDate,1,pos('-',SDate)-1),day,check); Delete(Sdate,1,pos('-',SDate)); Val(Copy(SDate,1,pos('-',SDate)-1),month,check); Delete(SDate,1,pos('-',SDate)); Val(SDate,year,check); wy:=year; wm:=month; wd:=day; try Dummy:=EncodeDate(wy,wm,wd); except year:=0; month:=0; day:=0; end; DateEncode:=(year*10000)+(month*100)+day; end;
[000011]



Функция DateSer


Привет, я хочу в качестве совета поделиться функцией DateSer, которую я написал перед этим на VB. Данная функция весьма полезна но, к сожалению, ее нет в Delphi. Применяется она так:

    DecodeDate(Date,y,m,d); NewDate:=DateSer(y-4,m+254,d+1234);

или приблизительно так....

    function DateSer(y,m,d: Integer): TDateTime; const
mj: array[1..12] of Integer=(31,28,31,30,31,30,31,31,30,31,30,31); var
add: Integer; begin
while(true) do begin y:=y+(m-1) div 12; m:= (m-1) mod 12 +1; if m<=0 then begin Inc(m,12); Dec(y); end; if  ((y mod 4 = 0) and ((y mod 100<>0) or (y mod 400=0))) and (m=2) then add:=1 //дополнительный день в феврале else add:=0; if (d>0) and (d<=(mj[m]+add)) then break; if d>0 then begin Dec(d,mj[m]+add); Inc(m); end else begin Inc(d,mj[m]+add); Dec(m); end; end; Result:=EncodeDate(y,m,d); end;
[000012]



Хочу перевести дату `December


Олегом Кулабухов отвечает:

    var
D1, D2, D3 : TDateTime;
begin
D1 := VarToDateTime('December 6, 1969');
D2 := VarToDateTime('6-Apr-1998');
D3 := VarToDateTime('1998-Apr-6');
ShowMessage(DateToStr(D1)+' '+DateToStr(D2)+' '+
DateToStr(D3));
end;

[001916]



Как получить универсальные дату и время?


Олегом Кулабухов отвечает:

В примере главную роль играет GetSystemTime()

    procedure TForm1.Button1Click(Sender: TObject);
var
lt : TSYSTEMTIME;
st : TSYSTEMTIME;
begin
GetLocalTime(lt);
GetSystemTime(st);
Memo1.Lines.Add('LocalTime = ' +
IntToStr(lt.wmonth) + '/' +
IntToStr(lt.wDay) + '/' +
IntToStr(lt.wYear) + ' ' +
IntToStr(lt.wHour) + ':' +
IntToStr(lt.wMinute) + ':' +
IntToStr(lt.wSecond));
Memo1.Lines.Add('UTCTime = ' +
IntToStr(st.wmonth) + '/' +
IntToStr(st.wDay) + '/' +
IntToStr(st.wYear) + ' ' +
IntToStr(st.wHour) + ':' +
IntToStr(st.wMinute) + ':' +
IntToStr(st.wSecond));
end;

[001825]



Количество дней между двумя датами I


ПЕРЕМЕННЫЕ:

    Year1, Month1, Day1, Year2, Month2, Day2, YearResult, MonthResult, DayResult: Word; TDay1, TDay2, DateDiff: TDateTime;

КОД:

    TDay1 := EncodeDate(Year1, Month1, Day1); TDay2 := EncodeDate(Year2, Month2, Day2); DateDiff := TDay2 - TDay1; {предположим, что TDay2 позднее, чем TDay1} DecodeDate(DateDiff, YearResult, MonthResult, DayResult);

DateDiff имеет тип LongInt (хотя и является объектом TDateTime), и содержит количество дней между датами. [001402]



Количество дней между двумя датами II


Для DateDiff:

Вы смотрели на функцию DecodeDate? Это не точно именно то, что вам нужно, но на ее основе можно сделать вашу функцию именно с нужной вам функциональностью.

Для величины Present:

    function PresentValue(const cashflows : array of double;    { отсортированные
транзакции, начальный индекс - cashflows[0] }
n : integer; { количество транзакций в массиве } rate : double; { оценочный процент за истекший период } atbegin : boolean) : double; { true, если транзакция была в начале периода, false если в конце }
var
i         : integer; factor    : double; begin
factor := (1 + rate / 100.0); result := 0; for i := n - 1 downto 0 do result := (result + cashflows[n]) / factor; if atbegin then result := result * factor; end;

[001404]



Конвертирование даты


    TheDateField.AsString := TheDateString;
TheDateString := TheDateField.AsString;

это делает преобразование подобно DateToStr и StrToDate. Аналогично:

    TheDateField.AsDateTime := StrToDate(TheDateString);
TheDateString := DateToStr(TheDateField.AsDateTime);

[001406]



Математика времени


Работа с временными величинами в Delphi очень проста, если пользоваться встроенными функциями преобразования. Определите глобальные Hour, Minute, Second и инициализируйте их следующим образом:

    Hour   := EncodeTime(1,0,0,0); Minute := EncodeTime(0,1,0,0); Second := EncodeTime(0,0,1,0);

Или, если вы предпочитаете константы, сделайте так:

    Hour = 3600000/MSecsPerDay; Minute = 60000/MSecsPerDay; Second = 1000/MSecsPerDay;

Теперь для того, чтобы добавить 240 минут к переменной TDateTime, просто сделайте

    T := T + 240*Minute;

[000467]



Организация цикла между двумя датами


TDateTime - вещественное число (дата размещается в левой части числа, до десятичной точки, время - в правой части).

Для организации цикла от StartDate до StopDate, просто напишите from trunc(StartDate) to trunc(StopDate). [000574]



Переменная времени


Используйте переменную типа TDateTime.

    procedure TForm1.XXXXXXXClick(Sender: TObject);
var StartTime, EndTime, ElapsedTime :TDateTime;
begin
StartTime := Now; {Здесь поместите свой код} EndTime := Now; ElapsedTime := EndTime - StartTime; Label1.Caption := TimeToStr(ElapsedTime); end;

{теперь все это в памяти, но в нашем случае это хорошее место. }
var
before, after, elapsed : TDateTime; Ehour, Emin, Esec, Emsec : WORD; ...

before := now;

some_process();

after := now;
elapsed := after - before;

decodetime(elapsed, Ehour, Emin, Esec, Emsec);

теперь Ehour:Emin:Esec.Emsec будет содержать истекшее время.

Это то, что я хотел. fStartWhen содержит дату/время начала процесса. (fStartWhen := NOW). OneSecond - константа, определенная как 1/24/3600. (Да, эта программа может выполняться для нескольких дней. Но даже самый быстрый P5 может не справиться с большим количеством данных!)

    PROCEDURE        TformDBLoad.UpdateTime;
VAR        Delta        :TDateTime

BEGIN
fLastUpdate := NOW IF ABS( fStartWhen - fLastUpdate ) < OneSecond THEN EXIT Delta := fLastUpdate - fStartWhen doElapsedTime.Caption := FORMAT( '%1. дней из %s', [INT(Delta),FORMATDATETIME('hh:nn:ss', FRAC(Delta))] )
END;

[001417]



Получение номера месяца по его имени


...через цикл обхода элементов глобального массива LongMonthNames:

    Function GetMonthNumber ( Month : String ) : Integer; Begin For Result := 1 to 12 do If Month = LongMonthNames[Result] Then Exit; Result := 0; End;

[000646]



Преобразование даты


    procedure TForm1.Button1Click(Sender: TObject);
var
st, formatsave : string; DT         : TDateTime; begin
st := Edit1.text; // '1996-06-03 00.00.00' formatsave := ShortDateFormat; ShortDateFormat := 'yyyy.mm.dd hh.mm.ss'; while pos ('-', st) > 0 do st [pos ('-', st)] := '.'; DT := StrToDateTime (st); ShortDateFormat := formatsave; Label1.Caption := DateTimeToStr (DT); end;

[001397]



Преобразование даты - добавление столетия


    LongDate := FormatDateTime('ddmmyyyy', StrToDate(ShortDate));

Данный код преобразует дату, переданную в формате, определенном в виде короткой даты в Панели Управления (типа DD/MM/YY) в формат, заданный в строке Format (в нашем примере DDMMYYYY).

Если DD/MM/YY - входное поле, а DDMMYYYY - поле базы данных, то приведенный выше код может сослужить пользователю хорошую службу, если он вдруг захочет использовать другой формат даты, с его соответствующим переопределением в Панели Управления.

(Естественно, YYYYMMDD для поля базы данных при обычных обстоятельствах будет лучше чем DDMMYYYY, поскольку в настоящее время используется метод последовательной сортировки). [001398]



Преобразование даты в количество секунд


EncodeDate возвращает объект TDateTime, который просто является double-числом. Для получения количества миллисекунд с даты 1/1/0001, умножьте результат на 86400000.0 Но чтобы избежать переполнения, лучше пользоваться более поздней датой. [001394]



Преобразование даты в неделю


    procedure TForm1.Button1Click(Sender: TObject);
var  frstDay,toDay : TDateTime;  week : Integer;
begin
frstDay := StrToDate('1/1/96'); toDay := StrToDate(Edit1.Text); week := Trunc((toDay - frstDay) / 7) + 1; Label1.Caption := IntToStr(week); end;

[001396]



Приведение даты


    procedure TForm1.MaskEdit1Exit(Sender: TObject);
var
y, m, d : word; begin
decodedate(strtodate(maskedit1.text) +  11, y, m, d); maskedit2.text := inttostr(m) + '/' + inttostr(d) + '/' + inttostr(y); end;

[001400]



Проблема со временем


...я нашел Time24Hour в файлах помощи, как вы и советовали. Но...

вот код для EncodeTime в SysUtils.Pas file:

    function DoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
 Result := False; if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then begin Time := (LongMul(Hour * 60 + Min, 60000) + Sec * 1000 + MSec) / MSecsPerDay; Result := True; end; end;

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
begin
if not DoEncodeTime(Hour, Min, Sec, MSec, Result) then ConvertError(LoadStr(STimeEncodeError)); end;

Как вы можете видеть, проверка Time24Hour присутствует. Я думал в Browser все будет также. Ничего подобного! Я уж грешным делом подумал, что Time24Hour объявили устаревшим, исключили из поддержки, выбросили частично из кода, но забыли почистить файл помощи. Вы так не думаете? [001415]



Проверка дат


    function ValidDate(const S : String) : Boolean; BEGIN Result := True; try StrToDate(S); except ON EConvertError DO Result := False; end; END

[000556]



Разница во времени


...я не знаю, когда вы выполняете TimeTaken.. Вы делали какую-нибудь паузу перед запуском TimeTaken после выполнения SetTimeStart? Если не делали, то удивительно, что tt=Now.. Я пробовал ваш код с несколькими незначительными изменениями... и я всегда получал разницу между Now и TimeStart. Но я объявляю tt как TDateTime, а не как Double, и использую событие OnTimer для запуска процедуры TimeTaken. Вы можете проверить это, запустив пример, приведенный ниже.

    {*******************************************************************
ФАЙЛ : TIMEEX.PAS ПРИМЕЧАНИЕ : Создайте форму, содержащую 1 TTimer и 6 TLabel. Установите событие OnTimer у TTimer на TForm.Timer1.Timer ********************************************************************} unit Time;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm) Timer1: TTimer; Label1: TLabel;           {Caption : 'Старт :'} Label2: TLabel; Label3: TLabel;           {Caption : 'Время : '} Label4: TLabel; Label5: TLabel;           {Caption : 'Истекшее время:'} Label6: TLabel; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } TimeStart : TDateTime; public { Public declarations } end;
var
Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
TimeStart := Now; Label2.Caption := TimeToStr(Now); end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
tt : TDateTime; begin
Label4.Caption := TimeToStr(Now); tt:= Now - TimeStart; Label6.Caption:= TimeToStr(tt); end;

end.

[001413]



Универсальная функция возврата значения элемента даты


Галимарзанов Фанис советует:

Универсальная функция возврата значения элемента даты (год, месяц, день, квартал):

    function RetDate(inDate:TDateTime;inTip:integer):integer; var xYear,xMonth,xDay:word;
begin
Result:=0;
DecodeDate(inDate,xYear,xMonth,xDay);
case inTip of
1: Result:=xYear;                  // год
2: Result:=xMonth;                 // месяц
3: Result:=xDay;                   // день
4: if xMonth<4 then Result:=1 else // квартал
if xMonth<7 then Result:=2 else if xMonth<10 then Result:=3 else Result:=4; end;
end;

[000795]



Для обратной сортировки во многих


Для обратной сортировки во многих моих таблицах я использую инвертирование поля типа дата (12/31/9999 минус реальная дата).

В первой версии Delphi все было нормально, но во второй это не сработало, зато вот что я обнаружил в на странице 135 Reference Library Guide:

Delphi 1.0 вычислял дату первого года с 1899. Для преобразования даты Delphi 1.0 в формат даты Delphi 2.0, необходимо вычесть 693594.0 из даты Delphi 1.0. Формат даты был изменен для обеспечения совместимости с OLE 2.0 Automation.

- Kenneth D. James [000904]


Вычисление даты Пасхи


    function TtheCalendar.CalcEaster:String;
var B,D,E,Q:Integer;
GF:String; begin
B:=225-11*(Year Mod 19); D:=((B-21)Mod 30)+21; If D>48 then Dec(D); E:=(Year+(Year Div 4)+D+1)Mod 7; Q:=D+7-E; If Q<32 then begin If ShortDateFormat[1]='d' then Result:=IntToStr(Q)+'/3/'+IntToStr(Year)
else Result:='3/'+IntToStr(Q)+'/'+IntToStr(Year); end else begin If ShortDateFormat[1]='d' then Result:=IntToStr(Q-31)+'/4/'+IntToStr(Year)
else Result:='4/'+IntToStr(Q-31)+'/'+IntToStr(Year); end; {вычисление страстной пятницы} If Q<32 then begin If ShortDateFormat[1]='d' then GF:=IntToStr(Q-2)+'/3/'+IntToStr(Year) else GF:='3/'+IntToStr(Q-2)+'/'+IntToStr(Year); end else begin If ShortDateFormat[1]='d' then GF:=IntToStr(Q-31-2)+'/4/'+IntToStr(Year)
else GF:='4/'+IntToStr(Q-31-2)+'/'+IntToStr(Year); end;
end;
[000009]



Вычисление даты Пасхи II


    function Easter (Year: Integer): TDateTime; {----------------------------------------------------------------}
{ Вычисляет и возвращает день Пасхи определенного года.          }
{ Идея принадлежит Mark Lussier, AppVision <MLussier@best.com>.  }
{ Скорректировано для предотвращения переполнения целых, если по }
{ ошибке передан год с числом 6554 или более.                    }
{----------------------------------------------------------------}
var nMonth, nDay, nMoon, nEpact, nSunday, nGold, nCent, nCorx, nCorz: Integer; begin { Номер Золотого Года в 19-летнем Metonic-цикле: } nGold := (Year mod 19) + 1; { Вычисляем столетие: } nCent := (Year div 100) + 1; { Количество лет, в течение которых отслеживаются високосные года... } { для синхронизации с движением солнца: } nCorx := (3 * nCent) div 4 - 12; { Специальная коррекция для синхронизации Пасхи с орбитой луны: } nCorz := (8 * nCent + 5) div 25 - 5; { Находим воскресенье: } nSunday := (Longint(5) * Year) div 4 - nCorx - 10; { ^ Предохраняем переполнение года за отметку 6554} { Устанавливаем Epact - определяем момент полной луны: } nEpact := (11 * nGold + 20 + nCorz - nCorx) mod 30; if nEpact < 0 then nEpact := nEpact + 30; if ((nEpact = 25) and (nGold > 11)) or (nEpact = 24) then nEpact := nEpact + 1; { Ищем полную луну: } nMoon := 44 - nEpact; if nMoon < 21 then nMoon := nMoon + 30; { Позиционируем на воскресенье: } nMoon := nMoon + 7 - ((nSunday + nMoon) mod 7); if nMoon &gtl 31 then begin nMonth := 4; nDay   := nMoon - 31; end else begin nMonth := 3; nDay   := nMoon; end; Easter := EncodeDate(Year, nMonth, nDay); end; {Easter}

[001392]



Как передать UserName и Password в удаленный модуль данных (remote datamodule)?


Nomadic отвечает:

В Удаленный Модуль Данных бросьте компонент TDatabase, затем добавьте процедуру автоматизации (пункт главного меню Edit | Add To Interface) для Login.

Убедитесь, что свойство HandleShared компонента TDatabase установлено в True.

    procedure Login(UserName, Password: WideString);
begin
{ DB = TDatabase }

{ Something unique between clients }
DB.DatabaseName := UserName + 'DB';
DB.Params.Values['USER NAME'] := UserName;
DB.Params.Values['PASSWORD'] := Password;
DB.Open;
end;

После того, как Вы создали этот метод автоматизации, Вы можете вызывать его с помощью:

    RemoteServer1.AppServer.Login('USERNAME','PASSWORD');

[001477]



Модуль данных для каждого MDIChild


Когда во время разработки вы устанавливаете "DataSource"-свойство в БД-компонентах для указания на модуль данных, VCL во время выполнения приложения будет пытаться создать связь с существующим TDataModule, основываясь на его свойтсве Name. Так, если вы добавите модуль данных к вашему проекту и переместите его в свойстве проекта из колонки автоматически создаваемых форм в колонку доступных, вы сможете разработать форму, содержащую элементы управления для работы с базами данных, после чего несколькими строчками кода можете создать экземпляр формы, имеющий экземпляр собственного модуля данных.

С помощью Репозитория создайте "standard MDI application" (стандартное MDI-приложение), в котором модуль TMDICHild будет похож на приведенный ниже. Добавленные строки имеют комментарий {!}. Хитрости спрятаны в конструкторе create и задании другого порядка следования операторов.

    unit Childwin;
interface
uses Windows, Classes, Graphics, Forms, Controls, ExtCtrls, DBCtrls, StdCtrls, Mask, Grids, DBGrids, DataM; {!} // Модуль TDataModule1
type TMDIChild = class(TForm) DBGrid1: TDBGrid; DBGrid2: TDBGrid; DBEdit1: TDBEdit; DBEdit2: TDBEdit; DBNavigator1: TDBNavigator; procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } {!} DM:TDataModule1; {!} constructor Create(AOwner:TComponent); override; end;
implementation
{$IFDEF XOXOXOX}  // DataM должен находиться в секции interface. Необходимо для среды
uses DataM;      // времени проектирования. Определение "XOXOXOX" подразумевает, {$ENDIF}         // что это никогда не будет определено, но чтобы компилятор видел это.
{$R *.DFM}
{!} constructor TMDIChild.Create; {!} begin {!}   DM := TDataModule1.Create(Application); {!}   inherited Create(AOwner); {!}   DM.Name := ''; {!} end;
procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end;
end.

- Pat Ritchey [001014]