PHP DM Gate v0.9 » enhcombos, D5 <span class="vd">[Delphi, Windows]</span>

RusSun © (06.12.09 11:47) [0]

Здравствуйте.
Делал меню с картинками.
Но оно мне не понравилось, пример есть
demomenubitmaps, но там компонент enhcombos.
Хотел спорсить, может
кто-нибудь переделал его для D7?

<Цитата>
RusSun © (14.03.10 16:31) [1]

Доброе время суток.

Тема связанна с меню. Точнее с отображением картинок
в меню. В D5 есть enhcombos, который хотелось бы использовать
для этого перекомпилировал его в D7. и kol 2.88

При этом компилятор выдал предупреждения:

[Предупреждение] KOLFontComboBox.pas(28): Unsafe type 'TObj: old style object'
[Предупреждение] KOLFontComboBox.pas(26): Unsafe type 'TFontCombo: old style object'
[Предупреждение] KOLFontComboBox.pas(120): Unsafe code 'GetMem'
[Предупреждение] KOLFontComboBox.pas(146): Unsafe type 'IDC_ARROW: PAnsiChar'
[Предупреждение] KOLFontComboBox.pas(159): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(159): Unsafe type 'Self: old style object'
[Предупреждение] KOLFontComboBox.pas(166): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(166): Unsafe type 'Self: old style object'
[Предупреждение] KOLFontComboBox.pas(173): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(173): Unsafe type 'Self: old style object'
[Предупреждение] KOLFontComboBox.pas(180): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(180): Unsafe type 'Self: old style object'
[Предупреждение] KOLFontComboBox.pas(244): Unsafe type 'Pointer'
[Предупреждение] KOLFontComboBox.pas(259): Unsafe type 'PChar'
[Предупреждение] KOLFontComboBox.pas(278): Unsafe type 'Pointer'
[Предупреждение] KOLFontComboBox.pas(281): Unsafe code 'FreeMem'
[Предупреждение] KOLFontComboBox.pas(313): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(313): Unsafe code '@ operator'
[Предупреждение] KOLFontComboBox.pas(313): Unsafe type 'Self: old style object'
[Предупреждение] KOLColorComboBox.pas(26): Unsafe type 'TObj: old style object'
[Предупреждение] KOLColorComboBox.pas(24): Unsafe type 'TColorCombo: old style object'
[Предупреждение] objects.pas(9): Unsafe type 'Pointer'
[Предупреждение] objects.pas(10): Unsafe type 'Pointer'
[Предупреждение] objects.pas(23): Unsafe type 'TObjectInstance'
[Предупреждение] objects.pas(33): Unsafe type 'Pointer'
[Предупреждение] objects.pas(48): Unsafe code 'ASM'
[Предупреждение] objects.pas(56): Unsafe type 'Pointer'
[Предупреждение] objects.pas(63): Unsafe type 'Pointer'
[Предупреждение] objects.pas(65): Unsafe type 'Dest: Pointer'
[Предупреждение] objects.pas(65): Unsafe type 'Src: Pointer'
[Предупреждение] objects.pas(68): Unsafe type 'Pointer'
[Предупреждение] objects.pas(83): Unsafe type 'WndProcPtr: Pointer'
[Предупреждение] objects.pas(83): Unsafe type 'Pointer'
[Предупреждение] objects.pas(83): Unsafe code '@ operator'
[Предупреждение] objects.pas(83): Unsafe code '@ operator'
[Предупреждение] objects.pas(84): Unsafe code '@ operator'
[Предупреждение] objects.pas(87): Unsafe code '@ operator'
[Предупреждение] objects.pas(94): Unsafe type 'Result: Pointer'
[Предупреждение] objects.pas(103): Unsafe type 'Pointer'
[Предупреждение] objects.pas(105): Unsafe type 'ObjectInstance: Pointer'
[Предупреждение] objects.pas(107): Unsafe type 'ObjectInstance: Pointer'
[Предупреждение] objects.pas(108): Unsafe type 'ObjectInstance: Pointer'
[Предупреждение] objects.pas(121): Unsafe type 'lpfnWndProc: Pointer'
[Предупреждение] objects.pas(121): Unsafe code '@ operator'
[Предупреждение] objects.pas(128): Unsafe type 'lpszMenuName: PAnsiChar'
[Предупреждение] objects.pas(129): Unsafe type 'lpszClassName: PAnsiChar'
[Предупреждение] objects.pas(137): Unsafe type 'lpszClassName: PAnsiChar'
[Предупреждение] objects.pas(139): Unsafe type 'lpfnWndProc: Pointer'
[Предупреждение] objects.pas(139): Unsafe code '@ operator'
[Предупреждение] objects.pas(142): Unsafe type 'lpszClassName: PAnsiChar'
[Предупреждение] objects.pas(145): Unsafe type 'lpszClassName: PAnsiChar'
[Предупреждение] objects.pas(153): Unsafe type 'Pointer'
[Предупреждение] objects.pas(155): Unsafe type 'Instance: Pointer'
[Предупреждение] objects.pas(155): Unsafe type 'Pointer'
[Предупреждение] objects.pas(157): Unsafe type 'Instance: Pointer'
[Предупреждение] objects.pas(157): Unsafe code '@ operator'
[Предупреждение] objects.pas(157): Unsafe type 'Instance: Pointer'
[Предупреждение] objects.pas(241): Unsafe code '@ operator'
[Предупреждение] KOLColorComboBox.pas(111): Unsafe type 'IDC_ARROW: PAnsiChar'
[Предупреждение] KOLColorComboBox.pas(140): Unsafe code '@ operator'
[Предупреждение] KOLColorComboBox.pas(140): Unsafe type 'Self: old style object'
[Предупреждение] KOLColorComboBox.pas(160): Unsafe code '@ operator'
[Предупреждение] KOLColorComboBox.pas(160): Unsafe type 'Self: old style object'
[Предупреждение] KOLColorComboBox.pas(167): Unsafe code '@ operator'
[Предупреждение] KOLColorComboBox.pas(167): Unsafe type 'Self: old style object'
[Предупреждение] KOLColorComboBox.pas(174): Unsafe code '@ operator'
[Предупреждение] KOLColorComboBox.pas(174): Unsafe type 'Self: old style object'
[Предупреждение] KOLColorComboBox.pas(246): Unsafe type 'PChar'
[Предупреждение] Demo_2.inc(5): Unsafe type 'Pointer'

