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

Тема в разделе "C/C++/C#", создана пользователем Dock1100, 12 май 2011.

Статус темы:
Закрыта.
  1. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Есть код на С++(неправильно переведена только та функция что ниже)(переводится вот это):
    Код (C++):
    ...

    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;
    }

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


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

    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;

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

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    return - это выход, тут не надо выйти после присваивания результата:
    ?
    exit или как там выход из процедуры... я уже не помню, как красиво на паскале выйти :( - у меня только на java/javascript - return и на vb/lotusscript Exit sub вспомнились=)

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

    Dock1100 :-]

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

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    stdcall не надо добавлять - в твоем случае это по дефолту идет?
     
  5. lazybiz

    lazybiz Well-Known Member
    C\C++ Team

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

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    В общем как оказалось ошибка была не только там, а во всём коде.
    Вот работающий вариант:
    Код (Delphi):
    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.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей