LED : array[1..10] of TLed; (10 элементов компонентного типа TLed)

for counter := 1 to 10 do
begin
LED[counter]:= TLED.Create;
LED[counter].top := ...
LED[counter].Left := ...
LED[counter].Parent := Mainform; {что-то типа этого}
end;

leds := 0;
for counter := 0 to Form.Componentcount do
begin
if (components[counter] is TLED) then
begin
inc(leds);
LED[leds] := TLED(components[counter]);
end
end;

for counter := 0 to Form.Componentcount do
begin
if (components[counter] is TLED) then
begin
LED[Component[counter].tag] := TLED(components[counter]);
end
end;

Var
MyButton : TButton;

MyButton := TButton.Create(MyForm); // MyForm теперь "обладает" MyButton
with MyButton do

BEGIN
Parent := MyForm; // Выбираем родителей. MyForm "усыновляет" MyButton
height := 32;
width := 128;
caption := 'Я здесь!';
left := (MyForm.ClientWidth - width) div 2;
top := (MyForm.ClientHeight - height) div 2;
END;

FSession := TSession.Create(nil);

FDatabase := TDatabase.Create(nil);
FSession.SessionName := 'DBSession'
FDatabase.Connected := False;
FDatabase.AliasName := Database;
FDatabase.DatabaseName := USER_DATABASE;
FDatabase.SessionName := FSession.SessionName;

FUserTBL := TTable.Create(nil);
FUserTBL.DatabaseName := FDatabase.DatabaseName;
FUserTBL.SessionName := FSession.SessionName;
FUserTBL.TableName := USERTBL;
FUserTBL.IndexName := USERSpIndex;

FUserSource := TDataSource.Create(nil);
FUserSource.DataSet := FUserTBL;

unit Unit2;

interface
uses db, DBTables, dialogs;

type fake = class(Ttable)

procedure fakeFilterRecord(DataSet: TDataSet; var Accept: Boolean);
end;

var

MyTable : fake;

implementation

procedure fake.fakeFilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin

showmessage('Здравствуй, Вася');
end;

Initialization

MyTable := fake.create(nil);
With Mytable do begin
DataBaseName := 'dbdemos';
TableName := 'biolife';
OnFilterRecord := MyTable.fakeFilterRecord;
Filtered := true;
active := true;
end;


{проверка получением неких данных...}
showmessage(MyTable.fields[1].asstring);

Finalization
{Важно! MyTable не имеет родителя, - уничтожаем объект сами, иначе память не высвобождается...}
MyTable.free;

end.

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TTabbedNotebook. }

procedure AddButton(tabNotebook : TTabbedNotebook);
var

tabpage : TTabPage;
button : TButton;
begin

with tabNotebook do
tabpage := TTabPage(Pages.Objects[PageIndex]);
button := TButton.Create(tabpage);
try
with button do begin
Parent := tabpage;
Left := Random(tabpage.ClientWidth - Width);
Top := Random(tabpage.ClientHeight - Height);
end;
except
button.Free;
end;
end;

TPage = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TNotebook. }

procedure AddButton(Notebook1 : TNotebook);
var

page : TPage;
button : TButton;
begin

with Notebook1 do
page := TPage(Pages.Objects[PageIndex]);
button := TButton.Create(page);
try
with button do begin
Parent := page;
Left := Random(page.ClientWidth - Width);
Top := Random(page.ClientHeight - Height);
end;
except
button.Free;
end;
end;

unit IDSLabel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,

ExtCtrls;

type
TIDSLabel = class(TBevel)
private
{ Private declarations }
FAlignment : TAlignment;
FCaption : String;
FFont : TFont;
FOffset : Byte;

FOn : TNotifyEvent;

