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

arthur (27.10.08 20:09) [0]

this is the code i use to create the menus

treemenu := NewMenu(channeltree, 0, [' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'Clear Hotkeys'], treemenuproc);
channeltree.SetAutoPopupMenu(treemenu);
traymenu := NewMenu(nil, 0, [' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'Clear Hotkeys'], traymenuproc);
Tray.PopupMenu := traymenu.Handle;

Tray is a BAPTrayIcon
channeltree is a treeview

the problem is, if i create those 2 menus i receive an application error when add items to my treeview

if i don't create the tray menu the chanelltree it works nice,
and if i don't create the channeltree menu the traymenu works nice

... i already tried several things, but to keep my treeview working i can't create more than 1 menu =\.

any idea of what is wrong?

Thanks,
Arthur.

obs: sorry my english, i'm from brazil.

<Цитата>
arthur (07.11.08 17:02) [1]

please help =\

<Цитата>
Jon © (07.11.08 17:50) [2]

Here is a complete example using KOL only:

program Test;

uses
Windows, Messages, KOL;

var
MainForm, Treeview: PControl;
TreeMenu, TrayMenu: PMenu;
TrayIcon: PTrayIcon;

procedure TrayIconMouse(Dummy: PControl; Sender: PObj; WMessage: Word);
var
Point: TPoint;
begin
if WMessage = WM_LBUTTONDOWN then
begin
GetCursorPos(Point);
TrayMenu.Popup(Point.X,Point.Y);
end;
end;

begin
Applet := NewApplet('Test');
MainForm := NewForm(Applet,Applet.Caption).SetSize(320,240);
NewMenu(MainForm,0,[''],nil);
TreeView := NewTreeView(MainForm,[],nil,nil).SetAlign(caClient);
TreeMenu := NewMenu(TreeView,0,[' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','Clear Hotkeys'],nil);
TreeView.SetAutoPopupMenu(TreeMenu);
TrayIcon := NewTrayIcon(Applet,LoadIcon(0,IDI_INFORMATION));
TrayIcon.Active := True;
TrayIcon.OnMouse := TOnTrayIconMouse(MakeMethod(nil,@TrayIconMouse));
TrayMenu := NewMenu(MainForm,0,[' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','Clear Hotkeys'],nil);
Applet.Add2AutoFree(TrayIcon);
Run(Applet);
end.

The important line is

NewMenu(MainForm,0,[''],nil);

<Цитата>
arthur (08.11.08 04:26) [3]

it works, =D Thanks!!!

NewMenu(MainForm,0,[''],nil);
is the really important

i just added it before creating the other menus everything is working nice now =D

<Цитата>
Jon © (08.11.08 16:04) [4]

You're welcome - happy to know that it worked.
Note: it is necessary only if MainForm does not have a main menu.

<Цитата>
arthur (09.11.08 02:25) [5]

just another question, is there a problem if i create the tray popup menu with MainForm as Parent (like in your example) ?

<Цитата>
Jon © (09.11.08 04:27) [6]

There should be no problem if you do not destroy MainForm.
My example is based upon what MCK would create.
If you want to, you could use Applet as the parent:

NewMenu(Applet,0,[''],nil);
TrayMenu := NewMenu(Applet,0,[' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','Clear Hotkeys'],nil);

<Цитата>
arthur (09.11.08 19:39) [7]

come on these menus are very problematic,

if i try,

> //# MENUS
> NewMenu(Form, 0, [''], nil);
>
> treemenu := NewMenu(channeltree, 0, [' ', ' ', ' ', '
> ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'Clear Hotkeys'],
> treemenuproc);
> channeltree.SetAutoPopupMenu(treemenu);
>
> traymenu := NewMenu(Form, 0, ['Radios', '(', ' ', ' ',
> ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ')',
> 'About', 'Exit'], traymenuproc);
> Tray.PopupMenu := traymenu.Handle;

app crashes when adding items to channeltree,
but if i create the the traymenu with less items it works!?, what's wrong now?

<Цитата>
Jon © (09.11.08 19:52) [8]

Your code works for me. Maybe the problem is with "traymenuproc" - try using "nil" to test. Or show us more of your code.

<Цитата>
Jon © (09.11.08 23:35) [9]

[OT] Seems like you are updating 1ClickMusic - I have v1.8.0 - would like update when done ;-)

<Цитата>
arthur (10.11.08 05:28) [10]

i tried with nil parameters, but app still crashes =\\

this is the problem, there is no more code

that code is on form.create event
before those lines i only init DirectSound and register some hotkeys
and after i start to add things to the treeview "channeltree" and on the first node to the tree the app crash saying about an AcessViolation..

i'm running out of options, i'm trying to add this menu for 1~2 months but could not make it work, the exactly same thing happen if i try to use MCK popupmenu

=> i almost have a heart attack now, how do you know about my app? Where did u heard about it =D ?

<Цитата>
Jon © (10.11.08 12:12) [11]

I really cannot find a problem.
Here is my example updated:

program Test;

uses
Windows, Messages, KOL;

var
MainForm, Treeview: PControl;
TreeMenu, TrayMenu: PMenu;
TrayIcon: PTrayIcon;

procedure TrayIconMouse(Dummy: PControl; Sender: PObj; WMessage: Word);
var
Point: TPoint;
begin
if WMessage = WM_LBUTTONDOWN then
begin
GetCursorPos(Point);
TrayMenu.Popup(Point.X,Point.Y);
end;
end;

procedure MenuItemClick(Dummy: Pointer; Sender: PMenu; Item: Integer);
begin
Treeview.TVInsert(TVI_ROOT,0,Format('[%s] %u: %s',[Time2StrFmt('',Now),Item,Sender.ItemText[Item]]));
end;

begin
Applet := NewApplet('Test');
MainForm := NewForm(Applet,Applet.Caption).SetSize(320,240);
NewMenu(MainForm,0,[''],nil);
TreeView := NewTreeView(MainForm,[],nil,nil).SetAlign(caClient);
TreeMenu := NewMenu(TreeView,0,[' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','Clear Hotkeys'],TOnMenuItem(MakeMethod(nil,@MenuItemClick)));
TreeView.SetAutoPopupMenu(TreeMenu);
TrayIcon := NewTrayIcon(Applet,LoadIcon(0,IDI_INFORMATION));
TrayIcon.Active := True;
TrayIcon.OnMouse := TOnTrayIconMouse(MakeMethod(nil,@TrayIconMouse));
TrayMenu := NewMenu(MainForm,0,['Radios','(',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',')','About','Exit'],TOnMenuItem(MakeMethod(nil,@MenuItemClick)));
Applet.Add2AutoFree(TrayIcon);
Run(Applet);
end.

I have added an event handler for the menus.
Clicking any menu item adds items to the treeview.
KOL only - it works fine - are you using MCK?

=> No need for heart attack - I have helped you before at delphifusion.com

<Цитата>
arthur (10.11.08 18:55) [12]

=> oh, at delpifusion =]

i'm using mck, but i think i will have to rewrite all this shit in kol to see if i can make it work

<Цитата>
Jon © (10.11.08 21:21) [13]

Why? I believe that MCK works well. Are you using the latest version? Maybe it is just BAPTrayIcon or other components that you use. No need to start again from scratch.

<Цитата>
arthur (10.11.08 22:45) [14]

yes, kol and mck are up to date, i already tried to use KOLTrayIcon instead of BapTrayIcon, but the problems stills the same

<Цитата>
Jon © (10.11.08 23:20) [15]

Well, I don't know what to suggest without seeing more code :-(

<Цитата>
arthur (11.11.08 00:31) [16]

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
appwinHANDLE := form.Handle;
//# Inicializa o SOM
DS := TDSoutput.Create(appwinHANDLE);

ITRAY := LoadIcon(HInstance, 'TRAY'); // gray icon
ITrayBlue := LoadIcon(HInstance, 'TRAYBLUE');
ITrayGreen := LoadIcon(HInstance, 'TRAYGREEN');
ITrayRed := LoadIcon(HInstance, 'TRAYRED');

Tray.Icon := ITRAY;
Tray.Active := True;

//# HOTKEYS
RegisterHotKey(appwinHANDLE, 2, MOD_CONTROL, VK_UP);
RegisterHotKey(appwinHANDLE, -2, MOD_CONTROL, VK_DOWN);
RegisterHotKey(appwinHANDLE, 1003, MOD_CONTROL, VK_END);
RegisterHotKey(appwinHANDLE, 1004, MOD_CONTROL, VK_HOME);
RegisterHotKey(appwinHANDLE, 2001, MOD_CONTROL, VK_F1);
RegisterHotKey(appwinHANDLE, 2002, MOD_CONTROL, VK_F2);
RegisterHotKey(appwinHANDLE, 2003, MOD_CONTROL, VK_F3);
RegisterHotKey(appwinHANDLE, 2004, MOD_CONTROL, VK_F4);
RegisterHotKey(appwinHANDLE, 2005, MOD_CONTROL, VK_F5);
RegisterHotKey(appwinHANDLE, 2006, MOD_CONTROL, VK_F6);
RegisterHotKey(appwinHANDLE, 2007, MOD_CONTROL, VK_F7);
RegisterHotKey(appwinHANDLE, 2008, MOD_CONTROL, VK_F8);
RegisterHotKey(appwinHANDLE, 2009, MOD_CONTROL, VK_F9);
RegisterHotKey(appwinHANDLE, 2010, MOD_CONTROL, VK_F10);
RegisterHotKey(appwinHANDLE, 2011, MOD_CONTROL, VK_F11);
RegisterHotKey(appwinHANDLE, 2012, MOD_CONTROL, VK_F12);

//# MENUS
NewMenu(Form, 0, [''], nil);

traymenu := NewMenu(Form, 0, ['Radios', '(', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ')', 'About','Exit'], nil);

treemenu := NewMenu(channeltree, 0, [' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'Clear Hotkeys'], treemenuproc);
channeltree.SetAutoPopupMenu(treemenu);

//# Cria lista de radios
Radiolist := TRadioList.Create;
//# inicializa os canais e o message handler
LoadDb(channeltree, radiolist);
LoadCustomDb(channeltree, radiolist, 'c:/userradios.txt');
LoadCustomDb(channeltree, radiolist, 'userradios.txt');
//channeltree.AttachProc(TreeListWndProc);
//# close the treeview
channeltree.TVSelected := channeltree.TVRoot;
channeltree.TVExpand(channeltree.TVRoot, TVE_COLLAPSE);

//# Load .INI Config
LoadConfig();
//# Show About box if first run or just updated!
if firstrun_enabled then showaboutbox;
end;

<Цитата>
arthur (11.11.08 00:32) [17]

mck unit1.inc
{ KOL MCK } // Do not remove this line!

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin

{$IFDEF KOLCLASSES}
Result := PForm1.Create;
{$ELSE OBJECTS}
New( Result, Create );
{$ENDIF KOL CLASSES/OBJECTS}
Result.Form := NewForm( AParent, '1ClickMusic' ).SetPosition( 418, 432 );
Applet := Result.Form;
Result.Form.Add2AutoFree( Result );
{$IFDEF UNICODE_CTRLS}
Result.Form.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
{$IFDEF USE_NAMES}
Result.Form.SetName( Applet, 'Form1' );
{$ENDIF}
Result.Form.Style := Result.Form.Style and not WS_MAXIMIZEBOX;
Result.Form.SetClientSize( 619, 278 );
Result.Form.IconLoad( hInstance, 'MAINICON' );
Result.Form.Font.FontName := 'MS Sans Serif';
Result.Form.Font.FontPitch := fpFixed;
Result.Form.OnMessage := Result.KOLForm1Message;
Result.Form.OnDestroy := Result.KOLForm1Destroy;

Result.Tray := NewBAPTrayIcon(Applet);
{$IFDEF USE_NAMES}
Result.Tray.SetName( Result.Form, 'Tray' );
{$ENDIF}
Result.Form.Add2AutoFree( Result.Tray );
Result.Tray.OnMouseUp := Result.TrayMouseUp;
// Result.lblbuffer.TabOrder = -1
Result.lblbuffer := NewLabel( Result.Form, '' ).SetPosition( 553, 112 ).SetSize( 57, 40 );
{$IFDEF USE_NAMES}
Result.lblbuffer.SetName( Result.Form, 'lblbuffer' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.lblbuffer.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.lblbuffer.Font.Color := TColor(clBlue);
Result.lblbuffer.Font.FontCharset := 0;
Result.lblbuffer.TextAlign := KOL.taRight;
// Result.lblhelp.TabOrder = -1
Result.lblhelp := NewLabel( Result.Form, 'Hotkeys:'+#13+#10+' CTRL + UP : raise volume'+#13+#10+' CTRL + Down : decrease volume'+#13+#10+' CTRL + END : Stop'+#13+#10+' CTRL + HOME : Play'+#13+#10+' CTRL + (F1..F12) : Hotkey for Channels'+#13+#10+#13+#10+'!! Right click on a channel to bind it for a hotkey'+#13+#10+'!! Left or Right click on TrayIcon to Hide/Show' ).SetPosition( 241, 136 ).SetSize( 272, 137 );
{$IFDEF USE_NAMES}
Result.lblhelp.SetName( Result.Form, 'lblhelp' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.lblhelp.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.lblhelp.Font.Color := TColor(clMaroon);
Result.lblhelp.Font.FontHeight := 15;
Result.lblhelp.Font.FontName := 'Arial';
Result.lblhelp.Font.FontPitch := fpDefault;
// Result.lblradio.TabOrder = -1
Result.lblradio := NewLabel( Result.Form, '' ).SetPosition( 245, 74 ).SetSize( 212, 0 );
{$IFDEF USE_NAMES}
Result.lblradio.SetName( Result.Form, 'lblradio' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.lblradio.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.lblradio.Font.Color := TColor(clPurple);
Result.lblradio.Font.FontCharset := 0;
// Result.lblstatus.TabOrder = -1
Result.lblstatus := NewLabel( Result.Form, '' ).SetPosition( 480, 75 ).SetSize( 130, 17 );
{$IFDEF USE_NAMES}
Result.lblstatus.SetName( Result.Form, 'lblstatus' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.lblstatus.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.lblstatus.Font.Color := TColor(clDefault);
Result.lblstatus.Font.FontCharset := 0;
Result.lblstatus.TextAlign := KOL.taRight;
Result.lblstatus.IgnoreDefault := TRUE;
// Result.lbltrack.TabOrder = -1
Result.lbltrack := NewLabel( Result.Form, '' ).SetPosition( 242, 8 ).SetSize( 366, 57 );
{$IFDEF USE_NAMES}
Result.lbltrack.SetName( Result.Form, 'lbltrack' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.lbltrack.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.lbltrack.Font.Color := TColor(clTeal);
Result.lbltrack.Font.FontStyle := [ fsBold ];
Result.lbltrack.Font.FontName := 'Times New Roman';
Result.lbltrack.Font.FontCharset := 0;
Result.lbltrack.TextAlign := KOL.taCenter;
// Result.channeltree.TabOrder = 0
Result.channeltree := NewTreeView( Result.Form, [ tvoLinesRoot, tvoNoTooltips, tvoTrackSelect, tvoSingleExpand ], nil, nil ).SetAlign ( caLeft ).SetSize( 231, 0 );
{$IFDEF USE_NAMES}
Result.channeltree.SetName( Result.Form, 'channeltree' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.channeltree.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.channeltree.Font.Color := TColor(clBlack);
// Result.btoptions.TabOrder = 1
Result.btoptions := NewButton( Result.Form, 'Options' ).SetPosition( 536, 248 ).SetSize( 76, 0 ).LikeSpeedButton;
{$IFDEF USE_NAMES}
Result.btoptions.SetName( Result.Form, 'btoptions' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.btoptions.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.btoptions.Font.FontStyle := [ fsBold ];
Result.btoptions.Style := Result.btoptions.Style or BS_FLAT;
// Result.btplay.TabOrder = 1
Result.btplay := NewButton( Result.Form, 'Play' ).SetPosition( 536, 216 ).SetSize( 76, 0 ).LikeSpeedButton;
{$IFDEF USE_NAMES}
Result.btplay.SetName( Result.Form, 'btplay' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.btplay.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.btplay.Font.FontStyle := [ fsBold ];
Result.btplay.Style := Result.btplay.Style or BS_FLAT;
// Result.pgrbuffer.TabOrder = 2
Result.pgrbuffer := NewProgressBarEx( Result.Form, [ pboSmooth ] ).SetPosition( 536, 93 ).SetSize( 74, 18 );
{$IFDEF USE_NAMES}
Result.pgrbuffer.SetName( Result.Form, 'pgrbuffer' );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
Result.pgrbuffer.SetUnicode(TRUE);
{$ENDIF UNICODE_CTRLS}
Result.pgrbuffer.Visible := False;
Result.pgrbuffer.Color := TColor($E39C5A);
Result.pgrbuffer.ProgressColor := clBtnFace;
Result.channeltree.OnMouseUp := Result.channeltreeMouseUp;
Result.channeltree.OnSelChange := Result.channeltreeSelChange;
Result.channeltree.OnTVSelChanging := Result.channeltreeTVSelChanging;
{$IFDEF OVERRIDE_SCROLLBARS}
OverrideScrollbars( Result.channeltree);
{$ENDIF OVERRIDE_SCROLLBARS}
Result.btoptions.OnClick := Result.btoptionsClick;
Result.btplay.OnClick := Result.btplayClick;
Result.Form.CenterOnParent.CanResize := False;
Result.Form.Perform( WM_INITMENU, 0, 0 );
Result.KOLForm1FormCreate( Result );

end;

app crashes inside LoadDb(); that is the function where i add nodes to the treeview "channeltree"

<Цитата>
Jon © (11.11.08 03:00) [18]

OK, I had a quick look...

Radiolist := TRadioList.Create;

What is TRadioList? Is it a StringList?
In which case it should be:

var
Radiolist: PStrList;
begin
Radiolist := NewStrList;
...
end;

There is still a lot of vital code missing.
Like, what is DS, LoadDB, etc, etc.
Can you zip up your project code and email it?

<Цитата>
arthur (11.11.08 04:40) [19]

TRadioList is a kind of "list" that i coded, it's not a KolList,
it stores the radio names and links and they correspondent node handles on the channeltree.

LoadDB takes 2 params, 1 is the treeview, the other is the RadioList,
it parse some data on the memory (radios names and links) and add it to both treeview and RadioList

LoadCustomDb makes the same, but they parse a text file instead

procedure LoadDb(const TV: PControl; const List: TRadioList);
var
i, n: Integer;
Parent: Cardinal;
Src: PByte;
sChn: string;

function ReadInt8(): Byte;
begin
Result := Src^;
Inc(Src);
end;

function ReadString: string;
var
l: Byte;
begin
l := Src^;
Inc(Src);
SetLength(Result, l);
Move(Src^, PChar(Result)^, l);
Inc(Src, l);
end;

begin
Src := @dbdata;
for n := 1 to ReadInt8() do // for 1 to count of genres
begin
Parent := TV.TVInsert(0, 0, ReadString());
for i := 1 to ReadInt8() do // for 1 to count of radios
begin
sChn := ReadString();

List.Add(
TV.TVInsert(Parent, 0, sChn),
sChn,
Crypt(ReadString())
);
end;
// Agora o Python faz o sort pra nois :]
// TV.TVSort(Parent);
end;;

<Цитата>
Jon © (11.11.08 12:17) [20]

If there is an error in dbdata (I assume it's a file) then the values that you read may be corrupted. Do you have a method for validating its consistency?

Also, with the new unicode capabilities of KOL, I would use AnsiString instead of String for compatability.

<Цитата>
arthur (11.11.08 21:45) [21]

creating one extr menu can't corrupt a file =p

<Цитата>
Jon © (12.11.08 03:56) [22]

I used MCK with BAPTrayIcon to create a project to your original specification.
Form, treeview+popup, trayicon+popup - all work fine with no modifications.
The link below contains the source files and compiled executable.

Download link: http://www.megaupload.com/?d=QHIXT875

<Цитата>
arthur (12.11.08 04:40) [23]

=o it works, so there must be something wrong with my mck stuff, cuz even using mck menu's i get the error

tomorrow i will try reinstalling kol and mck and starting a fresh mck project and add my old code to it, maybe it work, who knows =p

thanks for you time.

<Цитата>
Jon © (12.11.08 20:09) [24]

> =o it works

I wish that I had done that in the first place... ;-)

<Цитата>
arthur (18.11.08 22:47) [25]

Jon, after some intense debugging i discovered the problem, it was on my List.Add(), and i already solved it, but i still don't have any idea why it only happens when i create the other menu =p

<Цитата>
Jon © (19.11.08 02:14) [26]

There is something strange happening with MCK.
Take a look at the file: Unit1_1.inc

In the file that I created and sent previously, the order is:

Result.TrayMenu := NewMenu(....
Result.TrayIcon := NewBAPTrayIcon(Applet);
Result.TrayIcon.PopupMenu := Result.TrayMenu.Handle;

But when I re-open then re-compile it, the order becomes:

Result.TrayIcon := NewBAPTrayIcon(Applet);
Result.TrayIcon.PopupMenu := Result.TrayMenu.Handle;
Result.TrayMenu := NewMenu(....

So it tries to add the menu before the menu is created (Runtime Error)!

The best way around this that I found is to manually edit Unit1_1.inc then compile with the command-line compiler DCC32.exe

<Цитата>
Jon © (19.11.08 02:23) [27]

Better solution - Do not add the popup menu with the MCK, but add it to the FormCreate event:

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
TrayIcon.PopupMenu := TrayMenu.Handle;
end;

Seems to work every time. I can send another test project if you like.

<Цитата>
arthur (19.11.08 02:41) [28]

no need, i was setting it on formcreate before

thanks anyway

<Цитата>
Jon © (19.11.08 03:53) [29]

> but i still don't have any idea why it only happens when i create the other menu

Can you be more specific?

<Цитата>