PureBasic - форум

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

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » Программирование на PureBasic » Процедуры


Процедуры

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

1

Как из процедуры удобнее вернуть 5-6 параметров. У меня на ум приходит извращенный метод. Переслать их в строке типа: 67  55  44  88  22 . А потом считать с помощью MID. Плохо что нельзя вернуть массив, это был бы лучший вариант.

0

2

haav написал(а):

Как из процедуры удобнее вернуть 5-6 параметров

Как вариант, передать процедуре указатель на структуру и заполнить её возвращаемыми данными.

Код:
Structure Proba
 x.l
 y.l
 Text.s
 z.l
EndStructure

x.Proba

Procedure Proba(*x.Proba)
 *x\x=10
 *x\y=20
 *x\Text="Строка текста"
 *x\z=100
EndProcedure

Proba(@x)

Debug x\x
Debug x\y
Debug x\Text
Debug x\z
haav написал(а):

Плохо что нельзя вернуть массив, это был бы лучший вариант

Всё можно. :)

Код:
Dim proba(10)

Procedure ProbaArray(Array proba(1))

For i=0 To 10
 proba(i)=i
Next i

EndProcedure

ProbaArray(proba())

For i=0 To 10
 Debug proba(i)
Next i

0

3

Я забыл в вопросе указать из ProcedureDLL.  Первый вариант похоже подойдет. Не знаю только не потрутся данные структуры после завершения DLL. То есть я хочу себе сделать библиотечку.

Отредактировано haav (08.03.2010 18:18:43)

0

4

haav написал(а):

Первый вариант похоже подойдет. Не знаю только не потрутся данные структуры после завершения DLL

Нет не потрутся.
Дело в том, что это будет структура не DLLки, а основной проги.
Да и поидее и с массивом должно получится, но проверять нужно. Ведь процедуре передаётся не сам массив, а лишь указать на него. Попробуй.
Размер массива узнаём так:

Код:
size=ArraySize(proba())

0

5

Че то я запутался, да и вообще код с метками еще мало понимаю. Вот это как я понял надо в DLL

Код:
Structure Proba
 x.l
 y.l
 Text.s
 z.l
EndStructure

x.Proba

Procedure Proba(*x.Proba)
 *x\x=10
 *x\y=20
 *x\Text="Строка текста"
 *x\z=100
EndProcedure

Надо возращать адрес? Типа так ?

Код:
procedurereturn x

А в коде:

Код:
Proba(@x)

Debug x\x
Debug x\y
Debug x\Text

Ругается компилятор.  Я просто недопонимаю.

Debug x\z

0

6

haav написал(а):

Че то я запутался, да и вообще код с метками еще мало понимаю

О каких метках идёт речь?

haav написал(а):

Надо возращать адрес? Типа так ?

Зачем? Адрес мы уже знаем.

haav написал(а):

Ругается компилятор.

Что пишет?

Вот код DLLки.

Код:
Structure Proba
 x.l
 y.l
 Text.s
 z.l
EndStructure


ProcedureDLL Proba(*x.Proba)
 *x\x=10
 *x\y=20
 *x\Text="Строка текста"
 *x\z=100
EndProcedure

Вот её вызов

Код:
Structure Proba
 x.l
 y.l
 Text.s
 z.l
EndStructure

x.Proba

If OpenLibrary(1,"DLL.dll")
  CallFunction(1,"Proba",@x)
  Debug x\x
  Debug x\y
  Debug x\Text
  Debug x\z
EndIf

Файлы http://depositfiles.com/files/worcxpzw9

0

7

Во блин я в коде структуру не задавал, думал что она автоматом из DLL подгружается. Вот у меня и ругался на неизвестную структуру.

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

О каких метках идёт речь?

Этим я считаю адрес вызова.   :)  То есть это своеобразная метка в памяти на которую прыгает прога.

0

8

Все работает спасибо! Файлы уж я не скачивал, код твой скопировал и попробовал.

0

9

haav написал(а):

Этим я считаю адрес вызова

Это называется указателем (Pointer).
Указателем на обрасть памяти.

0

10

Вроде все делал как у тебя, вообще ничего не понимаю  %-)

Вот код DLL:

Код:
 
