home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / DRBOBC.ZIP / CONVERT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-02-20  |  9.4 KB  |  253 lines
  1. unit Convert;
  2. interface
  3. uses SysUtils, Classes, DrBob;
  4.  
  5. Type
  6.   TConvert = class(TDrBob)
  7.                private
  8.                  FValue: Word;
  9.  
  10.                protected
  11.                  function GetHex: String;
  12.                  function GetRoman: String;
  13.  
  14.                  procedure SetHex(Const Value: String);
  15.                  procedure SetRoman(Const Rom: String);
  16.  
  17.                published
  18.                  property Decimal: Word read FValue write FValue;
  19.                  property Hex:   String read GetHex write SetHex;
  20.                  property Roman: String read GetRoman write SetRoman;
  21.  
  22.                public
  23.                  constructor Create(AOwner: TComponent); override;
  24.              end {TConvert};
  25.  
  26. implementation
  27.  
  28.   constructor TConvert.Create(AOwner: TComponent);
  29.   begin
  30.     inherited Create(AOwner);
  31.     FValue := 0;
  32.     FAbout := 'TConvert (c) 1996 by Bob Swart (aka Dr.Bob - 100434,2072)'
  33.   end {Create};
  34.  
  35.   function TConvert.GetHex: String;
  36.   Const Digits: Array[0..$F] of Char = '0123456789ABCDEF';
  37.   begin
  38.     GetHex[0] := #4;
  39.     GetHex[1] := Digits[Hi(FValue) SHR 4];
  40.     GetHex[2] := Digits[Hi(FValue) AND $F];
  41.     GetHex[3] := Digits[Lo(FValue) SHR 4];
  42.     GetHex[4] := Digits[Lo(FValue) AND $F];
  43.   end {GetHex};
  44.  
  45.   procedure TConvert.SetHex(Const Value: String);
  46.   var code: Integer;
  47.   begin
  48.     if (Value[1] <> '$') then Val('$'+Value,FValue,code)
  49.                          else Val(Value,FValue,code)
  50.   end {SetHex};
  51.  
  52.  
  53.   function TConvert.GetRoman: String; Assembler;
  54.   ASM
  55.         les   DI,@Result
  56.         inc   DI
  57.         push  DS
  58.         lds   SI,self
  59.         add   SI,FValue
  60.         lodsw
  61.         pop   DS
  62.         mov   BX,AX        { BS := FValue;          }
  63.         xor   AX,AX        { len := 0;              }
  64.  
  65.   @1000:cmp   BX,1000      { if W < 1000 then       }
  66.         jb    @900         {   goto @900            }
  67.                            { else begin             }
  68.         sub   BX,1000      {   W := W - 1000;       }
  69.         inc   AH           {   len := len + 1;      }
  70.         mov   AL,'M'
  71.         stosb              {   Int2Rom[len] := 'M'; }
  72.                            { end;                   }
  73.         jmp   @1000        { goto @1000;            }
  74.  
  75.   @900: cmp   BX,900       { if W < 900 then        }
  76.         jb    @500         {   goto @500            }
  77.                            { else begin             }
  78.         sub   BX,900       {   W := W - 900;        }
  79.         inc   AH           {   len := len + 1;      }
  80.         mov   AL,'C'
  81.         stosb              {   Int2Rom[len] := 'C'; }
  82.         inc   AH           {   len := len + 1;      }
  83.         mov   AL,'M'
  84.         stosb              {   Int2Rom[len] := 'M'; }
  85.                            { end;                   }
  86.         jmp   @90          { goto @90;              }
  87.  
  88.   @400: cmp   BX,400       { if W < 400 then        }
  89.         jb    @100         {   goto @100            }
  90.                            { else begin             }
  91.         sub   BX,400       {   W := W - 400;        }
  92.         inc   AH           {   len := len + 1;      }
  93.         mov   AL,'C'
  94.         stosb              {   Int2Rom[len] := 'C'; }
  95.         inc   AH           {   len := len + 1;      }
  96.         mov   AL,'D'
  97.         stosb              {   Int2Rom[len] := 'D'; }
  98.                            { end;                   }
  99.         jmp   @90          { goto @90;              }
  100.  
  101.   @500: cmp   BX,500       { if W < 500 then        }
  102.         jb    @400         {   goto @400            }
  103.                            { else begin             }
  104.         sub   BX,500       {   W := W - 500;        }
  105.         inc   AH           {   len := len + 1;      }
  106.         mov   AL,'D'
  107.         stosb              {   Int2Rom[len] := 'D'; }
  108.                            { end;                   }
  109.       { jmp   @100           goto @100;             }
  110.  
  111.   @100: cmp   BX,100       { if W < 100 then        }
  112.         jb    @90          {   goto @90             }
  113.                            { else begin             }
  114.         sub   BX,100       {   W := W - 100;        }
  115.         inc   AH           {   len := len + 1;      }
  116.         mov   AL,'C'
  117.         stosb              {   Int2Rom[len] := 'C'; }
  118.                            { end;                   }
  119.         jmp   @100         { goto @100;             }
  120.  
  121.    @90: cmp   BX,90        { if W < 90 then         }
  122.         jb    @50          {   goto @50             }
  123.                            { else begin             }
  124.         sub   BX,90        {   W := W - 90;         }
  125.         inc   AH           {   len := len + 1;      }
  126.         mov   AL,'X'
  127.         stosb              {   Int2Rom[len] := 'X'; }
  128.         inc   AH           {   len := len + 1;      }
  129.         mov   AL,'C'
  130.         stosb              {   Int2Rom[len] := 'C'; }
  131.                            { end;                   }
  132.         jmp   @9           { goto @9;               }
  133.  
  134.    @40: cmp   BX,40        { if W < 40 then         }
  135.         jb    @10          {   goto @10             }
  136.                            { else begin             }
  137.         sub   BX,40        {   W := W - 40;         }
  138.         inc   AH           {   len := len + 1;      }
  139.         mov   AL,'X'
  140.         stosb              {   Int2Rom[len] := 'X'; }
  141.         inc   AH           {   len := len + 1;      }
  142.         mov   AL,'L'
  143.         stosb              {   Int2Rom[len] := 'L'; }
  144.                            { end;                   }
  145.         jmp   @9           { goto @9;               }
  146.  
  147.    @50: cmp   BX,50        { if W < 50 then         }
  148.         jb    @40          {   goto @40             }
  149.                            { else begin             }
  150.         sub   BX,50        {   W := W - 50;         }
  151.         inc   AH           {   len := len + 1;      }
  152.         mov   AL,'L'
  153.         stosb              {   Int2Rom[len] := 'L'; }
  154.                            { end;                   }
  155.       { jmp   @10            goto @10;              }
  156.  
  157.    @10: cmp   BX,10        { if W < 10 then         }
  158.         jb    @9           {   goto @9              }
  159.                            { else begin             }
  160.         sub   BX,10        {   W := W - 10;         }
  161.         inc   AH           {   len := len + 1;      }
  162.         mov   AL,'X'
  163.         stosb              {   Int2Rom[len] := 'X'; }
  164.                            { end;                   }
  165.         jmp   @10          { goto @10;              }
  166.  
  167.     @9: cmp   BX,9         { if W < 9 then          }
  168.         jb    @5           {   goto @5              }
  169.                            { else begin             }
  170.         sub   BX,9         {   W := W - 9;          }
  171.         inc   AH           {   len := len + 1;      }
  172.         mov   AL,'I'
  173.         stosb              {   Int2Rom[len] := 'I'; }
  174.         inc   AH           {   len := len + 1;      }
  175.         mov   AL,'X'
  176.         stosb              {   Int2Rom[len] := 'X'; }
  177.                            { end;                   }
  178.         jmp   @0           { goto @0;               }
  179.  
  180.     @4: cmp   BX,4         { if W < 4 then          }
  181.         jb    @1           {   goto @1              }
  182.                            { else begin             }
  183.         sub   BX,4         {   W := W - 4;          }
  184.         inc   AH           {   len := len + 1;      }
  185.         mov   AL,'I'
  186.         stosb              {   Int2Rom[len] := 'I'; }
  187.         inc   AH           {   len := len + 1;      }
  188.         mov   AL,'V'
  189.         stosb              {   Int2Rom[len] := 'V'; }
  190.                            { end;                   }
  191.         jmp   @0           { goto @0;               }
  192.  
  193.     @5: cmp   BX,5         { if W < 5 then          }
  194.         jb    @4           {   goto @4              }
  195.                            { else begin             }
  196.         sub   BX,5         {   W := W - 5;          }
  197.         inc   AH           {   len := len + 1;      }
  198.         mov   AL,'V'
  199.         stosb              {   Int2Rom[len] := 'V'; }
  200.                            { end;                   }
  201.       { jmp   @1             goto @1;               }
  202.  
  203.     @1: cmp   BX,1         { if W < 1 then          }
  204.         jb    @0           {   goto @0              }
  205.                            { else begin             }
  206.         dec   BX           {   W := W - 1;          }
  207.         inc   AH           {   len := len + 1;      }
  208.         mov   AL,'I'
  209.         stosb              {   Int2Rom[len] := 'I'; }
  210.                            { end;                   }
  211.         jmp   @1           { goto @1;               }
  212.  
  213.     @0: les   DI,@Result
  214.     {$IFOPT G+}
  215.         shr   AX,8
  216.     {$ELSE}
  217.         mov   CL,8
  218.         shr   AX,CL
  219.     {$ENDIF}
  220.         stosb              { Int2Rom[0] := Chr(len) }
  221.   end {GetRoman};
  222.  
  223.  
  224.   procedure TConvert.SetRoman(Const Rom: String);
  225.   const value: Array['A'..'Z'] of Word =
  226.        (0,0,100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10,0,0);
  227.   var len: Byte absolute Rom;
  228.       index,next: Char;
  229.       teller: Integer;
  230.       tmp: Word;
  231.   begin
  232.     tmp := 0;
  233.     teller := 0;
  234.     while (teller < len) do
  235.     begin
  236.       Inc(teller);
  237.       index := UpCase(Rom[teller]); { upcase is needed to index value }
  238.       if index in ['A'..'Z'] then
  239.       begin
  240.         next := UpCase(Rom[Succ(teller)]);
  241.         if (next in ['A'..'Z']) and (value[index] < value[next]) then
  242.         begin
  243.           Inc(tmp,value[next]);
  244.           Dec(tmp,value[index]);
  245.           Inc(teller)
  246.         end
  247.         else Inc(tmp,value[index])
  248.       end
  249.     end;
  250.     FValue := tmp
  251.   end {SetRoman};
  252. end.
  253.