Archive

Archive for November 19, 2014

Numbers to human words

November 19, 2014 Leave a comment

This is a great little function for converting numbers (10, 191, 20000 etc) into human readable words. An absolute must have for any program which counts something. A good way to avoid the typical “you have 1 files remaining” display text 🙂

Params and their meaning:

NTW(ChkER: Boolean; ER: String; D: Double): String;
ChkER = True for  Using Currency Format, False for math format
ER = Currency Name eg: 'Dollar'
D = Numeric Value

Typical use:


procedure TForm1.Button1Click(Sender
: TObject); //Currency Format
begin
     Memo1.Clear;
     Memo1.Text := NTW(True, 'Dollar', 185012,345020); 
     //Result : one hundred and eighty five thousand, and twelve dollar and thirty four cents
end;

procedure TForm1.Button2Click(Sender: TObject); //Math Format
begin
     Memo1.Clear;
     Memo1.Text := NTW(False, '', 185012,345020); 
     //Result : one hundred and eighty five thousand, and twelve point three four five zero two
end;

And last but not least, the actual code:

function NTW(ChkER: boolean; ER: string; D: double): string;
const
  Ones: array[0..9] of string = ('Zero', 'One', 'Two', 'Three', 'Four', 'Five', 'Six', 'Seven', 'Eight', 'Nine');
  Teens: array[10..19] of string = ('Ten', 'Eleven', 'Twelve', 'Thirteen', 'Fourteen', 'Fifteen', 'Sixteen', 'Seventeen', 'Eighteen', 'Nineteen');
  Tens: array[2..9] of string = ('Twenty', 'Thirty', 'Forty', 'Fifty', 'Sixty', 'Seventy', 'Eighty', 'Ninety');
  Suffix: array[0..5] of string = ('Hundred', 'Thousand', 'Million', 'Billion', 'Trillion', 'Quadrillion');