Structure ba
x.f
y.f
width.f
height.f
EndStructure

Structure ban
tx.f
ty.f
twidth.f
theight.f
EndStructure

Global *rrrrr.ban

ProcedureDLL razmer(*u.ba)
 
  *u\x=*rrrrr\tx
  *u\y=*rrrrr\ty
  *u\y=*rrrrr\twidth
  *u\height=*rrrrr\theight
EndProcedure

Procedure OnMouseSelection(fffffff,x_x,y_y,width_x,height_y) 

  *rrrrr\tx=x_x
  *rrrrr\ty=y_y
  *rrrrr\twidth=width_x
 *rrrrr\theight=height_y
  razmer(*rrrrr.ban)

EndProcedure 

Procedure DrawMouseSelector(fffffff) 
nnp=0
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  If WindowProc_MouseSelectStartX > WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectStartX 
  Else 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectStartX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectLastX 
  EndIf 
  If WindowProc_MouseSelectStartY > WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectStartY 
  Else 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectStartY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectLastY 
  EndIf 

  hDC = GetDC_(fffffff) 
  
    ;InvertRect_(hDC,@WindowProc_MouseSelectRect)   ; изменяет пиксели( инвертирует)

    DrawFocusRect_(hDC,@WindowProc_MouseSelectRect) ;Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.

    ReleaseDC_(fffffff,hDC) 

EndProcedure 


