Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.05.23;
Скачать: [xml.tar.bz2];

Вниз

TRadioGroup: раскрасить item ы   Найти похожие ветки 

 
Alx2   (2002-05-14 14:30) [0]

Ребята, научите красить итемы в TRadioGroup.
У меня на форме этих RadioGroupов целая куча и количество итемов в каждом тоже немаленькое. Хотелось бы у выбранного итема не просто точку проставлять, а всю строчку покрасить, чтобы заметнее его сделать. Новый компонент лепить - не хочу :(
Может решение где-то рядом?


 
Alx2   (2002-05-14 14:38) [1]

Вот это не спасает:

Procedure TLogoAppForm.RadioGroup4Click(Sender: TObject);
Var K: Integer;
RG: TRadioGroup;
RB: TRadioButton;
Begin
If Sender Is TRadioGroup Then
Begin
RG := Sender As TRadioGroup;
For K := 0 To RG.ControlCount - 1 Do
If RG.Controls[K] Is TRadioButton Then
Begin
RB := RG.Controls[K] As TRadioButton;
If RB.checked Then
RB.COLOR := clLime
Else
RB.COLOR := clBtnFace
End;
End;
End;

Так как надо чтобы он сам при изменении статуса красился.


 
Johnmen   (2002-05-14 14:51) [2]

Аналогичную задачу когда-то решал - ковырял исходники в части отрисовки переключаемых радиобутонов....Все получалось, как надо...


 
Alx2   (2002-05-14 14:58) [3]

Предлагаешь исходники поправить?


 
Johnmen   (2002-05-14 15:02) [4]

Конечно ! Поправить несложно, сложнее - найти, где поправить...


 
Игорь Шевченко   (2002-05-14 15:09) [5]

Исходники править - это сакс и мастдай :-)

Лучше использовать другой компонент, нету у стандартного RadioGroup свойств для изменения атрибутов выделенного item"а

С уважением,


 
Anatoly Podgoretsky   (2002-05-14 15:15) [6]

Johnmen © (14.05.02 15:02)
Не трогай генофонд :-)


 
Alx2   (2002-05-14 15:16) [7]

Во-во :)


Ну а я пока репу чешу...


 
Игорь Шевченко   (2002-05-14 15:37) [8]

День добрый, Alx2,

Вместо чеса предлагаю сделать следующее: Переписать из ExtCtrls весь TCustomRadioGroup. Объявить свой класс TMyGroupButton наследник от TMyRadioButton. У TMyRadioButton перекрыть метод
CreateParams, указав у него Style := Style OR BS_OWNERDRAW, дописать метод DrawItem - всем будет интересно :-)
Или на www.torry.net сходить, может, это кто-то уже сделал :-)

С уважением,


 
Alx2   (2002-05-14 15:44) [9]

Эх... таки придется этот "компонентище" писать :(


 
Johnmen   (2002-05-14 15:51) [10]

>All :
Да ладно вам...
Конечно курочить генофонд не есть хорошо.
Но иногда, тщательно помыв руки, пожно подправить пару-тройку кривоватых генов, вместо того, чтобы заниматься долгой селекцией по выведению новых сортов компонентов :))))


 
Игорь Шевченко   (2002-05-14 16:03) [11]

to Johnmen ©:

Тщательно помыв кривые руки... :-))


 
Johnmen   (2002-05-14 16:18) [12]

>Игорь Шевченко © (14.05.02 16:03)

Ты мои руки не обижай ! Ты их не видел !


 
Игорь Шевченко   (2002-05-14 16:18) [13]

День добрый, Alx2,

Стоит поглядеть:
http://www.torry.net/vcl/buttons/radiobuttons/pdj_sillitools.zip

С уважением,


 
Alx2   (2002-05-14 16:27) [14]

>Игорь Шевченко © (14.05.02 16:18)
Спасибо!

Сейчас-сейчас...


 
Игорь Шевченко   (2002-05-14 16:29) [15]

to Johnmen ©:

Разве я говорил о ТВОИХ руках ? :-)


 
Alx2   (2002-05-14 16:36) [16]

>Игорь Шевченко © (14.05.02 16:18)
Необычно :)
Но зато глаза не разбегаются


 
Игорь Шевченко   (2002-05-14 16:42) [17]

День добрый, Alx2,

там есть исходники, вполне можно довести до требуемого вида :-)

С уважением,


 
MBo   (2002-05-14 16:43) [18]

наколенная поделка ;)

TCRG=class(TRadioGroup)
private
procedure ButtonClick(Sender: TObject);
public
procedure updatecount;
end;

var crg1:tcrg;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
crg1:=tcrg.create(self);
crg1.parent:=self;
crg1.items.add("1");
crg1.items.add("2");
crg1.items.add("3");
crg1.updatecount;
end;

