Перевод кода из C++ в Pascal

[Dock1100]

Есть код на С++(неправильно переведена только та функция что ниже)(переводится

Ссылка скрыта от гостей

):

...

HWND APIENTRY InitializeCustomItem(TODAYLISTITEM *ptli,
HWND hwndParent)
{
WNDCLASS	  wc;
HWND	 hWnd = NULL;

if (ptli->fEnabled==0) return NULL;
hInstance = ptli->hinstDLL;			 

wc.style		 = CS_HREDRAW | CS_VREDRAW;
wc.lpfnWndProc	= (WNDPROC) WndProc;
wc.cbClsExtra			 = 0;
wc.cbWndExtra			 = 0;
wc.hInstance			 = hInstance;
wc.hIcon		 = 0;
wc.hCursor		= 0;
wc.hbrBackground = (HBRUSH) GetStockObject(LTGRAY_BRUSH);
wc.lpszMenuName  = 0;
wc.lpszClassName = TEXT("MyToday");
RegisterClass(&wc);

hWnd = CreateWindow(TEXT("MyToday"), TEXT("MyTodayScreen"),
WS_VISIBLE|WS_CHILD,CW_USEDEFAULT,CW_USEDEFAULT, 
240, 25, hwndParent, NULL, hInstance, NULL);
return hWnd;
}

...

результатом её выполнения должно быть вот это:



Пытаюсь уже второй день правильно перевести его на паскаль:

...

type PTODAYLISTITEM=^TODAYLISTITEM;

function InitializeCustomItem(ptli: PTODAYLISTITEM; hwndParent: HWND):HWND; export;
var wc:WNDCLASSW;
hWnd_:HWND=0;
begin
if (ptli^.fEnabled=false) then result := 0;
hInstance := ptli^.hinstDLL;

wc.style			:= CS_HREDRAW or CS_VREDRAW;
wc.lpfnWndProc		:= @WndProc;//WndProc - процедура обработки сообщений окна
wc.cbClsExtra		:= 0;
wc.cbWndExtra		:= 0;
wc.hInstance		:= hInstance;
wc.hIcon			:= 0;
wc.hCursor			:= 0;
wc.hbrBackground	:= HBRUSH(GetStockObject(LTGRAY_BRUSH));
wc.lpszMenuName		:= nil;
wc.lpszClassName	:= 'MyToday';
Windows.RegisterClass(wc);

hWnd_ := CreateWindow('MyToday','MyTodayScreen',WS_CHILD or WS_VISIBLE,
CW_USEDEFAULT,CW_USEDEFAULT,240,25, hwndParent, 0, hInstance, nil);
result := hWnd_;
end; 

...

а в результате получается вот это(окно налазит, перекрывает елементы, и если открыть что либо(программу, папку...), то оно исщезает):

 

[hosm]

if (ptli->fEnabled==0) return NULL;

return - это выход, тут не надо выйти после присваивания результата:

if (ptli^.fEnabled=false) then result := 0;

?
exit или как там выход из процедуры... я уже не помню, как красиво на паскале выйти - у меня только на java/javascript - return и на vb/lotusscript Exit sub вспомнились=)

Добавлено: таки exit =) короче, попробуй так:
if (ptli^.fEnabled=false) then begin result := 0; exit end;

 

[Dock1100]

exit или как там выход из процедуры...

Да exit, если его дописать то ничего не отображается,
Кстати если заменить hInstance := ptli^.hinstDLL; на hInstance := 0; то результат не изменится, тоесть скорее всего что-то не так с параметром ptli, но что?

 

[hosm]

stdcall не надо добавлять - в твоем случае это по дефолту идет?

 

[lazybiz]

Проверь, параметр hwndParent правильный передается в функцию?
И еще, если у тебя структура wc Юникодовская (WNDCLASSW) то и вызывать надо судя по всему Юникодовскую функцию RegisterClassW.
Может тебе нужно просто определить wc с типом WNDCLASS а не WNDCLASSW !?
Проверь на наличие ошибки функцию RegisterClass.

 

[Dock1100]

В общем как оказалось ошибка была не только там, а во всём коде.
Вот работающий вариант:

library MyToday;

{$mode delphi}{$H+}
{$R *.res}

uses
Windows, todaycmn;

var
g_hInst: HModule;
g_hWnd: HWND;
g_Sel: boolean;

const
APPNAME = 'MyToday';
g_Height = 30;

procedure memset(P: Pointer; B: Byte; count: Integer);cdecl;
begin
FillChar(P^, count, B);
end;

