io Programmo 21/IOPROG_21.ISO/SOFT/DFMTOOLS.ZIP/Delphi_DFM/Source/cdcUtils.pas

Pascal/Delphi Source File | 1998-11-02 | 38.1 KB | 1,128 lines

unit cdcUtils;
// Imported from Richard Library
//          LoadFormPosition
{
>Look up function ShellExecute in the help file. (shellapi unit).
>For ex:
>ShellExecute(Handle,'open',PChar(Edit1.Text),'','',SW_SHOWNORMAL);
>or
>ShellExecute(Handle,'open', 'c:\doc\bar.doc' ,'','',SW_SHOWNORMAL);
>
>This has the same effect as double clicking the file in the explorer.
}
interface

Uses
  Classes, Controls, ComCtrls, Forms, Windows, Graphics, Grids, DB,
  {$IFNDEF VCL3+}DBTables, {$ENDIF}
  DBGrids,
  cdcLibrary;

type
   TRResult = (rrFail,rrNoMatch,rrBadParam,rrOK);

Const
   MidNight : TDateTime = ((23+(59+59/60)/60)/24);

//Math Function not found in the Math unit -----------------------------------------------------------------------------}
function MinInt(const A,B:Integer):Integer;
function MaxInt(const A,B:Integer):Integer;
function ExtractTotal(Const Value:String;Const e:Integer):Integer;

//Registration Function --------------------------------------------------------------------------------------------
// Translate by Carlos de Cumont from code receive from A2i
function  GetRegistration(Const MasterHKEY:Integer;Const MasterKey,Key:String):string;
function  CheckRegistration(Const MasterHKey:Integer;Const MasterKey,Key:String):tRResult;
Procedure WriteRegistration(Const MasterHKey:Integer;Const MasterKey,Key:String);

procedure CenterControlsInParent(const ControlArray :array of TControl);
procedure CenterInParent(AParent : TWinControl);
procedure CenterAllInParent(AParent : TWinControl;Offset:Integer);
procedure CenterEachInParent(AParent : TWinControl);
procedure CenterSizedInParent(AControl : TControl);
procedure VCenterAllInParent(AParent : TWinControl;Offset:Integer);

procedure AlignControlWithHeader(AHeader : THeaderControl; ASectionIndex : Integer; AControl : TControl);
procedure AlignControlWithColumn(AGrid : TCustomGrid; AColumnIndex : Integer; AControl : TControl);
procedure AlignControlWithFieldColumn(AGrid : TCustomGrid; AField : TField; AControl : TControl);

function UniversalDecodeDate(DateFormat,DateString:String;var date:TDateTime):Boolean;
function UniversalDecodeTime(TimeFormat,TimeString:String;var time:TDateTime):Boolean;
function SecToDuration(Value:Integer):String;

function FirstDayOfMonth(aDate:TDate):TDateTime;
function LastDayOfMonth(aDate:TDate):TDateTime;
Procedure DayTimeToFromSunday(Const value:TDateTime;var fromSunday,fromMinuit:Integer);
function DateToNr(value:TDateTime):Integer;
function TrimRightDigit(Const AString : String):String;
function MinToStr(Const Value: Integer):String;
function IncString(Const Value:String;Const Idx:Integer):String;
function EnsureSentenceTerminates(Sentence: String; Terminator: Char): String;

Procedure SplitTel(Const Value: String; Var Ptel,Tel: String);
Procedure SplitTelFld(Const Value: String;Ptel,Tel: tField);

procedure PaintRainbow(Dc : HDC; {Canvas to paint to}
                       x : integer; {Start position X}
                       y : integer;  {Start position Y}
                       Width : integer; {Width of the rainbow}
                       Height : integer {Height of the rainbow};
                       bVertical : bool; {Paint verticallty}
                       WrapToRed : bool); {Wrap spectrum back to red}

{
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,0,nil,0);//OFF
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,1,nil,0);//ON
}

implementation

Uses SysUtils, Registry , Inifiles, Printers , Math;

{$IFDEF VER100}  // delphi 3 (version)
Type
  LongWord = Integer;
{$ENDIF}

//{------------------------------------------------------------------------------}


//{------------------------------------------------------------------------------}
function FindGridColumn(AGrid : TDBGrid; AFieldName : String) : TColumn;
var Counter : Integer;
begin
Result := nil;
for Counter := 0 to AGrid.Columns.Count - 1 do
    begin
    if CompareText(AGrid.Columns[Counter].FieldName, AFieldName) = 0 then
        begin
        Result := AGrid.Columns[Counter];
        Exit;
end end end;

//{------------------------------------------------------------------------------}
function GetGridColumn(AGrid : TDBGrid; AFieldName : String) : TColumn;
begin
Result := FindGridColumn(AGrid, AFieldName);
if Result = nil then
   raise Exception.Create('Cannot find ' + AGrid.Name + ' column for ' + AFieldName);
end;

//{------------------------------------------------------------------------------}
function OpenGridColumn(AGrid : TDBGrid; AFieldName : String) : TColumn;
begin
Result := FindGridColumn(AGrid, AFieldName);
if Result = nil then
    begin
    Result := TColumn.Create(AGrid.Columns);
    Result.FieldName := AFieldName;
end end;

//{------------------------------------------------------------------------------}
type
   TCrackerGrid = class(TCustomGrid)
   public
       property GridLineWidth;
       property ColWidths;
   end;

   TCrackerDBGrid = class(TCustomDBGrid)
   public
       property Options;
       property LeftCol;
   end;

//{------------------------------------------------------------------------------}
procedure AlignControlWithHeader(AHeader : THeaderControl; ASectionIndex : Integer; AControl : TControl);
var i , OffSet : Integer;
//    AParent : TWinControl;
begin
//By Carlos...
if (AControl=nil) then Exit;
Assert(ASectionIndex in [0..AHeader.Sections.Count-1]);

with AHeader do
   begin
//   AParent := AControl.Parent;
   //Find the common parent ---------------------

   //Get the left position
   OffSet:=0;
   for i:=0 to ASectionIndex-1 do
       Inc(OffSet,AHeader.Sections.Items[i].Width);

   //Move the Controls
   AControl.SetBounds(OffSet, AControl.Top,
                      AHeader.Sections.Items[ASectionIndex].Width, AControl.Height);
end end;

//{------------------------------------------------------------------------------}
procedure AlignControlWithColumn(AGrid : TCustomGrid; AColumnIndex : Integer; AControl : TControl);
var Counter, ColumnLeft, ParentOffset : Integer;
    AParent : TWinControl;
    Offset : Integer;
begin
//By Carlos...
if (AControl=nil) then Exit;

with TCrackerGrid(AGrid) do
   begin
   ColumnLeft := 0;
   if (AGrid is TCustomDBGrid) and (dgIndicator in TCrackerDBGrid(AGrid).Options) then
       begin
       Inc(AColumnIndex);
       Offset:=ColWidths[0];
   end else
       Offset:=0;

   if AColumnIndex < LeftCol then
      begin
      for Counter := 0 to LeftCol - 1 do
          begin
          Dec(ColumnLeft, ColWidths[Counter]);
          Dec(ColumnLeft, GridLineWidth);
      end;
   end else begin
      for Counter := LeftCol to AColumnIndex - 1 do
          begin
          Inc(ColumnLeft, ColWidths[Counter]);
          Inc(ColumnLeft, GridLineWidth);
          end;
   AParent := AControl.Parent;
   ParentOffset := 0;
   while (AParent <> nil) do
      begin
      if (AParent = AGrid.Parent) then
          begin
          Inc(ColumnLeft, ParentOffset);
          Break;
      end else begin
          Dec(ParentOffset, AParent.Left);
          AParent := AParent.Parent;
          end;
      end;
   end;
   AControl.SetBounds(ColumnLeft + AGrid.Left + OffSet , AControl.Top,
                      ColWidths[AColumnIndex], AControl.Height);
end end;

//{------------------------------------------------------------------------------}
procedure AlignControlWithFieldColumn(AGrid : TCustomGrid; AField : TField; AControl : TControl);
var ThisColumn : TColumn;
begin
if (AField <> nil) and (AField.FieldName <> '') and (AGrid <>nil) and (AGrid is TDBGrid) then
    begin
    ThisColumn := FindGridColumn(TDBGrid(AGrid), AField.FieldName);
    if ThisColumn <> nil then
       AlignControlWithColumn(AGrid, ThisColumn.Index, AControl);
end end;

//{------------------------------------------------------------------------------}
procedure NotifyAllForms(AMsg, WParam, LParam : Integer);
var Counter : Integer;
begin
for Counter := 0 to Screen.FormCount - 1 do
   begin
   SendMessage(Screen.Forms[Counter].Handle, AMsg, WParam, LParam);
   end;
end;

//-----------------------------------------------------------------------------------
function IncString(Const Value:String;Const Idx:Integer):String;
Var Str:String;
   procedure BumpCharacter(Pointer : Integer);
   begin
   if Pointer <= 0 then
       raise Exception.Create('Cannot increment first character in ' + Str);

   if (Str[Pointer] = 'z') then begin
       BumpCharacter(Pointer - 1);
       Str[Pointer] := 'A';
   end else
   if (Str[Pointer] = '9') then begin
       BumpCharacter(Pointer - 1);
       Str[Pointer] := '0';
   end else
       Str[Pointer] := Chr(Ord(Str[Pointer]) + 1)
   end;
begin
Str:=Value;
if Str = '' then
   Str := '0'
else
if not (Str[1] in ['0'..'9']) then
   BumpCharacter(Length(Str))
else
   try Str :=  IntToStr(StrToInt(Str) + 1);
   except
       {// I can't pick a StrToIntDef value that may not be a real value, so I have to use the exception   }
       on EConvertError do begin
           BumpCharacter(Length(Str));
   end end;
Result := Str;
end;

//------------------------------------------------------------------------------
function EnsureSentenceTerminates(Sentence: String; Terminator: Char): String;
begin
  if (Length(Sentence) > 0) and (Sentence[Length(Sentence)] <> Terminator) then
    result := Sentence + Terminator
  else
    result := Sentence;
end;


{
The following example demonstrates painting a color spectrum,
and calculating the color of a given point on the spectrum.
Two procedures are presented: PaintRainbow() and
ColorAtRainbowPoint(). The PaintRainbow() procedure paints a
spectrum from red to magenta if the WrapToRed parameter is
false, or paint red to red if the WrapToRed parameter is true.
The rainbow can progress either in a horizontal or
vertical progression. The ColorAtRainbowPoint() function
returns a TColorRef containing the color at a given point in
the rainbow.

Example:
}

procedure PaintRainbow(Dc : hDc; {Canvas to paint to}
                       x : integer; {Start position X}
                       y : integer;  {Start position Y}
                       Width : integer; {Width of the rainbow}
                       Height : integer {Height of the rainbow};
                       bVertical : bool; {Paint verticallty}
                       WrapToRed : bool); {Wrap spectrum back to red}
var
  i : integer;
  ColorChunk : integer;
  OldBrush : hBrush;
  //OldPen : hPen;
  r : integer;
  g : integer;
  b : integer;
  Chunks : integer;
  //ChunksMinus1 : integer;
  pt : TPoint;
begin
  OffsetViewportOrgEx(Dc,
                      x,
                      y,
                      pt);

  if WrapToRed = false then
    Chunks := 5 else
    Chunks := 6;
  //ChunksMinus1 := Chunks - 1;

  if bVertical = false then
    ColorChunk := Width div Chunks else
    ColorChunk := Height div Chunks;

 {Red To Yellow}
  r := 255;
  b := 0;
  for i := 0 to ColorChunk do begin
    g:= (255 div ColorChunk) * i;
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc, i, 0, 1, Height, PatCopy) else
      PatBlt(Dc, 0, i, Width, 1, PatCopy);
    DeleteObject(SelectObject(Dc, OldBrush));
  end;

 {Yellow To Green}
  g:=255;
  b:=0;
  for i := ColorChunk  to (ColorChunk * 2) do begin
    r := 255 - (255 div ColorChunk) * (i - ColorChunk);
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc, i, 0, 1, Height, PatCopy) else
      PatBlt(Dc, 0, i, Width, 1, PatCopy);
    DeleteObject(SelectObject(Dc, OldBrush));
  end;

 {Green To Cyan}
  r:=0;
  g:=255;
  for i:= (ColorChunk * 2) to (ColorChunk * 3) do begin
    b := (255 div ColorChunk)*(i - ColorChunk * 2);
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc, i, 0, 1, Height, PatCopy) else
      PatBlt(Dc, 0, i, Width, 1, PatCopy);
    DeleteObject(SelectObject(Dc,OldBrush));
  end;

 {Cyan To Blue}
  r := 0;
  b := 255;
  for i:= (ColorChunk * 3) to (ColorChunk * 4) do begin
    g := 255 - ((255 div ColorChunk) * (i - ColorChunk * 3));
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc, i, 0, 1, Height, PatCopy) else
      PatBlt(Dc, 0, i, Width, 1, PatCopy);
    DeleteObject(SelectObject(Dc, OldBrush));
  end;

 {Blue To Magenta}
  g := 0;
  b := 255;
  for i:= (ColorChunk * 4) to (ColorChunk * 5) do begin
    r := (255 div ColorChunk) * (i - ColorChunk * 4);
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc, i, 0, 1, Height, PatCopy) else
      PatBlt(Dc, 0, i, Width, 1, PatCopy);
    DeleteObject(SelectObject(Dc, OldBrush))
  end;

  if WrapToRed <> false then begin
   {Magenta To Red}
    r := 255;
    g := 0;
    for i := (ColorChunk * 5) to ((ColorChunk * 6) - 1) do begin
      b := 255 -((255 div ColorChunk) * (i - ColorChunk * 5));
      OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,g,b)));
      if bVertical = false then
        PatBlt(Dc, i, 0, 1, Height, PatCopy) else
        PatBlt(Dc, 0, i, Width, 1, PatCopy);
      DeleteObject(SelectObject(Dc,OldBrush));
    end;
  end;

 {Fill Remainder}
  if (Width - (ColorChunk * Chunks) - 1 ) > 0 then begin
    if WrapToRed <> false then begin
      r := 255;
      g := 0;
      b := 0;
    end else begin
      r := 255;
      g := 0;
      b := 255;
    end;
    OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
    if bVertical = false then
      PatBlt(Dc,
             ColorChunk * Chunks,
             0,
             Width - (ColorChunk * Chunks),
             Height,
             PatCopy) else
      PatBlt(Dc,
             0,
             ColorChunk * Chunks,
             Width,
             Height - (ColorChunk * Chunks),
             PatCopy);
    DeleteObject(SelectObject(Dc,OldBrush));
  end;
  OffsetViewportOrgEx(Dc,
                      Pt.x,
                      Pt.y,
                      pt);
