📄 zmisc1.htm
字号:
<!-- This document was created with HomeSite v2.0 -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Misc</TITLE>
<META NAME="Description" CONTENT="Miscellaneous section of the Delphi Developers FAQ" >
<META NAME="KeyWords" CONTENT="" >
</HEAD>
<BODY bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" color="#00FF00">
<CENTER><FONT SIZE="7" FACE="Arial Black" COLOR="RED">Miscellaneous</FONT></CENTER>
<P><H1><A NAME="zmisc10">Compile Date</P></A></H1>
<P><I>Martin Larsson <martin.larsson@delfi-data.msmail.telemax.no> wrote:</I></P>
<PRE>
> 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.
</PRE>
<P>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.</P>
<P>"today.inc" will have the form -</P>
<HR><PRE>const
_day : string[10] = 'Monday';
_date : word = 12;
_month : word = 8;
_year : word = 1996;
</PRE><HR>
<P>Then, just do a {$I c:\today.inc} at the top of all your programs.</P>
<P>Easy, although I agree - {$DATE} would be easier!</P>
<P><H1><A NAME="zmisc11">Delay again!</P></A></H1>
<P><I>From: Tim_Hyder@msn.com (Tim Hyder)</I></P>
<PRE>
>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.
</PRE>
<P>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</P>
<HR><PRE>DelayInit := False;
Delay(0); {If delay NOT done then init}
</PRE><HR>
<P>This calibrates itself for the system.</P>
<HR><PRE>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.
</PRE><HR>
<P><H1><A NAME="zmisc12">Array in Delphi</P></A></H1>
<H2>Solution 1</H2>
<P><I>From: luribe@slip.net (Luis C. Uribe)</I></P>
<P>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:</P>
<HR><PRE>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;
</PRE><HR>
<P><H2>Solution 2</H2></P>
<P><I>From: Lord of Darkness <j.biddiscombe@rl.ac.uk></I></P>
<P>the simplest way is create the array dynamically</P>
<HR><PRE>Myarray := GetMem(rows * cols * sizeof(byte,word,single,double etc)</PRE><HR>
<P>do a fetch_num function like</P>
<P>function fetch_num(r,c:integer) : single;</P>
<P>result := pointer + row + col*rows</P>
<P>and then instead of myarray[2,3]</P>
<P>do myarray.fetch_num(2,3)</P>
<P>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.</P>
<P><H2>Solution 3</H2></P>
<P><I>From: m.a.vaughan@larc.nasa.gov (Mark Vaughan)</I></P>
<P>here's one way to create simple one-dimensional and two-dimensional dynamic array classes.</P>
<HR><PRE>(*
--
-- 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;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -