1. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление

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

Тема в разделе "Вопросы новичков и не только", создана пользователем Dock1100, 12 май 2011.

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

    Dock1100 :-]

    Репутация:
    0
    Регистрация:
    9 ноя 2009
    Сообщения:
    665
    Симпатии:
    1
    Есть код на С++(неправильно переведена только та функция что ниже)(переводится вот это):
    Код:
    ...
    
    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;
    }
    
    ...
    результатом её выполнения должно быть вот это:
    Перевод кода из C++ в Pascal


    Пытаюсь уже второй день правильно перевести его на паскаль:
    Код:
    ...
    
    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; 
    
    ...
    а в результате получается вот это(окно налазит, перекрывает елементы, и если открыть что либо(программу, папку...), то оно исщезает):
    Перевод кода из C++ в Pascal Перевод кода из C++ в Pascal
     
  2. hosm

    hosm * so what *

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

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

    Dock1100 :-]

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

    hosm * so what *

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

    lazybiz Well-Known Member

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

    Dock1100 :-]

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

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