Форум: "Основная";
Текущий архив: 2002.10.14;
Скачать: [xml.tar.bz2];

Вниз

ListBox, ComboBox и т.д.   Найти похожие ветки 

← →
Dim!S   (2002-10-04 12:29) [0]

Уважаемые мастера, подскажите, пожалуйста, как в ListBox и подобных компонентах вставить черту-разделитель как в меню. Необходимо несколько пунктов сделать постоянными, не зависимо от пользователя и их отделить тонкой чертой. Спасибо.

---

← →
Best Before 2024   (2002-10-04 12:34) [1]

OnDrawItem ?

---

← →
Игорь Шевченко   (2002-10-04 12:38) [2]

Часть 1
{
Расширение компонента TCustomComboBox, позволяющее запрещать выбор отдельных
элементов списка и имеющее список ассоциированных значений.
Стиль этого компонента может быть только csDropDownList, csOwnerDrawFixed
или csOwnerDrawVariable.
08.04.2002
Добавлено событие рисования прямоугольника фокуса отдельной процедурой

07.04.2002
(С) 2002, Игорь Шевченко, HyperSoft
}

unit HSComboBox;

interface
uses
Windows, Messages, Classes, Controls, StdCtrls;

type
TOnCanSelectEvent = procedure (Sender : TObject; Index : Integer;
var CanSelect : Boolean) of object;
TOnDrawFocusRectEvent = procedure (Sender : TObject;
const Rect : TRect;
State: TOwnerDrawState) of object;
TFocusRectKind = (frStandard, frCustom);

THSComboBox = class(TCustomComboBox)
private
{ Список ассоциированных значений }
FValues : TStrings;
FLastKey : Integer;
FOnCanSelect: TOnCanSelectEvent;
FFocusRectKind: TFocusRectKind;
FOnDrawFocusRect: TOnDrawFocusRectEvent;
function CanSelectItem (AItemIndex : Integer) : Boolean;
function GetValue: String;
procedure SetValue(const Value: String);
procedure SetValues(const Value: TStrings);
procedure SetFocusRectKind(const Value: TFocusRectKind);
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
protected
{ Обработчик события определения доступности элемента списка }
{ Сделан виртуальным для возможности переопределения в наследниках компонента}
procedure DoCanSelect (AItemIndex : Integer; var CanSelect : Boolean); dynamic;
{ Отрисовка FocusRect }
procedure DoDrawFocusRect (const Rect : TRect;
State: TOwnerDrawState); dynamic;
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure SetStyle (Value : TComboBoxStyle); override;
{ Для рисования разделительных строк не надо
вызывать процедуру пользователя }
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
{ Ассоциированное с элементом списка значение из списка значений.
Сделано только в runtime, так как в design-time оно не имеет смысла }
property Value : String read GetValue write SetValue;
published
property Style; {Must be published before Items}
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Visible;
{ Список ассоциированных значений для редактирования, копирования и т.д. }
property Values : TStrings read FValues write SetValues;
{ Тип прямоугольника фокуса }
property FocusRectKind : TFocusRectKind
read FFocusRectKind write SetFocusRectKind default frStandard;
{ События }
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDock;
property OnStartDrag;

