StaircaseMatrix
unit StaircaseMatrix;
interface
uses Classes;
function Summation( SumTo: Integer ): Integer;
type
TStaircaseMatrixOfObjects = class
private
FSize: Integer;
FlatMatrix: array of TObject;
function GetCell(I, J: Integer): TObject;
procedure SetCell(I, J: Integer; const Value: TObject);
procedure SetSize(const Value: Integer);
public
constructor Create;
destructor Destroy; override;
property Size: Integer read FSize write SetSize;
property Cell[ I, J: Integer ]: TObject read GetCell write SetCell; default;
procedure PopulateRowAndColumn( IJ: Integer; Value: TObject );
procedure PopulateMatrix( Value: TObject );
end;
TStaircaseMatrixOfIntegers = class
private
FSize: Integer;
FlatMatrix: array of Integer;
function GetCell(I, J: Integer): Integer;
procedure SetCell(I, J: Integer; const Value: Integer);
procedure SetSize(const Value: Integer);
public
constructor Create;
destructor Destroy; override;
property Size: Integer read FSize write SetSize;
property Cell[ I, J: Integer ]: Integer read GetCell write SetCell; default;
procedure PopulateRowAndColumn( IJ: Integer; Value: Integer );
procedure PopulateMatrix( Value: Integer );
end;
TStaircaseMatrixOfStrings = class
private
FSize: Integer;
FlatMatrix: TStringList;
function GetCell(I, J: Integer): String;
procedure SetCell(I, J: Integer; const Value: String);
procedure SetSize(const Value: Integer);
public
constructor Create;
destructor Destroy; override;
property Size: Integer read FSize write SetSize;
property Cell[ I, J: Integer ]: String read GetCell write SetCell; default;
procedure PopulateRowAndColumn( IJ: Integer; Value: String );
procedure PopulateMatrix( Value: String );
end;
TStairCaseMatrixOfVariants = class
private
FSize: Integer;
FlatMatrix: Variant;
function GetCell(I, J: Integer): Variant;
procedure SetCell(I, J: Integer; const Value: Variant);
procedure SetSize(const Value: Integer);
public
constructor Create;
property Size: Integer read FSize write SetSize;
property Cell[ I, J: Integer ]: Variant read GetCell write SetCell; default;
procedure PopulateRowAndColumn( IJ: Integer; Value: Variant );
procedure PopulateMatrix( Value: Variant );
end;
TStaircaseMatrixOfDoubles = class
private
FSize: Integer;
FlatMatrix: array of Double;
function GetCell(I, J: Integer): Double;
procedure SetCell(I, J: Integer; const Value: Double);
procedure SetSize(const Value: Integer);
public
constructor Create;
destructor Destroy; override;
property Size: Integer read FSize write SetSize;
property Cell[ I, J: Integer ]: Double read GetCell write SetCell; default;
procedure PopulateRowAndColumn( IJ: Integer; Value: Double );
procedure PopulateMatrix( Value: Double );
end;
implementation
uses Math, SysUtils, Variants;
function Summation(SumTo: Integer): Integer;
begin
Result := SumTo * ( SumTo + 1 ) div 2;
end;
procedure BadSizeParameter;
begin
raise Exception.Create( 'A Staircase Matrix cannot have a Size less than 2.' );
end;
{ TStaircaseMatrixOfObjects }
constructor TStaircaseMatrixOfObjects.Create;
begin
FSize := 0;
end;
destructor TStaircaseMatrixOfObjects.Destroy;
begin
SetLength( FlatMatrix, 0 );
inherited;
end;
function TStaircaseMatrixOfObjects.GetCell(I, J: Integer): TObject;
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
Result := FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ]
else
Result := nil;
end;
procedure TStaircaseMatrixOfObjects.PopulateMatrix(Value: TObject);
var
I: Integer;
begin
for I := 0 to High( FlatMatrix ) do
FlatMatrix[ I ] := Value;
end;
procedure TStaircaseMatrixOfObjects.PopulateRowAndColumn(IJ: Integer;
Value: TObject);
var
K, RowLow, RowHigh, Offset, CellIndex: Integer;
begin
RowLow := Summation( IJ - 1 );
RowHigh := RowLow + IJ - 1;
for K := RowLow to RowHigh do
FlatMatrix[ K ] := Value;
Offset := IJ;
CellIndex := Summation( IJ ) + Offset;
while CellIndex < Length( FlatMatrix ) do
begin
FlatMatrix[ CellIndex ] := Value;
Offset := Offset + 1;
CellIndex := CellIndex + Offset;
end;
end;
procedure TStaircaseMatrixOfObjects.SetCell(I, J: Integer;
const Value: TObject);
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] := Value;
end;
procedure TStaircaseMatrixOfObjects.SetSize(const Value: Integer);
begin
if Value < 2 then
BadSizeParameter;
FSize := Value;
SetLength( FlatMatrix, Summation( Size - 1 ) );
end;
{ TStaircaseMatrixOfIntegers }
constructor TStaircaseMatrixOfIntegers.Create;
begin
FSize := 0;
end;
destructor TStaircaseMatrixOfIntegers.Destroy;
begin
SetLength( FlatMatrix, 0 );
inherited;
end;
function TStaircaseMatrixOfIntegers.GetCell(I, J: Integer): Integer;
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
Result := FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ]
else
Result := High(Integer);
end;
procedure TStaircaseMatrixOfIntegers.PopulateMatrix(Value: Integer);
var
I: Integer;
begin
for I := 0 to High( FlatMatrix ) do
FlatMatrix[ I ] := Value;
end;
procedure TStaircaseMatrixOfIntegers.PopulateRowAndColumn(IJ,
Value: Integer);
var
K, RowLow, RowHigh, Offset, CellIndex: Integer;
begin
RowLow := Summation( IJ - 1 );
RowHigh := RowLow + IJ - 1;
for K := RowLow to RowHigh do
FlatMatrix[ K ] := Value;
Offset := IJ;
CellIndex := Summation( IJ ) + Offset;
while CellIndex < Length( FlatMatrix ) do
begin
FlatMatrix[ CellIndex ] := Value;
Offset := Offset + 1;
CellIndex := CellIndex + Offset;
end;
end;
procedure TStaircaseMatrixOfIntegers.SetCell(I, J: Integer;
const Value: Integer);
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] := Value;
end;
procedure TStaircaseMatrixOfIntegers.SetSize(const Value: Integer);
begin
if Value < 2 then
BadSizeParameter;
FSize := Value;
SetLength( FlatMatrix, Summation( Size - 1 ) );
end;
{ TStaircaseMatrixOfStrings }
constructor TStaircaseMatrixOfStrings.Create;
begin
FlatMatrix := TStringList.Create;
FSize := 0;
end;
destructor TStaircaseMatrixOfStrings.Destroy;
begin
FreeAndNil( FlatMatrix );
inherited;
end;
function TStaircaseMatrixOfStrings.GetCell(I, J: Integer): String;
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
Result := FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ]
else
Result := '';
end;
procedure TStaircaseMatrixOfStrings.PopulateMatrix(Value: String);
var
I: Integer;
begin
for I := 0 to FlatMatrix.Count - 1 do
FlatMatrix[ I ] := Value;
end;
procedure TStaircaseMatrixOfStrings.PopulateRowAndColumn(IJ: Integer;
Value: String);
var
K, RowLow, RowHigh, Offset, CellIndex: Integer;
begin
RowLow := Summation( IJ - 1 );
RowHigh := RowLow + IJ - 1;
for K := RowLow to RowHigh do
FlatMatrix[ K ] := Value;
Offset := IJ;
CellIndex := Summation( IJ ) + Offset;
while CellIndex < FlatMatrix.Count do
begin
FlatMatrix[ CellIndex ] := Value;
Offset := Offset + 1;
CellIndex := CellIndex + Offset;
end;
end;
procedure TStaircaseMatrixOfStrings.SetCell(I, J: Integer;
const Value: String);
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] := Value;
end;
procedure TStaircaseMatrixOfStrings.SetSize(const Value: Integer);
var
Top: Integer;
begin
if Value < 2 then
BadSizeParameter;
Top := Summation( Value - 1 );
if Value > Size then
while FlatMatrix.Count < Top do
FlatMatrix.Add( '' )
else
while FlatMatrix.Count > Top do
FlatMatrix.Delete( FlatMatrix.Count - 1 );
FSize := Value;
end;
{ TStairCaseMatrixOfVariants }
constructor TStairCaseMatrixOfVariants.Create;
begin
FSize := 0;
end;
function TStairCaseMatrixOfVariants.GetCell(I, J: Integer): Variant;
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
Result := VarArrayGet( FlatMatrix, [ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] )
else
Result := Unassigned;
end;
procedure TStairCaseMatrixOfVariants.PopulateMatrix(Value: Variant);
var
I: Integer;
begin
for I := 0 to VarArrayHighBound( FlatMatrix, 1 ) do
VarArrayPut( FlatMatrix, Value, [ I ] );
end;
procedure TStairCaseMatrixOfVariants.PopulateRowAndColumn(IJ: Integer;
Value: Variant);
var
K, RowLow, RowHigh, Offset, CellIndex: Integer;
begin
RowLow := Summation( IJ - 1 );
RowHigh := RowLow + IJ - 1;
for K := RowLow to RowHigh do
VarArrayPut( FlatMatrix, Value, [ K ] );
Offset := IJ;
CellIndex := Summation( IJ ) + Offset;
while CellIndex <= VarArrayHighBound( FlatMatrix, 1 ) do
begin
VarArrayPut( FlatMatrix, Value, [ CellIndex ] );
Offset := Offset + 1;
CellIndex := CellIndex + Offset;
end;
end;
procedure TStairCaseMatrixOfVariants.SetCell(I, J: Integer;
const Value: Variant);
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
VarArrayPut( FlatMatrix, Value, [ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] )
end;
procedure TStairCaseMatrixOfVariants.SetSize(const Value: Integer);
begin
if Value < 2 then
BadSizeParameter;
If VarIsEmpty( FlatMatrix ) then
FlatMatrix := VarArrayCreate( [ 0, Summation( Size - 1 ) ], varVariant )
else
VarArrayRedim( FlatMatrix, Summation( Size - 1 ) );
end;
{ TStaircaseMatrixOfDoubles }
constructor TStaircaseMatrixOfDoubles.Create;
begin
FSize := 0;
end;
destructor TStaircaseMatrixOfDoubles.Destroy;
begin
SetLength( FlatMatrix, 0 );
inherited;
end;
function TStaircaseMatrixOfDoubles.GetCell(I, J: Integer): Double;
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
Result := FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ]
else
Result := Infinity;
end;
procedure TStaircaseMatrixOfDoubles.PopulateMatrix(Value: Double);
var
I: Integer;
begin
for I := 0 to High( FlatMatrix ) do
FlatMatrix[ I ] := Value;
end;
procedure TStaircaseMatrixOfDoubles.PopulateRowAndColumn(IJ: Integer;
Value: Double);
var
K, RowLow, RowHigh, Offset, CellIndex: Integer;
begin
RowLow := Summation( IJ - 1 );
RowHigh := RowLow + IJ - 1;
for K := RowLow to RowHigh do
FlatMatrix[ K ] := Value;
Offset := IJ;
CellIndex := Summation( IJ ) + Offset;
while CellIndex < Length( FlatMatrix ) do
begin
FlatMatrix[ CellIndex ] := Value;
Offset := Offset + 1;
CellIndex := CellIndex + Offset;
end;
end;
procedure TStaircaseMatrixOfDoubles.SetCell(I, J: Integer;
const Value: Double);
begin
if ( I >= 0 ) and ( I < Size ) and ( J >= 0 ) and ( J < Size ) and ( I <> J ) then
FlatMatrix[ Summation( Max( I, J ) - 1 ) + Min( I, J ) ] := Value;
end;
procedure TStaircaseMatrixOfDoubles.SetSize(const Value: Integer);
begin
if Value < 2 then
BadSizeParameter;
FSize := Value;
SetLength( FlatMatrix, Summation( Size - 1 ) );
end;
end.
Delphi - .....................................
SxTable
unit SxTable;
interface
uses
SysUtils, Windows, DBTables, Classes,DBITypes, Db;
type
{ TTmpTable }
TSxTable = class(TTable)
private
hCursor: hDBICur;
FAutoCreate,
FTemporal,
FPermanent: Boolean;
FTmpFile,
FTmpDir:String;
OpenSortedTable: boolean;
protected
tmpFile:String;
IsIndex:Boolean;
procedure OpenCursor(InfoQuery: Boolean); override;
procedure CloseCursor; override;
function GetDBHandle: HDBIDB;
procedure SetPermanent(Value:Boolean);
procedure SetTemporal(Value:Boolean);
Function ExistTable(sTable:String):Boolean;
public
destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
procedure CreateTmpTable;
procedure MyAddIndex(sIndex:String);
procedure Sort(Field: TField);
procedure Sorts(Fields:array of TField);
procedure SortEx(Field: TField; Order: SORTOrder;
CaseInsensitive: BOOL; var NumberToSort: longint);
procedure SortExs(Fields:array of TField; Order: SORTOrder;
CaseInsensitive: BOOL; var NumberToSort: longint);
function GetUniqueFileName: string;
function GetTempDirectory: string;
procedure Open ;
published
property AutoCreate:Boolean read FAutoCreate Write FAutoCreate;
property Permanent: Boolean read FPermanent write SetPermanent;
property Temporal: Boolean read FTemporal write SetTemporal;
end;
procedure Register;
implementation
uses forms;
function TSxTable.GetUniqueFileName: string;
var
a:Pchar;
S:string;
begin
a:=stralloc(255);
s:=GetTempDirectory + #0;
{$ifdef win32}
getTempfilename(@s[1],'DB'+#0,0,a);
{$else}
getTempfilename(#0,'DB'+#0,1,a);
{$endif}
s:=changefileext(extractfilename(StrPas(a)),'.db');
tmpFile:=StrPas(a);
Result := s;
strdispose(a);
end;
function TSxTable.GetTempDirectory: string;
begin
SetLength(Result, 255);
GetTempPath(255, PChar(Result));
end;
Function TSxTable.ExistTable(sTable:String):Boolean;
Var i:Integer;
lsTable:TStringList;
Begin
Result:= False;
lsTable:=TStringList.Create;
Session.GetTableNames(DatabaseName , '*' , True, False, lsTable);
for i:=0 to lsTable.Count -1 do
if UpperCase(sTable) = UpperCase(lsTable[i]) then
result := TRue;
lsTable.free;
End;
procedure TSxTable.OpenCursor(InfoQuery: Boolean);
//mik prove
Var sIndex:String;
Begin
//mik prove
//mik prove
sIndex:= IndexFieldNames;
IndexFieldNames:= '';
//mik prove
if FTemporal then
Begin
try
if FTmpfile = '' then
Begin
createTmpTable;
end;
except
raise;
exit;
end;
end
Else
Begin
if FAutoCreate and not ExistTable(TableName) then
Try
CreateTable;
except
end;
end;
inherited OpenCursor(InfoQuery);
//mik prove
if not IsIndex then
MyAddIndex(sIndex);
//mik prove
End;
procedure TSxTable.Open ;
Var sIndex:String;
Begin
// sIndex:= IndexFieldNames;
// IndexFieldNames:= '';
inherited Open;
// if not IsIndex then
// MyAddIndex(sIndex);
end;
constructor TSxTable.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTemporal := False;
FPermanent := False;
FAutoCreate := False;
IsIndex := false;
end;
procedure TSxTable.CreateTmpTable;
begin
if active then exit;
FTemporal := True;
try
DatabaseName := GetTempDirectory;
TableName := GetUniqueFileName;
FTmpFile:=TableName;
FTmpDir :=DatabaseName;
CreateTable;
except
raise;
end;
end;
procedure TSxTable.CloseCursor;
Var d,t:String;
begin
inherited CloseCursor;
if FTemporal and not Permanent and (FTmpFile <>'') then
Begin
t:=TableName;
d :=DatabaseName;
TableName:=FTmpFile;
DatabaseName:=FTmpDir;
try
DeleteTable;
SysUtils.deletefile(TmpFile);
except
raise;
end;
TableName:=t;
DatabaseName:=d;
FTmpFile:='';
FTmpDir:='';
end
end;
destructor TsxTable.Destroy;
begin
if Fpermanent then
if (FTmpFile <>'') then
try
DeleteTable;
except
raise;
end;
inherited Destroy;
end;
function TsxTable.GetDBHandle: HDBIDB;
Var hDb:HDBIDB;
s:string;
begin
if Database <> nil then
Result := Database.Handle else
begin
if FTemporal then
Begin
Check(DbiOpenDatabase(nil, nil, dbiREADONLY, dbiOPENSHARED,
nil, 0, nil, nil, hDb));
s:= DatabaseName;
Check(DbiSetDirectory(hDb, PChar(s)));
end
else
Begin
s:= DatabaseName;
Check(DbiOpenDatabase(PChar(s), nil, dbiReadWrite, dbiOpenShared,
nil, 0, nil, nil, hdb));
end;
Result := hDb;
end;
end;
procedure TsxTable.MyAddIndex(sIndex:String);
Var ba,OK:Boolean;
iNIndex,iNField:Integer;
Begin
if FTemporal then exit;
if Trim(sIndex) = '' then exit;
IsIndex:= true;
ba:= Exclusive;
iNIndex := IndexFieldCount;
OK:=TRUE;
FieldDefs.Update;
IndexDefs.Update;
if self.IndexDefs.IndexOf(sIndex) > -1 then
IndexFieldNames:= sIndex
else
Begin
{ try
close;
FieldDefs.Update;
infield:=Self.IndexFieldCount;
Exclusive := True;
try
if (iNField = 0) then
AddIndex(sIndex,sIndex,[ixPrimary,ixUnique])
else
AddIndex(sIndex,sIndex,[]);
except
FieldDefs.Update;
end;
IndexFieldNames := sIndex;
finally
Exclusive := ba;
Open;
end;}
try
close;
iNIndex:=Self.IndexDefs.count;
infield:=Self.IndexFieldCount;
try Exclusive := True; except end;
inherited Open;
IndexDefs.Clear;
if (iNIndex = 0) then
Begin
AddIndex('',sIndex ,[ixPrimary,ixUnique]);
IndexFieldNames := sIndex;
end
else
Begin
// IndexDefs.Clear;
Try Self.AddIndex(sIndex, sIndex,[]); except end;
Try IndexDefs.Update ; except end;
try Self.IndexFieldNames := sIndex; except end;
end;
finally
Close;
Exclusive := ba;
inherited Open;
end;
end;
IsIndex:= false;
End;
procedure TsxTable.Sort(Field: TField);
var
SortNumber: longint;
FieldNumber: word;
CaseInsensitive: BOOL;
Order: SORTOrder;
FTableName:String;
apermanent:Boolean;
sIndexFieldName,sFieldName:String;
begin
SortNumber:=0;
sIndexFieldName:=Field.FieldName;
if self.Temporal then
Begin
CaseInsensitive := TRUE;
FieldNumber := Field.DataSet.FieldDefs.Find(sIndexFieldName).FieldNo ;
// FieldNumber := Field.index + 1;
Check(DbiGetRecordCount(Handle, SortNumber));
Order := sortASCEND;
FTableName:=TableName;
apermanent := permanent;
permanent:= True;
OpenSortedTable := True;
Active := False;
try
Check(DbiSortTable(GetDBHandle , PChar(FTableName), PChar(TableType),
nil, nil, nil, nil, 1, @FieldNumber, @CaseInsensitive, @Order, nil,
False, nil, SortNumber));
Active := True;
finally
permanent := apermanent;
OpenSortedTable := False;
end;
end
else
Begin
MyAddIndex(sIndexFieldName);
end;
end;
procedure TsxTable.Sorts(Fields:array of TField);
var
SortNumber: longint;
FieldNumbers: array [0..100]of word;
CaseInsensitive: BOOL;
Order: SORTOrder;
FTableName:String;
apermanent:Boolean;
sIndexFieldName,sFieldName:String;
i,NumField:Integer;
begin
// sIndexFieldName:=Field.FieldName;
if self.Temporal then
Begin
for i:=0 to High(Fields) do
FieldNumbers[i] := Fields[i].index + 1;
NumField:= High(Fields)+1;
CaseInsensitive := TRUE;
Check(DbiGetRecordCount(Handle, SortNumber));
Order := sortASCEND;
FTableName:=TableName;
apermanent := permanent;
permanent:= True;
OpenSortedTable := True;
Active := False;
try
Check(DbiSortTable(GetDBHandle , PChar(FTableName), PChar(TableType),
nil, nil, nil, nil, NumField, @FieldNumbers[0], @CaseInsensitive, @Order, nil,
False, nil, SortNumber));
Active := True;
finally
permanent := apermanent;
OpenSortedTable := False;
end;
end
else
Begin
MyAddIndex(sIndexFieldName);
end;
end;
procedure TsxTable.SortEx(Field: TField; Order: SORTOrder;
CaseInsensitive: BOOL; var NumberToSort: longint);
var
// SortNumber: longint;
FieldNumber: word;
FTableName:String;
apermanent:Boolean;
sIndexFieldName,sFieldName:String;
begin
sIndexFieldName:=Field.FieldName;
if self.Temporal then
Begin
FieldNumber := Field.DataSet.FieldDefs.Find(sIndexFieldName).FieldNo ;
// FieldNumber := Field.index + 1;
Check(DbiGetRecordCount(Handle, NumberToSort));
FTableName:=TableName;
apermanent := permanent;
permanent:= True;
OpenSortedTable := True;
Active := False;
try
Check(DbiSortTable(GetDBHandle , PChar(FTableName), PChar(TableType),
nil, nil, nil, nil, 1, @FieldNumber, @CaseInsensitive, @Order, nil,
False, nil, NumberToSort));
Active := True;
finally
permanent := apermanent;
OpenSortedTable := False;
end;
end
else
Begin
MyAddIndex(sIndexFieldName);
end;
end;
procedure TsxTable.SortExs(Fields: array of TField; Order: SORTOrder;
CaseInsensitive: BOOL; var NumberToSort: longint);
var
FieldNumbers: array[0..100] of word;
FTableName:String;
apermanent:Boolean;
i,NumField:Integer;
begin
for i:=0 to High(Fields) do
FieldNumbers[i] := Fields[i].index + 1;
NumField:= High(Fields)+1;
FTableName:=TableName;
apermanent := permanent;
permanent:= True;
OpenSortedTable := True;
Active := False;
try
Check(DbiSortTable(GetDBHandle, PChar(FTableName), PChar(TableType),
nil, nil, nil, nil, NumField , @FieldNumbers[0], @CaseInsensitive,
@Order, nil, False, nil, NumberToSort));
Active := True;
finally
OpenSortedTable := False;
permanent := apermanent;
end;
end;
procedure TSxTable.SetPermanent(Value:Boolean);
Var d,t:String;
Begin
if value = FPermanent then exit;
FPermanent:=Value;
if active then exit;
if FTemporal and not Permanent and (FTmpFile <>'') then
Begin
t:=TableName;
d :=DatabaseName;
TableName:=FTmpFile;
DatabaseName:=FTmpDir;
DeleteTable;
TableName:=t;
DatabaseName:=d;
FTmpFile:='';
FTmpDir:='';
end
End;
procedure TSxTable.SetTemporal(Value:Boolean);
Var d,t:String;
Begin
if value = FTemporal then exit;
FTemporal:=Value;
if active then exit;
if FTemporal and not Permanent and (FTmpFile <>'') then
Begin
t:=TableName;
d :=DatabaseName;
TableName:=FTmpFile;
DatabaseName:=FTmpDir;
DeleteTable;
TableName:=t;
DatabaseName:=d;
FTmpFile:='';
FTmpDir:='';
end
End;
procedure Register;
begin
RegisterComponents('Sx', [TSxTable]);
end;
end.
Delphi - .....................................
Winzip veya sıkıştırma programı ve akış şeması gerekli
Arkadaşlar selam,
Bayadır yoktum, işler ve dersler yoğun,Winzip veya sıkıştırma programı ve akış şeması gerekli yardımcı olabilecek var mı?
Saygılar.
Delphi - .....................................
hesap makinesi
3 edit 3 label 4 button konulur
1. button toplama
2. button çıkarma
3. button çarpma
4. button bölme için olsun
button 1 in içine
edit3.text:=floattostr(strtoint(edit1.text)+strtoint(edit2.text));
button 2 nin içine
edit3.text:=floattostr(strtoint(edit1.text)-strtoint(edit2.text));
button 3 ün içine
edit3.text:=floattostr(strtoint(edit1.text)*strtoint(edit2.text));
button 4 ün içine
edit3.text:=floattostr(strtoint(edit1.text)/strtoint(edit2.text));
not:bunu genelde delphi de ilk öğrenenler için yazdım kolay gelsin
Delphi - .....................................
