PureBasic - форум

Тигрёнок · [1992-11-09]

В код-архиве есть пример создания окна на WAPI.

Код:

 
Declare.l WndProc(Wnd, Message, wParam, lParam)  
Declare.l XHiWord(a.l)  
Declare.l XLoWord(a.l)  
 
Global Appname.s,hMenu.l  
Appname = "Meinfenster"  
 
wc.WNDCLASS  
wc\style          =  #CS_VREDRAW | #CS_HREDRAW  
wc\lpfnWndProc    =  @WndProc()  
wc\cbClsExtra     =  0  
wc\cbWndExtra     =  0  
wc\hInstance      =  hInstance  
wc\hIcon          =  LoadIcon_(hInstance, "#1")  
wc\hCursor        =  LoadCursor_(0, #IDC_ARROW)  
wc\hbrBackground  =  CreateSolidBrush_(GetSysColor_(15))  
wc\lpszMenuName   =  0  
wc\lpszClassName  =  @Appname  
RegisterClass_(wc)  
hWnd = CreateWindowEx_(0,Appname,Caption$,#WS_OVERLAPPEDWINDOW,#CW_USEDEFAULT,0,#CW_USEDEFAULT,0,0,0,hInstance,0)  
 
UpdateWindow_(hWnd)  
ShowWindow_(hWnd,#SW_SHOWNORMAL)  
SetForegroundWindow_(hWnd)  
  
hMenu = CreateMenu(0,hWnd)  
MenuTitle("File")  
MenuItem( 1, "Load")  
MenuItem( 2, "Save")  
MenuItem( 3, "Save As")  
MenuBar()  
MenuItem( 4, "Ende")  
 
CreateGadgetList(hWnd)  
ButtonGadget(100,10,10,80,24,"Drьck mich")  
 
 
While GetMessage_(m.MSG, 0, 0, 0)  
  TranslateMessage_(m)  
  DispatchMessage_(m)  
Wend  
 
Procedure.l WndProc(Wnd,Message,wParam,lParam)  
  Returnval.l = DefWindowProc_(Wnd, Message, wParam, lParam)  
  Select Message  
  ; ***************************************************************************  
    Case #WM_COMMAND  
          Select XLoWord(wParam)  
          Case 1  
          MessageRequester("Meldung","Load gewдhlt",0)  
          Case 2  
          MessageRequester("Meldung","Save gewдhlt",0)  
          Case 3  
          MessageRequester("Meldung","Save as...gewдhlt",0)  
          Case 4  
          PostQuitMessage_(0)  
          Case 100  
          MessageRequester("Meldung","Button gedrьckt",0)  
          EndSelect  
  ; ***************************************************************************  
  ; ***************************************************************************  
    Case #WM_CLOSE  
  ; ***************************************************************************  
    UnregisterClass_(Appname,hInstance)  
    PostQuitMessage_(0)  
  EndSelect  
  ProcedureReturn Returnval  
EndProcedure  
 
Procedure.l XHiWord(a.l)  
  ProcedureReturn Int(a / $10000)  
EndProcedure  
 
Procedure.l XLoWord(a.l)  
  ProcedureReturn Int(a - (Int(a/$10000)*$10000))  
EndProcedure

Но в нём есть процедура CreateGadgetList(), которую в PB начиная с версии 4.30~ использовать не рекомендуется. В общем, пример не работает.
Как можно создавать гаджеты на таком окне?

0

Пётр

Тигрёнок написал(а):

Как можно создавать гаджеты на таком окне

С помощью WinAPI нужно создавать.
Какой смысл в создании окна с помощью WinAPI и использования пуриковских гаджетов?

Лучше посмотри этот пример.

Код:

Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hButton
  
  Select Msg
    Case #WM_COMMAND
       If hButton = lParam
         MessageBox_(hWnd,"Ну что ж за день сегодня такой?"+Chr(10)+"Все меня закликали бедную!","Бедная я кнопко!",64)
       EndIf
    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0 
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  
 
InitCommonControls_()
DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
 
WindowClass.s    = "PureBasic_Win" 
wc.WNDCLASSEX 
wc\cbsize        = SizeOf(WNDCLASSEX) 
wc\lpfnWndProc   = @WindowCallback() 
wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
wc\hbrBackground = #COLOR_WINDOW
wc\lpszClassName = @WindowClass 
RegisterClassEx_(@wc) 
 
Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
 
hWndMain  = CreateWindowEx_(0, WindowClass, "Мелкая прога API", #WS_SYSMENU | #WS_MINIMIZEBOX, Win_x, Win_y, 200, 120, 0, 0, 0, 0)
 
Text.s="Бинарник этой проги довольно мелкий и не требует дополнительных DLL для своей работы"
hText=CreateWindowEx_(0,"Static", Text, #WS_CHILD | #WS_VISIBLE, 10,10,180,54, hWndMain, 0, 0, 0)
SendMessage_(hText, #WM_SETFONT, DefaultFont, 1)
 
hButton=CreateWindowEx_(0, "Button", "Типа кнопко", #WS_CHILD | #WS_VISIBLE, 100,64,80,24, hWndMain, 0, 0, 0) 
SendMessage_(hButton, #WM_SETFONT, DefaultFont, 1)
 
 
ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
UpdateWindow_(hWndMain); 
 
While GetMessage_(msg.MSG, #Null, 0, 0 ) 
  TranslateMessage_(msg) 
  DispatchMessage_(msg) 
Wend
End

0

Тигрёнок · [1992-11-09]

Пётр написал(а):

Какой смысл в создании окна с помощью WinAPI и использования пуриковских гаджетов?

Смысла действительно нет. Я увидел пример, и думал, что так и должно быть. Благодарю за разъяснение.

0

Тигрёнок · [1992-11-09]

Ещё вопрос. Я хочу сделать такое окно, которому я буду посылать текстовые сообщения из другой программы. Как-то так:

Код:

Procedure WindowCallback(hWnd, Msg, wParam, lParam)
  Shared hText
  
  Select Msg
    Case #WM_USER
      SendMessage_(hText, #LB_ADDSTRING, 0, lParam)

    Case #WM_CLOSE 
      DestroyWindow_(hWnd) 
    Case #WM_DESTROY 
      PostQuitMessage_(0) : Result  = 0 
    Default 
      Result  = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  EndSelect 
  
  ProcedureReturn Result 
EndProcedure  
 
InitCommonControls_()
DefaultFont = GetStockObject_(#DEFAULT_GUI_FONT)
 
WindowClass.s    = "PureBasic_Win" 
wc.WNDCLASSEX 
wc\cbsize        = SizeOf(WNDCLASSEX) 
wc\lpfnWndProc   = @WindowCallback() 
wc\hCursor       = LoadCursor_(0, #IDC_ARROW) 
wc\hbrBackground = #COLOR_WINDOW
wc\lpszClassName = @WindowClass 
RegisterClassEx_(@wc) 
 
Win_x=GetSystemMetrics_(#SM_CXSCREEN)/2-100
Win_y=GetSystemMetrics_(#SM_CYSCREEN)/2-50
 
hWndMain  = CreateWindowEx_(0, WindowClass, "Мелкая прога API", #WS_SYSMENU | #WS_MINIMIZEBOX, Win_x, Win_y, 300, 400, 0, 0, 0, 0)
 
hText=CreateWindow_("listbox", 0, #WS_CHILD | #WS_VISIBLE | #LBS_STANDARD | #LBS_WANTKEYBOARDINPUT, 5,5,285,345, hWndMain, 0, 0, 0)
SendMessage_(hText, #WM_SETFONT, DefaultFont, 1)

ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) 
UpdateWindow_(hWndMain); 

String.s="Какой-либо текст"
SendMessage_(hWndMain, #WM_USER, 0, @String)

While GetMessage_(msg.MSG, #Null, 0, 0 ) 
  TranslateMessage_(msg) 
  DispatchMessage_(msg) 
Wend
End

Окно должно обрабатывать сообщение
SendMessage_(hWndMain, #WM_USER, 0, @String)

и добавлять в список новый элемент с текстом String,s. Но на практике передать указатель на строку в другое окно не выходит. Как можно передать текстовое сообщение в другое окно?

0

Пётр

Ты хочешь передать указатель на память одного процесса другому?
Так не получится из-за того что процессы изолированы друг от друга.

Нужно узнать PID процесса, которому требуется передать данные, выделить в его контексте требуемый участок памяти, поместить туда передаваемые данные и передать указатель функцией SendMessage_().
В проге, которая принимает данные, нужно прочитать их из памяти, указатель на область которой был передан и освободить память.

Пример передачи (предполагается что hWnd и PID мы уже получили). Это для проги с юникодными строками.

Код:

      If hWnd And PID
        proc = OpenProcess_(#PROCESS_VM_OPERATION|#PROCESS_VM_WRITE, #False, PID)
        If proc
          *ProcMem = VirtualAllocEx_(proc, 0, StringByteLength(String, #PB_Unicode)+10, #MEM_COMMIT, #PAGE_READWRITE)
          If *ProcMem
            WriteProcessMemory_(proc, *ProcMem, @String, StringByteLength(String, #PB_Unicode), #Null)
            SendMessage_(hWnd, #MY_MESSAGE,  $A8F24028, *ProcMem)
            ; Освобождает память нужно в программе, которой передаются данные.
            ;Delay(400)
            ;VirtualFreeEx_(proc, *ProcMem, 0, #MEM_RELEASE)
          EndIf
          CloseHandle_(proc)
        EndIf
      EndIf

----------

Хотя нет, работа в одном процессе.
И более того, у меня все работает как задумано. Какая у тебя возникает ошибка?

0

Тигрёнок · [1992-11-09]

Да-да, именно передать указатель на память одного процесса другому. В теории, так можно передавать и указатель на структуру, верно?
Сделать программу-передатчик я сумел, а вот правильно обработать полученное сообщение что-то не получается. Я использовал PeekS().

0

Тигрёнок · [1992-11-09]

Хм. Заработало. Видимо я задал неверный PID. (будучи нубом, я брал его из диспетчера задач). Работает чётко.

Отредактировано Тигрёнок (14.08.2012 20:09:05)

0

Тигрёнок · [1992-11-09]

На днях нашёл ещё один пример. Вот ссылка.
Меня смутил один момент.

Код:

...
Select uMsg 
...
Case  #WM_NOTIFY
      *pNMHDR.NMHDR = lParam ; - 1
      If *pNMHDR\code = #NM_CUSTOMDRAW
        *pNMCD.NMCUSTOMDRAW = *pNMHDR ; - 2
        ...

Получается, что значение передаваемое в lParam служит указателем сразу на две структуры различного типа. Как это возможно?

0

Пётр

Тигрёнок написал(а):

Получается, что значение передаваемое в lParam служит указателем сразу на две структуры различного типа. Как это возможно?

Возможно потому что в NMCUSTOMDRAW содержится структура NMHDR.

Код:

Structure NMCUSTOMDRAW
  hdr.NMHDR
  dwDrawStage.l
  hdc.i
  rc.RECT
  dwItemSpec.i
  uItemState.l
  lItemlParam.i
EndStructure

0

Изменение интерфейса окна	Вопросы по PureBasic	09.09.2012
Вопросы новичка	Вопросы по PureBasic	23.12.2010

PureBasic - форум

Меню навигации

Пользовательские ссылки

Информация о пользователе

Окно на Win API

Сообщений 1 страница 9 из 9

Поделиться106.08.2012 18:33:19

Поделиться206.08.2012 18:42:38

Поделиться306.08.2012 18:55:25

Поделиться414.08.2012 15:42:06

Поделиться514.08.2012 19:16:19

Поделиться614.08.2012 20:01:04

Поделиться714.08.2012 20:08:44

Поделиться828.08.2012 12:35:21

Поделиться928.08.2012 13:57:21

Похожие темы