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

    0

    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
    unit Unit1;
    interface
    uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, ComCtrls;
    
    type
    TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ...
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    GroupBox2: TGroupBox;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    RadioButton7: TRadioButton;
    RadioButton8: TRadioButton;
    GroupBox3: TGroupBox;
    RadioButton9: TRadioButton;
    RadioButton10: TRadioButton;
    ...
    GroupBox14: TGroupBox;
    RadioButton52: TRadioButton;
    RadioButton53: TRadioButton;
    RadioButton54: TRadioButton;
    RadioButton55: TRadioButton;
    GroupBox15: TGroupBox;
    RadioButton56: TRadioButton;
    RadioButton57: TRadioButton;
    RadioButton58: TRadioButton;
    RadioButton59: TRadioButton;
    
    ... 
    end;
    
    var 
    Form1: TForm1;
    
    implementation 
    
    {$R *.dfm}
    
    procedure TForm1.BitBtn1Click(Sender: TObject);
    begin
    form1.Close;
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    var s: integer;
    begin
    Button3.enabled:=true;
    
    s:=0;
    if Form1.RadioButton2.Checked then s:=s+1;
    if Form1.RadioButton6.Checked then s:=s+1;
    if Form1.RadioButton20.Checked then s:=s+1;
    if Form1.RadioButton15.Checked then s:=s+1;
    if Form1.RadioButton11.Checked then s:=s+1;
    if Form1.RadioButton21.Checked then s:=s+1;
    if Form1.RadioButton24.Checked then s:=s+1;
    if Form1.RadioButton28.Checked then s:=s+1;
    if Form1.RadioButton33.Checked then s:=s+1;
    if Form1.RadioButton39.Checked then s:=s+1;
    if Form1.RadioButton43.Checked then s:=s+1;
    if Form1.RadioButton44.Checked then s:=s+1;
    if Form1.RadioButton50.Checked then s:=s+1;
    if Form1.RadioButton54.Checked then s:=s+1;
    if Form1.RadioButton56.Checked then s:=s+1;
    
    if s=15 then Label3.Caption:=' Молодец, ты ответил на все вопросы!(Твоя оценка 5)';
    if s=14 then Label3.Caption:=' Молодец, ты ответил на четырнадцать вопросов!(Твоя оценка 5)';
    if s=13 then Label3.Caption:=' Молодец, ты ответил на 13 вопросов!(Твоя оценка 5)';
    if s=12 then Label3.Caption:=' Хорошо, ты ответил на 12!(Твоя оценка 4)';
    if s=11 then Label3.Caption:=' Ты ответил на все 11!(Твоя оценка 4)';
    if s=10 then Label3.Caption:='10 парвильных ответов молодец!(Твоя оценка 4)";
    if s=9 then Label3.Caption:='9 ПРАВИЛЬНЫХ ОТВЕТОВ!(Твоя оценка 3)';
    if s=8 then Label3.Caption:='Отлично! Ты ответил на 8 вопрос(Твоя оценка 3)';
    if s=7 then Label3.Caption:='Молодец! Ты ответил на 7 вопрос(Твоя оценка 3)';
    if s=6 then Label3.Caption:='6 Вопросов? Ты не плох!(Твоя оценка 3)';
    if s=5 then Label3.Caption:='5 правильных вопросов! ура!(Твоя оценка 2)';
    if s=4 then Label3.Caption:='Учи предмет лучше! Всего 4 правильных вопроса!(Твоя оценка 2)';
    if s=3 then Label3.Caption:=' Слабо! Всего 3 правильных ответа!(Твоя оценка 2)';
    if s=2 then label3.Caption:=' Всего 2 правильных ответа!( Твоя оценка 2)';
    if s=1 then label3.Caption:=' Тебе не быть программистом! Всего 1 правильный ответ!(Твоя оценка 2)';
    if s=0 then label3.Caption:=' Давай заново!(Твоя оценка 2)';
    
    end;

    Автор пытается сделать тест по информатике. Вроде бы для диплома.

    Alex11223, 03 Апреля 2018

    Комментарии (10)
  2. Pascal / Говнокод #24060

    0

    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
    procedure ustbet;
    begin
    if (200*GCtrl.CurLines>coins.realBalance) then  begin
    if (150*GCtrl.CurLines>coins.realBalance) then  begin
    if (100*GCtrl.CurLines>coins.realBalance) then  begin
    if (50*GCtrl.CurLines>coins.realBalance) then  begin
        if (40*GCtrl.CurLines>coins.realBalance) then  begin
           if (30*GCtrl.CurLines>coins.realBalance) then  begin
             if (20*GCtrl.CurLines>coins.realBalance) then  begin
               if (15*GCtrl.CurLines>coins.realBalance) then  begin
                 if (10*GCtrl.CurLines>coins.realBalance) then  begin
                  if (5*GCtrl.CurLines>coins.realBalance) then  begin
                     if (4*GCtrl.CurLines>coins.realBalance) then  begin
                       if (3*GCtrl.CurLines>coins.realBalance) then  begin
                         if (2*GCtrl.CurLines>coins.realBalance) then  begin
                           if (1*GCtrl.CurLines>coins.realBalance) then  begin
     end else Coins.CurBet:=1
     end else Coins.CurBet:=2;
     end else Coins.CurBet:=3;
     end else Coins.CurBet:=4;
     end else Coins.CurBet:=5;
     end else Coins.CurBet:=10;
     end else Coins.CurBet:=15;
     end else Coins.CurBet:=20;
     end else Coins.CurBet:=30;
     end else Coins.CurBet:=40;
     end else Coins.CurBet:=50;
     end else Coins.CurBet:=100;
     end else Coins.CurBet:=150;
     end else Coins.CurBet:=200;
     coins.AllBet:=Coins.CurBet*gctrl.curlines;
    end;

    Предположительно, установка текущей ставки в слотовой игре. Но это ещё далеко не самый трэш в этом говнопроекте.

    SadButTrue, 03 Апреля 2018

    Комментарии (1)
  3. Pascal / Говнокод #23945

    +1

    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
    program bio;
    uses crt, graphABC;
    const y1=200; r1=20;
    var
    x2,x3,r:real;
    
    procedure del (x1,x11:integer);
    begin
    circle (x1,y1,r1); 
    sleep(1000); 
    ClearWindow();
    r:=r1/2;
    x2:=x1-(r);
    circle (Trunc(x2),y1,Trunc(r));
    x3:=x11+(r);
    circle (Trunc(x3),y1,Trunc(r));
    sleep(1000); 
    r:=r*2;
    x2:=x1-(r);
    circle (Trunc(x2),y1,Trunc(r));
    x3:=x11+(r);
    circle (Trunc(x3),y1,Trunc(r));
    del(Trunc(x2),Trunc(x3));
    end;
    
    
    begin
    SetWindowSize(600,400);
    setBrushColor(clGreen);
    del(300,300);
    end.

    Симулятор деления клеток на паскале, который не работает.

    SewerSurfer, 17 Марта 2018

    Комментарии (2)
  4. Pascal / Говнокод #23863

    +10

    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
    var
     DPen: TGPPen;
     Drawer: TGPGraphics;
     DBrush: TGPSolidBrush;
     DFntFam: TGPFontFamily;
     DPath: TGPGraphicsPath;
     IC,BC:Integer;
     ICL, BCL:TGPColor;
     W:WideString;
     si:TGPRectF;
     rt:TGPRectF;
     GP:TGPPoint;
    begin
      W:=FWaterMark.Text;
      IC:=ColortoRGB(FWaterMark.Font.Color);
      BC:=ColorToRGB(FWaterMark.CircuitColor);
      ICl:=MakeColor(GetRValue(IC), GetGValue(IC), GetBValue(IC));
      BCL:=MakeColor(GetRValue(BC), GetGValue(BC), GetBValue(BC));
      Drawer:=TGPGraphics.Create(FBitMap.Canvas.Handle);
      Drawer.SetCompositingQuality(CompositingQualityHighQuality);
      Drawer.SetSmoothingMode(SmoothingModeAntiAlias);
      Drawer.SetTextRenderingHint(TextRenderingHintAntiAlias);
      DPath:=TGPGraphicsPath.Create;
      DPen:=TGPPen.Create(BCL, FWaterMark.FCircuitWidth);
      DBrush:=TGPSolidBrush.Create(ICL);
      DFntFam:=TGPFontFamily.Create(FWaterMark.Font.Name);
    
      RT.X:=0;
      RT.Y:=0;
      RT.Width:=FBitMap.Width;
      RT.Height:=FBitMap.Height;
      
      DPath.AddString(W, Length(W), DFntFam, FontStyleBold, FWaterMark.Font.Size, GP, TGPStringFormat.Create()); 
      DPath.GetBounds(RT, nil, DPen);
      DPath.Reset; 
    
    //В общем, хз, как узнать ширину и высоту нарисованного.
    //MeasureString/MeasureCharacterRanges не подходят,а в доке такая муть, что я чуть не спился.

    Нежнейший аромат...

    Exception, 04 Марта 2018

    Комментарии (271)
  5. Pascal / Говнокод #23647

    −1

    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
    program voynasharov;
    uses crt, graphABC;
    
    type shar = class
     col, x, y, r: integer;
     pm: byte;
     constructor Create (ccol, cx, cy, cr: integer);
      begin
      col:=ccol;
      x:=cx;
      y:=cy;
      r:=cr;
      end;
     procedure make;
      begin
      setbrushcolor (col);
      circle (x,y,r);
      end;
     procedure mov;
     begin
     pm:=random(5);
     case pm of
     1: x:=x+20;
     2: x:=x-20;
     3: y:=y-20;
     4: y:=y+20;
     end;
     end;
    end;
    
    var first, second:shar;
    
    begin
     setwindowsize(1280,720);
     first:=shar.Create(666,550,400,60);
     second:=shar.Create(1488,740,300,60);
     first.make;
     second.make;
     repeat
     //clrscr;
     first.mov;
     second.mov;
     first.make;
     second.make;
     delay(50);
     until first.x=70;
    end.

    Лёгкий способ наколдовать перекатывание кругов в паскале

    SewerSurfer, 09 Января 2018

    Комментарии (3)
  6. Pascal / Говнокод #23646

    0

    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
    program sharokat;
    uses crt, graphABC;
    
    type shar = class
     col, x, y, r: integer;
     constructor Create (ccol, cx, cy, cr: integer);
      begin
      col:=ccol;
      x:=cx;
      y:=cy;
      r:=cr;
      end;
     procedure make;
      begin
      setbrushcolor (col);
      circle (x,y,r);
      end;
    end;
    
    var my:shar;
    
    begin
     my:=shar.Create(666,100,100,60);
     my.make;
    end.

    Лёгкий способ наколдовать круг в паскале

    SewerSurfer, 09 Января 2018

    Комментарии (41)
  7. Pascal / Говнокод #23616

    −1

    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
    97. 97
    98. 98
    99. 99
    uses crt;
    var
    n, c, d:text;//текстовые переменный сохранений
    name:string;//имя игрока
    namet, cot, dit:string;//имена файлов 
    co,di:real;//переменные в игре
    cdi:integer;//переменные с курсом
    dif:string;//комманды
    pm:byte;//+-курс
    col:integer;//выбор количества для продажи
    procedure cur; //вывод курса
    begin
    writeln ('Курс алмаза - ',cdi,' монет(ы)');
    end;
    procedure newr; //изменение курса
    begin
    pm:=random(2);//курс алмазов +- в промежутке 5,10
    if pm=1 then cdi:=cdi+random(5)+5 else cdi:=cdi-(random(5)+5); 
    cur();
    end;
    procedure buyco;
    begin
    write ('Сколько алмазов вы обменяете на монеты: ');
    readln (col);
    if col>di then 
     begin
     writeln ('У вас нет такого количества алмазов, введите меньше');
     write ('Сколько алмазов вы обменяете на монеты: ');
     col:=0;  readln (col);
     end 
     else 
      begin
      co:=co+(di*cdi);  di:=di-col;
      writeln ('Монет: ',co);  writeln ('Алмазов: ',di);
      end;
    end;
    procedure buydi;
    begin
    write ('Сколько монет вы обменяете на алмазы: ');
    readln (col);
    if col>co then 
     begin
     writeln ('У вас нет такого количества монет, введите меньше');
     write ('Сколько монет вы обменяете на алмазы: ');
     col:=0;
     readln (col);
     end 
     else 
      begin
      di:=di+((col*co)/cdi); co:=co-col;  
      writeln ('Монет: ',co); writeln ('Алмазов: ',di);  
      end;
    end;
    procedure buy;
    begin
    Writeln ('Введиде "co", если хотите купить монеты'); Writeln ('Введиде "di", если хотите купить алмазы');
    Write ('Ввод: '); Readln (dif);
    if dif = 'co' then buyco(); if dif = 'di' then buydi();
    end;
    procedure save;
    begin
       assign(n, namet);
       rewrite (n);//cоздаём имена файлов   
       cot:=concat(name,'co.txt');
       dit:=concat(name,'di.txt');   
       {создаём сохранения}assign (c, cot); rewrite(c); co:=5; write(c,co);
       assign (d, dit); rewrite(d); di:=1; write(d,di);
       writeln ('Монет: ',co); writeln ('Алмазов: ',di); writeln ('Игра ',name,' сохранена');      
    end;
    begin
    cdi:=random(20)+10; //Задаём начальный курс
    write ('Введите ваше имя: '); readln (name); 
    namet:=concat(name,'.txt');
    if FileExists(namet) then
      begin
         writeln ('Сохранение ',name,' обнаружено');
         writeln ('Загружается сохранение...');
         assign (n, namet);
         reset(n);     
         cot:=concat(name,'co.txt');
         dit:=concat(name,'di.txt');//"вспомиаем" имена файлов     
         assign (c, cot); reset(c); read(c,co);
         assign (d, dit); reset(d); read(d,di);//загрузка сохранений     
         writeln ('Монет: ',co);
         writeln ('Алмазов: ',di);  //вывод данных из сохранений
      end  
      else 
       begin
       //создаём файл с именем игрока
       writeln ('Сохранение ',name,' не обнаружено'); writeln ('Создаётся сохранение...');   
       save();
       end;
       repeat //бесконечный репит
       write('Введите комманду: ');
       readln(dif);
         case dif of
        'new' : newr(); 'cur' : cur(); 'buy' : buy();'save' : save();   
        else Writeln ('Такой команды нет'); end;  
       until dif='end'; close(n);close(c);close(d);

    Ну вот. Одна из моих первых программ на паскале. Про переводы из одной валюты в другую с учётом курса. Есть даже сохранения.
    Чёрт ногу сломит, я сам уже не понимаю, что тут написал.

    SewerSurfer, 24 Декабря 2017

    Комментарии (2)
  8. Pascal / Говнокод #23334

    −9

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    {получить I}
    function getSafeItoDBID(TEmployer e):Integer;
    begin
      if (e<>nil) and (e.getIdentificator()<>nil) and (e.getIdentificator().getID()<>nil) and (e.getIdentificator().getID().getID()<>nil)
        then result:= e.getIdentificator().getID().getID().getValue().i;
        else result:= 0;
    end;

    Получить без ERROR ID для записи в MySQL

    AlCodel, 07 Сентября 2017

    Комментарии (0)
  9. Pascal / Говнокод #23147

    −1

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    TServerThread = class(TThread)
      private
        procedure DoReadData;
      protected
        ThreadOwner: TIPCServer;
        procedure Execute; override;
        constructor Create(AThreadOwner: TIPCServer);
        destructor Destroy; override;
      public
      end;

    Мы кодили, кодили и наконец накодили!

    antipattern, 27 Июня 2017

    Комментарии (3)
  10. Pascal / Говнокод #23137

    0

    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
    procedure TForm1.ProcListAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    var
      TP:TprocessInfo;
      xColor: TColor;
      xRect: TRect;
      xBitmap: TBitmap;
      I, L, R: Integer;
    begin
      DefaultDraw:=False;
      TP:=TProcessInfo(Item.SubItems.Objects[0]);
      if (Item.Selected) then
      begin
        if Sender.Focused then
        begin
          if (FItemAtCursor <> -1) and (Item.Index = FItemAtCursor) then
            xColor:=clNavy
          else
            xColor:=$00C56A31;
        end
        else
          xColor:=$00D8E9EC
      end
      else
      begin
        if (TP.New<2) or (TP.Terminated<2) or (TP.Hidden) then
        begin
    
          if ShowDangerousProcesses then
          if TP.Hidden then
          xColor:=$00DBDBDB;
    
          if ShowNewProcesses then
          if TP.New <2 then
          xColor:=$001DEB2D;
    
          if ShowTerminatedProcesses then
          if TP.Terminated < 2 then
          xColor:=$001D2DEB;
        end
        else
    
        if (Item.Index mod 2 = 1) then
        xColor:=RGB(245,245,255)
        else
        xColor:=clWindow;
      end;
      Sender.Canvas.Brush.Color:=xColor;
      DefaultDraw:=True;
    
      if (Item.Selected) and Sender.Focused
      then Sender.Canvas.Font.Color:=clWindow
      else Sender.Canvas.Font.Color:=clWindowText;
      Sender.Canvas.FillRect(Item.DisplayRect(drLabel));
      DefaultDraw:=True;
    
      Exit; 
    
      xRect:=Item.DisplayRect(drLabel);
      Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.Caption);
    
      for I:=0 to TListView(Sender).Columns.Count-1 do
      begin
        if TListView(Sender).Columns[TListView(Sender).Columns[I].ID].Width<=0 then Continue;
        if (I=0) and (TListView(Sender).Columns[I].ID <> 0) then
        begin
          xRect.Left:=0;
          xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
          Sender.Canvas.FillRect(xRect);
          Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.SubItems[TListView(Sender).Columns[I].ID-1]);
        end
        else
        begin
        if I>0 then
        begin
          xRect.Left:=xRect.Right+1;
          xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
          Sender.Canvas.FillRect(xRect);
          if TListView(Sender).Columns[I].ID >0 then
          Sender.Canvas.TextRect(xRect,xRect.Left+5,xRect.Top,Item.SubItems[Pred(TListView(Sender).Columns[I].ID)])
          else
          begin
            L:=(Item.DisplayRect(drIcon).Right-Item.DisplayRect(drIcon).Left)+6;
          Sender.Canvas.TextRect(xRect,xRect.Left+L,xRect.Top, Item.Caption)
        end;
        end;
    
        end;
      end;
      Sender.Canvas.Brush.Color:=clWindow;
      Sender.Canvas.FillRect(Item.DisplayRect(drIcon));
      if Item.ImageIndex=-1 then Exit;
      xBitmap:=TBitmap.Create;
      TListView(Sender).SmallImages.GetBitmap(Item.ImageIndex,xBitmap);

    ListView - великий и ужасный! - в режиме OwnerDraw.
    Писал диспетчер процессов. Когда я разрешил прятать столбцы и включил свойство FullDrag, моя жизнь круто изменилась.

    antipattern, 19 Июня 2017

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