end;

function ColorAtRainbowPoint(ColorPlace : integer;
                             RainbowWidth : integer;
                             WrapToRed : bool) : TColorRef;
var
  ColorChunk : integer;
  ColorChunkIndex : integer;
  ColorChunkStart : integer;
begin
  if ColorPlace = 0 then begin
    result := RGB(255, 0, 0);
    exit;
 end;
{WhatChunk}
  if WrapToRed <> false then
    ColorChunk := RainbowWidth div 6 else
    ColorChunk := RainbowWidth div 5;
    ColorChunkStart := ColorPlace div ColorChunk;
    ColorChunkIndex := ColorPlace mod ColorChunk;
  case ColorChunkStart of
   0 : result := RGB(255,
                     (255 div ColorChunk) * ColorChunkIndex,
                     0);
   1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex,
                     255,
                     0);
   2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);
   3 : result := RGB(0,
                     255 - (255 div ColorChunk) * ColorChunkIndex,
                     255);
   4 : result := RGB((255 div ColorChunk) * ColorChunkIndex,
                     0,
                     255);
   5 : result := RGB(255,
                     0,
                     255 - (255 div ColorChunk) * ColorChunkIndex);
  else
    if WrapToRed <> false then
      result := RGB(255, 0, 0) else
      result := RGB(255, 0, 255);
  end;{Case}
end;

{
procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintRainbow(Form1.Canvas.Handle,
               0,
               0,
               Form1.ClientWidth,
               Form1.ClientHeight,
               false,
               true);

end;

procedure TForm1.FormResize(Sender: TObject);
begin
  InvalidateRect(Form1.Handle, nil, false);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Color : TColorRef;
begin
  Color := ColorAtRainbowPoint(y,
                               Form1.ClientWidth,
                               true);
  ShowMessage(IntToStr(GetRValue(Color)) + #32 +
              IntToStr(GetGValue(Color)) + #32 +
              IntToStr(GetBValue(Color)));
end;
}

//------------------------------------------------------------------------------
procedure DivMod(Dividend: Integer; Divisor: Word;var Result, Remainder: Word);
asm
        PUSH    EBX
        MOV     EBX,EDX
        MOV     EDX,EAX
        SHR     EDX,16
        DIV     BX
        MOV     EBX,Remainder
        MOV     [ECX],AX
        MOV     [EBX],DX
        POP     EBX
end;

//------------------------------------------------------------------------------
function UniversalDecodeTime(TimeFormat,TimeString:String;var time:TDateTime):Boolean;
var Hour, Min, Sec, MSec : Word;
    i:Integer;
begin
TimeFormat:=lowerCase(TimeFormat);
try MSec:=0;
    //Decode Sec !!!!!!!!!!!!! //      TimeFormat  : String = 'ss:mm:hh';          //00:01:27
    i:=pos('ss',TimeFormat);
    if i<=0 then Exception.Create('Invalid Time Format :'+TimeFormat+':'+TimeString);
    sec:=StrToInt(copy(TimeString,i,2));
    //Decode Min !!!!!!!!!!!!! //      TimeFormat  : String = 'ss:mm:hh';          //00:01:27
    i:=pos('mm',TimeFormat);
    if i<=0 then Exception.Create('Invalid Time Format :'+TimeFormat+':'+TimeString);
    min:=StrToInt(copy(TimeString,i,2));
    //Decode Hour !!!!!!!!!!!!! //      TimeFormat  : String = 'ss:mm:hh';          //00:01:27
    i:=pos('hh',TimeFormat);
    if i<=0 then Exception.Create('Invalid Time Format :'+TimeFormat+':'+TimeString);
    hour:=StrToInt(copy(TimeString,i,2));
    time:=EncodeTime(Hour, Min, Sec, MSec);
    result:=true;
except
    result:=false;
end end;

//------------------------------------------------------------------------------
function UniversalDecodeDate(DateFormat,DateString:String;var date:TDateTime):Boolean;
var day, month, year: Word;
    i:Integer;
