First you need a couple global variables:
var
GlobalExcept: Exception;
GlobalExceptAddr: Pointer;
And a global exception handler:
procedure TForm1.ApplicationException(Sender: TObject; E: Exception);
begin
if E is EAccessViolation then
begin
// Keep the exception object from being destroyed!
AcquireExceptionObject;
GlobalExcept := e;
GlobalExceptAddr := ExceptAddr;
Application.Terminate;
end;
end;
The rest of the magic happens in the project file (DPR)
begin
GlobalExcept := nil;
GlobalExceptAddr := nil;
try
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
finally
if Assigned( GlobalExcept ) then
begin
raise GlobalExcept at GlobalExceptAddr;
end;
end;
end.
{ ---------------------------------------------------
Numbers Manager Copyright (r) by
Version : 1.75 Author : William Yang
Last Update 24 - Aug - 97
--------------------------------------------------- }
unit NumMan;
interface
uses Classes, SysUtils, Windows;
// Force an integer number to be between certain range
function MakeBetween(S, nFrom, nTo : Integer) : Integer;
// Check if an integer is between n1 and n2
function Between(S, N1, N2 : Integer) : Boolean;
// Check if an real/float number is between n1 and n2
function fBetween(S, N1, N2 : Real) : Boolean;
// Calculate rectangular width
function RectWidth(Rect: TRect) : Integer;
// Calculate rectangular height
function RectHeight(Rect: TRect) : Integer;
// Find smallest integer in an array
function MinMost(Nums: array of Integer): Integer;
// Find largest integer in an array
function MaxMost(Nums: array of Integer): Integer;
// Check if the integers in an array are equal
function AllEqual(Nums: array of Integer): Boolean;
// Check if the integers in an array are different
function AllDiff(Nums: array of Integer): Boolean;
//Check if these numbers in the range
function AllBetween(Nums: array of Integer; nFrom, nTo : Integer): Boolean;
{Check if the numbers are like (1, 2, 3, 4, 5),
you can set InOrder to false if you want check(4,2,3,5,1) }
function IsIncreasement(Nums: array of Integer; InOrder: Boolean): Boolean;
{more customisable with amount that increase }
function IsIncreasementExt(Nums: array of Integer; InOrder: Boolean;
Incs: Integer): Boolean;
//Find a number an array of numbers, returns the index of the first catch.
function FindNum(Num: Integer; Nums: array of Integer): Integer;
//Find pairs, returns the total amount of pairs.
function FindPairs(Nums: array of Integer): Integer;
//Find the how many times the number appears.
function NumAppears(Num: Integer; Nums: array of Integer): Integer;
// A byte has 8 bits, ReadBits returns number value between certain bits in an integer
function ReadBits(Num, Start, Count: Integer): Integer;
// Returns how many bits are used to store this integer, e.g. 8 returns 4, 7 return 3
function MaxBits(Num: Integer): Integer;
// Translate integer to binaries
function IntToBin(Num: Integer): String;
// Modify certain bits in an integer
function WriteBits(Num, Start, Val: Integer): Integer;
// Integer swap
procedure ISwap(var n1, n2: Integer);
// Byte swap
procedure BSwap(var n1, n2: Byte);
// Real/ float number swap
procedure FSwap(var n1, n2: Double);
// Round up an real number by certain integer value, e.g. RoundBy(67.4, 10) return 70
function RoundBy(ANum: Real; By: Integer): Integer;
// Smallest float number
function MinFloat(X, Y: Extended): Extended;
// Largest float number
function MaxFloat(X, Y: Extended): Extended;
implementation
function fBetween(S, N1, N2 : Real) : Boolean;
begin
if (S >= N1) and (S <= N2) then
Result := True
else
Result := False;
end;
function RoundBy(ANum: Real; By: Integer): Integer;
begin
Result := Round(ANum / By);
Result := Result*By;
end;
procedure ISwap(var n1, n2: Integer);
var
t: Integer;
begin
t := n1;
n1 := n2;
n2 := t;
end;
procedure BSwap(var n1, n2: Byte);
var
t: Byte;
begin
t := n1;
n1 := n2;
n2 := t;
end;
procedure FSwap(var n1, n2: Double);
var
t: Double;
begin
t := n1;
n1 := n2;
n2 := t;
end;
function WriteBits(Num, Start, Val: Integer): Integer;
begin
Val := Val shl (Start - 1);
Result := Num or Val;
end;
function MaxBits(Num: Integer): Integer;
begin
Result := 0;
repeat
Num := Num shr 1;
Inc(Result);
until Num <= 0;
end;
function IntToBin(Num: Integer): String;
var
Mask: Integer;
i, Bits: Integer;
begin
Result := ''; Mask := 1;
Bits := MaxBits(Num);
for i := 1 to bits do
begin
if (Num and Mask) = Mask then
Result := Result + '1'
else
Result := Result + '0';
Mask := Mask shl 1;
end;
end;
function ReadBits(Num, Start, Count: Integer): Integer;
var
BitMask: Integer;
i, Max: Integer;
begin
Max := MaxBits(Num);
{
0000 1111
and 1011 0111
---- ---- ----
0000 0111
}
//Initialize Bitmask with 0.
BitMask := 0;
for i := Max downto 1 do
begin
if (i >= Start) and (i <= Start + Count - 1) then
begin
Bitmask := Bitmask or 1;
end;
if i > 1 then
begin
BitMask := BitMask shl 1;
end;
end;
Result := BitMask and Num;
Result := Result shr (Start - 1)
end;
function FindPairs(Nums: array of Integer): Integer;
var
i: Integer;
begin
Result := 0;
for i := Low(Nums) to High(Nums) do
begin
if NumAppears(Nums[i], Nums) = 2 then
Inc(Result);
end;
Result := Result div 2;
end;
function FindNum(Num: Integer; Nums: array of Integer): Integer;
var
i:Integer;
begin
Result := -1;
for i := Low(Nums) to High(Nums) do
begin
if Nums[i] = Num then
begin
Result := i;
Exit;
end;
end;
end;
function NumAppears(Num: Integer; Nums: array of Integer): Integer;
var
i:Integer;
begin
Result := 0;
for i := Low(Nums) to High(Nums) do
begin
if Nums[i] = Num then
begin
Inc(Result);
end;
end;
end;
function IsIncreasementExt(Nums: array of Integer; InOrder: Boolean;
Incs: Integer): Boolean;
var
i,j, k : Integer;
begin
Result := True;
if InOrder then
begin
j := Nums[Low(Nums)] + Incs;
for i := Low(Nums) + 1 to High(Nums) do
begin
if Nums[i] <> J then
begin
Result := False;
Exit;
end;
Inc(j, Incs);
end;
end
else
begin
k := MinMost(Nums);
//Get the smallest number to start with.
j := k + Incs;
while (FindNum(j, Nums) <> - 1) do
begin
Inc(j, Incs);
end;
//if j is equal to the total increasement + minmost value.
if j = k + (High(Nums) - Low(Nums)) * Incs then
Result := True
else
Result := False;
end;
end;
function IsIncreasement(Nums: array of Integer; InOrder: Boolean): Boolean;
begin
Result := IsIncreasementExt(Nums, InOrder, 1);
end;
function AllBetween(Nums: array of Integer; nFrom, nTo : Integer): Boolean;
var
i:Integer;
begin
Result := True;
for i := Low(Nums) to High(Nums) do
begin
if not Between(Nums[i], nFrom, nTo) then
begin
Result := False;
Exit;
end;
end;
end;
function AllDiff(Nums: array of Integer): Boolean;
var
i, j : Integer;
begin
Result := True;
for i := Low(Nums) to High(Nums) do
for j := Low(Nums) to High(Nums) do
begin
if (i<>j) and (Nums[j] = Nums[i]) then
begin
Result := False;
Exit;
end;
end;
end;
function AllEqual(Nums: array of Integer): Boolean;
var
i : Integer;
begin
Result := True;
for i := Low(Nums) + 1 to High(Nums) do
begin
if Nums[Low(Nums)] <> Nums[i] then
begin
Result := False;
Exit;
end;
end;
end;
function MinMost(Nums: array of Integer): Integer;
var
i,j, k : Integer;
begin
//Go through each numbers.
for i := Low(Nums) to High(Nums) do
begin
k := 0;
//check if this number is smaller than others
for j := Low(Nums) to High(Nums) do
begin
if (Nums[i] <= Nums[j]) and (i <> j) then
Inc(k);
end;
{If there is 5 numbers, if a number smaller than other 4
then it is the smallest}
if k = High(Nums) - Low(Nums) then
Result := Nums[i];
end;
end;
function MaxMost(Nums: array of Integer): Integer;
var
i,j, k : Integer;
begin
for i := Low(Nums) to High(Nums) do
begin
k := 0;
for j := Low(Nums) to High(Nums) do
begin
if (Nums[i] >= Nums[j]) and (i <> j) then
Inc(k);
end;
if k = High(Nums) - Low(Nums) then
Result := Nums[i];
end;
end;
function RectWidth(Rect: TRect) : Integer;
begin
Result := Rect.Right - Rect.Left;
end;
function RectHeight(Rect: TRect) : Integer;
begin
Result := Rect.Bottom - Rect.Top;
end;
Function Min(X, Y : Integer) : Integer;
begin
if X<=Y then
Result := X
else
Result := y;
end;
Function Max(X, Y : Integer) : Integer;
begin
if X>=Y then
Result := X
else
Result := y;
end;
function MinFloat(X, Y: Extended): Extended;
begin
if X < Y then Result := X else Result := Y;
end;
function MaxFloat(X, Y: Extended): Extended;
begin
if X > Y then Result := X else Result := Y;
end;
function Between(S, N1, N2 : Integer) : Boolean;
begin
if (S >= N1) and (S <= N2) then
Result := True
else
Result := False;
end;
function MakeBetween(S, nFrom, nTo : Integer) : Integer;
begin
Result := S;
while Result < nFrom do
begin
Result := Result + (nTo - nFrom);
end;
while Result > nTo do
begin
Result := Result - (nTo - nFrom);
end;
end;
end.