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

    +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
    type
    TReadCoils = array [0..3] of word;
    
    CONST crctab: ARRAY[0..255] OF WORD = (
        $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,
        $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,
        $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,
        $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,
        $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,
        $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,
        $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
        $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,
        $F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,
        $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,
        $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
        $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,
        $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,
        $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
        $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,
        $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,
        $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,
        $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,
        $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,
        $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,
        $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
        $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
        $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,
        $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,
        $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,
        $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,
        $9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,
        $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
        $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,
        $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,
        $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,
        $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040 );
    
     //ôóíêöèÿ íàõîæäåíèÿ êîíòðîëüíîé ñóììû
    function crc16(twoSym:array of Word; size:word):Word;
    var
     i:Integer;
     crc:Word;
    begin
      crc:=$FFFF;
    
      for i:=0 to ((size div 2) -1) do
    
      begin
        crc:=  (crc shr 8) xor CrcTab[(crc and $FF) xor twoSym[i]];
      end;
       Result:=(crc shr 8) or (crc shl 8);
    end;
    function ReadCoils(DeviceAddress: byte; StartingAddress:word; QuantityCoils : word): TReadCoils;
      var
    
        Datagramm: Array[0..3] of Word;
         ToPort: Array[0..5] of word;
    begin
        Datagramm[0]:=TwoBytesToWord(DeviceAddress,$3);
        Datagramm[1]:=TwoBytesToWord(hi(StartingAddress),lo(StartingAddress));
        Datagramm[2]:=TwoBytesToWord(hi(QuantityCoils),lo(QuantityCoils));
         ToPort[0]:=hi(datagramm[0]);
         ToPort[1]:=lo(datagramm[0]);
         ToPort[2]:=hi(datagramm[1]);
         ToPort[3]:=lo(datagramm[1]);
         ToPort[4]:=hi(datagramm[2]);
         ToPort[5]:=lo(datagramm[2]);
         Datagramm[3]:=crc16(toport,12);
    end;

    Вот такими костылями заставляем вычисляться CRC-16 для Modbus в Readcoils

    untitled_001, 23 Января 2017

    Комментарии (27)
  2. 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)
  3. 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

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

    0

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

    Dr_Stertor, 10 Января 2017

    Комментарии (129)
  5. 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)
  6. 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)
  7. 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)
  8. 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)
  9. 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)
  10. 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)