procedure SetAlignment( taIn : TAlignment );
procedure SetCaption( const strIn : String);
procedure SetFont( fntNew : TFont );
procedure SetOffset( bOffNew : Byte );
protected
{ Protected declarations }
constructor Create( compOwn : TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Caption : String read FCaption write SetCaption;
property Font : TFont read FFont write SetFont;
property Offset : Byte read FOffset write SetOffset;

property On : TNotifyEvent read FOn write FOn;
end;

implementation

constructor TIDSLabel.Create;
begin

inherited Create(compOwn);

FFont := TFont.Create;
with compOwn as TForm do
FFont.Assign(Font);

Offset := 4;
Height := 15;
end;

destructor TIDSLabel.Destroy;
begin

FFont.Free;

inherited Destroy;
end;

procedure TIDSLabel.Paint;
var

wXPos, wYPos : Word;
begin

{Рисуем рамку}
inherited Paint;

{Назначаем шрифт}
Canvas.Font.Assign(Font);

{Вычисляем вертикальную позицию}
wYPos := (Height - Canvas.TextHeight(Caption)) div 2;

{Вычисляем горизонтальную позицию}
wXPos := Offset;
case Alignment of
taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
end;
Canvas.Brush := Parent.Brush;
Canvas.TextOut(wXPos,wYPos,Caption);

end;

procedure TIDSLabel.SetAlignment;
begin

FAlignment := taIn;
Invalidate;
end;

procedure TIDSLabel.SetCaption;
begin
FCaption := strIn;


if Assigned(FOn) then
FOn(Self);


Invalidate;
end;

procedure TIDSLabel.SetFont;
begin

FFont.Assign(fntNew);
Invalidate;
end;

procedure TIDSLabel.SetOffset;
begin

FOffset := bOffNew;
Invalidate;
end;

end.

Procedure DoSomethingWithEditControls;
Var K: Integer;

EditArray: Array[0..99] of Tedit;
begin
Try

For K:= 0 to 99 do
begin
EditArray[K]:= TEdit.Create(Self);
EditArray[K].Parent:= Self;
SetSomeOtherPropertiesOfTEdit; {Устанавливаем необходимые свойства TEdit}
Left:= 100; Top:= K;
OnMouseMove:= WhatToDoWhenMouseIsMoved; {Что-то делаем при перемещении мыши}
end;
DoWhateverYouWantToDoWithTheseEdits; {Делаем все что хотим с полученным массивом Edit-компонентов}
Finally
For K:= 0 to 99 do EditArray[K].Free;
end;

implementation

{$R *.DFM}

var n: integer; // При инициализации программы данное значение будет равным нулю

procedure TForm1.Button1Click(Sender: TObject);
var Image: TBitmap;
begin // Изменение иконки в BitBtn1

Image:= TBitmap.Create;
if n < ImageList1.Count then
ImageList1.GetBitmap(n, Image);
{end if}


BitBtn1.Glyph.Assign(Image) // Примечание: Для изменения свойств объекта используется метод Assign


inc(n,2); // В данный момент кнопка содержит две иконки!
if n > ImageList1.Count then
n:= 0;
{end if}
Image.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin // добавляем новую иконку кнопки в список ImageList1
if OpenDialog1.ute then
ImageList1.FileLoad(rtBitMap,OpenDialog1.FileName,clBtnFace);
label1.Caption:= 'Количество иконок = ' + IntToStr(ImageList1.Count);
end;

uses clipbrd;

procedure TShowVRML.Kopieren1Click(Sender: TObject);
var bitmap:tbitmap;
begin

bitmap:=tbitmap.create;
bitmap.width:=clientwidth;
bitmap.height:=clientheight;
try
with bitmap.Canvas do
CopyRect (clientrect,canvas,clientrect);
clipboard.assign(bitmap);
finally
bitmap.free;
end;
end;

unit ClipboardViewer;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FNextViewerHandle : THandle;
procedure WMDrawClipboard (var message : TMessage);
message WM_DRAWCLIPBOARD;
procedure WMCBCHain (var message : TMessage);
message WM_CBCHAIN;
public
end;
var

Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin

// Проверяем работоспособность функции.
// При невозможности просмотра буфера обмена
// функция возвратит значение Nil.
FNextViewerHandle := SetClipboardViewer(Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

// Восстанавливаем цепочки.
ClipboardChain(Handle, FNextViewerHandle);
end;

procedure TForm1.WMDrawClipboard (var message : TMessage);
begin
// Вызывается при любом изменении содержимого буфера обмена

message.Result := SendMessage(WM_DRAWCLIPBOARD, FNextViewerHandle, 0, 0);
end;

procedure TForm1.WMCBCHain (var message : TMessage);
begin

// Вызывается при любом изменении цепочек буфера обмена.
if message.wParam = FNextViewerHandle then begin
// Удаляем следующую цепочку просмотра. Корректируем внутреннюю переменную.
FNextViewerHandle := message.lParam;
// Возвращаем 0 чтобы указать, что сообщение было обработано
message.Result := 0;
end else begin
// Передаем сообщение следующему окну в цепочке.
message.Result := SendMessage(FNextViewerHandle, WM_CBCHAIN,
message.wParam, message.lParam);

end;
end;

end.

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, TypInfo, Debug;

type

TUniqueReader = Class(TReader)
LastRead: TComponent;
procedure ComponentRead(Component: TComponent);
procedure SetNameUnique(
Reader: TReader;
Component: TComponent;
var Name: string
);
end;

implementation

procedure TUniqueReader.ComponentRead(

Component: TComponent
);
begin

LastRead := Component;
end;

procedure TUniqueReader.SetNameUnique( // Задаем уникальное имя считываемому компоненту

Reader: TReader;
Component: TComponent; // Считываемый компонент
var Name: string // Имя компонента для дальнейшей модификации
);
var

i: Integer;
tempname: string;
begin

i := 0;
tempname := Name;
while Component.Owner.FindComponent(Name) <> nil do begin
Inc(i);
Name := Format('%s%d', [tempname, i]);
end;
end;


function DuplicateComponents(

AComponent: TComponent // исходный компонент
): TComponent; // возвращаемся к созданию нового компонента

procedure RegisterComponentClasses(
AComponent: TComponent
);
var
i : integer;
begin
RegisterClass(TPersistentClass(AComponent.ClassType));
if AComponent is TWinControl then
if TWinControl(AComponent).ControlCount > 0 then
for i := 0 to
(TWinControl(AComponent).ControlCount-1) do

RegisterComponentClasses(TWinControl(AComponent).Controls[i]);

end;

var

Stream: TMemoryStream;
UniqueReader: TUniqueReader;
Writer: TWriter;
begin

result := nil;
UniqueReader := nil;
Writer := nil;


try
Stream := TMemoryStream.Create;
RegisterComponentClasses(AComponent);


try
Writer := TWriter.Create(Stream, 4096);
Writer.Root := AComponent.Owner;
Writer.WriteSignature;
Writer.WriteComponent(AComponent);
Writer.WriteListEnd;
finally
Writer.Free;
end;


Stream.Position := 0;
try
UniqueReader := TUniqueReader.Create(Stream, 4096); // создаем поток, перемещающий данные о компоненте в конструктор
UniqueReader.OnSetName := UniqueReader.SetNameUnique;
UniqueReader.LastRead := nil;


if AComponent is TWinControl then

UniqueReader.ReadComponents(
// считываем компоненты и суб-компоненты

TWinControl(AComponent).Owner,
TWinControl(AComponent).Parent,
UniqueReader.ComponentRead
)
else

UniqueReader.ReadComponents(
// читаем компоненты

AComponent.Owner,
nil,
UniqueReader.ComponentRead
);
result := UniqueReader.LastRead;
finally
UniqueReader.Free;
end;
finally
Stream.Free;
end;
end;

procedure TConvertForm.CopyTable(FromDir, SrcTblName, ToDir, DestTblName: String);
var

DBHandle: HDBIDB;
ResultCode: DBIResult;
Src, Dest, Err: Array[0..255] of Char;
SrcTbl, DestTbl: TTable;
begin

SrcTbl := TTable.Create(Application);
DestTbl := TTable.Create(Application);
try
SrcTbl.DatabaseName := FromDir;
SrcTbl.TableName := SrcTblName;
SrcTbl.Open;
DBHandle := SrcTbl.DBHandle;
SrcTbl.Close;
ResultCode := DbiCopyTable(DBHandle,false,
StrPCopy(Src,FromDir + '' + SrcTblName),nil,
StrPCopy(Dest,ToDir + '' + DestTblName));
if (ResultCode <> DBIERR_NONE) then
begin
DbiGetErrorString(ResultCode,Err);
raise EDatabaseError.Create('При копировании ' +
FromDir + '' + SrcTblName + ' в ' +
ToDir + '' + DestTblName + ' ,'
+ 'BDE сгенерировал ошибку '''
+ StrPas(Err) + '''');
end;
finally
SrcTbl.Free;
DestTbl.Free;
end;
end;

procedure TConvertForm.Table(Dir, TblName: String);
var

DBHandle: HDBIDB;
ResultCode: DBIResult;
tbl, Err: Array[0..255] of Char;
SrcTbl, DestTbl: TTable;
SrcTbl := TTable.Create(Application);
try
SrcTbl.DatabaseName := Dir;
SrcTbl.TableName := TblName;
SrcTbl.Open;
DBHandle := SrcTbl.DBHandle;
SrcTbl.Close;
ResultCode := DbiTable(DBHandle,
StrPCopy(Tbl,Dir + '' + TblName),nil);
if (ResultCode <> DBIERR_NONE) then
begin
DbiGetErrorString(ResultCode,Err);
raise EDatabaseError.Create('Удаляя ' +
Dir + '' + TblName + ', BDE ' +
'сгенерировал ошибку '''
+ StrPas(Err) + '''');
end;
finally
SrcTbl.Free;
end;
end;

unit Finder;

interface

uses DB, DBTables, SysUtils;

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
function DoFindIn(TheField : TField; SFor : String): Boolean;
function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
{применение функции FindIt -

if FindIt(NotesSearchT,
[NotesSearchT.FieldByName('Leadman').Index],
False, True, SearchText.Text) then DoSomething; }

implementation

function GrabMemoFieldAsPChar(TheField : TMemoField): PChar;
begin
with TBlobStream.Create(TheField, bmRead) do

begin
GetMem(Result, Size + 1);
FillChar(Result^, Size + 1, #0);
Read(Result^, Size);
Free;
end;
end;

function DoFindIn(TheField : TField; SFor : String): Boolean;
var

PChForMemo : PChar;
begin
Result := False;
case TheField.DataType of

ftString :
begin
if (Pos(SFor, UpperCase(TheField.AsString)) > 0) then
Result := True;
end;
ftInteger :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftBoolean :
begin
if SFor = UpperCase(TheField.AsString) then
Result := True;
end;
ftFloat :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftCurrency :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftDate .. ftDateTime :
begin
if (Pos(SFor, TheField.AsString) > 0) then Result := True;
end;
ftMemo :
begin
SFor[Ord(SFor[0]) + 1] := #0;
PChForMemo := GrabMemoFieldAsPChar(TMemoField(TheField));
StrUpper(PChForMemo);
if not (StrPos( PChForMemo, @SFor[1] ) = nil) then Result :=
True; FreeMem(PChForMemo, StrLen(PChForMemo + 1));
end;
end;
end;

function FindIt(TheTable : TDataSet; TheFields : array of integer;

SearchBackward : Boolean; Beginning : Boolean; SFor : String): Boolean;
var

i, HighTheFields, LowTheFields : integer;
BM : TBookmark;
begin
TheTable.DisableControls;
BM := TheTable.GetBookmark;
try
LowTheFields := Low(TheFields);
HighTheFields := High(TheFields);
SFor := UpperCase(SFor);
Result := False;
if Beginning then TheTable.First;
if SearchBackward then

begin
TheTable.Prior;
while not TheTable.BOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Prior;
end;
end else
begin
TheTable.Next;
while not TheTable.EOF do
begin
for i := LowTheFields to HighTheFields do
begin
if DoFindIn(TheTable.Fields[TheFields[i]], SFor) then
begin
Result := True;
Break;
end;
end;
if Result then Break else TheTable.Next;
end;
end;
finally
TheTable.EnableControls;
if not Result then

TheTable.GotoBookmark(BM);
TheTable.FreeBookmark(BM);
end;

end;

end.

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;

type

VArray : Array[1..1] of double;
var

X : ^VArray;
NR, NC : Longint;

begin

NR := 10000;
NC := 100;
if AllocArray(pointer(X), N*Sizeof(VArray)) then exit;
SetV(X^, NC, 2000, 5, 3.27); { X[2000,5] := 3.27 }
end;

function AllocArray(var V : pointer; const N : longint) : Boolean;
begin {распределяем память для массива V размера N}

try
GetMem(V, N);
except
ShowMessage('ОШИБКА выделения памяти. Размер:' + IntToStr(N));
Result := True;
exit;
end;
FillChar(V^, N, 0); {в случае включения длинных строк заполняем их нулями}
Result := False;
end;

procedure SetV(var X : Varray;const N,ir,ic : LongInt;const value :
double);
begin {заполняем элементами двухмерный массив X размером ? x N : X[ir,ic] := value}

X[N*(ir-1) + ic] := value;
end;

function GetV(const X : Varray; const N, ir,ic : Longint) : double;
begin {возвращаем величины X[ir,ic] для двухмерного массива шириной N столбцов}

Result := X[N*(ir-1) + ic];
end;

Myarray := GetMem(rows * cols * sizeof(byte,word,single,double и пр.)

function fetch_num(r,c:integer) : single;
result := pointer + row + col*rows

myarray.fetch_num(2,3)

(*


модуль для создания двух очень простых классов обработки динамических массивов
TDynaArray : одномерный массив
TDynaMatrix : двумерный динамический массив

*)

unit DynArray;

INTERFACE

uses

SysUtils;

Type

TDynArrayBaseType = double;

Const

vMaxElements = (High(Cardinal) - $f) div sizeof(TDynArrayBaseType);
{= гарантирует максимально возможный массив =}


Type

TDynArrayNDX = 1..vMaxElements;
TArrayElements = array[TDynArrayNDX] of TDynArrayBaseType;
{= самый большой массив TDynArrayBaseType, который мы может объявить =}
PArrayElements = ^TArrayElements;
{= указатель на массив =}


EDynArrayRangeError = CLASS(ERangeError);


TDynArray = CLASS
Private
fDimension : TDynArrayNDX;
fMemAllocated : word;
Function GetElement(N : TDynArrayNDX) : TDynArrayBaseType;
Procedure SetElement(N : TDynArrayNDX; const NewValue : TDynArrayBaseType);
Protected
Elements : PArrayElements;
Public
Constructor Create(NumElements : TDynArrayNDX);
Destructor Destroy; override;
Procedure Resize(NewDimension : TDynArrayNDX); virtual;
Property dimension : TDynArrayNDX
read fDimension;
Property Element[N : TDynArrayNDX] : TDynArrayBaseType
read GetElement
write SetElement;
default;
END;

Const

vMaxMatrixColumns = 65520 div sizeof(TDynArray);
{= построение матрицы класса с использованием массива объектов TDynArray =}

Type

TMatrixNDX = 1..vMaxMatrixColumns;
TMatrixElements = array[TMatrixNDX] of TDynArray;
{= каждая колонка матрицы будет динамическим массивом =}
PMatrixElements = ^TMatrixElements;
{= указатель на массив указателей... =}


TDynaMatrix = CLASS
Private
fRows : TDynArrayNDX;
fColumns : TMatrixNDX;
fMemAllocated : longint;
Function GetElement( row : TDynArrayNDX;
column : TMatrixNDX) : TDynArrayBaseType;
Procedure SetElement( row : TDynArrayNDX;
column : TMatrixNDX;
const NewValue : TDynArrayBaseType);
Protected
mtxElements : PMatrixElements;
Public
Constructor Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);
Destructor Destroy; override;
Property rows : TDynArrayNDX
read fRows;
Property columns : TMatrixNDX
read fColumns;
Property Element[row : TDynArrayNDX; column : TMatrixNDX] : TDynArrayBaseType
read GetElement
write SetElement;
default;
END;

IMPLEMENTATION

(*


методы TDynArray

*)
Constructor TDynArray.Create(NumElements : TDynArrayNDX);

BEGIN {==TDynArray.Create==}
inherited Create;
fDimension := NumElements;
GetMem( Elements, fDimension*sizeof(TDynArrayBaseType) );
fMemAllocated := fDimension*sizeof(TDynArrayBaseType);
FillChar( Elements^, fMemAllocated, 0 );
END; {==TDynArray.Create==}

Destructor TDynArray.Destroy;

BEGIN {==TDynArray.Destroy==}
FreeMem( Elements, fMemAllocated );
inherited Destroy;
END; {==TDynArray.Destroy==}

Procedure TDynArray.Resize(NewDimension : TDynArrayNDX);

BEGIN {TDynArray.Resize==}
if (NewDimension < 1) then
raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [NewDimension]);
Elements := ReAllocMem(Elements, fMemAllocated, NewDimension*sizeof(TDynArrayBaseType));
fDimension := NewDimension;
fMemAllocated := fDimension*sizeof(TDynArrayBaseType);
END; {TDynArray.Resize==}

Function TDynArray.GetElement(N : TDynArrayNDX) : TDynArrayBaseType;

BEGIN {==TDynArray.GetElement==}
if (N < 1) OR (N > fDimension) then
raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [N]);
result := Elements^[N];
END; {==TDynArray.GetElement==}

Procedure TDynArray.SetElement(N : TDynArrayNDX; const NewValue : TDynArrayBaseType);

BEGIN {==TDynArray.SetElement==}
if (N < 1) OR (N > fDimension) then
raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [N]);
Elements^[N] := NewValue;
END; {==TDynArray.SetElement==}

(*


методы TDynaMatrix

*)
Constructor TDynaMatrix.Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);

Var col : TMatrixNDX;
BEGIN {==TDynaMatrix.Create==}
inherited Create;
fRows := NumRows;
fColumns := NumColumns;
{= выделение памяти для массива указателей (т.е. для массива TDynArrays) =}
GetMem( mtxElements, fColumns*sizeof(TDynArray) );
fMemAllocated := fColumns*sizeof(TDynArray);
{= теперь выделяем память для каждого столбца матрицы =}
for col := 1 to fColumns do
BEGIN
mtxElements^[col] := TDynArray.Create(fRows);
inc(fMemAllocated, mtxElements^[col].fMemAllocated);
END;
END; {==TDynaMatrix.Create==}

Destructor TDynaMatrix.Destroy;

Var col : TMatrixNDX;
BEGIN {==TDynaMatrix.Destroy;==}
for col := fColumns downto 1 do
BEGIN
dec(fMemAllocated, mtxElements^[col].fMemAllocated);
mtxElements^[col].Free;
END;
FreeMem( mtxElements, fMemAllocated );
inherited Destroy;
END; {==TDynaMatrix.Destroy;==}

Function TDynaMatrix.GetElement( row : TDynArrayNDX;

column : TMatrixNDX) : TDynArrayBaseType;
BEGIN {==TDynaMatrix.GetElement==}
if (row < 1) OR (row > fRows) then
raise EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);
if (column < 1) OR (column > fColumns) then
raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);
result := mtxElements^[column].Elements^[row];
END; {==TDynaMatrix.GetElement==}

Procedure TDynaMatrix.SetElement( row : TDynArrayNDX;

column : TMatrixNDX;
const NewValue : TDynArrayBaseType);
BEGIN {==TDynaMatrix.SetElement==}
if (row < 1) OR (row > fRows) then
raise EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);
if (column < 1) OR (column > fColumns) then
raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);
mtxElements^[column].Elements^[row] := NewValue;
END; {==TDynaMatrix.SetElement==}


END.


Тестовая программа для модуля DynArray

uses DynArray, WinCRT;

Const

NumRows : integer = 7;
NumCols : integer = 5;

Var

M : TDynaMatrix;
row, col : integer;
BEGIN

M := TDynaMatrix.Create(NumRows, NumCols);
for row := 1 to M.Rows do
for col := 1 to M.Columns do
M[row, col] := row + col/10;
writeln('Матрица');
for row := 1 to M.Rows do
BEGIN
for col := 1 to M.Columns do
write(M[row, col]:5:1);
writeln;
END;
writeln;
writeln('Перемещение');
for col := 1 to M.Columns do
BEGIN
for row := 1 to M.Rows do
write(M[row, col]:5:1);
writeln;
END;
M.Free;
END.

PROCEDURE TForm1.Edit1Exit(Sender: TObject);
BEGIN

IF Edit1.Text<>'' THEN BEGIN
TRY
StrToDate(Edit1.Text);
EXCEPT
Edit1.SetFocus;
MessageBeep(0);
raise Exception.Create('"'+Edit1.Text
+'" - некорректная дата');
END{try};
Edit1.Text:=DateToStr(StrToDate(Edit1.Text));
END{if};
END;