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

    −3

    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
    type
      TheCurrency = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheWHouse = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheProvider = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheNds = class(TObject)
            nds: Double;
      end;

    tucvbif, 16 Января 2017

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

    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
    lst:=proclist.Selected;
      if assigned(lst) then
      begin
        tp:=tmyproc(lst.SubItems.Objects[0]);
        S:=tp.exename;
        P:=tp.PID;
      end
      else
      begin
        S:='';
        P:=0;
      end;
      ID:=-1;
      proclist.Items.BeginUpdate;
      try
      //////////////////////////////////////////////////////////
      if prlist.Count > 0 then
      while proclist.Items.Count > prlist.Count do
      begin
        lst:=proclist.Items[proclist.Items.Count-1];
        lst.Delete;
      end;
    
      while proclist.Items.Count < prlist.Count do
      with proclist.Items.Add do
      begin
        caption:='';
        subitems.Add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
      end;
     /////////////////////////////////////////////////////////
      for i:=0 to prlist.Count -1 do
      begin
        tp:=(prlist.Objects[i] as tmyproc);
        with proclist.items[i] do
        begin
          if tp.isHidden then
          begin
            Inc(HidProcs);
            ImageIndex:=8;
          end
          else
          ImageIndex:=7;
          if (s <> emptystr) and (p=tp.pid) and (s=tp.exename) then
          ID:=Index;
          Caption:=tp.ExeName;
          with Subitems do
          begin
            Objects[0].Free;
            Objects[0]:=tp;
            Strings[0]:=tp.ModulePath;
          end;
          subitems.Strings[1]:=IntToStr(tp.PID);

    Ваш ListView всё ещё съезжает при обновлении? Тогда мы идём к Вам.

    rotretS, 15 Января 2017

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

    0

    1. 1
    Знаете ли Вы, что в FreePascal блоки try..finally/except не работают в контексте DLL?

    Dr_Stertor, 10 Января 2017

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

    +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
    program XMLParser;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    uses
      System.SysUtils,
      Xml.XMLDoc, XMLIntf;
     
    var XMLDocument1 : TXMLDocument;
        Node : IXMLNode;
     
    begin
    XMLDocument1:=TXMLDocument.Create('Путь до файла\Text1.XML');
    XMLDocument1.LoadFromFile('Путь до файла\Text1.XML');
    XMLDocument1.Active := true;
    Node.GetAttribute(WideString('x'));
    WriteLn;
    XMLDocument1.Active := false;
    end.

    Путь до файла. бгг

    chizztectep, 10 Января 2017

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

    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
    if not DoubleBuffered then
        begin
          BufferDC := CreateCompatibleDC(DC);
          // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
          // return <> 0 => need to double buffer || return = 0 => no need to double buffer
          if BufferDC <> 0 then
          begin
            // Using the cache if possible
            if FIsCachedBuffer or FIsFullSizeBuffer then
            begin
              // Create cache if need
              if CacheBitmap = 0 then
              begin
                BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
                // Assign to cache if need
                if FIsCachedBuffer then
                  CacheBitmap := BufferBitMap;
              end
              else
                BufferBitMap := CacheBitmap;
    
              // Assign region for minimal overdraw
              Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
              SelectClipRgn(BufferDC, Region);
            end
            else
              // Create buffer
              BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
            // Select buffer bitmap
            SelectObject(BufferDC, BufferBitMap);
            // [change coord], if need
            // Moving update region to the (0,0) point
            if not(FIsCachedBuffer or FIsFullSizeBuffer) then
            begin
              GetViewportOrgEx(BufferDC, SaveViewport);
              SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
            end;
          end
          else
            BufferDC := DC;
        end
        else
          BufferDC := DC;
    //.......

    https://habrahabr.ru/post/318876/

    gost, 06 Января 2017

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

    +3

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    procedure TaQuoteReestr.gSearchResultKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    begin
      inherited;
      if (ssctrl in Shift) and ((Key = ord('C')) or (ord(Key) = ord('c')) or (Key = ord('С')) or (ord(Key) = ord('с'))) then 
        gSearchResultDblClick(Sender);
    end;

    Не удержался... это же чем должна быть забита голова, чтобы так писать.
    Тут копирование (gSearchResultDblClick) некоего набора данных происходит по двойному клику (!) на строке грида. И оно же продублировано по Ctrl+C. Естественно, что когда на двойной клик повесили более адекватное действие: вход в режим редактирования — копирование отвалилось.
    Особенно радует обработка клавиши. Последовательно проверяется заглавная и строчная буква английского и русского алфавитов. При этом почему-то забыты Греция, Габон, Гондурас... и все остальные.

    RoschinSpb, 28 Декабря 2016

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

    +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
    dep_id:=-1;
    next_day:=1;
    cds.First;
    while not (cds.Eof) do
    begin
      if (dep_id <> cds.FieldByName('DEP_ID').AsInteger) then
      begin
        dep_id := cds.FieldByName('DEP_ID').AsInteger;
        //переходим на новую страницу, печатаем шапку
        //...
        
        row:=7;
        next_day :=1;
      end;
      if (DS_Parametes.FieldByName('DATE').AsString <> FieldByName('RS_DATE').AsString) and (next_day <> 5) then
             next_day := 2;
      if (next_day < 3) then
      begin
        //Печатаем шапку дня 
        //...
        if (DS_Parametes.FieldByName('DATE').AsString <> cds.FieldByName('RS_DATE').AsString)  then
        begin
          WS.Cells[Row,01]:= 'Завтра, '+ cds.FieldByName('RS_DATE').AsString;
          next_day :=5;
        end
        else
        begin
          WS.Cells[Row,01]:= cds.FieldByName('RS_DATE').AsString;
          next_day :=4;
        end;
        inc(row);
      end;
      //Ну и дальше печатаем строчки таблицы
      //...
      inc(row);
      cds.next;
      
    end;

    next_day := 4

    tucvbif, 22 Декабря 2016

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

    −3

    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
    uses crt;
    
    procedure dl(a,b,c,d:real; var e:real);
     begin
      e:=sqrt(sqr(a-c)+sqr(b-d));
     end;
    
    procedure abc(a,b,c,d:real; var x,y,z:real);
     begin
      x:=d-b;
      y:=a-c;
      z:=b*c-a*d;
     end;
    
    var x1,y1,x2,y2,x3,y3,x4,y4,d1,d2,d3,d4,a1,b1,c1,a2,b2,c2,a3,b3,c3,a4,b4,c4:real;
    
    Begin
     ClrScr;
     Writeln('‚ўҐ¤ЁвҐ Є®®а¤Ё­ вл ЇҐаў®© в®зЄЁ');
     Read(x1,y1);
     Writeln('‚ўҐ¤ЁвҐ Є®®а¤Ё­ вл ўв®а®© в®зЄЁ');
     Read(x2,y2);
     Writeln('‚ўҐ¤ЁвҐ Є®®а¤Ё­ вл ваҐв쥩 в®зЄЁ');
     Read(x3,y3);
     Writeln('‚ўҐ¤ЁвҐ Є®®а¤Ё­ вл зҐвўҐав®© в®зЄЁ');
     Read(x4,y4);
     dl(x1,y1,x2,y2,d1);
     dl(x2,y2,x3,y3,d2);
     dl(x3,y3,x4,y4,d3);
     dl(x4,y4,x1,y1,d4);
     abc(x1,y1,x2,y2,a1,b1,c1);
     abc(x2,y2,x3,y3,a2,b2,c2);
     abc(x3,y3,x4,y4,a3,b3,c3);
     abc(x4,y4,x1,y1,a4,b4,c4);
     write(d1:3:1,d2:3:1,d3:3:1,d4:3:1);
     ReadKey()
     End.

    Шкварюсь на ОАП. Условия задачи - даны четыре точки, которые образует четырехугольник. Нужно определить его вид и найти площадь.

    Simodgo, 06 Декабря 2016

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

    +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
    procedure TForm1.TrackBar1Change(Sender: TObject);
       var I: integer;
       priority:TThreadPriority;
    { Изменение приоритета соответствующего потока }
    begin
       priority:=tpIdle;
       for i:=0 to ((Sender as TTrackBar).position -1) do 
          inc(priority);
       
       if sender=trackbar1 then thread1.priority:=priority  else
       if sender=trackbar3 then thread3.priority:=priority
       else thread2.Priority:=priority;
    end;

    Из методички к лабе.

    vn13, 26 Октября 2016

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

    +3

    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
    procedure TALScrollingText.InvalidateEverything;
    var
      i: Integer;
    begin
      with WholeBitmap do
      begin
        Canvas.Brush.Color := fBackgroundColor;
        Canvas.FillRect(Rect(0, 0, Width, Height));
        Canvas.Font := Self.Font;
        Width := WholeBitmap.Canvas.TextWidth(fText) + (2 * Self.Width);
        Height := Self.Height;
        if (Self.Font.Color = clGreen) or (fBackgroundColor = clGreen) then
        begin
          TransparentColor := clRed;
          Canvas.Font.Color := clRed;
        end
        else
        begin
          TransparentColor := clGreen;
          Canvas.Font.Color := clGreen;
        end;
        if fLayout = tlTop then
          Canvas.TextOut(Self.Width, 0, fText)
        else if fLayout = tlCenter then
          Canvas.TextOut(Self.Width, (Self.Height div 2) - (Canvas.TextHeight(fText) div 2), fText)
        else
          Canvas.TextOut(Self.Width, Self.Height - Canvas.TextHeight(fText), fText);
      end;
    
      with BackBitmap do
      begin
        Width := Self.Width;
        Height := Self.Height;
        Canvas.Brush.Color := Self.Font.Color;
        Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
        if fEdgeFadeWidth > 0 then
        begin
          for i := 0 to fEdgeFadeWidth-1 do
          begin
            Canvas.Pen.Color := CalcColorIndex(fBackgroundColor, Self.Font.Color, fEdgeFadeWidth, i+1);
            Canvas.MoveTo(i, 0);
            Canvas.LineTo(i, Self.Height);
            Canvas.MoveTo(Width-i-1, 0);
            Canvas.LineTo(Width-i-1, Self.Height);
          end;
        end;
      end;
    
      DrawnBitmap.Width := Width;
      DrawnBitmap.Height := Height;
    end;
    
    function TALScrollingText.CalcColorIndex(StartColor, EndColor: TColor; Steps, ColorIndex: Integer): TColor;
    var
      BeginRGBValue: Array[0..2] of Byte;
      RGBDifference: Array[0..2] of Integer;
      Red, Green, Blue: Byte;
      NumColors: Integer;
    begin
      if (ColorIndex < 1) or (ColorIndex > Steps) then
        raise ERangeError.Create('ColorIndex can''t be less than 1 or greater than ' + IntToStr(Steps));
      NumColors := Steps;
      Dec(ColorIndex);
      BeginRGBValue[0] := GetRValue(ColorToRGB(StartColor));
      BeginRGBValue[1] := GetGValue(ColorToRGB(StartColor));
      BeginRGBValue[2] := GetBValue(ColorToRGB(StartColor));
      RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGBValue[0];
      RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGBValue[1];
      RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGBValue[2];
    
      // Calculate the bands color
      Red := BeginRGBValue[0] + MulDiv(ColorIndex, RGBDifference[0], NumColors - 1);
      Green := BeginRGBValue[1] + MulDiv(ColorIndex, RGBDifference[1], NumColors - 1);
      Blue := BeginRGBValue[2] + MulDiv(ColorIndex, RGBDifference[2], NumColors - 1);
      Result := RGB(Red, Green, Blue);
    end;

    Процедура для размытия концов бегущей строки.
    Прикол в том, что шрифты, поддерживающие ClearType, приобретают зеленоватый оттенок.

    father__Muldoon, 26 Октября 2016

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