сменить курсор у static a.

← →
sw (2004-10-13 16:08) [0]

Вопрос по поводу WinApi.
Вообщем цель: сменить курсор у static"a.
Вроде создал static, потом отслеживаю wm_setcursor,
и передаю предедыдущей процедуре, для обработке остальных сообщений.
Не работает и все тут, работает если закоментировать, callwindowproc,
хотя по сути вещей это ведь не правильно ?

program MAIN23;
{$R n.res}

uses windows, messages;
var
wc : TWndClassEx;
wndMain, lb : THandle;
Mesg : TMsg;
stWNDproc: Pointer;

function MyLblWndProc(wnd: hWnd; msg, wParam, lParam: longint): longint; stdcall;
begin
result:=0;
case msg of
WM_SETCURSOR:
begin
SetCursor(LoadCursor(0,IDC_HAND)); //для надежности и так сделал и так
SetCursor(LoadCursor(hInstance,"HAND")); //
result:=1;
end;
end;
Result := CallWindowProc(stWndProc, wnd, msg, wparam, lparam);
end;

function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;
Begin
case msg of
wm_destroy : begin
postquitmessage(0); exit;
Result:=0;
end;
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;
End;

begin

wc.cbSize:=sizeof(wc);
wc.style:=0;
wc.lpfnWndProc:=@WindowProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=DLGWINDOWEXTRA;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:="window";

RegisterClassEx(wc);

wndMain:= CreateWindow("window", "",
WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
0, 0,hInstance,nil);

lb:=CreateWindow("static", "http://www.vasya.ru", WS_VISIBLE+WS_CHILD, 100, 100, 200, 80, Wndmain, 0, hInstance, nil);

stWNDproc:=Pointer(SetWindowLong(lb, GWL_WNDPROC, Integer(@MyLblWndProc)));
// PGroup1Proc := Pointer(SetWindowLong(hGroup1, GWL_WNDPROC, Integer(@Group1Proc)));
// PSystemProc := Pointer(SetWindowLong(hControl, GWL_WNDPROC, Integer(@ControlProc)));
{ stWNDproc:=Pointer(GetWindowLong(lb, GWL_WNDPROC));
SetWindowLong(lb, GWL_WNDPROC, Integer(Addr(MyLblWndProc))); }

ShowWindow(wndMain,CmdShow);
While GetMessage(Mesg,0,0,0) do begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
end.

Компилирую на D7.

← →
Nick Denry © (2004-10-13 16:40) [1]

попробуй так:

Result := SetCursor(LoadCursor(0,IDC_HAND));

должно помочь, если нет, есть другие варианты.

Да, еще лучше сделать так:
...
WM_CREATE:
begin
Hand_Cursor := LOadCursor(0, IDC_HAND);
end;

WM_SETCURSOR:

Result := SetCursor(Hand_Cursor);

← →
BiN © (2004-10-13 16:46) [2]

function MyLblWndProc(wnd: hWnd; msg, wParam, lParam: longint): longint; stdcall;
begin
result:=0;
case msg of
WM_SETCURSOR:
begin
SetCursor(LoadCursor(0,IDC_HAND)); //для надежности и так сделал и так
SetCursor(LoadCursor(hInstance,"HAND")); //
result:=1;
end;
end;
Result := CallWindowProc(stWndProc, wnd, msg, wparam, lparam);
end;

после result:=1; поставь Exit;

← →
sw (2004-10-13 19:56) [3]

все дело в том что и метод выше и
Result := SetCursor(LoadCursor(0,IDC_HAND));
работает но только если
Result := CallWindowProc(stWndProc, wnd, msg, wparam, lparam);
закоментирована, курсор отображается как надо(рука), но метка само собой не отрисовывается.
Такое ощущение что вызов стандартной процедуры просто игнорируется

← →
Nick Denry © (2004-10-14 00:26) [4]

Я тебе для гиперссылок предлагаю сделать не сабклассинг, а суперклассинг. Выглядит это слудующим образом:

... var SCDLabelClassEx:WNDCLASSEX; //Переменная для суперклассирования надписи с майлом UFont : HFONT; //Шрифт для контролов HandCursor : HCURSOR; //курсор - рука для кнопок и гиперлабелов ... Процедура обработки сообщейний главного окна (окна, которое содежит гипертекстовую ссылку): ......... WM_CREATE: begin ..... UFont:=createfont(-11,0,0,0,fw_normal,0,1,0, DEFAULT_CHARSET,Out_Default_Precis,Out_Default_Precis, DEFAULT_QUALITY,DEFAULT_PITCH,"MS Sans Serif"); //Создание шрифта с подчеркиванием HandCursor := LoadCursor(0,IDC_HAND); // Курсор - "рука" для майллабела и кнопок end; WM_COMMAND: begin ..... if (HIWORD(wParam)=STN_CLICKED) and (lParam=Label6) then begin ShellExecute( SCDWnd, "open", "http://www.nickdenry.narod.ru", nil, nil, 0); end; ..... end; ... WM_CTLCOLORSTATIC : {Обработка лабелов} Begin SetBkMode(Wparam,TRANSPARENT); Result:=GetStockObject(Null_Brush); if (wparam<>0) and (lparam=label6) then begin SetTextColor(wparam,rgb(0,0,255)); end; End; ........ begin {start of the program (можешь расметить в любом месте, хоть в том же WM_CREATE} ....... {Создание гипертекстовой ссылки с майлом (суерклассирование)} SCDLabelClassEx.cbSize:=SizeOF(SCDLabelClassEx); GetClassInfoEx(hInstance,"static",SCDLabelClassEx); SCDLabelClassEx.hInstance:=hInstance; SCDLabelClassEx.hCursor:=HandCursor; SCDLabelClassEx.lpszClassName:="scdlabel"; RegisterClassEx(SCDLabelClassEx); label6 := CreateWindow("scdlabel",PChar(scd_caption_site_rus), WS_CHILD or WS_VISIBLE or SS_NOTIFY,110,189,55,15, SCDWnd, 0, hInstance, nil); UnRegisterClass("scdlabel",hInstance); SendMessage(Label6,wm_setfont,UFont,0); ...... end;

таким образом, на основе класса SCDLabelClassEx ты сможешь создавать любое количество гиперрсылок....

Если не понятно, могу еще более детально изложить...

Да и замени

wndMain, lb : THandle;

на wndMain, lb : HWND;

Так оно правильней.

← →
sw (2004-10-16 13:15) [5]

спаситель :)
все работает.
Вопрос только как лучше поместить обработку в WM_COMMAND
у меня там еще меню есть

WM_COMMAND: { Выбран пункт меню }
begin
{ Если выбран нулевой пункт - закрыть программу: }
if (HIWORD(wParam)=STN_CLICKED) then
begin
if (lparam=lbl2) then
ShellExecute(mywnd, "open", "http://www.vasya.ru", nil, nil, 0);
end;
// else
case lo(wparam) of
0: begin
SendMessage(mywnd, WM_CLOSE, 0, 0);
result := 0;
end;
как быть ?

2sw (16.10.04 13:15) [5]

На здоровье :)
Честно говоря, я не совсем понял, что ты спросил второй раз, если не то, уточни :)

Как два варианта обработки WM_COMMAND, могу предложить следующий пример:

WM_COMMAND: Begin if (HIWORD(wParam)=BN_clicked) and (lParam=Button1) then //первая кнопка begin ConfirmExit; end; if (HIWORD(wParam)=BN_CLICKED) and (lParam=Button2) then begin HideSCD; end; if (HIWORD(wParam)=BN_CLICKED) and (lParam=Button3) then begin SaveOptions; end; if (HIWORD(wParam)=BN_CLICKED) and (lParam=Button4) then begin HelpSCD; end; if (HIWORD(wParam)=STN_CLICKED) and (lParam=Label6) then begin GoToHHCSite; end; case wParam of ID_EXIT: begin ConfirmExit; end; ID_HELP: begin HelpSCD; end; ID_HIDE: begin HideSCD; end; ID_OPTIONS: begin ShowSCD; end; ID_OPENCD: begin OpenCD; end; ID_CLOSECD: begin CloseCD; end; ID_RUSSIAN: begin SCDStartInfo.Language:=true; ChangeLanguage; SaveOptions; end; ID_ENGLISH: begin SCDStartInfo.Language:=false; ChangeLanguage; SaveOptions; end; end; result:=0; End;

Т.е. тут case и if ...

сменить курсор у static a. Найти похожие ветки