| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Problem with new cute control ;)

thaddy ©   (2006-04-18 20:46:00) 

Hi,

I saw this (for VCL) on Delphi about and translated it to KOL like this:


// Based on VCL code on Delphi About. Easter 2006.
// KOL code by Thaddy
unit KolExtListBox;

interface
uses Kol, Windows;

type
 PRadioListBox = ^ TRadioListBox;
 TRadioListBox = object(Tcontrol)
 public
   function DoDrawItem( Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer;
                            DrawAction: TDrawAction; ItemState: TDrawState ): Boolean;
 end;

function NewRadioListBox(aOwner:PControl):PRadioListBox;

implementation

function TRadioListBox.DoDrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
 ItemIdx: Integer; DrawAction: TDrawAction;ItemState: TDrawState): Boolean;
const
  IsSelected : array[Boolean] of Integer = (DFCS_BUTTONRADIO, DFCS_BUTTONRADIO or DFCS_CHECKED) ;
var
  optionButtonRect: TRect;
begin
  with PControl(sender).Canvas^ do
  begin
    FillRect(rect) ;
    optionButtonRect.Left := rect.Left + 1;
    optionButtonRect.Right := Rect.Left + 13;
    optionButtonRect.Bottom := Rect.Bottom;
    optionButtonRect.Top := Rect.Top;
    DrawFrameControl(Handle, optionButtonRect, DFC_BUTTON, IsSelected[odsSelected in ItemState]) ;
    TextOut(15, rect.Top, PControl(Sender).Items[ItemIdx]) ;
  end;
end;

function NewRadioListBox(aOwner:PControl):PRadioListBox;
begin
Result := PRadioListBox(NewListBox(aOwner,[loOwnerDrawFixed]));
Result.OnDrawItem :=Result.DoDrawItem
end;

end.


The problem is that both cCtrl and Shft work, so you can have multiple selects (as opposed to the VCL version).

I Can't find the bug. Who can help me ;)
I Know this was a quick one, but I must have overlooked something.

Tnx,

Thaddy

---

thaddy   (2006-04-18 22:22:00) [1]

Ignore "classes", ignore last two routines ;) Scratchbook stuff, as are the controls. But still:funny, they are usefull...

---

thaddy   (2006-04-18 22:20:00) [2]

Again thanks!
Here's a weird one (variation):

// Made by Thaddy with a litlle help from Vladimir Kladov ;)
unit KolButtonListBox;
interface
uses Kol, Windows;

type
 PButtonListBox = ^ TButtonListBox;
 TButtonListBox = object(Tcontrol)
 public
   function DoDrawItem( Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer; DrawAction: TDrawAction; ItemState: TDrawState ): Boolean;
end;

function NewButtonListBox(aOwner:PControl):PButtonListBox;

implementation

function TButtonListBox.DoDrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
 ItemIdx: Integer; DrawAction: TDrawAction;ItemState: TDrawState): Boolean;
const
  IsSelected : array[Boolean] of Integer = (DFCS_BUTTONPUSH, DFCS_BUTTONPUSH or DFCS_CHECKED) ;
var
  optionButtonRect: TRect;
begin
  with PControl(sender).Canvas^ do
  begin
    FillRect(rect) ;
    optionButtonRect.Left := rect.Left + 1;
    optionButtonRect.Right := Rect.Left + 13;
    optionButtonRect.Bottom := Rect.Bottom;
    optionButtonRect.Top := Rect.Top;
    DrawFrameControl(Handle, optionButtonRect, DFC_BUTTON, IsSelected[odsSelected in ItemState]) ;
    TextOut(15, rect.Top, PControl(Sender).Items[ItemIdx]) ;
  end;
end;

function NewButtonListBox(aOwner:PControl):PButtonListBox;
begin
Result := PButtonListBox(NewListBox(aOwner,[loOwnerDrawFixed,loNoExtendSel]));
Result.OnDrawItem :=Result.DoDrawItem
end;

procedure Button(const aList:TList; const aPChar:PChar);
begin
 aList.Add(aPChar); //Haal hem er zo straks ook weer achteraan vanaf ;)
end;

function Pop(const aList:TList):PChar;
begin
 Result := aList.Items[Pred(aList.Count)];
 aList.Delete(Pred(aList.Count)); // Snel, omdat er nauwelijks herallocatie plaats vindt
end;

end.


Long time i wrote two in a day :)

Thanks, Vladimir!

---

thaddy   (2006-04-18 22:06:00) [3]

YES!

Thank you!

(Hm, why didn't I see that ;) )

Regards,

Thaddy

---

Vladimir Kladov   (2006-04-18 21:07:00) [4]

loNoExtendSel - to prevent multiselecting with shift?

---

Наверх