Как в CheckListBox галочки ставить , только программно?

[midavik]

Как в компоненте CheckListBox убрать возможность кликая мышкой ставить/снимать галочку, т.е. чтоб свойство Checked изменять только программно? Вроде свойства ReadOnly у него нет.

[Rouse_]

Перекрой либо CN_COMMAND либо

procedure SetChecked(Value: Boolean); override;

[Prk]

А Enabled если попробывать

Сообщение отредактировано: Prk - 20.09.05, 11:07

[Krid]

Можно перекрыть KeyPress и MouseDown. Как-нить так

 MyCheckLB=class(TCheckListBox)
 ...
 protected
   procedure KeyPress(var Key: Char); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                       X, Y: Integer); override;
 ...
 end;
 
 ...
 
procedure MyCheckLB.KeyPress(var Key: Char);
begin
    if (Key <> ' ') then inherited;
end;
 
procedure MyCheckLB.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    if Button <> mbLeft then inherited;
end;

[midavik]

Krid спасибо большое, вроде работает как надо. вернее мышкой и клавой галочки уже не ставятся и не снимаются.

[midavik]

еще вопрос. а можно ли перекрыть процедуры KeyPress и MouseDown непосредственно в объекте класса TCheckListBox? т.е. без создания наследника TCheckListBox, а то ради каких-то мелких возможностей приходится плодить компонент и соответственно распространять исходники приложения с этим компонентом.

[Rouse_]

Конечно можно, так даже проще...

procedure TfrmGLMain.CheckBox1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  TCheckBox(Sender).Checked := not TCheckBox(Sender).Checked;
end;
 
procedure TfrmGLMain.Button1Click(Sender: TObject);
begin
  CheckBox1.Checked := True;
end;

[midavik]

>> Rouse
Что-то я не понял причем тут CheckBox1, если речь идет о TCheckListBox?

[Krid]

Цитата midavik @ 22.09.05, 13:48

можно ли перекрыть процедуры KeyPress и MouseDown непосредственно в объекте класса TCheckListBox? т.е. без создания наследника TCheckListBox

Нет, эти методы нельзя.
Если тебе очень не хочется делать наследника, тогда сделай сабклассинг - замени оконную процедуру CheckListBox'а на свою и там обрабатывай сообщение от клавы и мышки. Примерно вот так

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst;
 
type
  TForm1 = class(TForm)
    CheckListBox1: TCheckListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
 
 function NewCheckListBoxProc(wnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
 var
  Index: Integer;
  X,Y:word;
  bm:BITMAP;
  CheckWidth: Integer;
 begin
   case uMsg of
       WM_CHAR : if wParam=ord(' ') then uMsg:=0;
       WM_LBUTTONDOWN,WM_LBUTTONDBLCLK:
                 begin
                   GetObject(LoadBitmap(0, PChar(OBM_CHECKBOXES)),SizeOf(BITMAP),@bm);
                   CheckWidth := bm.bmWidth div 4;
                   X:=LOWORD(lParam); Y:=HIWORD(lParam);
                   Index:=Form1.CheckListBox1.ItemAtPos(Point(X,Y),True);
                   if (Index <> -1) and Form1.CheckListBox1.ItemEnabled[Index] then
                   begin
                    // следующую строчку можно убрать, если не хочешь,
                    // чтобы итем выделялся при клике на его CheckBox (по дефолту он выделяется).
                     Form1.CheckListBox1.Selected[Index]:=true;
                     if not Form1.CheckListBox1.UseRightToLeftAlignment then
                     begin
                       if (X - Form1.CheckListBox1.ItemRect(Index).Left) < (CheckWidth + 2) then
                       uMsg:=0
                     end else
                     begin
                       Dec(X, Form1.CheckListBox1.ItemRect(Index).Right - (CheckWidth+2));
                       if (X > 0) and (X < (CheckWidth+2)) then
                       uMsg:=0;
                     end;
                   end;
                 end;
   end;
      result:=CallWindowProc(Pointer(GetWindowLong(wnd,GWL_USERDATA)),wnd,uMsg,wParam,lParam);
 end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  SetWindowLong(CheckListBox1.Handle,GWL_USERDATA,SetWindowLong(CheckListBox1.Handle,
                                           GWL_WNDPROC, LPARAM(@NewCheckListBoxProc)));
end;
 
end.

[Rouse_]

Цитата midavik @ 22.09.05, 14:14

TCheckListBox?

Блиин, мои пардоны Невнимательность... Сори.
Сложно с работы переключаться на форум...