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

    +110

    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
    // Двухклеточная прямая.
       ({D2A2}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clBlack)     and{D2A2} (Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A2}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A2}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A2}
    ({D2A2A-1}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A2A-1}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A2A-1}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clBlack) and{D2A2A-1}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A2A-1}
       ({D2A3}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A3}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)  and{D2A3}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A3}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite) and{D2A3}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2A3}
       ({D2A4}(Pixels[X+h,Y-1]=clBlack) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A4}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A4}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A4}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A4}
   ... Ещё 20 строк в таком стиле
       ({D2B2}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clBlack)     and{D2B2}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)      and{D2B2}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B2}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B2}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2B2}
       ({D2B3}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clWhite)     and{D2B3}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)      and{D2B3}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B3}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B3}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2B3}
       ({D2B4}(Pixels[X+h,Y-1]=clBlack) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clWhite)     and{D2B4}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)      and{D2B4}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B4}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B4}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) {or} {D2B4}
         {(J1(Pixels[X+h,Y-1]=clWhite) and (Pixels[x+h,y]=clWhite) and (Pixels[x+h,y-2]=clBlack))} then // Проверка, если обрыв по x, начало следующей ступенрки.
         begin
          goto k8;
           end ;
            goto k3;//Если убрать эту строчку,то может фиксироваться вся линия исключая точку с дифектоми, т.к.
             end;   // если не отрабатывает сравнение пикселей по длине ступеньки и не отрабатывает по переходу на новую ступеньку, прог. прибавляет h и перемещает пиксель опроса в право.
 
    k8: if (CPlx-CPLxI=0) or (CPlx-CPlxI=1) or (CPlxI-CPlx=1)or(CPlxI-CPlx=CPlxI/2) or (CPlx-CPlxI=CPlx/2) or (CPlxI-CPlx=(CPlxI/2)-1) or (CPlx-CPlxI=(CPlx/2)-1) or ((CPlxI-CPlx>(CPlxI/2)-1) and (CPlxI-CPlx<(CPlxI/2)+1)) then
 
    begin
     a:=x+h;
     b:=y-1;
     count:=count+1; // Счет ступеник.
     goto k5;
      end;
 
      k3: OperEnd:=DateTimeToTimeStamp(Now);
 Total:=OperEnd.Time-OperBegin.Time;
 
 
   ListBox1.Items.Add(IntToStr(CPlx0)+' CPlx0');
   ListBox1.Items.Add(IntToStr(CPlxI)+' CPlxI');
   ListBox1.Items.Add(IntToStr(count)+' Ступеньки.');
   ListBox1.Items.Add(IntToStr(Total)+' MSec');
     end; // Конец прог.
       end;
         end.

    Адовый пиздец с киберфорума.

    http://www.cyberforum.ru/delphi-beginners/thread941698.html

    murder, 23 Августа 2013

    Комментарии (24)

  2. Pascal / Говнокод #13642

    +130

    1. 1
    Народ, вы где? Я реально соскучился.

    Stertor, 22 Августа 2013

    Комментарии (0)

  3. Pascal / Говнокод #13595

    +87

    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
    *-*-*-*-*-*-*-*-*-*-*-*-*-*-зашифрованные прокси:*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
<TD id="address">
<script language=javascript>
<!--
					proxy(3,'28','70','216','172',80);
					proxy(4,'70','216','172','28',80);
					proxy(1,'103','10','59','30',8080);
					proxy(2,'10','59','30','103',80);
					proxy(3,'251','151','101','109',80);
					proxy(4,'83','209','222','25',8080);
					proxy(1,'101','109','251','89',80);
					proxy(2,'50','26','5','101',8080);
					proxy(3,'220','89','186','93',8000);
					proxy(4,'158','98','190','250',8090);
					proxy(1,'92','39','185','18',80);
					proxy(2,'8','240','44','5',8080);
					proxy(3,'127','84','124','81',8080);
                                                       
                                                               [...]
// -->
</script>
				</TD>

//*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-Свиток-расшифровщик*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