Procedure WindowProc(fffffff,Msg,wParam,lParam) 

 
  Shared WindowProc_MouseSelect 
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  Select Msg 
  
    Case #WM_LBUTTONDOWN 

         WindowProc_MouseSelect  = 1 
         WindowProc_MouseSelectStartX = lParam&$FFFF  ; определяют любое расстояние  по оси Х (без нее все время будет от нуля)
         WindowProc_MouseSelectStartY = (lParam>>16)&$FFFF  ; определяют любое расстояние  по оси Y (без нее все время будет от нуля)
 
         GetClientRect_(fffffff,winrect.RECT) 
         MapWindowPoints_(fffffff,0,winrect,2)  ;преобразует (отображает) ряд точек относительно координатного пространства одного окна  относительно координатного пространства другого окна.
         ClipCursor_(winrect)          ;ограничитель курсора в рамке окна
       ProcedureReturn 0 
    Case #WM_LBUTTONUP 
 
      If WindowProc_MouseSelect > 1 
        
         DrawMouseSelector(fffffff)  ; отлючив ее инвертация(изображение) остается
     
        If WindowProc_MouseSelectRect\left <> WindowProc_MouseSelectRect\right And WindowProc_MouseSelectRect\top <> WindowProc_MouseSelectRect\bottom 
         OnMouseSelection(fffffff,WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\top,WindowProc_MouseSelectRect\right-WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\bottom-WindowProc_MouseSelectRect\top) 
         SetCapture_(0) ;устанавливает захват мыши в заданном окне, принадлежащем текущему потоку.
        EndIf 
      EndIf 
      ClipCursor_(0) 
      WindowProc_MouseSelect = 0 
      ProcedureReturn 0 
 
    Case #WM_MOUSEMOVE   
      If WindowProc_MouseSelect > 0 And wParam & #MK_LBUTTON 
        If WindowProc_MouseSelect > 1 
          DrawMouseSelector(fffffff)
        Else 
          WindowProc_MouseSelect + 1 
        EndIf 
          WindowProc_MouseSelectLastX = lParam&$FFFF
          WindowProc_MouseSelectLastY = (lParam>>16)&$FFFF 
        DrawMouseSelector(fffffff) 
        SetCapture_(fffffff) 
      EndIf 
      ProcedureReturn 0 
   
  EndSelect 
   
   old=GetWindowLong_(fffffff,#GWL_USERDATA) ;извлекает информацию об определяемом окне.
  If old 
    ProcedureReturn CallWindowProc_(old,fffffff,Msg,wParam,lParam) ;  передает информацию сообщения процедуре заданного окна.
  Else 
    DefWindowProc_(fffffff,Msg,wParam,lParam) ;Функция DefWindowProc вызывается оконной процедурой по умолчанию, чтобы обеспечить обработку по умолчанию любого сообщения окна, которые приложение не обрабатывает. Эта функция гарантирует то, что обрабатывается каждое сообщение. Функция DefWindowProc вызывается с теми же самыми параметрами, принятыми оконной процедурой.
  EndIf 


EndProcedure 

ProcedureDLL SelectorImage(a)

    old = SetWindowLong_(a,#GWL_WNDPROC,@WindowProc()) ; Устанавливает информацию для окна
    SetWindowLong_(a,#GWL_USERDATA,old) 
    
  ProcedureReturn old
EndProcedure 

ProcedureDLL SelectorFreeImage(a, old)
  SetWindowLong_(a,#GWL_WNDPROC,old) ; Устанавливает информацию для окна 
EndProcedure

Вот код EXE:

Код:
  Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global u.ba

If OpenLibrary(1,"DLLCUR.dll")<>0
  dll=1
EndIf  

Procedure vv()
  CallFunction(1,"razmer",@u)
 If u\x<>0 Or u\y<>0 Or u\width<>0 Or u\height<>0
     Debug u\x
     Debug u\y
     Debug u\width
     Debug u\height
 EndIf
 EndProcedure



If LoadImage(1,"FEN.bmp")
Else
  End
EndIf

If OpenWindow(0,100,100,500,500,"")
    ImageGadget(0,0,0,500,500,ImageID(1))
    gad=GadgetID(0)
EndIf

CallFunction(1,"SelectorImage",gad)

Repeat

    ev=WaitWindowEvent()

   If dll=1
      vv()
   EndIf

Until ev=16

CallFunction(1,"SelectorFreeImage",gad,old)
CloseLibrary(1)

Вываливается ошибка и все тут.  :(

0

11

haav написал(а):

Structure ba
x.f
y.f
width.f
height.f
EndStructure

Structure ban
tx.f
ty.f
twidth.f
theight.f
EndStructure

Зачем две одинаковые структуры, да ещё и с флоатными переменными?
Тут нужен тип LONG.
Да и побольшому счёту, можно было-бы использовать готовую структуру RECT и не изобретать колесо.

Теперь о том, почему не работало.
Вот сравни этот код, с твоим и найди отличия.

Код:
Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global rrrrr.ba

ProcedureDLL razmer(*u.ba)
 
  *u\x=rrrrr\x
  *u\y=rrrrr\y
  *u\y=rrrrr\width
  *u\height=rrrrr\height
EndProcedure

Procedure OnMouseSelection(fffffff,x_x,y_y,width_x,height_y) 

  rrrrr\x=x_x
  rrrrr\y=y_y
  rrrrr\width=width_x
  rrrrr\height=height_y
  razmer(@rrrrr)
EndProcedure

.

DLLка

Код:
Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global rrrrr.ba

ProcedureDLL razmer(*u.ba)
 
  *u\x=rrrrr\x
  *u\y=rrrrr\y
  *u\y=rrrrr\width
  *u\height=rrrrr\height
EndProcedure

Procedure OnMouseSelection(fffffff,x_x,y_y,width_x,height_y) 

  rrrrr\x=x_x
  rrrrr\y=y_y
  rrrrr\width=width_x
  rrrrr\height=height_y
  razmer(@rrrrr)
EndProcedure 

Procedure DrawMouseSelector(fffffff) 
nnp=0
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  If WindowProc_MouseSelectStartX > WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectStartX 
  Else 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectStartX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectLastX 
  EndIf 
  If WindowProc_MouseSelectStartY > WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectStartY 
  Else 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectStartY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectLastY 
  EndIf 

  hDC = GetDC_(fffffff) 
  
    ;InvertRect_(hDC,@WindowProc_MouseSelectRect)   ; изменяет пиксели( инвертирует)

    DrawFocusRect_(hDC,@WindowProc_MouseSelectRect) ;Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.

    ReleaseDC_(fffffff,hDC) 

EndProcedure 


Procedure WindowProc(fffffff,Msg,wParam,lParam) 

 
  Shared WindowProc_MouseSelect 
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  Select Msg 
  
    Case #WM_LBUTTONDOWN 

         WindowProc_MouseSelect  = 1 
         WindowProc_MouseSelectStartX = lParam&$FFFF  ; определяют любое расстояние  по оси Х (без нее все время будет от нуля)
         WindowProc_MouseSelectStartY = (lParam>>16)&$FFFF  ; определяют любое расстояние  по оси Y (без нее все время будет от нуля)
 
         GetClientRect_(fffffff,winrect.RECT) 
         MapWindowPoints_(fffffff,0,winrect,2)  ;преобразует (отображает) ряд точек относительно координатного пространства одного окна  относительно координатного пространства другого окна.
         ClipCursor_(winrect)          ;ограничитель курсора в рамке окна
       ProcedureReturn 0 
    Case #WM_LBUTTONUP 
 
      If WindowProc_MouseSelect > 1 
        
         DrawMouseSelector(fffffff)  ; отлючив ее инвертация(изображение) остается
     
        If WindowProc_MouseSelectRect\left <> WindowProc_MouseSelectRect\right And WindowProc_MouseSelectRect\top <> WindowProc_MouseSelectRect\bottom 
         OnMouseSelection(fffffff,WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\top,WindowProc_MouseSelectRect\right-WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\bottom-WindowProc_MouseSelectRect\top) 
         SetCapture_(0) ;устанавливает захват мыши в заданном окне, принадлежащем текущему потоку.
        EndIf 
      EndIf 
      ClipCursor_(0) 
      WindowProc_MouseSelect = 0 
      ProcedureReturn 0 
 
    Case #WM_MOUSEMOVE   
      If WindowProc_MouseSelect > 0 And wParam & #MK_LBUTTON 
        If WindowProc_MouseSelect > 1 
          DrawMouseSelector(fffffff)
        Else 
          WindowProc_MouseSelect + 1 
        EndIf 
          WindowProc_MouseSelectLastX = lParam&$FFFF
          WindowProc_MouseSelectLastY = (lParam>>16)&$FFFF 
        DrawMouseSelector(fffffff) 
        SetCapture_(fffffff) 
      EndIf 
      ProcedureReturn 0 
   
  EndSelect 
   
   old=GetWindowLong_(fffffff,#GWL_USERDATA) ;извлекает информацию об определяемом окне.
  If old 
    ProcedureReturn CallWindowProc_(old,fffffff,Msg,wParam,lParam) ;  передает информацию сообщения процедуре заданного окна.
  Else 
    DefWindowProc_(fffffff,Msg,wParam,lParam) ;Функция DefWindowProc вызывается оконной процедурой по умолчанию, чтобы обеспечить обработку по умолчанию любого сообщения окна, которые приложение не обрабатывает. Эта функция гарантирует то, что обрабатывается каждое сообщение. Функция DefWindowProc вызывается с теми же самыми параметрами, принятыми оконной процедурой.
  EndIf 


EndProcedure 

ProcedureDLL SelectorImage(a)

    old = SetWindowLong_(a,#GWL_WNDPROC,@WindowProc()) ; Устанавливает информацию для окна
    SetWindowLong_(a,#GWL_USERDATA,old) 
    
  ProcedureReturn old
EndProcedure 

ProcedureDLL SelectorFreeImage(a, old)
  SetWindowLong_(a,#GWL_WNDPROC,old) ; Устанавливает информацию для окна 
EndProcedure

Прога.

Код:
Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global u.ba

If OpenLibrary(1,"E:\DLLCUR.dll")<>0
  dll=1
EndIf  

Procedure vv()
  CallFunction(1,"razmer",@u)
 If u\x<>0 Or u\y<>0 Or u\width<>0 Or u\height<>0
     Debug u\x
     Debug u\y
     Debug u\width
     Debug u\height
 EndIf
 EndProcedure



If LoadImage(1,"FEN.bmp")
Else
  End
EndIf


If OpenWindow(0,100,100,500,500,"")
    ImageGadget(0,0,0,500,500,ImageID(1))
    gad=GadgetID(0)
EndIf

old=CallFunction(1,"SelectorImage",gad)

Repeat

    ev=WaitWindowEvent()

   If dll=1
      vv()
   EndIf

Until ev=16

CallFunction(1,"SelectorFreeImage",gad,old)
CloseLibrary(1)

0

12

Зачем две одинаковые структуры, да ещё и с флоатными переменными?
Тут нужен тип LONG.

Изначально он у меня и был, это я потом начал слепо все менять от безысходности. Я понял ошибку, спасибо.

0

13

А из DLL можно вызывать функцию находящуюся в файле EXE? Это я к тому, чтобы вообще обойтись без моих структур.

0

14

haav написал(а):

А из DLL можно вызывать функцию находящуюся в файле EXE?

Теоритически да, но нужно проверить. Я так делал, правда, в библиотеке для пурика XP_Menu_Lib в функции XP_SetSideText_CB.

DLLке передаёшь указатель на процедуру основной проги (указатель получаем с помощью собаки).
В DLLке вызываем процедуру по указателю с помощью CallFunctionFast.

haav написал(а):

Это я к тому, чтобы вообще обойтись без моих структур.

А какая связь между вызовом процедуры основной проги и структурами?

0

15

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

А какая связь между вызовом процедуры основной проги и структурами?

В кодах выше для того чтобы узнать размеры выделяемой области, надо посылать постоянно запрос в процедуру. Отсюда все мои вопросы и были. С другой стороны если есть возможность посылать прямо из dll в exe, когда выделение сделано, это и быстрее и продуктивнее мне кажется.

0

16

Вроде работает.

DLL

Код:
Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global rrrrr.ba, *ProcPoint

ProcedureDLL razmer(*u.ba)
 
  *u\x=rrrrr\x
  *u\y=rrrrr\y
  *u\y=rrrrr\width
  *u\height=rrrrr\height
EndProcedure

Procedure OnMouseSelection(fffffff,x_x,y_y,width_x,height_y) 

  ;rrrrr\x=x_x
  ;rrrrr\y=y_y
  ;rrrrr\width=width_x
  ;rrrrr\height=height_y
  ;razmer(@rrrrr)
  If *ProcPoint
    CallFunctionFast(*ProcPoint,x_x,y_y,width_x,height_y)
  EndIf
EndProcedure 

Procedure DrawMouseSelector(fffffff) 
nnp=0
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  If WindowProc_MouseSelectStartX > WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectLastX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectStartX 
  Else 
    WindowProc_MouseSelectRect\left   = WindowProc_MouseSelectStartX 
    WindowProc_MouseSelectRect\right  = WindowProc_MouseSelectLastX 
  EndIf 
  If WindowProc_MouseSelectStartY > WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectLastY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectStartY 
  Else 
    WindowProc_MouseSelectRect\top    = WindowProc_MouseSelectStartY 
    WindowProc_MouseSelectRect\bottom = WindowProc_MouseSelectLastY 
  EndIf 

  hDC = GetDC_(fffffff) 
  
    ;InvertRect_(hDC,@WindowProc_MouseSelectRect)   ; изменяет пиксели( инвертирует)

    DrawFocusRect_(hDC,@WindowProc_MouseSelectRect) ;Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.

    ReleaseDC_(fffffff,hDC) 

EndProcedure 


Procedure WindowProc(fffffff,Msg,wParam,lParam) 

 
  Shared WindowProc_MouseSelect 
  Shared WindowProc_MouseSelectStartX, WindowProc_MouseSelectLastX 
  Shared WindowProc_MouseSelectStartY, WindowProc_MouseSelectLastY 
  Shared WindowProc_MouseSelectRect.RECT 

  Select Msg 
  
    Case #WM_LBUTTONDOWN 

         WindowProc_MouseSelect  = 1 
         WindowProc_MouseSelectStartX = lParam&$FFFF  ; определяют любое расстояние  по оси Х (без нее все время будет от нуля)
         WindowProc_MouseSelectStartY = (lParam>>16)&$FFFF  ; определяют любое расстояние  по оси Y (без нее все время будет от нуля)
 
         GetClientRect_(fffffff,winrect.RECT) 
         MapWindowPoints_(fffffff,0,winrect,2)  ;преобразует (отображает) ряд точек относительно координатного пространства одного окна  относительно координатного пространства другого окна.
         ClipCursor_(winrect)          ;ограничитель курсора в рамке окна
       ProcedureReturn 0 
    Case #WM_LBUTTONUP 
 
      If WindowProc_MouseSelect > 1 
        
         DrawMouseSelector(fffffff)  ; отлючив ее инвертация(изображение) остается
     
        If WindowProc_MouseSelectRect\left <> WindowProc_MouseSelectRect\right And WindowProc_MouseSelectRect\top <> WindowProc_MouseSelectRect\bottom 
         OnMouseSelection(fffffff,WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\top,WindowProc_MouseSelectRect\right-WindowProc_MouseSelectRect\left,WindowProc_MouseSelectRect\bottom-WindowProc_MouseSelectRect\top) 
         SetCapture_(0) ;устанавливает захват мыши в заданном окне, принадлежащем текущему потоку.
        EndIf 
      EndIf 
      ClipCursor_(0) 
      WindowProc_MouseSelect = 0 
      ProcedureReturn 0 
 
    Case #WM_MOUSEMOVE   
      If WindowProc_MouseSelect > 0 And wParam & #MK_LBUTTON 
        If WindowProc_MouseSelect > 1 
          DrawMouseSelector(fffffff)
        Else 
          WindowProc_MouseSelect + 1 
        EndIf 
          WindowProc_MouseSelectLastX = lParam&$FFFF
          WindowProc_MouseSelectLastY = (lParam>>16)&$FFFF 
        DrawMouseSelector(fffffff) 
        SetCapture_(fffffff) 
      EndIf 
      ProcedureReturn 0 
   
  EndSelect 
   
   old=GetWindowLong_(fffffff,#GWL_USERDATA) ;извлекает информацию об определяемом окне.
  If old 
    ProcedureReturn CallWindowProc_(old,fffffff,Msg,wParam,lParam) ;  передает информацию сообщения процедуре заданного окна.
  Else 
    DefWindowProc_(fffffff,Msg,wParam,lParam) ;Функция DefWindowProc вызывается оконной процедурой по умолчанию, чтобы обеспечить обработку по умолчанию любого сообщения окна, которые приложение не обрабатывает. Эта функция гарантирует то, что обрабатывается каждое сообщение. Функция DefWindowProc вызывается с теми же самыми параметрами, принятыми оконной процедурой.
  EndIf 


EndProcedure 

ProcedureDLL SelectorImage(a, *Proc_Point)
    *ProcPoint=*Proc_Point
    old = SetWindowLong_(a,#GWL_WNDPROC,@WindowProc()) ; Устанавливает информацию для окна
    SetWindowLong_(a,#GWL_USERDATA,old) 
    
  ProcedureReturn old
EndProcedure 

ProcedureDLL SelectorFreeImage(a, old)
  SetWindowLong_(a,#GWL_WNDPROC,old) ; Устанавливает информацию для окна 
EndProcedure

EXE

Код:
Structure ba
x.l
y.l
width.l
height.l
EndStructure

Global u.ba

If OpenLibrary(1,"E:\DLLCUR.dll")<>0
  dll=1
EndIf  

Procedure vv()
  CallFunction(1,"razmer",@u)
 If u\x<>0 Or u\y<>0 Or u\width<>0 Or u\height<>0
     Debug u\x
     Debug u\y
     Debug u\width
     Debug u\height
 EndIf
 EndProcedure

Procedure DLL_Proc(x_x,y_y,width_x,height_y)
 Debug x_x
 Debug y_y
 Debug width_x
 Debug height_y
EndProcedure

If LoadImage(1,"FEN.bmp")
Else
  End
EndIf


If OpenWindow(0,100,100,500,500,"")
    ImageGadget(0,0,0,500,500,ImageID(1))
    gad=GadgetID(0)
EndIf

old=CallFunction(1,"SelectorImage",gad, @DLL_Proc())

Repeat

    ev=WaitWindowEvent()

   If dll=1
     ; vv()
   EndIf

Until ev=16

CallFunction(1,"SelectorFreeImage",gad,old)
CloseLibrary(1)

0

17

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

Вроде работает.

А у меня после выделения области  сразу закрывается окно, но приложение работает. Кстати а где ты тут отправил адрес процедуры? Я попробовал что то типа @ffff  в качестве параметра передать, но прога вылетает. конечно перед этим создал процедуру ffff

Отредактировано haav (13.03.2010 17:19:11)

0

18

haav написал(а):

а где ты тут отправил адрес процедуры

Вот

Код:
old=CallFunction(1,"SelectorImage",gad, @DLL_Proc())
haav написал(а):

Я попробовал что то типа @ffff  в качестве параметра передать, но прога вылетает

Скобки надо было ставить, типа @ffff(), а иначе, компилятор считал что нужно определить адрес переменной ffff

0

19

Теперь все работает, хороший урок. Спасибо Петр, а куда теперь DLL то выложить? Вещь то нужная, новичкам конечно в большей степени.

0

20

Ну сюда выложи.

0

21

Готовая к применению библиотека для работы с выделением нужной области на изображении в заданном окне:

Скачать

А это пример ее использования:

Код:
 

; Пример использования библиотеки DLLCUR.dll
; Библиотека создана Высочанским Пётром
; Библиотека может быть использована для различных фоторедакторов.
; Функция библиотеки:      выделение области в заданном изображении и вывод размеров выделения.



If OpenLibrary(1,"DLLCUR.dll")=0            
End     
EndIf  



Procedure DLL_Proc(x_x,y_y,width_x,height_y)
 Debug x_x
 Debug y_y
 Debug width_x
 Debug height_y
EndProcedure

If LoadImage(1,"FEN.bmp")   ; ФОТО поставьте свое
Else
  End
EndIf


If OpenWindow(0,100,100,500,500,"")
    ImageGadget(0,0,0,500,500,ImageID(1))
    gad=GadgetID(0)
EndIf

old=CallFunction(1,"SelectorImage",gad, @DLL_Proc())

Repeat

    ev=WaitWindowEvent()

Until ev=16

CallFunction(1,"SelectorFreeImage",gad,old)
CloseLibrary(1)

0

22

В архиве два кода: 1 для создания DLL,  2 для EXE. Что может быть там не правильно, почему не вызывается DLL ?

АРХИВ (52 кб)

0

23

DLL то вызывается, только вот зачем запихивать полноценную программу в DLLку?
DLLки не для этого предназначены.

0

24

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

DLL то вызывается, только вот зачем запихивать полноценную программу в DLLку?DLLки не для этого предназначены.

То есть как вызывается? У меня на первой строчке виснет, при открытии библиотеки. Что касается для чего в DLL, то у меня это часть программы, я решил ее из блоков DLL собирать

0

25

haav написал(а):

У меня на первой строчке виснет, при открытии библиотеки

Винет на

Код:
ss=CallFunction(0, "RUL", 10000)

Да и по большому счёту, это не зависание, а всего лишь передача управления DLLке.
Только вот окна в DLLках не отображаются, точнее, код работает не корректно!

Но вот если окно создать на чистом API, то оно отображается.

0

26

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

Но вот если окно создать на чистом API, то оно отображается.

То есть половину кода переписывать на API?
Или только строку openwindow() ?

0

27

haav написал(а):

То есть половину кода переписывать на API?

Почти всё писать на API

0

28

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

Почти всё писать на API

Ну нафиг  :D . Сделаю лучше исполняемый файл и через командную строку параметр(структуру) перешлю.

0

29

haav написал(а):

через командную строку параметр(структуру) перешлю

И операционка "обрадует" сообщением что прога выполнила не допустимую операцию и будет закрыта....

0

30

Да сейчас попробовал:
А почему память не может быть прочитана, ведь я вызывал ее по правильному адресу?

Код:
Enumeration
   #Window_0
EndEnumeration


Procedure Open_Window_0()
   If OpenWindow(#Window_0, 216, 0, 600, 600, "New window ( 0 )", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar)
      
   EndIf
EndProcedure


Procedure dll_3(a)
   MessageRequester("",Str(a))
EndProcedure

Open_Window_0()
RunProgram("1.exe",Str(@dll_3),"")
Repeat
   ev=WaitWindowEvent()
    
  Until ev=#PB_Event_CloseWindow

это отправка по адресу:

Код:
d.s=ProgramParameter(0)
MessageRequester("", d)
*ee=Val(d.s)
CallFunctionFast(*ee,12000)

0


Вы здесь » PureBasic - форум » Программирование на PureBasic » Процедуры