(*****************************************************************************
* DbUtils.pas
*
* Утилита для работы с базами данных
*****************************************************************************)
unit Dbutils;

(****************************************************************************)
(****************************************************************************)

interface
(****************************************************************************)
(****************************************************************************)

uses

DbTables;

function DbGetVersion(table: TTable): LongInt;


(****************************************************************************)
(****************************************************************************)

implementation
(****************************************************************************)
(****************************************************************************)

uses

Db, DbiProcs, DbiTypes, {DbiErrs,}
SysUtils;


{-}
(*

* Цель: определение номера версии структуры таблицы
* Параметры: table (I) - интересующая нас таблица
* Возвращаемая величина: номер версии
* Исключительная ситуация: EDatabaseError
*)
function DbGetVersion(table: TTable): LongInt;
var

hCursor : hDBICur;
tableDesc: TBLFullDesc;
cName : array[0..255] of Char;
begin

{ копируем имя таблицы в строку 'с' }
StrPCopy(cName, table.TableName);


{ просим BDE создать запись, содержащую информацию об определенной таблице }
Check(DbiOpenTableList(table.DBHandle, True, False, cName, hCursor));


{ получаем запись, содержащую информацию о структуре }
Check(DbiGetNextRecord(hCursor, dbiNOLOCK, @tableDesc, nil));


{ возвращаем поле записи, содержащее номер версии структуры нашей таблицы }
Result := tableDesc.tblExt.iRestrVersion;


Check(DbiCloseCursor(hCursor));
end;

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.

//*************************************************************************
// Функция (раздел Public) SetPCSystemTime
//изменяет системную дату и время.
// Параметр(ы) : tDati Новая дата и время
// Возвращаемые значения:
//True - успешное завершение
//False - метод несработал
//*************************************************************************
function SetPCSystemTime(tDati: TDateTime): Boolean;
var

tSetDati: TDateTime;
vDatiBias: Variant;
tTZI: TTimeZoneInformation;
tST: TSystemTime;
begin

GetTimeZoneInformation(tTZI);
vDatiBias := tTZI.Bias / 1440;
tSetDati := tDati + vDatiBias;
with tST do
begin
wYear := StrToInt(FormatDateTime('yyyy', tSetDati));
wMonth := StrToInt(FormatDateTime('mm', tSetDati));
wDay := StrToInt(FormatDateTime('dd', tSetDati));
wHour := StrToInt(FormatDateTime('hh', tSetDati));
wMinute := StrToInt(FormatDateTime('nn', tSetDati));
wSecond := StrToInt(FormatDateTime('ss', tSetDati));
wMilliseconds := 0;
end;
SetPCSystemTime := SetSystemTime(tST);
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;

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);
('-',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:=(year000)+(month0)+day;
end;

Word.ActiveDocument.Bookmarks.Add(BookMarkName);

Word.ActiveDocument.Bookmarks.Item(BookMarkName);

Word.ActiveDocument.Bookmarks.Item(1);

Word.ActiveDocument.Bookmarks.Item(BookMarkName);
Word.ActiveDocument.Bookmarks.Item(1);

Word.ActiveWindow.View.ShowBookmarks:=True; // отобразить закладки
Word.ActiveWindow.View.ShowBookmarks:=False; // скрыть закладки

Word.ActiveDocument.Bookmarks.Item('StartOfDoc');