Martin Larsson <martin.larsson@delfi-data.msmail.telemax.no> wrote:
> It's very nice to have a number say in the about box that the > customer can read you, and you can immediately find the version. > Using date and time of compilation would be a good number.
I'm assuming you already do something like this, but for all those who haven't realised this workaround, write a program which outputs the current date to a text file and call it something like "today.inc". A DOS program works best ( run it from your autoexec.bat - takes no time at all ), or stick a windows prog in you startup group/folder.
"today.inc" will have the form -
const
_day : string[10] = 'Monday';
_date : word = 12;
_month : word = 8;
_year : word = 1996;
Then, just do a {$I c:\today.inc} at the top of all your programs.
Easy, although I agree - {$DATE} would be easier!
From: Tim_Hyder@msn.com (Tim Hyder)
>Delays are still one of the major leaks in Delphi. >I'm using delphi1 and looking for a 2 ms delay with an accuracy of >about >-0 ms +1 ms error. Does anyone know something. >A loop is not accurate enough. Timer component is 18.2 times/sec.
I Have included a module I have used when making some 16 bit screen savers. It has a global called DelayInit which is global and should made in your form create like this
DelayInit := False;
Delay(0); {If delay NOT done then init}
This calibrates itself for the system.
unit Globals;
interface
Uses WinProcs, WinTypes, Messages,Classes, Graphics, IniFiles;
Const
OT_USER = 1;
Var
SsType : Integer;
{ iObjL : Integer; { Current Object LEFT position }
{ iObjR : Integer; { Current Object RIGHT position }
{ iObjT : Integer; { Current Object TOP position }
Finish : Boolean;
TestMode : Boolean; { True if testing }
LoopsMs : LongInt; { Ms loops }
ScreenWd : Integer; { Screen width }
ScreenHt : Integer; { Screen Height }
SpotSize : Integer; { Spotlight Size }
SpotSpeed : Integer; { Spotlight Speed }
DelayInit : Boolean; { True if delay loop initiated }
Procedure Delay(Ms : Integer); { Delay for Ms Millsecs }
Procedure CursorOff; { Turn the cursor Off }
Procedure CursorOn; { Turn the Cursor On }
{$IFDEF NOVELL}
{$ENDIF}
implementation
Uses
SysUtils,
Toolhelp;
Procedure CursorOff; { Turn the Cursor Off }
Var
Cstate : Integer; { Current cursor State }
Begin
Cstate := ShowCursor(True); { Get State }
While Cstate >= 0 do Cstate := ShowCursor(False); { While ON turn Off }
End;
Procedure CursorOn; { Turn Cursor On }
Var
Cstate : Integer; { Current cursor State }
Begin
Cstate := ShowCursor(True); { Get current State }
While Cstate < 0 do Cstate := ShowCursor(True); { While off turn on }
End;
Procedure Delay(Ms : Integer); { Delay for Ms millisecs }
{If Ms is passed as 0, then calibrate }
Var
L,MaxLoops,StartL,EndL,Down,Up,Res : LongInt; { Local Vars }
Ti : TTimerInfo;
Begin
Up := 0;
Down := 100000;
if Not DelayInit then begin
Ti.dwSize := sizeof(LongInt) * 3;
TimerCount(@Ti);
StartL := Ti.dwmsSinceStart; { Get Start Time }
if Not DelayInit then begin { Include the Test }
for L := 0 to 100000 do begin { Loop through the following 100000 times }
Dec(Down); { Drop it }
Res := Abs(Down - Up); { Diff }
if Res = 0 then Inc(Res); { Bump }
Inc(Up); { Inc }
end;
end;
TimerCount(@Ti);
EndL := Ti.dwmsSinceStart; { Get Start Time }
LoopsMs := 100000 Div (EndL - StartL); { Calc MS Rate }
DelayInit := True; { We are done }
end
else begin
if Ms = 0 then Exit;
MaxLoops := LoopsMs * Ms; { Get Number of Loops }
for L := 0 to MaxLoops do Begin { Loop through }
Dec(Down); { Drop it }
Res := Abs(Down - Up); { Diff }
if Res = 0 then Inc(Res); { Bump }
Inc(Up); { Inc }
end
end;
End;
end.
From: luribe@slip.net (Luis C. Uribe)
Here are some functions that you can use to handle 2-dim arrays, they can be extended to more dimensions easily. SetV and GetV are made to store and retrieve values from an array of type VArray that you declare as you want. For example:
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 {allocate memory for array V of size N}
try
GetMem(V, N);
except
ShowMessage('ERROR allocating memory. Size:' + IntToStr(N));
Result := True;
exit;
end;
FillChar(V^, N, 0); {in case Long strings involved, need to 0}
Result := False;
end;
procedure SetV(var X : Varray;const N,ir,ic : LongInt;const value :
double);
begin {store in 2-dim array X of size ? 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 {returns value X[ir,ic] for 2-dim array with N columns}
Result := X[N*(ir-1) + ic];
end;
From: Lord of Darkness <j.biddiscombe@rl.ac.uk>
the simplest way is create the array dynamically
Myarray := GetMem(rows * cols * sizeof(byte,word,single,double etc)
do a fetch_num function like
function fetch_num(r,c:integer) : single;
result := pointer + row + col*rows
and then instead of myarray[2,3]
do myarray.fetch_num(2,3)
wrap it all up in an object and you're laughing. I've done a multidimensional (up to 8) dynamic complex array class which is based on this principle and it works a treat.
From: m.a.vaughan@larc.nasa.gov (Mark Vaughan)
here's one way to create simple one-dimensional and two-dimensional dynamic array classes.
(*
--
-- unit to create two very simple dynamic array classes
-- TDynaArray : a one dimensional array
-- TDynaMatrix : a two dimensional dynamic array
--
*)
unit DynArray;
INTERFACE
uses
SysUtils;
Type
TDynArrayBaseType = double;
Const
vMaxElements = (High(Cardinal) - $f) div sizeof(TDynArrayBaseType);
{= guarantees the largest possible array =}
Type
TDynArrayNDX = 1..vMaxElements;
TArrayElements = array[TDynArrayNDX] of TDynArrayBaseType;
{= largest array of TDynArrayBaseType we can declare =}
PArrayElements = ^TArrayElements;
{= pointer to the array =}
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);
{= build the matrix class using an array of TDynArray objects =}
Type
TMatrixNDX = 1..vMaxMatrixColumns;
TMatrixElements = array[TMatrixNDX] of TDynArray;
{= each column of the matrix will be a dynamic array =}
PMatrixElements = ^TMatrixElements;
{= a pointer to an array of pointers... =}
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 methods
--
*)
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('Index out of range : %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('Index out of range : %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('Index out of range : %d', [N]);
Elements^[N] := NewValue;
END; {==TDynArray.SetElement==}
(*
--
-- TDynaMatrix methods
--
*)
Constructor TDynaMatrix.Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);
Var col : TMatrixNDX;
BEGIN {==TDynaMatrix.Create==}
inherited Create;
fRows := NumRows;
fColumns := NumColumns;
{= acquire memory for the array of pointers (i.e., the array of TDynArrays) =}
GetMem( mtxElements, fColumns*sizeof(TDynArray) );
fMemAllocated := fColumns*sizeof(TDynArray);
{= now acquire memory for each column of the matrix =}
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('Row index out of range : %d', [row]);
if (column < 1) OR (column > fColumns) then
raise EDynArrayRangeError.CreateFMT('Column index out of range : %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('Row index out of range : %d', [row]);
if (column < 1) OR (column > fColumns) then
raise EDynArrayRangeError.CreateFMT('Column index out of range : %d', [column]);
mtxElements^[column].Elements^[row] := NewValue;
END; {==TDynaMatrix.SetElement==}
END.
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('Matrix');
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('Transpose');
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.
From: Yeo Keng Hua <cinyeo@singnet.sg.com>
Check out FMXUTIL.PAS in Delphi examples:
function ExecuteFile(const FileName, Params, DefaultDir: string;
ShowCmd: Integer): THandle;
var
zFileName, zParams, zDir: array[0..79] of Char;
begin
Result := ShellExecute(Application.MainForm.Handle, nil,
StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
StrPCopy(zDir, DefaultDir), ShowCmd);
end;
Called with the code :
executeFile('maker.exe','text_file','c:\maker', SW_SHOWNORMAL);From: rkr@primenet.com
This is a bit of code that came on a CD-ROM with a "How To Book" I bought.. The file is called "HowUtils.Pas" Fades Text in, and or out on a Canvas.
function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: String): TRect; var Pic: TBitmap; W, H: integer; PicRect, TarRect: TRect; begin Pic := TBitmap.Create; Pic.Canvas.Font := Target.Font; W := Pic.Canvas.TextWidth(FText); H := Pic.Canvas.TextHeight(FText); Pic.Width := W; Pic.Height := H; PicRect := Rect(0, 0, W, H); TarRect := Rect(X, Y, X + W, Y + H); Pic.Canvas.CopyRect(PicRect, Target, TarRect); SetBkMode(Pic.Canvas.Handle, Transparent); Pic.Canvas.TextOut(0, 0, FText); FadeInto(Target, X, Y, Pic); Pic.Free; FadeInText := TarRect; end; procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig: TBitmap); var Pic: TBitmap; PicRect: TRect; begin Pic := TBitmap.Create; Pic.Width := TarRect.Right - TarRect.Left; Pic.Height := TarRect.Bottom - TarRect.Top; PicRect := Rect(0, 0, Pic.Width, Pic.Height); Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect); FadeInto(Target, TarRect.Left, TarRect.Top, Pic); Pic.Free; end;
This page has been created with