procedure TCRG.ButtonClick(Sender: TObject);
var i:integer;
begin
for i:=0 to controlCount-1 do
if controls[i]<>Sender then
TRadiobutton(controls[i]).font.style:=TRadiobutton(controls[i]).font.style-[fsBold]
else begin
ItemIndex:=i;
TRadiobutton(controls[i]).font.style:=TRadiobutton(controls[i]).font.style+[fsBold];
end;
Changed;
Click;
end;

procedure TCRG.updatecount;// над этим надо подумать - вставлять код в конструктор и еще где-то.
// Пока не вижу, почему не устанавливается обработчик
//в конструкторе Radiobutton
var i:integer;
begin
for i:=0 to controlCount-1 do
TRadioButton(controls[i]).onclick:=buttonclick;
end;


 
Alx2   (2002-05-14 16:44) [19]

Угу.
Еще раз спасибо!


 
Alx2   (2002-05-14 17:10) [20]

>MBo © (14.05.02 16:43)
Привет, Борис!

Хм. Поздно я прочитал - уже скачанный компонент внедрил.
А вот это Пока не вижу, почему не устанавливается обработчик в конструкторе Radiobutton с каким смыслом? "Не устанавливается" или "почему бы не установить"?


 
MBo   (2002-05-14 17:16) [21]

в TGroupButton.InternalCreate(RadioGroup: TCustomRadioGroup)
уже есть
OnClick := RadioGroup.ButtonClick;
а мне приходится делать вручную ;)


 
Alx2   (2002-05-14 17:18) [22]

А вот это:
for i:=0 to controlCount-1 do
if controls[i]<>Sender then ...

Напоминает, правда очень отдаленно, мой пост - Alx2 © (14.05.02 14:38)

Я просто не хотел в цикле перелопачивать все RadioButtons.

И, все-таки, по поводу:
// Пока не вижу, почему не устанавливается обработчик
//в конструкторе Radiobutton
Где - то в RadioGroup стоит переприсваивание обработчика OnClick для RadioButtonов
Вот это, кажется:

constructor TGroupButton.InternalCreate(RadioGroup: TCustomRadioGroup);
begin
inherited Create(RadioGroup);
RadioGroup.FButtons.Add(Self);
Visible := False;
Enabled := RadioGroup.Enabled;
ParentShowHint := False;
OnClick := RadioGroup.ButtonClick;
Parent := RadioGroup;
end;


 
Alx2   (2002-05-14 17:19) [23]

Блин, не синхронизирую ответы никак :))


 
Alx2   (2002-05-14 17:22) [24]

А я пытался провернуть такой вот бред:

TNotifyEventsArray = Array Of Record
OnClick: TNotifyEvent;
OnExit: TNotifyEvent;
End;
......................
Procedure TLogoAppForm.FormCreate(Sender: TObject);
Procedure AssignHandler(RG: TRadioGroup);
Var K: Integer;
Begin
For K := 0 To RG.ControlCount - 1 Do
If RG.Controls[K] Is TRadioButton Then
With (RG.Controls[K] As TRadioButton) Do
Begin
Tag := Length(NotifyEventsArray);
SetLength(NotifyEventsArray, Tag + 1);
NotifyEventsArray[Tag].OnClick := OnClick;
NotifyEventsArray[Tag].OnExit := OnExit;
OnClick := OnRadioButtonClick;
OnExit := OnRadioButtonExit;
End;
End;

Var K: Integer;
Begin
For K := 0 To ComponentCount - 1 Do
If Components[K] Is TRadioGroup Then
AssignHandler(Components[K] As TRadioGroup);
End;

...................

Procedure TLogoAppForm.OnRadioButtonClick(Sender: TObject);
Begin
If Sender Is TRadioButton Then
With TRadioButton(Sender) Do
Begin
If checked Then COLOR := clLime Else
COLOR := clBtnFace;

If (Tag < Length(NotifyEventsArray)) And
Assigned(NotifyEventsArray[Tag].OnClick) Then
NotifyEventsArray[Tag].OnClick(Sender);

End;
End;



 
MBo   (2002-05-14 17:26) [25]

В общем-то проблема не раскрасить, а аккуратно отследить момент переключения.


 
Alx2   (2002-05-14 17:29) [26]

>MBo © (14.05.02 17:26)
Вот в этом и вопрос. У меня почему-то создалось впечатление, что отметку снимает сама операционка :(
Нигде не мог отследить, чтобы отрабатывало SetChecked(False)



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

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

Наверх





Память: 0.5 MB
Время: 0.006 c
1-73094
KvORubin
2002-05-01 12:45
2002.05.23
Можно ли нажав на ссылку в RichEdit1 выполнить процедуру ???


6-73321
Semen Pleshivtsev
2002-02-19 18:06
2002.05.23
Выделение фразы цветом в TWebBrowser ? Help!


3-73009
Олег219
2002-04-23 23:08
2002.05.23
Paradox


1-73224
Как сделать?
2002-05-14 18:36
2002.05.23
Как сохранить из StringGrid в текстовый файл


6-73336
tupica
2002-03-12 20:50
2002.05.23
Как отправить майл?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский