Главная страница
    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.066 c
8-1149251065
h8394E
2006-06-02 16:24
2007.01.28
Отображение в D3Dx 2х-мерных изображений


15-1168435066
Piroxyline
2007-01-10 16:17
2007.01.28
Turbo Delphi Explorer


15-1168001545
Anatoly Podgoretsky
2007-01-05 15:52
2007.01.28
День рождения шефа


2-1168081609
Antoha111
2007-01-06 14:06
2007.01.28
Array of Byte в String


4-1158154410
Jimmm
2006-09-13 17:33
2007.01.28
COM сервер в Win32 Service





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