установил. Попробовал в демке, которая была вместе с пакетом.
Компилится, но при нажатии на закрытие выдает ошибку:
http://slil.ru/28792284
то что скомпилировал + demka :
http://slil.ru/28792305

<Цитата>
Vladimir Kladov © (14.03.10 17:22) [2]

Наверное старый компонент, включите символ USE_PROPS или посмотрите как переделать в более новых, чтобы не нужно было USE_PROPS. Для избавления от большого числа предупреждений вставьте в начале {$I KOLDEF.inc} в код компонента.

<Цитата>
RusSun © (22.03.10 18:58) [3]

Доброе время суток.
Попробовал просто посмотреть ставить функцию WndFunc с 1.91, не вылетает
1.91 ->
//[function WndFunc]
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
: Integer; stdcall;
const size_TMsg = sizeof( TMsg );
asm
ADD ESP, -size_TMsg
MOV EDX, ESP

PUSH ESI
PUSH EDI

MOV EDI, EDX
LEA ESI, [W]

MOVSD
MOVSD
MOVSD
MOVSD

MOV EDI, EDX
MOV EAX, [EDI]
TEST EAX, EAX
JZ @@self_is_nil

MOV ECX, [CreatingWindow]
JECXZ @@get_self_prop

MOV [ECX].TControl.fHandle, EAX

//set_self_prop:
PUSH ECX
PUSH ECX
PUSH Offset[ID_SELF]
PUSH EAX
CALL SetProp

XOR EAX, EAX
MOV [CreatingWindow], EAX
POP EAX // EAX = self_
JMP @@self_got

@@get_self_prop:
PUSH Offset[ID_SELF]
PUSH EAX
CALL GetProp
TEST EAX, EAX
JNZ @@self_got

@@self_is_nil:
OR EAX, [ Applet ]
JNZ @@self_got

//try_defwndproc:
POP EDI
POP ESI
MOV ESP, EBP
POP EBP
JMP DefWindowProc

//@@id_self:
// DB 'SELF_',0

@@self_got:
MOV EDX, EDI
//CALL TControl.WndProc
CALL CallCtlWndProc

POP EDI
POP ESI

MOV ESP, EBP
end;
{$ELSE ASM_VERSION} //Pascal
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
: Integer; stdcall;
var M: TMsg;
self_: PControl;
begin
M.hwnd := W;
M.message := Msg;
M.wParam := wParam;
M.lParam := lParam;

{$IFDEF DEBUG_ENDSESSION}
if EndSession_Initiated then
begin
LogFileOutput( GetStartDir + 'es_debug.txt',
'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
' WParam: ' + Int2Str( wParam ) + '($' + Int2Hex( wParam, 8 ) + ')' +
' LParam: ' + Int2Str( lParam ) + '($' + Int2Hex( lParam, 8 ) + ')' );
end;
{$ENDIF}

self_ := nil;
if W <> 0 then
begin
if CreatingWindow <> nil then
begin
{$IFDEF DEBUG_CREATEWINDOW}
LogFileOutput( GetStartDir + 'Session.log',
'WndFunc: Creating window = ' + Int2Hex( Integer( CreatingWindow ), 4 ) +
' hwnd=' + Int2Str( M.hwnd ) +
' message=' + Int2Hex( M.message, 4 ) +
' wParam=' + Int2Str( M.wParam ) + '=$' + Int2Hex( M.wParam, 4 ) +
' lParam=' + Int2Str( M.lParam ) + '=$' + Int2Hex( M.lParam, 4 )
);
{$ENDIF DEBUG_CREATEWINDOW}
self_ := CreatingWindow;
CreatingWindow.fHandle := W;
SetProp( W, ID_SELF, THandle( CreatingWindow ) );
CreatingWindow := nil;
end
else
self_ := Pointer( GetProp( W, ID_SELF ) );
end;

if self_ <> nil then
Result := self_.WndProc( M )
else
if Assigned( Applet ) then
Result := Applet.WndProc( M )
else
Result := DefWindowProc( W, Msg, wParam, lParam );
{$IFDEF DEBUG_ENDSESSION}
if EndSession_Initiated then
begin
LogFileOutput( GetStartDir + 'es_debug.txt',
'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
' Result: ' + Int2Str( Result ) + '($' + Int2Hex( Result, 8 ) + ')' );
end;
{$ENDIF}
end;
//[END WndFunc]
{$ENDIF ASM_VERSION}

<Цитата>
RusSun © (22.03.10 19:01) [4]

Вот таже фукция в 2.88, что вылетает при закрытий.
2.88->
//[function WndFunc]
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
: Integer; stdcall;
const size_TMsg = sizeof( TMsg );
asm
ADD ESP, -size_TMsg
MOV EDX, ESP

PUSH ESI
PUSH EDI

MOV EDI, EDX
LEA ESI, [W]

MOVSD
MOVSD
MOVSD
MOVSD

MOV EDI, EDX
MOV EAX, [EDI]
TEST EAX, EAX
JZ @@self_is_nil

MOV ECX, [CreatingWindow]
JECXZ @@get_self_prop

MOV [ECX].TControl.fHandle, EAX

PUSH ECX
PUSH ECX
{$IFDEF USE_PROP}
PUSH Offset[ID_SELF]
PUSH EAX
CALL SetProp
{$ELSE}
PUSH GWL_USERDATA
PUSH EAX
CALL SetWindowLong
{$ENDIF}

XOR EAX, EAX
MOV [CreatingWindow], EAX
POP EAX // EAX = self_
JMP @@self_got

@@get_self_prop:
{$IFDEF USE_PROP}
PUSH Offset[ID_SELF]
PUSH EAX
CALL GetProp
{$ELSE}
PUSH GWL_USERDATA
PUSH EAX
CALL GetWindowLong
{$ENDIF}
TEST EAX, EAX
JNZ @@self_got

@@self_is_nil:
OR EAX, [ Applet ]
JNZ @@self_got

POP EDI
POP ESI
MOV ESP, EBP
POP EBP
JMP DefWindowProc

@@self_got:
MOV ESI, EAX
INC [ESI].TControl.fNestedMsgHandling
MOV EDX, EDI
CALL CallCtlWndProc
DEC [ESI].TControl.fNestedMsgHandling
JA @@1
CMP [ESI].TControl.fBeginDestroying, 0
JZ @@1
CMP [ESI].TObj.fRefCount, 0
JNZ @@1
CMP ESI, [Applet]
JZ @@1
XCHG EAX, ESI
CALL TObj.Free
XCHG ESI, EAX
@@1:

POP EDI
POP ESI

MOV ESP, EBP
end;
{$ELSE ASM_VERSION} //Pascal
function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer )
: Integer; stdcall;
var M: TMsg;
self_: PControl;
begin
{if (Msg >= $BD33) and (Msg <= $BD33) then
begin
Result := WndFunc_asm( W, Msg, wParam, lParam );
Exit;
end;}

{$IFDEF INPACKAGE}
Log( '->WndFunc ' + Int2Hex( Msg, 4 ) + ' (' + Int2Str( Msg ) + ')' );
TRY
{$ENDIF INPACKAGE}

M.hwnd := W;
M.message := Msg;
M.wParam := wParam;
M.lParam := lParam;

{$IFDEF DEBUG_ENDSESSION}
if EndSession_Initiated then
begin
LogFileOutput( GetStartDir + 'es_debug.txt',
'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
' WParam: ' + Int2Str( wParam ) + '($' + Int2Hex( wParam, 8 ) + ')' +
' LParam: ' + Int2Str( lParam ) + '($' + Int2Hex( lParam, 8 ) + ')' );
end;
{$ENDIF}

self_ := nil;
if W <> 0 then
begin
if CreatingWindow <> nil then
begin
{$IFDEF INPACKAGE}
Log( '//// CreatingWindow <> nil' );
{$ENDIF INPACKAGE}
{$IFDEF DEBUG_CREATEWINDOW}
LogFileOutput( GetStartDir + 'Session.log',
'WndFunc: Creating window = ' + Int2Hex( Integer( CreatingWindow ), 4 ) +
' hwnd=' + Int2Str( M.hwnd ) +
' message=' + Int2Hex( M.message, 4 ) +
' wParam=' + Int2Str( M.wParam ) + '=$' + Int2Hex( M.wParam, 4 ) +
' lParam=' + Int2Str( M.lParam ) + '=$' + Int2Hex( M.lParam, 4 )
);
{$ENDIF DEBUG_CREATEWINDOW}
self_ := CreatingWindow;
CreatingWindow.fHandle := W;
{$IFDEF USE_PROP}
{$IFDEF INPACKAGE}
Log( '//// SetProp' );
{$ENDIF INPACKAGE}
SetProp( W, ID_SELF, THandle( CreatingWindow ) );
{$ELSE}
SetWindowLong( W, GWL_USERDATA, Integer( CreatingWindow ) );
{$ENDIF}
CreatingWindow := nil;
end
else
{$IFDEF USE_PROP}
self_ := Pointer( GetProp( W, ID_SELF ) );
{$ELSE}
self_ := Pointer( GetWindowLong( W, GWL_USERDATA ) );
{$ENDIF}
end;

if self_ <> nil then
begin
{$IFDEF INPACKAGE}
Log( '//// self_ <> nil, calling self_.WndProc' );
{$ENDIF INPACKAGE}
inc( self_.fNestedMsgHandling );
Result := self_.WndProc( M );
dec( self_.fNestedMsgHandling );
if (self_.RefCount = 0) and (self_.fNestedMsgHandling <= 0) and
self_.fBeginDestroying and (self_ <> Applet) then
self_.Free;
end
else
if Assigned( Applet ) then
Result := Applet.WndProc( M )
else
Result := DefWindowProc( W, Msg, wParam, lParam );
{$IFDEF DEBUG_ENDSESSION}
if EndSession_Initiated then
begin
LogFileOutput( GetStartDir + 'es_debug.txt',
'HWND:' + Int2Str( W ) + ' MSG:$' + Int2Hex( Msg, 4 ) +
' Result: ' + Int2Str( Result ) + '($' + Int2Hex( Result, 8 ) + ')' );
end;
{$ENDIF}
{$IFDEF INPACKAGE}
LogOK;
FINALLY
Log( '<-WndFunc' );
END;
{$ENDIF INPACKAGE}
end;
//[END WndFunc]
{$ENDIF ASM_VERSION}

Вопрос может кто-нибудь c более широким диапазоном знаний поправить 2.88 чтобы
можно было использовать компонент Enhcombos в D7 без этой ошибки?

В этой деме сделано меню, которое "не искажает цвет" при наведении курсора

правда выдаёт ошибки при компиляции
DemoMenuMeasureItem.dpr

[Ошибка] Unit2.pas(68): Undeclared identifier: 'FirstCommand'
[Ошибка] Unit2.pas(83): Undeclared identifier: 'FirstCommand'
[Ошибка] Unit2.pas(103): Incompatible types: 'tagMENUITEMINFOA' and 'TMenuitemInfo'

[Фатальная ошибка] DemoMenuMeasureItem.dpr(6): Could not compile used unit 'Unit2.pas'

<Цитата>
Vladimir Kladov © (22.03.10 20:45) [5]

Я так полагаю, что поправить надо enhcombos. USE_PROPS пробовали?

<Цитата>
RusSun © (23.03.10 20:24) [6]

Да, эффекта нет.

<Цитата>
Дмитрий К © (23.03.10 21:19) [7]

> то что скомпилировал + demka :
> http://slil.ru/28792305

В Demo.dpr дважды подключается Demo_0.inc
И, кстати, для demomenubitmaps enhcombos совершенно не нужен.

<Цитата>
Vladimir Kladov © (24.03.10 16:56) [8]

Попробуйте вот этот вариант:
http://kolmck.net/Components/enhcombos_fix.zip

Кстати, если кто имеет время, проверьте, пожалуйста, на утечки памяти. На глазок, новых утечек я не должен был добавить, а проверить некогда.

<Цитата>
RusSun © (24.03.10 16:57) [9]

Спасибо;)

<Цитата>
mdw (24.03.10 18:01) [10]

Я сразу не понял о чем речь. Вам нужен ColorBox и FontBox? Если да, то могу выложить, недавно переписывал второй раз. В первом было на основе Menu. сейчас переделал на combobox. Работает также и под WinCE (пришлось реализовать свой combobox, т.к. там CustomDraw не поддерживается). Ну это так, немного рекламы:).
А насчет enhcombos, пробовал его давно, Ошибки и утечки памяти....

<Цитата>
RusSun © (24.03.10 19:21) [11]

> Вам нужен ColorBox и FontBox?

Нужен:)

<Цитата>
mdw (25.03.10 11:47) [12]

> > Вам нужен ColorBox и FontBox?Нужен:)

Обновил
http://kolnmck.kolmck.net/files/components/controls/kolmdvcontrols.7z

Изменения:
Добавлен TKOLComboBoxLV - своя реализация ComboBox. Актуально в WinCE для пользовательской отрисовки.

KOLmdvDialogEx:
Добавил поддержку WinCE для AboutDialog

KOLmdvShellControls:
Добавил TKOLmdvShellTreeView - Расширение TreeView. Отображает и позволяет выбирать содержимое папки.
Добавил TKOLmdvShellTreeContainer - Контейнер для TKOLmdvShellTreeView. Реализует горизонтальный скроллинг и заголовок для колонок
Реализована полная функциональность TKOLmdvShellComboBox для WinCE

KOLmdvSysBox:
Изменена реализация контролов. Вместо Menu теперь используется ComboBox

<Цитата>
mdw (25.03.10 11:47) [13]

Вам нужен KOLmdvSysBox

<Цитата>
RusSun © (25.03.10 18:00) [14]

2mdw спасибо, скачал по ссылке;)

<Цитата>
RusSun © (25.03.10 18:16) [15]

> И, кстати, для demomenubitmaps enhcombos совершенно не нужен.
>
>

Попробовал пример.
Почему то он вызывает у меня ошибку:

Error reading MainMenu1.genearteSepeartorConstants:
Property genearteSepeartorConstants:does not exist.
Ignor all errors and continue? Note:Ignoring the error
may case compnents to be deleted or property value to
be lost.
|Ignor | |Cancel| |Ignor all|

На kol без mck пробую так :

program test;

uses
windows,
kol;

const miFaces: Integer = 0;
const miKind: Integer = 1;
const miMore: Integer = 2;
const miFoots: Integer = 3;
const N1: Integer = 4;
const N2: Integer = 5;

{$R *.res}
var
form:PControl;
MainMenu1:pMenu; S12Bmp: PBitmap;
const KindHeight = 29;
{$R i24bit.res}
//область для функции
function MainMenu1MeasureItem(Sender: PObj; Idx: Integer): Integer;
begin
Result := 0;
if Idx = miKind then
Result := (KindHeight + 6) or ((KindHeight * 2) shl 16);
end;
function MainMenu1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect;
ItemIdx: Integer; DrawAction: TDrawAction;
ItemState: TDrawState): Boolean;
begin
Result := FALSE;
if ItemIdx = miKind then
begin
S12Bmp.DrawTransparent( DC, 0, 0, clWhite );
TextOut( DC, KindHeight + 6, 6, 'Hello!', 6 );
Result := TRUE;
end;
end;

//область для процедур
procedure formDestroy(Sender: PObj);
begin
S12Bmp.Free;
end;
Begin
form:=NewForm(Applet,'Form1').SetClientSize( 245, 98 ).SetPosition( 246, 107 );
form.Font.FontName := 'MS Sans Serif';
S12Bmp := NewBitmap( 0, 0 );
S12Bmp.LoadFromResourceName( hInstance, 'S12' );
MainMenu1 := NewMenu(form, 0, [ 'Faces', '('
, 'Kind', 'More', ')', 'Foots', '(', '111', '222', ')'
, '' ], nil );

//область для работы
form.OnDestroy :=TonEvent(MakeMethod(nil,@formDestroy));
MainMenu1.OnMeasureItem :=TOnMeasureItem(MakeMethod(nil,@MainMenu1MeasureItem));
MainMenu1.OnDrawItem := TOnDrawItem(MakeMethod(nil,@MainMenu1DrawItem));
Run(form);
end.

картинки нет.

<Цитата>
mdw (25.03.10 18:50) [16]

На вскидку.
1. Обявлены неправильно:
function MainMenu1MeasureItem(Sender: PObj; Idx: Integer): Integer;
function MainMenu1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect;

2. MainMenu1.Items[..].OwnerDraw:= True;

3. В MainMenu1DrawItem передается Rect. А вы почему-то выводите все время в координату (0,0)

<Цитата>
Дмитрий К © (25.03.10 18:56) [17]

MainMenu1.Items[miKind].OwnerDraw := True;

<Цитата>
RusSun © (26.03.10 16:05) [18]

Вроде бы так. Если да, то тема закрыта:)

program test;

uses
windows,
kol;
type TOnEvent = procedure( Sender: PObj )of object;
const miFaces: Integer = 0;
const miKind: Integer = 1;
const miMore: Integer = 2;
const miFoots: Integer = 3;

{$R *.res}
var
form:PControl;
MainMenu1:pMenu; S12Bmp: PBitmap;
const KindHeight = 29;
{$R i24bit.res}
//область для функции

function MainMenu1MeasureItem(Dummy:pointer;Sender: PObj; Idx: Integer): Integer;
begin
Result := 0;
if Idx = miKind then
Result := (KindHeight + 6) or ((KindHeight * 2) shl 16);
end;

function MainMenu1DrawItem(Dummy:pointer;Sender: PObj; DC: HDC; const Rect: TRect;
ItemIdx: Integer; DrawAction: TDrawAction;
ItemState: TDrawState): Boolean;
begin
Result := FALSE;
if ItemIdx = miKind then
begin
S12Bmp.DrawTransparent( DC, 0, 0, clWhite );
TextOut( DC, KindHeight + 6, 6, pchar('Hello!'), 6 );
Result := TRUE;
end;

end;
//область для процедур
procedure formDestroy(Sender: PObj);
begin
S12Bmp.Free;
end;
Begin
form:=NewForm(Applet,'Form1').SetClientSize( 245, 98 ).SetPosition( 246, 107 );
form.Font.FontName := 'MS Sans Serif';

S12Bmp := NewBitmap( 0, 0 );
S12Bmp.LoadFromResourceName( hInstance, 'S12' );

MainMenu1 := NewMenu(form, 0, [ 'Faces', '('
, 'Kind', 'More', ')', 'Foots', '(', '111', '222', ')'
, '' ], nil );

//область для работы
form.OnDestroy :=TonEvent(MakeMethod(nil,@formDestroy));
MainMenu1.OnMeasureItem :=TOnMeasureItem(MakeMethod(nil,@MainMenu1MeasureItem));
MainMenu1.OnDrawItem:=TOnDrawItem(MakeMethod(nil,@MainMenu1DrawItem));
MainMenu1.Items[miKind].OwnerDraw := True;
Run(form);
end.

<Цитата>
mdw (26.03.10 17:27) [19]

function MainMenu1DrawItem(Dummy:pointer;Sender: PObj; DC: HDC; const Rect: TRect;
ItemIdx: Integer; DrawAction: TDrawAction;
ItemState: TDrawState): Boolean;
begin
Result := FALSE;
if ItemIdx = miKind then
begin
S12Bmp.DrawTransparent( DC, Rect.Left, Rect.Top, clWhite );
TextOut( DC, Rect.Left + KindHeight + 6, Rect.Top+6, pchar('Hello!'), 6 );
Result := TRUE;
end;

<Цитата>
RusSun © (12.04.10 18:04) [20]

2mdw Спасибо.)

<Цитата>