begin
DateFormat:=lowerCase(DateFormat);
try //Decode day !!!!!!!!!!!!! DateFormat  : String = 'dd/mm/yyyy';               //08-08-1997
    i:=pos('dd',DateFormat);
    if i<=0 then Exception.Create('Invalid Date Format :'+DateFormat);
    day:=StrToInt(copy(dateString,i,2));
    //Decode month !!!!!!!!!!!!! DateFormat  : String = 'dd/mm/yyyy';               //08-08-1997
    i:=pos('mm',DateFormat);
    if i<=0 then Exception.Create('Invalid Date Format :'+DateFormat);
    month:=StrToInt(copy(dateString,i,2));
    //Decode year !!!!!!!!!!!!! DateFormat  : String = 'dd/mm/yyyy';               //08-08-1997
    i:=pos('yyyy',DateFormat);
    if i<=0 then
       begin
       i:=pos('yy',DateFormat);
       if i<=0 then Exception.Create('Invalid Date Format :'+DateFormat);
       year:=StrToInt(copy(dateString,i,2));
       if year>50 then year:=year+1900;
    end else
       year:=StrToInt(copy(dateString,i,4));
    Date:=EncodeDate(year,month,day);
    result:=true;
except
    result:=false;
end end;

//------------------------------------------------------------------------------
//Transform a Date to a Nr YYYYMMDD
function DateToNr(value:TDateTime):Integer;
var Year,Month,Day:Word;
begin
DecodeDate(Value, Year,Month,Day);
Result:=Year*100+Month;
end;

//------------------------------------------------------------------------------
function TrimRightDigit(Const AString : String):String;
begin
result:=AString;
while (Length(result)>0)and(result[Length(result)] in ['0'..'9']) do
   System.Delete(result,Length(result),1)
end;

//------------------------------------------------------------------------------
function MinToStr(Const Value: Integer):String;
var Min,Sec,Hour,i:Integer;
begin
Hour:=value div (60*60);
i:=value mod (60*60);
Min:=i div 60;
Sec:=i div 60;
if hour>0 then
   result :=format('%dh%2d''%2d"',[hour,min,sec])
else
if Min>0 then
   result :=format('%2d''%2d"',[min,sec])
else
   result :=format('%2d"',[sec])
end;

//------------------------------------------------------------------------------
Procedure SplitTelFld(Const Value: String;Ptel,Tel: tField);
Var
   Stel,SPtel : String;
Begin
   SplitTel(Value,SPtel,Stel);
   Ptel.ASstring:=SPtel;
   Tel.ASstring:= STel;
end;

//------------------------------------------------------------------------------
Procedure SplitTel(Const Value: String; Var Ptel,Tel: String);
   function deleteNoneDigit(Var V: String): String;
   Var    i:Integer;
   Begin
     For i:=1 to Length(V) do Begin
         if not (V[i] in ['0'..'9']) then
            Delete(V,i,1)
     end;
     Result :=V;
   End;

Var i : Integer;
Begin
Tel := Value;
if (Tel='') or (Tel[1]<>'0') then
   Begin
   Tel:=deleteNoneDigit(Tel);
   end
else
  Begin
  for i:=1 to Length(Tel) do begin
     if not (Tel[i] in ['0'..'9']) then
        Begin
        Ptel := Copy(Tel,1,i-1);
        Delete(Tel,1,i);
        Tel  := deleteNoneDigit(Tel);
        Break;
        end
     end;
  //More code
  end
End;


//------------------------------------------------------------------------------
//; DateTime Seconds, proc to calc the number of seconds from Sunday 00:00:00
//paraodox --> Proc DTseconds(dd SmallInt, tt time) LongInt
Procedure DayTimeToFromSunday(Const value:TDateTime;var fromSunday,fromMinuit:Integer);
Var Hour, Min, Sec, MSec:Word;
begin
//Calcul time elapsed from SunDay 00:00
//and with the tarif definiton look if DayTime is in the WeekEnd Time !!!!!!!!!!!!!!
//The DayOfWeek function returns the day of the week of the specified date as an integer between 1 and 7. Sunday is the first day of the week and Saturday is the seventh.        DayOfWeek
DecodeTime(Value, Hour, Min, Sec, MSec);
fromMinuit:=hour*60*60+min*60+sec;
fromSunday:=(DayOfWeek(value)-1)*24*60*60+fromMinuit
end;

//-----------------------------------------------------------------------------}
function FirstDayOfMonth(aDate:TDate):TDateTime;
Begin
result:=Trunc(cdcUtils.LastDayOfMonth(now-39)+1);
End;

//-----------------------------------------------------------------------------}
function LastDayOfMonth(aDate:TDate):TDateTime;
var aDay,aMonth,aYear:Word;
begin
  DecodeDate(aDate,aYear,aMonth,aDay);
  if aMonth=12 then
     result:=EncodeDate(aYear+1,1,1)-1+MidNight
  else
     result:=EncodeDate(aYear,aMonth+1,1)-1+MidNight
end;

//-----------------------------------------------------------------------------}
function SecToDuration(Value:Integer):String;
var i,Hour,Min,Sec:Word;
begin
   Hour:=value div (60*60);
   i:=value mod (60*60);
   DivMod(i,60,Min,Sec);
   if hour>0 then
      Result :=format('%dh%2d''%2d"',[hour,min,sec])
   else
   if Min>0 then
      Result :=format('%2d''%2d"',[min,sec])
   else
      Result :=format('%2d"',[sec])
end;

{------------------------------------------------------------------------------}
procedure CenterControlsInParent(const ControlArray :array of TControl);
var Counter : Integer;
    ControlWidth, SpacerWidth : Integer;
begin
if not ControlArray[0].Parent.Showing then
   Exit;

ControlWidth := 0;
for Counter := Low(ControlArray) to High(ControlArray) do
    Inc(ControlWidth, ControlArray[Counter].Width);

{  Assuming at least one element: ControlArray[0]   }
SpacerWidth := (ControlArray[0].Parent.ClientWidth - ControlWidth) div
               ((High(ControlArray) - Low(ControlArray))
               + 2);

ControlWidth := 0;
for Counter := Low(ControlArray) to High(ControlArray) do
    begin
    Inc(ControlWidth, SpacerWidth);
    with ControlArray[Counter] do
       begin
       Left := ControlWidth;
       Inc(ControlWidth, Width);
       end;
    end;
end;

{------------------------------------------------------------------------------}
procedure CenterInParent(AParent : TWinControl);
var Counter : Integer;
    ControlWidth, SpacerWidth : Integer;
    ControlList : TList;

   procedure AddControl(AControl : TControl);
   var Counter : Integer;
   begin
   for Counter := 0 to ControlList.Count - 1 do
      begin
      if AControl.Left < TControl(ControlList[Counter]).Left then
         begin
         ControlList.Insert(Counter, AControl);
         Exit;
         end;
      end;
   ControlList.Add(AControl);
   end;

begin
ControlList := TList.Create;
try
    ControlWidth := 0;
    for Counter := 0 to AParent.ControlCount - 1 do
       begin
       if AParent.Controls[Counter].Visible then
          begin
          Inc(ControlWidth, AParent.Controls[Counter].Width);
          AddControl(AParent.Controls[Counter]);
          end;
       end;
    SpacerWidth := (AParent.ClientWidth - ControlWidth) div
                   (ControlList.Count + 1);
    ControlWidth := 0;
    for Counter := 0 to ControlList.Count - 1 do
        begin
        Inc(ControlWidth, SpacerWidth);
        with TControl(ControlList[Counter]) do
           begin
           Left := ControlWidth;
           Inc(ControlWidth, Width);
           end;
        end;
finally
    ControlList.Free;
end end;

{------------------------------------------------------------------------------}
procedure VCenterAllInParent(AParent : TWinControl;Offset:Integer);
var Counter : Integer;
    ControlHeight, SpacerHeight : Integer;
    ControlList : TList;

   procedure AddControl(AControl : TControl);
   var Counter : Integer;
   begin
   for Counter := 0 to ControlList.Count - 1 do
      begin
      if AControl.Left < TControl(ControlList[Counter]).Left then
         begin
         ControlList.Insert(Counter, AControl);
         Exit;
         end;
      end;
   ControlList.Add(AControl);
   end;

begin
ControlList := TList.Create;
try
    ControlHeight := 0;
    for Counter := 0 to AParent.ControlCount - 1 do
       begin
       if AParent.Controls[Counter].Visible then
          begin
          Inc(ControlHeight, AParent.Controls[Counter].Height);
          AddControl(AParent.Controls[Counter]);
          end;
       end;
    SpacerHeight := (AParent.ClientHeight - ControlHeight -Offset -Offset ) div
                   (ControlList.Count - 1);
    ControlHeight := 0;
    for Counter := 0 to ControlList.Count - 1 do
        begin
        if Counter=0 then
           Inc(ControlHeight, Offset)
        else
        if Counter=ControlList.Count - 1 then
           ControlHeight:=AParent.ClientHeight-Offset-TControl(ControlList[Counter]).Height
        else
           Inc(ControlHeight, SpacerHeight);
        with TControl(ControlList[Counter]) do
           begin
           top := ControlHeight;
           Inc(ControlHeight, Height);
           end;
        end;
finally
    ControlList.Free;
end end;

{------------------------------------------------------------------------------}
procedure CenterAllInParent(AParent : TWinControl;Offset:Integer);
var Counter : Integer;
    ControlWidth, SpacerWidth : Integer;
    ControlList : TList;

   procedure AddControl(AControl : TControl);
   var Counter : Integer;
   begin
   for Counter := 0 to ControlList.Count - 1 do
      begin
      if AControl.Left < TControl(ControlList[Counter]).Left then
         begin
         ControlList.Insert(Counter, AControl);
         Exit;
         end;
      end;
   ControlList.Add(AControl);
   end;

begin
ControlList := TList.Create;
try
    ControlWidth := 0;
    for Counter := 0 to AParent.ControlCount - 1 do
       begin
       if AParent.Controls[Counter].Visible then
          begin
          Inc(ControlWidth, AParent.Controls[Counter].Width);
          AddControl(AParent.Controls[Counter]);
          end;
       end;
    SpacerWidth := (AParent.ClientWidth - ControlWidth -Offset -Offset ) div
                   (ControlList.Count - 1);
    ControlWidth := 0;
    for Counter := 0 to ControlList.Count - 1 do
        begin
        if Counter=0 then
           Inc(ControlWidth, Offset)
        else
        if Counter=ControlList.Count - 1 then
           ControlWidth:=AParent.ClientWidth-Offset-TControl(ControlList[Counter]).Width
        else
           Inc(ControlWidth, SpacerWidth);
        with TControl(ControlList[Counter]) do
           begin
           Left := ControlWidth;
           Inc(ControlWidth, Width);
           end;
        end;
finally
    ControlList.Free;
end end;

{------------------------------------------------------------------------------}
procedure CenterEachInParent(AParent : TWinControl);
var Counter : Integer;
begin
for Counter := 0 to AParent.ControlCount - 1 do
   begin
   with AParent.Controls[Counter] do
       begin
       Left := (Parent.ClientWidth - Width) div 2;
       end;
   end;
end;

{------------------------------------------------------------------------------}
procedure CenterSizedInParent(AControl : TControl);
begin
   AControl.Width := (AControl.Parent.Width - (AControl.Left * 2));
end;

{------------------------------------------------------------------------------}
//   crc32tab and UPDC32
//   Copyright (C) 1986 Gary S. Brown.
//   used by permission
//static unsigned long crc32tab[] = { /* CRC polynomial $EDB88320  */
Const crc32tab : Array[0..255] of Longword  =
   ($00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535, $9E6495A3,
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
    $3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
    $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
    $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
    $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
    $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
    $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
    $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
    $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
    $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F,
    $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
    $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
    $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
    $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7,
    $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
    $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
    $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F,
    $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
    $9B64C2B0, $EC63F226, $756AA39C, $026D930A, $9C0906A9, $EB0E363F, $72076785, $05005713,
    $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
    $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
    $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, $3E6E77DB,
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF,
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D
    );

//{------------------------------------------------------------------------------}
function GetUnKnowData(Const f:TRegistry;const Name: string; Buffer: Pointer;BufSize: Integer): Integer;
var //RegData: TRegDataType;
    DataType: Integer;
begin
    DataType := REG_NONE;
    If RegQueryValueEx(f.CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),@BufSize) <> ERROR_SUCCESS then
       Result := 0 //e ERegistryException.Create('Unable to get data for '+Name);
    else
       Result := BufSize;
end;

//{------------------------------------------------------------------------------}
//#define UPDC32(c, crc) (crc32tab[((int)(crc) ^ (c)) & $ff] ^ (((crc) >> 8) & $00FFFFFFL))
//Void CreatePartialCRC(Uint32& crc,buffer , Int32 count)
Procedure CreatePartialCRC(Const buffer:LongWord;Const Count:Word;var crc:LongWord);
Type PInt = ^LongWord;
Var i:Word;
begin
  //for (Int32 i = 0; i < count; i++)
  //     crc = UPDC32((int)(buffer[i]), crc);
  for i := 0 to count-1 do
      crc:=(crc32tab[(crc xor (PInt(Buffer+i)^)) and $ff]) xor ((crc shl 8)and($00FFFFFF))
end;

//****************************************************************************
// * FUNCTION     : RC GetLocalMachineID(ConstStr programName, CString& lmid)
// * DESCRIPTION  : Generates the LMID by combining the _programName_ with
// *                various features of the machine (ex. system bios, cpu id)
// ***************************************************************************/
TYPE
  Tos = (TOS_WIN95 , TOS_WINNT);
function GetLocalMachineID(Const os:tOS;Const MasterKey,Key:String;Var lmid:String):boolean;
var k,s:String;
    buffer:Array[Word] of Char;
    l:Word;
    fRegistry:TRegistry;
    crc:LongWord;
