Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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.039 c
15-1168186755
VolJinn
2007-01-07 19:19
2007.01.28
Еще задачка :)


3-1162996402
pic509
2006-11-08 17:33
2007.01.28
как убрать пароль с базы данных ib5?


15-1168525384
Prohodil Mimo
2007-01-11 17:23
2007.01.28
Есть ли какой редактор для MySQL ?


15-1168599776
Rouse_
2007-01-12 14:02
2007.01.28
Как правильно рисовать в MS Paint - е :)


2-1168607734
Plotnick
2007-01-12 16:15
2007.01.28
Unicode





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский