Форум: "KOL";
Текущий архив: 2007.01.28;
Скачать: [xml.tar.bz2];

Вниз

Problem with new cute control ;)   Найти похожие ветки 

← →
thaddy   (2006-04-18 20:46) [0]

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

---

← →
Vladimir Kladov   (2006-04-18 21:07) [1]

loNoExtendSel - to prevent multiselecting with shift?

---

← →
thaddy   (2006-04-18 22:06) [2]

YES!

Thank you!

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

Regards,

Thaddy

---

← →
thaddy   (2006-04-18 22:20) [3]

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:22) [4]

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

---

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

Форум: "KOL";
Текущий архив: 2007.01.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.744 c