begin
lmid:='';
fRegistry:=TRegistry.create;
try s:='';
    fRegistry.RootKey:=HKEY_LOCAL_MACHINE;
    // get win nt product id
    IF OS = TOS_WINNT THEN
       k:='SOFTWARE\Microsoft\Windows NT\CurrentVersion'
    ELSE
       k:='SOFTWARE\Microsoft\Windows\CurrentVersion';
    fRegistry.OpenKey(k,false);
    s:=s+fRegistry.ReadString('ProductId');
    fRegistry.CloseKey;
    // cpu id
    k:='HARDWARE\DESCRIPTION\System\CentralProcessor\0';
    fRegistry.OpenKey(k,false);
    s:=s+fRegistry.ReadString('Identifier');
    fRegistry.CloseKey;
    // system bios
    k:='HARDWARE\DESCRIPTION\System';
    fRegistry.OpenKey(k,false);
    // video bios
    l:=GetUnKnowData(fRegistry,'VideoBiosVersion',@Buffer,high(word));
    buffer[l]:=#0;
    s:=s+buffer;
    l:=GetUnKnowData(fRegistry,'SystemBiosVersion',@Buffer,high(word));
    buffer[l]:=#0;
    s:=s+buffer;
    fRegistry.CloseKey;
    // it is possible that one or more of the values do not exist
    // if ALL of them do not exist, the LMID cannot be generated
    if(s='') then
       result:=false
    else
       Begin
       // create a 32-bit numerical CRC value from the string
       s:=UpperCase(Key)+s;
       crc:=$ffffffff;
       CreatePartialCRC(Integer(Pchar(s)),length(s),crc);
       lmid:=Format('%02x%02x%02x%02x',[HIBYTE(HIWORD(crc)),LOBYTE(HIWORD(crc)),HIBYTE(LOWORD(crc)),LOBYTE(LOWORD(crc))]);
       //return RC_OK;
       result:=true
       end;
finally fRegistry.free;
end end;

//****************************************************************************
// * FUNCTION     : RC CheckRegistration(ConstStr programName)
// * DESCRIPTION  : Checks to see if the LMID value in the registry matches the
// *                  generated LMID.
// ***************************************************************************/
function CheckRegistration(Const MasterHKey:Integer;Const MasterKey,Key:String):tRResult;
Var s,lmid:String;
begin
   s:=GetRegistration(MasterHKEY,MasterKey,Key);
   if s='' then
      result:=rrFail
   else
   if not GetLocalMachineID(TOS_WIN95,MasterKey,Key,lmid) then
      result:=rrBadParam
   else
   if s<>lmid then
      result:=rrNoMatch
   else
      result:=rrOK
end;

//{------------------------------------------------------------------------------}
//****************************************************************************
// * PROCEDURE    : Void GetRegistration(ConstStr programName, CString& value)
// * DESCRIPTION  : Retrieves the "LMID" (Local Machine ID) value of
// *                  HKEY_LOCAL_MACHINE\SOFTWARE\A2i\_programName_ in the registry.
// ***************************************************************************/
function GetRegistration(Const MasterHKEY:Integer;Const MasterKey,Key:String):string;
var fRegistry:TRegistry;
begin
fRegistry:=TRegistry.create;
try
    fRegistry.RootKey:=MasterHKEY;
    fRegistry.OpenKey(MasterKey,false);
    result:=fRegistry.ReadString(Format('%sLMID',[Key]));
finally fRegistry.free;
end end;

// ***************************************************************************/
Procedure WriteRegistration(Const MasterHKey:Integer;Const MasterKey,Key:String);
var fRegistry:TRegistry;
    s:String;
begin
if GetLocalMachineID(TOS_WIN95,MasterKey,Key,s) then
   begin
   fRegistry:=TRegistry.create;
   try fRegistry.RootKey:=MasterHKey;
       fRegistry.OpenKey(MasterKey,True);
       fRegistry.WriteString(Format('%sLMID',[Key]),s);
   finally fRegistry.free;
   end end
else
   Raise Exception.Create('Unable to register the program');
end;

//Math Function not found in the Math unit -----------------------------------------------------------------------------}
function MinInt(const A,B:Integer):Integer;
begin
if A<=B then
   Result := A
else
   Result := B
end;

//{------------------------------------------------------------------------------}
function MaxInt(const A,B:Integer):Integer;
begin
if A>=B then
   Result := A
else
   Result := B
end;

//{------------------------------------------------------------------------------}
function ExtractTotal(Const Value:String;Const e:Integer):Integer;
Var p,l,ll,dec:Integer;  s:String;
Begin
Result:=0;
l:=Length(Value);
if l=0 then
   exit;
p:=Pos(Value,'.');
if p>0 then
   begin
   //Extract decimal part
   s:=System.Copy(Value,p,l-p-1);
   ll:=length(s);
   dec:=StrToIntDef(s,0);
   if ll>0 then
      dec:=Round(dec*IntPower(10,e)/IntPower(10,ll));
   s:=System.Copy(Value,0,p-1);
   result:=dec
   end
else s:=Value;
result:=Round(StrToIntDef(s,0)*IntPower(10,e)+Result)
end;


end.