function proxy(mode,arg1,arg2,arg3,arg4,port){
	var ret;
	switch(mode) {
		case 1:
			ret=arg1+"."+arg2+"."+arg3+"."+arg4+":"+port+"<BR>";
			break;
		case 2:
			ret=arg4+"."+arg1+"."+arg2+"."+arg3+":"+port+"<BR>";
			break;
		case 3:
			ret=arg3+"."+arg4+"."+arg1+"."+arg2+":"+port+"<BR>";
			break;
		case 4:
			ret=arg2+"."+arg3+"."+arg4+"."+arg1+":"+port+"<BR>";
			break;
	}
	document.write(ret);
}
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

var
  StartPos : Integer;
  MyText ,temp: string;
  memorystream:tmemorystream;
  anolink:string;
  i:integer;
  ccount:integer;
  counter:string;
  endpos:integer;
  steg,eteg:string;
  b:integer;
  mode,arg1,arg2,arg3,arg4,port:string;
begin
  steg:='proxy(';
  eteg:=');';
  memorystream:=tmemorystream.create;
  idhttp1.Request.UserAgent:='Mozilla/5.0 (Windows NT 5.1; rv:19.0) Gecko/20100101 Firefox/19.0';
  idhttp1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
  idhttp1.request.AcceptLanguage:='ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  idhttp1.Request.AcceptEncoding:='ngnix';
  idhttp1.Request.Connection:='keep-alive';
  idhttp1.Get('http://anonymousinet.com/index.php',memorystream);
  memorystream.Position:=0;
  mytext:=memorystreamtostring(memorystream);
  mytext:=utf8toansi(mytext);
  memorystream.Clear;
  startpos:=0;
  While true do
  begin
    startPos := PosEx(steg, MyText, StartPos + 1);
    if StartPos > 0 then
    begin
      temp:=copy(mytext,startpos+length(steg),length(mytext));
      b:=pos(eteg,temp);
      if b >0 then
      temp:=copy(temp,1,b-1);
      temp:=trim(temp);
      temp:=stringreplace(temp,'''','',[rfreplaceall]);
      mode:=stringfield(temp,',',1);
      arg1:=stringfield(temp,',',2);
      arg2:=stringfield(temp,',',3);
      arg3:=stringfield(temp,',',4);
      arg4:=stringfield(temp,',',5);
      port:=stringfield(temp,',',6);
      smemo1.lines.add(proxy(mode,arg1,arg2,arg3,arg4,port));
    end
    else
    Break;
  end;

    end;

    Зловонная попытка защитить прокси от парсинга. Гм, как бы помягче,гм, неудачная...

    Stertor, 11 Августа 2013

    Комментарии (3)

  4. Pascal / Говнокод #13593

    +97

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    Сегодня был приятно удивлен тем, что цикл

for i:=0 to memo1.lines.count -1 do
...

приостанавливает работу, когда идет обращение к мемо (пользователь выделяет текст или печатает в этом мемо) до тех пор, пока идет обращение. 
Очевидно, это такая фишка компилятора. Приятно, когда компилятор прикрывает спину.

    Stertor, 10 Августа 2013

    Комментарии (85)

  5. Pascal / Говнокод #13544

    +82

    1. 1
    2. 2
    3. 3
    Stertor, TThreadList - список указателей и предназначен для хранения TThread. 
Для хранения объектов используйте TObjectList, там есть метод IndexOf 
который сравнивает объекты списка, наследуйте свой класс от его и перепишите методы на свой лад с контролем дубликатов.

    Так говорил Лажаратустра.

    Stertor, 03 Августа 2013

    Комментарии (6)

  6. Pascal / Говнокод #13494

    +131

    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
    1
1
	

Имеется графический обозреватель картинок, где мини-изображения хранятся в ImageList, а выводятся ListView (поименованные графические файлы). При открытие папок с картинками (где большое количество картинок) возникает торможение отображения. Вся программа начинает тормозить, ожидая загрузки картинок в ListView. Чтобы избежать такого, я вынес загрузку ListBox в отдельный процесс Thread. В результате возникла другая проблема: при загрузке картинок, часть загружается просто черными квадратами. Как избавиться от этого неприятного эффекта?

Код выбора папки для дальнейшего просмотра содержимого:

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
  Form1.ListView1.Clear;
  Form1.ImageList1.Clear;
  NewThread:=TNewThread.Create(false);
  NewThread.FreeOnTerminate:=true;
  NewThread.Priority:=tpHighest;
  NewThread.Resume;
end;

Код отдельно выделенного процесса:

procedure TNewThread.Execute;
begin
  Form1.FillListView(form1.DirectoryListBox1.Directory , '*.jpg');
  Form1.FillListView(form1.DirectoryListBox1.Directory, '*.bmp');
end;

И наконец код обработки графических файлов с последующей загрузкой в ListBox:

procedure TForm1.fillListView(path: string; mask: string = '*.jpg');
var
  sr:  TSearchRec;
  img: TPicture;
  bmp: TBitmap;
  pic: TBitMap;
  x,y: integer;
begin
  img := TPicture.Create;
  bmp := TBitMap.Create;
  pic := TBitMap.Create;

  With Form1 do
  if FindFirst(path +'\'+mask, faAnyFile, sr) = 0 then
  begin
    repeat
      if (sr.Name<>'.') and (sr.Name<>'..') and (sr.Attr<>faDirectory) then
      //if (sr.Attr and $20) = $20 then
      begin
        try
          img.LoadFromFile(path +'\'+ sr.Name);
        except
          Continue;
        end;
        bmp.Assign(img.Graphic);
        x:=bmp.Width;
        y:=bmp.Height;
        pic.Width := ImageList1.Width;
        pic.Height:= ImageList1.Height;
        pic.Canvas.Brush.Color :=clWhite;
        pic.Canvas.FillRect(Canvas.ClipRect);
        pic.Canvas.StretchDraw(Rect(0,0,pic.Width, Round((pic.Height*y)/x)), bmp);
        ImageList1.Add(pic, nil);

        with ListView1.Items.Add do
        begin
          Caption := sr.Name;
          ImageIndex := ListView1.Items.Count-1;
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  img.Free;
  bmp.Free;
  pic.Free;
end;

    Не сопротивляйся, смерть сладка.

    http://hashcode.ru/questions/86688/delphi-%D1%80%D0%B0%D0%B1%D0%BE%D1%82%D0%B0-%D1%81-listview-%D0%B2-%D0%B4%D0%B5%D0%BB%D1%84%D0%B8

    Stertor, 27 Июля 2013

    Комментарии (35)

  7. Pascal / Говнокод #13462

    +141

    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
    if x > 0 then 
begin
if y <= 0 then 
begin
if z <> 0 then 
begin
if x1 > 0 then 
begin
if y1 < 7 then 
begin
if z1 > 0 then 
begin
if z1 mod 5 = 0 then 
begin
if m <> 3 then 
begin
if n > 5 then 
begin
writeln('1');
end;
end;
end;
end;
end;
end;
end;
end;
end;

    iNsectus, 21 Июля 2013

    Комментарии (3)

  8. Pascal / Говнокод #13444

    +88

    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
    program Project6;

{$APPTYPE CONSOLE}

uses SysUtils;

type TIntArr = array of integer;

function GetSingleArr (i: integer): TIntArr;
begin
  SetLength(Result, 1);
  Result[0] := i;
end;

var
  W: TIntArr;
  i : integer;
begin
  readln(i);
  if i=0 then begin
    W := GetSingleArr(5);
    WriteLn(W[0]);
  end;
  ReadLn;
end.

Delphi-7
[Warning] Project6.dpr(25): Variable 'W' might not have been initialized

    Да какого хуя? Динмассив вообще по определению - чисто автоматический тип, как он может не инициализироваться?
    И почему для других типов такая хрень не вылазит?

    TarasB, 18 Июля 2013

    Комментарии (60)

  9. 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)

  10. Pascal / Говнокод #13397

    +132

    1. 1
    2. 2
    3. 3
    Прокси-граббер

http://rghost.ru/47337858

    Прокси-граббер

    http://rghost.ru/47337858

    Stertor, 11 Июля 2013

    Комментарии (2)