property Items; { Must be published after OnMeasureItem }
{ Событие для определения доступности элемента списка ComboBox"а }
property OnCanSelect : TOnCanSelectEvent read FOnCanSelect
write FOnCanSelect;
{ Событие для отрисовки FocusRect,когда компонент имеет фокус }
{ Вызывается только в случае установки FocusRectKind в frCustom }
property OnDrawFocusRect : TOnDrawFocusRectEvent read FOnDrawFocusRect
write FOnDrawFocusRect;

end;

{TODO: Перенести в отдельный unit и включить его в design-time package }
procedure Register;

implementation
uses
Graphics, SysUtils;

{ THSComboBox }



---

← →
Игорь Шевченко   (2002-10-04 12:38) [3]

Часть 2
function THSComboBox.CanSelectItem(AItemIndex: Integer): Boolean;
var
CanSelect : Boolean;
begin
DoCanSelect (AItemIndex, CanSelect);
Result := CanSelect;
end;

procedure THSComboBox.Change;
var
OldIndex, NewIndex : Integer;
begin
OldIndex := ItemIndex;
NewIndex := OldIndex;
while NOT CanSelectItem(NewIndex) do
if FLastKey = VK_UP then begin
Dec(NewIndex);
if NewIndex < 0 then
FLastKey := VK_DOWN;
end else begin
Inc(NewIndex);
if NewIndex > Pred(Items.Count) then
FLastKey := VK_UP;
end;
if NewIndex <> OldIndex then
ItemIndex := NewIndex;
inherited;
end;

{ Переписано с небольшими исправлениями из TCustomComboBox.CNDrawItem }
procedure THSComboBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do begin
State := TOwnerDrawState(LongRec(itemState).Lo);
if itemState and ODS_COMBOBOXEDIT <> 0 then
Include(State, odComboBoxEdit);
if itemState and ODS_DEFAULT <> 0 then
Include(State, odDefault);
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (odSelected in State) then begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText
end;
if Integer(itemID) >= 0 then
DrawItem(itemID, rcItem, State)
else
Canvas.FillRect(rcItem);
if odFocused in State then
DoDrawFocusRect(rcItem, State);
Canvas.Handle := 0;
end;
end;

constructor THSComboBox.Create(AOwner: TComponent);
begin
inherited;
FValues := TStringList.Create;
FLastKey := VK_DOWN; { По умолчанию, последнее движение было вниз, при выборе
недоступного элемента фокус автоматически перемещается на следующий
доступный элемент }
FFocusRectKind := frStandard;
end;

destructor THSComboBox.Destroy;
begin
FValues.Free();
inherited;
end;

procedure THSComboBox.DoCanSelect(AItemIndex: Integer;
var CanSelect: Boolean);
begin
CanSelect := NOT ((Style = csOwnerDrawFixed) AND (Items[AItemIndex] = "-"));
if Assigned(FOnCanSelect) then
FOnCanSelect (Self, AItemIndex, CanSelect);
end;

procedure THSComboBox.DoDrawFocusRect(const Rect: TRect;
State: TOwnerDrawState);
begin
case FFocusRectKind of
frStandard:
Windows.DrawFocusRect(Canvas.Handle, Rect);
frCustom:
if Assigned(OnDrawFocusRect) then
FOnDrawFocusRect(Self, Rect, State);
end;
end;

procedure THSComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
if (Style = csOwnerDrawFixed) AND (Items[Index] = "-") AND
NOT (odComboBoxEdit in State) then begin
{ Нарисовать разделительную линию }
with TControlCanvas(Canvas) do begin
FillRect(Rect);
if odFocused in State then
Pen.Color := clWhite
else
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo (Rect.Left, Rect.Top + (Rect.Bottom - Rect.Top) DIV 2);
LineTo (Rect.Right, Rect.Top + (Rect.Bottom - Rect.Top) DIV 2);
end;
end else
inherited;
end;

{ Вернуть ассоциированное с текущим элементом списка значение }
function THSComboBox.GetValue: String;
begin
Result := "";
if (ItemIndex >= 0) AND (ItemIndex < FValues.Count) then
Result := FValues[ItemIndex];
end;

procedure THSComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
{ Для определения того, в какую сторону двигаться, если выбран недоступный
элемент, запоминаем последнюю нажатую клавишу. }
FLastKey := Key;
inherited;
end;

{ Установить новый стиль с запретом стилей csSimple,csDropDown. }
procedure THSComboBox.SetFocusRectKind(const Value: TFocusRectKind);
begin
if (FFocusRectKind <> Value) then begin
FFocusRectKind := Value;
Invalidate();
end;
end;

procedure THSComboBox.SetStyle(Value: TComboBoxStyle);
begin
if Value in [csSimple, csDropDown] then
Value := csDropDownList;
inherited SetStyle(Value);
end;

{ Установить элемент списка, с которым ассоциируется значение.
Если нового значения нет в списке, то установить выбранный индекс в -1 }
procedure THSComboBox.SetValue(const Value: String);
var NewIndex : Integer;
begin
NewIndex := FValues.IndexOf(Value);
if NewIndex > Pred(Items.Count) then
NewIndex := -1;
ItemIndex := NewIndex;
Change();
end;

procedure THSComboBox.SetValues(const Value: TStrings);
begin
FValues.Assign(Value);
end;

{TODO: Перенести в отдельный unit и включить его в design-time package }
procedure Register;
begin
RegisterComponents("HyperSoft", [THSComboBox]);
end;

end.


---

← →
Dim!S   (2002-10-04 12:54) [4]

Спасибо, но не совсем то, что надо.
Я использую OnDrawItem, но отделительная линия хоть и тонкая, но занимает по высоте размер одного элемента, а надо как в меню...

---

← →
Игорь Шевченко   (2002-10-04 12:57) [5]

Dim!S (04.10.02 12:54)

Добавить в OnMeasureItem код, установить стиль csOwnerDrawVariable

---

← →
Dim!S   (2002-10-04 13:00) [6]

Посмотрю, спасибо.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.10.14;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.011 c