var RStr, sDec, sFrac: string;
    vFrac: double;
    I, vDec : integer;
    TruncTens, TruncHund, TruncThou, TruncMio, TruncBio, TruncTril, iD: Int64;
    ReadFrac: boolean;
    function fTensENG(xD: integer): string;
    var BTStr: string;
    begin
       if (xD >= 0) and (xD <= 9) then BTStr := Ones[xD] else
       if (xD >= 10) and (xD <= 19) then BTStr := Teens[xD] else
       if (xD >= 20) and (xD <= 99) then
       begin
          if (StrToInt(RightStr(IntToStr(xD), 1)) = 0) then
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 1))]
          else
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' +
                      Ones[StrToInt(RightStr(IntToStr(xD), 1))]
       end;
       Result := BTStr;
    end;
    function fHundENG(xD: integer): string;
    var BTStr: string;
    begin
       BTStr := Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[0];
       TruncTens := StrToInt(RightStr(IntToStr(xD), 2));
       if (TruncTens <> 0) then
          BTStr := BTStr + ' and ' + fTensENG(TruncTens);
       Result := BTStr;
    end;
    function fThouENG(xD: Integer): string;
    var BTStr: string;
    begin
       if (xD >= 1000) and (xD <= 9999) then
       begin
          BTStr := Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[1];
          TruncHund := StrToInt(RightStr(IntToStr(xD), 3));
          TruncTens := StrToInt(RightStr(IntToStr(xD), 2));
          if (TruncHund <> 0) and (TruncTens = 0) then
             BTStr := BTStr + 'and ' + Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[0]
          else
          if (TruncHund <> 0) and (TruncTens <> 0) then
             BTStr := BTStr + ', ' + fHundENG(TruncHund);
       end
       else
       if (Trunc(xD) >= 10000) and (Trunc(xD) <= 19999) then
       begin
          BTStr := Teens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[1];
          TruncHund := StrToInt(RightStr(IntToStr(xD), 3));
          TruncTens := StrToInt(RightStr(IntToStr(xD), 2));
          if (TruncHund <> 0) and (TruncTens = 0) then
             BTStr := BTStr + ' and ' + Ones[StrToInt(LeftStr(IntToStr(TruncHund), 1))] + ' ' + Suffix[0]
          else
          if (TruncHund <> 0) and (TruncTens <> 0) then
             BTStr := BTStr + ', ' + fHundENG(TruncHund);
       end
       else
       if (Trunc(xD) >= 20000) and (Trunc(xD) <= 99999) then
       begin
          if (StrToInt(MidStr(IntToStr(xD), 2, 1)) = 0) then
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[1]
          else
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' +
                      Ones[StrToInt(MidStr(IntToStr(xD), 2, 1))] + ' ' + Suffix[1];
          TruncHund := StrToInt(RightStr(IntToStr(xD), 3));
          TruncTens := StrToInt(RightStr(IntToStr(xD), 2));
          if (TruncHund <> 0) and (TruncTens = 0) then
             BTStr := BTStr + 'and ' + Ones[StrToInt(LeftStr(IntToStr(TruncHund), 1))] + ' ' + Suffix[0]
          else
          if (TruncHund <> 0) and (TruncTens <> 0) then
             BTStr := BTStr + ', ' + fHundENG(TruncHund);
       end
       else
       if (xD >= 100000) and (xD <= 9999999) then
       begin
          BTStr := fHundENG(StrToInt(LeftStr(IntToStr(xD), 3))) + ' ' + Suffix[1];
          TruncHund := StrToInt(RightStr(IntToStr(xD), 3));
          TruncTens := StrToInt(RightStr(IntToStr(xD), 2));
          if (TruncHund <> 0) and (TruncTens = 0) then
             BTStr := BTStr + 'and ' + Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[0]
          else
          if (TruncHund <> 0) and (TruncTens <> 0) then
             BTStr := BTStr + ', ' + fHundENG(TruncHund);
       end;
       Result := BTStr;
    end;
    function fMioENG(xD: Int64): string;
    var BTStr: string;
    begin
       if (xD >= 1000000) and (xD <= 9999999) then
       begin
          BTStr := Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[2];
          TruncThou := StrToInt(RightStr(IntToStr(xD), 6));
          if (TruncThou <> 0) then
             BTStr := BTStr + ', ' + fThouENG(TruncThou);
       end
       else
       if (xD >= 10000000) and (xD <= 19999999) then
       begin
          BTStr := Teens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[2];
          TruncThou := StrToInt(RightStr(IntToStr(xD), 6));
          if (TruncThou <> 0) then
             BTStr := BTStr + ', ' + fThouENG(TruncThou);
       end
       else
       if (xD >= 20000000) and (xD <= 99999999) then
       begin
          if (StrToInt(LeftStr(IntToStr(xD), 2)) = 0) then
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[2]
          else
             BTStr := Tens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' +
                      Ones[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[2];
          TruncThou := StrToInt(RightStr(IntToStr(xD), 6));
          if (TruncThou <> 0) then
             BTStr := BTStr + ', ' + fThouENG(TruncThou);
       end
       else
       if (xD >= 100000000) and (xD <= 999999999) then
       begin
          BTStr := fHundENG(StrToInt(LeftStr(IntToStr(xD), 3))) + ' ' + Suffix[2];
          TruncThou := StrToInt(RightStr(IntToStr(xD), 6));
          if (TruncThou <> 0) then
             BTStr := BTStr + ', ' + fThouENG(TruncThou);
       end
       else
       begin
          TruncThou := StrToInt(RightStr(IntToStr(xD), 6));
          if (TruncThou <> 0) then
             BTStr := BTStr + fThouENG(TruncThou);
       end;
       Result := BTStr;
    end;
    function fBioENG(xD: Int64): string;
    var BTStr: string;
    begin
       if (xD >= 1000000000) and (xD <= 9999999999) then
       begin
          BTStr := Ones[StrToInt64(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[3];
          TruncMio := StrToInt64(RightStr(IntToStr(xD), 9));
          if (TruncMio <> 0) then
             BTStr := BTStr + ', ' + fMioENG(TruncMio);
       end
       else
       if (xD >= 10000000000) and (xD <= 19999999999) then
       begin
          BTStr := Teens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[3];
          TruncMio := StrToInt64(RightStr(IntToStr(xD), 9));
          if (TruncMio <> 0) then
             BTStr := BTStr + ', ' + fMioENG(TruncMio);
       end
       else
       if (xD >= 20000000000) and (xD <= 99999999999) then
       begin
          if (StrToInt64(LeftStr(IntToStr(xD), 2)) = 0) then
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[3]
          else
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' +
                      Ones[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[3];
          TruncMio := StrToInt64(RightStr(IntToStr(xD), 9));
          if (TruncMio <> 0) then
             BTStr := BTStr + ', ' + fMioENG(TruncMio);
       end
       else
       if (xD >= 100000000000) and (xD <= 999999999999) then
       begin
          BTStr := fHundENG(StrToInt64(LeftStr(IntToStr(xD), 3))) + ' ' + Suffix[3];
          TruncMio := StrToInt64(RightStr(IntToStr(xD), 9));
          if (TruncMio <> 0) then
             BTStr := BTStr + ', ' + fMioENG(TruncMio);
       end
       else
       begin
          TruncMio := StrToInt64(RightStr(IntToStr(xD), 9));
          if (TruncMio <> 0) then
             BTStr := BTStr + fMioENG(TruncMio);
       end;
       Result := BTStr;
    end;
    function fTrilENG(xD: Int64): string;
    var BTStr: string;
    begin
       if (xD >= 1000000000000) and (xD <= 9999999999999) then
       begin
          BTStr := Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[4];
          TruncBio := StrToInt64(RightStr(IntToStr(xD), 12));
          if (TruncBio <> 0) then
             BTStr := BTStr + ', ' + fBioENG(TruncBio);
       end
       else
       if (xD >= 10000000000000) and (xD <= 19999999999999) then
       begin
          BTStr := Teens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[4];
          TruncBio := StrToInt64(RightStr(IntToStr(xD), 12));
          if (TruncBio <> 0) then
             BTStr := BTStr + ', ' + fBioENG(TruncBio);
       end
       else
       if (xD >= 20000000000000) and (xD <= 99999999999999) then
       begin
          if (StrToInt64(LeftStr(IntToStr(xD), 2)) = 0) then
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[4]
          else
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' +
                      Ones[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[4];
          TruncBio := StrToInt64(RightStr(IntToStr(xD), 12));
          if (TruncBio <> 0) then
             BTStr := BTStr + ', ' + fBioENG(TruncBio);
       end
       else
       if (xD >= 100000000000000) and (xD <= 999999999999999) then
       begin
          BTStr := fHundENG(StrToInt64(LeftStr(IntToStr(xD), 3))) + ' ' + Suffix[4];
          TruncBio := StrToInt64(RightStr(IntToStr(xD), 12));
          if (TruncBio <> 0) then
             BTStr := BTStr + ', ' + fBioENG(TruncBio);
       end
       else
       begin
          TruncBio := StrToInt64(RightStr(IntToStr(xD), 12));
          if (TruncBio <> 0) then
             BTStr := BTStr + fBioENG(TruncBio);
       end;
       Result := BTStr;
    end;
    function fQuadENG(xD: Int64): string;
    var BTStr: string;
    begin
       if (xD >= 1000000000000000) and (xD <= 9999999999999999) then
       begin
          BTStr := Ones[StrToInt(LeftStr(IntToStr(xD), 1))] + ' ' + Suffix[5];
          TruncTril := StrToInt64(RightStr(IntToStr(xD), 15));
          if (TruncTril <> 0) then
             BTStr := BTStr + ', ' + fTrilENG(TruncTril);
       end
       else
       if (xD >= 10000000000000000) and (xD <= 19999999999999999) then
       begin
          BTStr := Teens[StrToInt(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[5];
          TruncTril := StrToInt64(RightStr(IntToStr(xD), 15));
          if (TruncTril <> 0) then
             BTStr := BTStr + ', ' + fTrilENG(TruncTril);
       end
       else
       if (xD >= 20000000000000000) and (xD <= 99999999999999999) then
       begin
          if (StrToInt64(LeftStr(IntToStr(xD), 2)) = 0) then
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[5]
          else
             BTStr := Tens[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' +
                      Ones[StrToInt64(LeftStr(IntToStr(xD), 2))] + ' ' + Suffix[5];
          TruncTril := StrToInt64(RightStr(IntToStr(xD), 15));
          if (TruncTril <> 0) then
             BTStr := BTStr + ', ' + fTrilENG(TruncTril);
       end
       else
       if (xD >= 100000000000000000) and (xD <= 999999999999999999) then
       begin
          BTStr := fHundENG(StrToInt64(LeftStr(IntToStr(xD), 3))) + ' ' + Suffix[5];
          TruncTril := StrToInt64(RightStr(IntToStr(xD), 15));
          if (TruncTril <> 0) then
             BTStr := BTStr + ', ' + fTrilENG(TruncTril);
       end;;
       Result := BTStr;
    end;
begin
   iD := abs(Trunc(D));
   if (iD >= 0) and (iD <= 99) then RStr := fTensENG(iD) else
   if (iD >= 100) and (iD <= 999) then Rstr := RStr + fHundENG(iD) else
   if (iD >= 1000) and (iD <= 999999) then RStr := RStr + fThouENG(iD) else
   if (iD >= 1000000) and (iD <= 999999999) then RStr := RStr + fMioENG(iD) else
   if (iD >= 1000000000) and (iD <= 999999999999) then RStr := RStr + fBioENG(iD) else
   if (iD >= 1000000000000) and (iD <= 999999999999999) then RStr := RStr + fTrilENG(iD) else
   if (iD >= 1000000000000000) and (iD <= 999999999999999999) then RStr := RStr + fQuadENG(iD);
   if ChkER then RStr := RStr + ' ' + ER;
   vFrac := Frac(D);
   if (vFrac <> 0) then
   begin
      sDec := FormatFloat('0.000000', vFrac);
      if ChkER then
      begin
         sDec := MidStr(sDec, 3, 2);
         vDec := StrToInt(sDec);
         if (vDec > 0) then RStr := RStr + ' and ' + fTensENG(vDec) + ' cents.';
      end
      else
      begin
         RStr := RStr + ' point ';
         ReadFrac := False;
         sFrac := '';
         for I := Length(sDec) downto 3 do
         begin
            if (sDec[I] <> '0') then ReadFrac := True;
            if ReadFrac then sFrac := Ones[StrToInt(sDec[I])] + ' ' + sFrac;
         end;
         RStr := RStr + sFrac;
      end;
   end;
   Result := RStr;
end;

USB device detection

November 19, 2014 5 comments

This is a cool unit for USB device detection. Simply create an instance of the object and catch the events. Very cool for dealing with external disks.

 

unit uUsb;

interface

uses Windows, Messages, Classes;

type
  PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
  DEV_BROADCAST_HDR = packed record
    dbch_size: DWORD;
    dbch_devicetype: DWORD;
    dbch_reserved: DWORD;
  end;
  TDevBroadcastHdr = DEV_BROADCAST_HDR;

type
  PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
  DEV_BROADCAST_DEVICEINTERFACE = record
    dbcc_size: DWORD;
    dbcc_devicetype: DWORD;
    dbcc_reserved: DWORD;
    dbcc_classguid: TGUID;
    dbcc_name: Char;
  end;
  TDevBroadcastDeviceInterface = DEV_BROADCAST_DEVICEINTERFACE;

const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  DBT_DEVICEARRIVAL          = $8000;
  DBT_DEVICEREMOVECOMPLETE   = $8004;
  DBT_DEVTYP_DEVICEINTERFACE = $00000005;

type
  TUsbNotifyProc = procedure(Sender: TObject; const DeviceName: String) of Object;
  TUsbNotifier = class
  private
    FWindowHandle: HWND;
    FNotificationHandle: Pointer;
    FOnUsbArrival: TUsbNotifyProc;
    FOnUsbRemoval: TUsbNotifyProc;
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create;
    property OnUsbArrival: TUsbNotifyProc read FOnUsbArrival write FOnUsbArrival;
    property OnUsbRemoval: TUsbNotifyProc read FOnUsbRemoval write FOnUsbRemoval;
    destructor Destroy; override;
  end;


implementation

constructor TUsbNotifier.Create;
var
  Size: Cardinal;
  Dbi: TDevBroadcastDeviceInterface;
begin
  inherited;
  FWindowHandle := AllocateHWnd(WndProc);

  Size := SizeOf(Dbi);
  ZeroMemory(@Dbi, Size);

  Dbi.dbcc_size := Size;
  Dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  Dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;

  FNotificationHandle := RegisterDeviceNotification(FWindowHandle, @Dbi,
                                              DEVICE_NOTIFY_WINDOW_HANDLE);
end;

procedure TUsbNotifier.WndProc(var Msg: TMessage);
var
  Dbi: PDevBroadcastDeviceInterface;
begin
  with Msg do
  if (Msg = WM_DEVICECHANGE)
      and ((WParam = DBT_DEVICEARRIVAL)
        or (WParam = DBT_DEVICEREMOVECOMPLETE)) then
  try
    Dbi := PDevBroadcastDeviceInterface(LParam);
    if Dbi.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE then
    begin
      if WParam = DBT_DEVICEARRIVAL then
      begin
        if Assigned(FOnUsbArrival) then
          FOnUsbArrival(Self, PChar(@Dbi.dbcc_name));
      end
      else
      begin
        if Assigned(FOnUsbRemoval) then
          FOnUsbRemoval(Self, PChar(@Dbi.dbcc_name));
      end;
    end;
  except
    Result := DefWindowProc(FWindowHandle, Msg, WParam, LParam);
  end
  else
    Result := DefWindowProc(FWindowHandle, Msg, WParam, LParam);
end;

destructor TUsbNotifier.Destroy;
begin
  UnregisterDeviceNotification(FNotificationHandle);
  DeallocateHWnd(FWindowHandle);
  inherited;
end;

end.