function MyWndProc(hwnd_: hwnd; msg: UINT; wParam_: WPARAM; lParam_: LPARAM): LResult; cdecl;
var
ps: PAINTSTRUCT;
hdc_: HDC;
ptli: PTODAYLISTITEM;
backBrush:HBrush;
winRect, parentRect: RECT;
twm: TODAYDRAWWATERMARKINFO;
ptwm: ^TODAYDRAWWATERMARKINFO;
begin
case msg of
WM_TODAYCUSTOM_RECEIVEDSELECTION:
begin
g_Sel := true;
Result := LResult(true);
end;
WM_TODAYCUSTOM_LOSTSELECTION:
begin
g_Sel := false;
Result := LResult(true);
end;
WM_LBUTTONUP, WM_TODAYCUSTOM_ACTION:
begin
MessageBox(hwnd_, 'Action', APPNAME, MB_OK);
Result := LResult(false);
end;
WM_TODAYCUSTOM_QUERYREFRESHCACHE:
begin
ptli := Pointer(wParam_);
if ptli.cyp <> g_Height then
begin
ptli.cyp := g_Height;
Result := LResult(true);
end
else
Result := LResult(false);
end;
WM_ERASEBKGND:
begin
Result := LResult(false);
end;
WM_PAINT:
begin
hdc_ := BeginPaint(hwnd_, ps);
GetClientRect(hwnd_, winRect);
backBrush := CreateSolidBrush(SendMessage(GetParent(hwnd_), TODAYM_GETCOLOR, TODAYCOLOR_HIGHLIGHT, 0));
SetBkMode(hdc_, TRANSPARENT);
if g_Sel then
begin
FillRect(hdc_, winRect, backBrush);
SetTextColor(hdc_, SendMessage(GetParent(hwnd_), TODAYM_GETCOLOR, TODAYCOLOR_HIGHLIGHTEDTEXT, 0));
winRect.left := 5;
DrawText(hdc_, 'Hello World(selected)', -1, winRect, DT_VCENTER);
end
else
begin
ptwm := Pointer(@twm);
twm.hdc_ := hdc_;
twm.hwnd_ := hwnd_;
twm.rc := winRect;
SendMessage(GetParent(hwnd_), TODAYM_DRAWWATERMARK, 0, LongInt(ptwm));
SetTextColor(hdc_, SendMessage(GetParent(hwnd_), TODAYM_GETCOLOR, TODAYCOLOR_TEXT, 0));
winRect.left := 5;
DrawText(hdc_, 'Hello World', -1, winRect, DT_VCENTER);
end;
DeleteObject(backBrush);
EndPaint(hwnd_, ps);
Result := LResult(false);
end;
WM_WINDOWPOSCHANGED:
begin
GetClientRect(hwnd_, winRect);
GetClientRect(GetParent(hwnd_), parentRect);
if (winRect.Right <> parentRect.Right) then SetWindowPos(hwnd_, NULL, 0, 0, parentRect.Right, g_Height, SWP_NOMOVE or SWP_NOZORDER);
Result := LResult(false);
end;
WM_TODAYCUSTOM_CLEARCACHE:
begin
Result := LResult(false);
end;
WM_COMMAND:
begin
Result := DefWindowProc(hwnd_, msg, wParam_, lParam_);
end;
else
begin
Result := DefWindowProc(hwnd_, msg, wParam_, lParam_);
end;
end;
end;

function InitializeClasses(): integer;
var
wc : TWndClass;
begin
memset(@wc, 0, SizeOf(wc));
wc.style := CS_HREDRAW or CS_VREDRAW;
wc.lpfnWndProc := @MyWndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := g_hInst;
wc.hIcon := 0;
wc.hCursor := 0;
wc.hbrBackground := HBRUSH((COLOR_WINDOW + 1));
wc.lpszClassName := APPNAME;
wc.lpszMenuName := 0;
Result := RegisterClass(wc);
if Result = 0 then
begin
MessageBox (0, 'Class not register!', 'Error!', MB_ICONSTOP);
Halt (1)
end;
end;

function InitializeCustomItem(var ptli: TODAYLISTITEM; hwndParent: hwnd): Hwnd; cdecl; export;
begin
if not(ptli.fEnabled) then
begin
Result := 0;
Exit;
end;
g_hWnd := CreateWindow(APPNAME,APPNAME,WS_CHILD or WS_VISIBLE,
CW_USEDEFAULT,CW_USEDEFAULT,GetSystemMetrics(SM_CXSCREEN),g_Height,
hwndParent, NULL, g_hInst, nil);
ShowWindow(g_hWnd, SW_SHOW);
Result := g_hWnd;
end;


exports
InitializeCustomItem index 240;

initialization
g_hInst := HINSTANCE;
InitializeClasses();
g_Sel := false;

finalization
UnregisterClass(LPCTSTR(APPNAME), g_hInst);
g_hInst := NULL;

end.