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

    +86

    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
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    96. 96
    procedure TForm1.Colorize;
procedure SetStr(var s: string; const Style: TFontStyles; const Color, BackColor: Byte);
var
  Format: TCharFormat2;
begin
 If s<>'' Then
  begin
    FillChar(Format, SizeOf(Format), 0);
    Format.cbSize := SizeOf(Format);
    Format.dwMask:= CFM_BACKCOLOR or CFM_COLOR;
    Format.crBackColor:= GetIRCColor(BackColor, True);
    Format.crTextColor:= GetIRCColor(Color);
    if RichEdit1.HandleAllocated then
    SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION,
      LPARAM(@Format));
    RichEdit1.SelAttributes.Style:= Style;
    RichEdit1.SelText:= s;
    RichEdit1.SelAttributes.Assign(RichEdit1.DefAttributes);
    s:= ''
  end;
end;
var
  Color, BackColor: Byte;
  Style: TFontStyles;
  CurrStr: string;
  I: Integer;
begin
  Style:= [];
  Color:= DefForeColor;
  BackColor:= DefBackColor;
  CurrStr:= '';
  I:= 0;
  While (I<Length(Str))do
   begin
    Inc(I);
    case Str[I] of
      #31:
          begin
           SetStr(CurrStr, Style, Color, BackColor);
           If fsUnderLine in Style Then
            Exclude(Style, fsUnderLine)
           else
            Include(Style, fsUnderLine);
         end;
      #2:
         begin
           SetStr(CurrStr, Style, Color, BackColor);
           If fsBold in Style Then
            Exclude(Style, fsBold)
           else
            Include(Style, fsBold);
         end;
       #15, #13:
           begin
            SetStr(CurrStr, Style, Color, BackColor);
            Color:= DefForeColor;
            BackColor:= DefBackColor;
           end;
       #3:
          begin
            SetStr(CurrStr, Style, Color, BackColor);
            Inc(I);
            Color:= DefForeColor;
            If (Str[I] in ['0', '1'..'9'])Then
             begin
              Color:= StrToInt(Str[I]);
              Inc(I);
              If (Str[I] in ['0', '1'..'9'])Then
               begin
                 Color:= StrToInt(IntToStr(Color)+Str[I]);
                 Inc(I)
               end;
             end;
             If Str[I] = ',' Then                         //BackColor
               begin
                BackColor:= DefBackColor;
                Inc(I);
                If (Str[I] in ['0', '1'..'9'])Then
                 begin
                  BackColor:= StrToInt(Str[I]);
                  Inc(I);
                  If (Str[I] in ['0', '1'..'9'])Then
                   begin
                    BackColor:= StrToInt(IntToStr(BackColor)+Str[I]);
                    Inc(I)
                   end;
                  end;
                end;
               Dec(I) 
          end;
       else
        CurrStr:= CurrStr+Str[I]
    end;
   end;
   SetStr(CurrStr, Style, Color, BackColor);
end;

    Процедура раскрашивающая текст из Log-файла mIRC загруженого в TRichEdit на форме.

    function GetIRCColor(const Color: Byte; const Back: Boolean=False): TColor;
    begin
    case Color of
    0: Result:= clWhite;
    1: Result:= clBlack;
    2: Result:= clNavy;
    3: Result:= clGreen;
    4: Result:= clRed;
    5: Result:= clMaroon;
    6: Result:= clPurple;
    7: Result:= $000080FF;
    8: Result:= clYellow;
    9: Result:= clLime;
    10: Result:= clTeal;
    11: Result:= clAqua;
    12: Result:= clBlue;
    13: Result:= clFuchsia;
    14: Result:= clGray;
    15: Result:= clSilver;
    else
    begin
    If Back Then
    Result:= clWhite
    else
    Result:= clBlack
    end;
    end;
    end;

    Запостил: ASNightingale, 12 Июля 2013

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

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