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

    +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
    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
    Попытка внедрить контрол TCheckBox в заголовок 1 колонки TListView:

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListHeaderWnd: HWND;
    FListHeaderChk: TCheckBox;
    FSaveListHeaderWndProc, FListHeaderWndProc: Pointer;
    procedure ListHeaderWndProc(var Msg: TMessage);
  end;

var
  Form1: TForm1;

implementation

uses
  commctrl;

{$R *.dfm}

function GetCheckSize: TPoint;    
begin                                                  
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
      Result.X := Width div 4;
      Result.Y := Height div 3;
    finally
      Free;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  CheckSize: TPoint;
  HeaderSize: TRect;
begin
  ListView1.HandleNeeded;
  FListHeaderWnd := ListView_GetHeader(ListView1.Handle);

  FListHeaderChk := TCheckBox.Create(nil);
  CheckSize := GetCheckSize;
  FListHeaderChk.Height := CheckSize.X;
  FListHeaderChk.Width := CheckSize.Y;

  // the below won't show anything since the form is not visible yet
  ShowWindow(ListView1.Handle, SW_SHOWNORMAL); // otherwise header is not sized
  windows.GetClientRect(FListHeaderWnd, HeaderSize);
  FListHeaderChk.Top := (HeaderSize.Bottom - FListHeaderChk.Height) div 2;
  FListHeaderChk.Left := FListHeaderChk.Top;

  FListHeaderChk.Parent := Self;
  windows.SetParent(FListHeaderChk.Handle, FListHeaderWnd);

  FListHeaderWndProc := classes.MakeObjectInstance(ListHeaderWndProc);
  FSaveListHeaderWndProc := Pointer(GetWindowLong(FListHeaderWnd, GWL_WNDPROC));
  SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FListHeaderWndProc));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FSaveListHeaderWndProc));
  classes.FreeObjectInstance(FListHeaderWndProc);
  FListHeaderChk.Free;
end;

procedure TForm1.ListHeaderWndProc(var Msg: TMessage);
begin
  if (Msg.Msg = WM_COMMAND) and (HWND(Msg.LParam) = FListHeaderChk.Handle)
        and (Msg.WParamHi = BN_CLICKED) then begin
    FListHeaderChk.Checked := not FListHeaderChk.Checked;

    // code that checks/clears all items

  end;

  Msg.Result := CallWindowProc(FSaveListHeaderWndProc, FListHeaderWnd,
                               Msg.Msg, Msg.WParam, Msg.LParam);
end;

    function GetCheckSize: TPoint;    
    
begin                                                  
    
  with TBitmap.Create do
    
    try
    
      Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
    
      Result.X := Width div 4;
    
      Result.Y := Height div 3;
    
    finally
    
      Free;
    
    end;
    
end;

    без комментариев.

    Запостил: Stertor, 10 Февраля 2014

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

    • ava LispGovno 10.02.2014 23:37 # +4

      Заведи гетхаб
      Ответить

    • ava kegdan 11.02.2014 10:20 # −2

      pascal - без комметариев
      Ответить

    • ava bormand 11.02.2014 10:37 # +1

      > Попытка внедрить контрол TCheckBox в заголовок 1 колонки TListView
      Блин, вот походу все дельфины через этот ад прошли. Я тоже в свое время "внедрял" комбобоксы в грид :) Причем "внедрял" я их через жопу, тупо размещая поверх грида и позиционируя над ячейкой...
      Ответить

    • ava Lure Of Chaos 12.02.2014 06:42 # +1

      какие ужасные хакоконтролы
      Ответить

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