1. Pascal / Говнокод #7624

    +123

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    function HexWrdToStr(Dval : integer) : string;
    var i : integer;
    retstr : string;
    begin
    retstr := '';
    i := (Dval AND $F000) DIV $1000;
    case i of
      0 : retstr := retstr + '0';
      1 : retstr := retstr + '1';
      2 : retstr := retstr + '2';
      3 : retstr := retstr + '3';
      4 : retstr := retstr + '4';
      5 : retstr := retstr + '5';
      6 : retstr := retstr + '6';
      7 : retstr := retstr + '7';
      8 : retstr := retstr + '8';
      9 : retstr := retstr + '9';
      10 : retstr := retstr + 'A';
      11 : retstr := retstr + 'B';
      12 : retstr := retstr + 'C';
      13 : retstr := retstr + 'D';
      14 : retstr := retstr + 'E';
      15 : retstr := retstr + 'F';
    end;
    i := (Dval AND $F00) DIV $100;
    case i of
      0 : retstr := retstr + '0';
      1 : retstr := retstr + '1';
      2 : retstr := retstr + '2';
      3 : retstr := retstr + '3';
      4 : retstr := retstr + '4';
      5 : retstr := retstr + '5';
      6 : retstr := retstr + '6';
      7 : retstr := retstr + '7';
      8 : retstr := retstr + '8';
      9 : retstr := retstr + '9';
      10 : retstr := retstr + 'A';
      11 : retstr := retstr + 'B';
      12 : retstr := retstr + 'C';
      13 : retstr := retstr + 'D';
      14 : retstr := retstr + 'E';
      15 : retstr := retstr + 'F';
    end;
    i := (Dval AND $F0) DIV $10;
    case i of
      0 : retstr := retstr + '0';
      1 : retstr := retstr + '1';
      2 : retstr := retstr + '2';
      3 : retstr := retstr + '3';
      4 : retstr := retstr + '4';
      5 : retstr := retstr + '5';
      6 : retstr := retstr + '6';
      7 : retstr := retstr + '7';
      8 : retstr := retstr + '8';
      9 : retstr := retstr + '9';
      10 : retstr := retstr + 'A';
      11 : retstr := retstr + 'B';
      12 : retstr := retstr + 'C';
      13 : retstr := retstr + 'D';
      14 : retstr := retstr + 'E';
      15 : retstr := retstr + 'F';
    end;
    i := Dval AND $F;
    case i of
      0 : retstr := retstr + '0';
      1 : retstr := retstr + '1';
      2 : retstr := retstr + '2';
      3 : retstr := retstr + '3';
      4 : retstr := retstr + '4';
      5 : retstr := retstr + '5';
      6 : retstr := retstr + '6';
      7 : retstr := retstr + '7';
      8 : retstr := retstr + '8';
      9 : retstr := retstr + '9';
      10 : retstr := retstr + 'A';
      11 : retstr := retstr + 'B';
      12 : retstr := retstr + 'C';
      13 : retstr := retstr + 'D';
      14 : retstr := retstr + 'E';
      15 : retstr := retstr + 'F';
    end;
    HexWrdToStr := retstr;
    end;

    Авторы - программисты из FTDI, взято из экзамплов работы с USB-конвертерами.
    Полный текст можно найти здесь: __http://www.ftdichip.com/Support/SoftwareExamples/CodeExamples/Delphi.htm

    З.Ы. Ниже по тексту идет аналогичная функция HexByteToStr. Алгоритм, так сказать, тот же.

    Запостил: 1291, 23 Августа 2011

    Комментарии (10) RSS

    • ох щит
      Ответить
    • Странно видеть в подобном коде i := (Dval AND $F000) DIV $1000;
      Ответить
    • ай да умничка!
      Ответить
    • Str := SetupForm.BaudSelect.Text;
      If Str = '300' then FT_Current_Baud := FT_BAUD_300 else
      If Str = '600' then FT_Current_Baud := FT_BAUD_600 else
      If Str = '1,200' then FT_Current_Baud := FT_BAUD_1200 else
      If Str = '2,400' then FT_Current_Baud := FT_BAUD_2400 else
      If Str = '4,800' then FT_Current_Baud := FT_BAUD_4800 else
      If Str = '9,600' then FT_Current_Baud := FT_BAUD_9600 else
      If Str = '19,200' then FT_Current_Baud := FT_BAUD_19200 else
      If Str = '38,400' then FT_Current_Baud := FT_BAUD_38400 else
      If Str = '57,600' then FT_Current_Baud := FT_BAUD_57600 else
      If Str = '115,200' then FT_Current_Baud := FT_BAUD_115200 else
      If Str = '230,400' then FT_Current_Baud := FT_BAUD_230400 else
      If Str = '460,800' then FT_Current_Baud := FT_BAUD_460800 else
      If Str = '921,600' then FT_Current_Baud := FT_BAUD_921600 else
      FT_SetupError := True;

      D2XXUnit оттуда же
      Ответить
      • Да, там _этого_ навалом. Или дебилы, или у них посимвольная оплата труда.
        Ответить
    • интересно, а чем не угодил IntToHex?
      Ответить
      • Думаете, они знали о его существовании?
        Ответить
        • function IntToHex(Value: Integer; Digits: Integer): string;
          asm
          CMP EDX, 32 // Digits < buffer length?
          JBE @A1
          XOR EDX, EDX
          @A1: PUSH ESI
          MOV ESI, ESP
          SUB ESP, 32
          PUSH ECX // result ptr
          MOV ECX, 16 // base 16 EDX = Digits = field width
          CALL CvtInt
          MOV EDX, ESI
          POP EAX // result ptr
          CALL System.@LStrFromPCharLen
          ADD ESP, 32
          POP ESI
          end;

          Здесь же все непонятно. А у них - наоборот, все понятно и прозрачно, сразу видно, откуда и как получается каждая цифра.
          Ответить
    • показать все, что скрытоvanished
      Ответить

    Добавить комментарий