Structure koordinaty
  x.i
  y.i
  x1.i
  y1.i
EndStructure

Structure ikrangadgeta
koordinatyikrana.koordinaty
HDC.i
Fon.i
Shrift.i
ControlFon.i
count.l
EndStructure

Structure control
  *text
  textlen.l
  id.a
 koordinatycontrola.koordinaty
 ;ControlFon.i 
EndStructure


Global ikrangadgeta.ikrangadgeta
ikrangadgeta\count=-1
Global Dim control.control(0)

Procedure.l HandleError(Result.l,Text$,flag.i=0);Вывод еррор сообщений
If Result=0
    MessageRequester("Error",Text$,flag)
Else
   ProcedureReturn Result
 EndIf
EndProcedure

Procedure Len_UTF16R(*s);возврат количество символов
!mov eax,DWORD PTR esp+4
!hut15:
!CMP word ptr eax,0h
!Je rr15
!add eax,4
!CMP word ptr eax-2,0h
!Jnz hut15
!sub eax,2
!rr15:
!SUB eax,DWORD PTR esp+4
!Sar eax,1 
!retn 4
EndProcedure

Procedure Customgadget(id,x,y,x1,y1,texst.s)
Protected r.i
 
!mov dword eax,[esp+40]
!mov dword [p.v_r],eax


ikrangadgeta\count+1
If ikrangadgeta\count>0
  ReDim control.control(ikrangadgeta\count)
EndIf



control(ikrangadgeta\count)\text=r

control(ikrangadgeta\count)\textlen=Len_UTF16R(control(ikrangadgeta\count)\text)


control(ikrangadgeta\count)\koordinatycontrola\x=x
control(ikrangadgeta\count)\koordinatycontrola\x1=control(ikrangadgeta\count)\koordinatycontrola\x+x1
control(ikrangadgeta\count)\koordinatycontrola\y=y
control(ikrangadgeta\count)\koordinatycontrola\y1=control(ikrangadgeta\count)\koordinatycontrola\y+y1
control(ikrangadgeta\count)\id=id

EndProcedure  





Procedure vyvodcontrola(prioritet.i)
Protected lenstr.i
Protected i.i
  
;StartDrawing(CanvasOutput(1))
;Box(0, 0, 800,500, $FFFFFF)


 
FillRect_(ikrangadgeta\HDC,@ikrangadgeta\koordinatyikrana,ikrangadgeta\Fon)



For i=0 To ikrangadgeta\count
  ;Debug 888888888
  
If i<>prioritet
 
  

  
FillRect_(ikrangadgeta\HDC,@control(i)\koordinatycontrola,ikrangadgeta\ControlFon)


;Rectangle_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x, control(i)\koordinatycontrola\y,control(i)\koordinatycontrola\x1,control(i)\koordinatycontrola\y1)
;FrameRect_(ikrangadgeta\HDC, @control(i)\koordinatycontrola, $070808)

MoveToEx_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x,control(i)\koordinatycontrola\y,0);
LineTo_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x1,control(i)\koordinatycontrola\y)
LineTo_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x1,control(i)\koordinatycontrola\y1)
LineTo_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x,control(i)\koordinatycontrola\y1)
LineTo_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x,control(i)\koordinatycontrola\y)

TextOut_(ikrangadgeta\HDC,control(i)\koordinatycontrola\x,control(i)\koordinatycontrola\y,control(i)\text,control(i)\textlen)

;ExtTextOut_(Texthdc,x.i,y.i,options.i,*RECT,*lpString,c.i,*lpDx )

EndIf
Next



FillRect_(ikrangadgeta\HDC,@control(prioritet)\koordinatycontrola,ikrangadgeta\ControlFon)
MoveToEx_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x,control(prioritet)\koordinatycontrola\y,0);
LineTo_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x1,control(prioritet)\koordinatycontrola\y)
LineTo_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x1,control(prioritet)\koordinatycontrola\y1)
LineTo_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x,control(prioritet)\koordinatycontrola\y1)
LineTo_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x,control(prioritet)\koordinatycontrola\y)

TextOut_(ikrangadgeta\HDC,control(prioritet)\koordinatycontrola\x,control(prioritet)\koordinatycontrola\y,control(prioritet)\text,control(prioritet)\textlen)


;DrawImage(ImageID(0), WindowMouseX(0), WindowMouseY(0))
;StopDrawing()
  
EndProcedure
Procedure move(clik.i)
  Protected numberobject.i;для поиска объекта,переменная среда от 0 и выше на выход найденного объекта,если объект найден по клику то его
  ;индекс заносится в переменную ocnoobjecta для дольнейшего действия на перемещение мыши,если нет то бездействие и по отпускании кнопки мыши 
  ;возврат в исходное состояние (объект не найден,ocnoobjecta=-1)
  Static ocnoobjecta.i=-1
  Static prioteretobjecta.i;есле объект накладывается поверх другого для отрисовки
  Static xy.Point
  Static xy1.Point
  
  Static xy2.Point
  

  
  If clik=2;
    If ocnoobjecta>-1
        GetCursorPos_(@xy2)
        ScreenToClient_(GadgetID(1), @xy2)
        Debug xy2\y
        
      control(ocnoobjecta)\koordinatycontrola\x=xy2\x-xy\x
      control(ocnoobjecta)\koordinatycontrola\x1=xy2\x+xy1\x
      control(ocnoobjecta)\koordinatycontrola\y=xy2\y-xy\y
      control(ocnoobjecta)\koordinatycontrola\y1=xy2\y+xy1\y
      
      vyvodcontrola(ocnoobjecta)
    EndIf
  ElseIf clik=1
  GetCursorPos_(@xy)
  ScreenToClient_(GadgetID(1), @xy)
  ;xy\x+GetGadgetAttribute(0, #PB_ScrollArea_X)
  ;xy\y+GetGadgetAttribute(0, #PB_ScrollArea_Y)
  ;
  For numberobject=0 To ikrangadgeta\count
    If xy\x>control(numberobject)\koordinatycontrola\x And xy\x<control(numberobject)\koordinatycontrola\x1
     If xy\y>control(numberobject)\koordinatycontrola\y And xy\y<control(numberobject)\koordinatycontrola\y1
        
       ocnoobjecta=numberobject
       ;prioteretobjecta=numberobject
       ;вычислим разницу от краёв x,y объекта и x,y точки  клика,и запомним её
       xy1\x=control(numberobject)\koordinatycontrola\x1-xy\x
       xy\x-control(numberobject)\koordinatycontrola\x
       xy1\y=control(numberobject)\koordinatycontrola\y1-xy\y
       xy\y-control(numberobject)\koordinatycontrola\y
       
       Continue;
       
       ;Debug xy\y
     EndIf
    EndIf
  Next
  ;
 ElseIf clik=0
    ocnoobjecta=-1
    
    
 ElseIf clik=3;#WM_RBUTTONDOWN
  GetCursorPos_(@xy)
  ScreenToClient_(GadgetID(1), @xy)  
   For numberobject=0 To ikrangadgeta\count
    If xy\x>control(numberobject)\koordinatycontrola\x And xy\x<control(numberobject)\koordinatycontrola\x1
     If xy\y>control(numberobject)\koordinatycontrola\y And xy\y<control(numberobject)\koordinatycontrola\y1
       
       
       SetGadgetState(990,numberobject+1)
       
          Continue;
       

     EndIf
    EndIf
   Next    
       
EndIf  
EndProcedure 

Procedure Canvas_calbak(hwnd,msg,wparam,lparam)
  Static Rodnoy_calbak.i
  Static a.a
  Protected Rezultat.i
  If Not msg=1
  Rezultat=CallWindowProc_(Rodnoy_calbak, hWnd, Msg, wParam, lParam);сначала прыгнем в родной обработчик 
  EndIf
  
  ;Debug msg
  Select msg
    Case #WM_CREATE
      ;ScrollAreaGadget(0, 0, 60, 800,500,5000,5000,100)
      ;SetGadgetAttribute(0, #PB_ScrollArea_X ,2500);установка ползунка по х
      ;CanvasGadget(1, 0, 0,5000,5000,#PB_Screen_SmartSynchronization)
      ;GetClientRect_(GadgetID(1),@ikrangadgeta\koordinatyikrana);запишим полученные координаты экрана

      ;InvalidateRect_(GadgetID(2), 0, #True)
      
      
      ;ikrangadgeta\HDC=GetDC_(GadgetID(1));запишим контекст рисования
      ;SetBkMode_(ikrangadgeta\HDC,#TRANSPARENT);#TRANSPARENT(цвет фона прозрачный,остается нетронутым ),#OPAQUE(сначала красит ячейку текста текущим цветом фона)пока так 

      ;ikrangadgeta\Fon=CreateSolidBrush_($00FFFFFF);фон экрана по умолчанию
      ;ikrangadgeta\ControlFon=CreateSolidBrush_($3DFFFC);фон контролов
      
      ;ikrangadgeta\Shrift=CreateFont_(24,0,0,0,0,0,0,0,#RUSSIAN_CHARSET,0,0,#CLEARTYPE_QUALITY,0,"Lucida Console");создаем логический шрифт по умолчанию
     ;If ikrangadgeta\Shrift=0;дескриптор не получен(Шрифт не создан)
     ;  HandleError(0,"Невозможно создать шрифт для CustomEditora")
      ; Goto NOSHRIFT
     ;Else
     ;  SelectObject_(ikrangadgeta\HDC,ikrangadgeta\Shrift);установить шрифт в контекст окна рисования текста
     ;EndIf 
      
      
      
      
      

       ;SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE)|#WS_EX_COMPOSITED)
     ; Rodnoy_calbak= GetWindowLongPtr_(WindowID(0), #GWL_WNDPROC)
       ;SetWindowLongPtr_(WindowID(0), #GWL_WNDPROC,  @Window_calbak());назначаем свой обработчик
       Rodnoy_calbak= GetWindowLongPtr_(GadgetID(1), #GWL_WNDPROC)
       SetWindowLongPtr_(GadgetID(1), #GWL_WNDPROC,@Canvas_calbak());назначаем свой обработчик
       
     Case #WM_ERASEBKGND;при заполнении окна цветом фона  
      ;Debug 66666
      ; FillRect_(ikrangadgeta\HDC,@ikrangadgeta\koordinatyikrana,ikrangadgeta\Fon)
     Case #WM_PAINT 
      ; Debug 44
       vyvodcontrola(0)
       
       
       
       
       
       
        Case #WM_MOUSEMOVE
            
 
       If a=1
   ;Debug wparam
           move(2)

        EndIf
      ;Case #WM_LBUTTONDBLCLK
        
        ;control(0)\status=1
        
     Case #WM_LBUTTONDOWN
        Debug hwnd
        move(1)
       a=1
     Case #WM_LBUTTONUP
       move(0)
       a=0
     Case #WM_RBUTTONDOWN  
       move(3)

     Case #WM_CLOSE  
       CloseWindow_(GadgetID(0))
       CloseWindow_(GadgetID(1))
      
     Case #WM_DESTROY
              DeleteObject_(ikrangadgeta\Fon)
              DeleteObject_(ikrangadgeta\ControlFon)
              DeleteObject_(ikrangadgeta\Shrift);Освободить дескриптор обычного печатного шрифта 
              
              ReleaseDC_(GadgetID(1),ikrangadgeta\HDC)
          
          DestroyWindow_(GadgetID(0))    
          DestroyWindow_(GadgetID(1))
         
      EndSelect
   
  ProcedureReturn Rezultat
EndProcedure











Procedure formy(fr.a)
Protected a.a
For a=0 To 1
 If IsWindow(a) 
  CloseWindow(a) 
 EndIf 
Next

If fr=0 
 If OpenWindow(0, 50, 0, 1200, 600, "")
      SmartWindowRefresh(0, #True); Уменьшаем мерцания окна при изменении его размеров
      HideWindow(0,1);Окно пока не отображается(закрыто) и типа все элементы на нём (гаджеты) создаются в фоновом режиме
      
  PanelGadget(990,0,25,1200,530);1-я панель
  AddGadgetItem(990, -1, "Бyyyy")
  ;
  ScrollAreaGadget(0, 0, 0, 1193,504,5000,5000,100)
  SetGadgetAttribute(0, #PB_ScrollArea_X ,2500);установка ползунка по х
  CanvasGadget(1, 0, 0,5000,5000,#PB_Screen_SmartSynchronization)
  
  GetClientRect_(GadgetID(1),@ikrangadgeta\koordinatyikrana);запишем полученные координаты экрана
   
      ikrangadgeta\HDC=GetDC_(GadgetID(1));запишим контекст рисования
      ;ikrangadgeta\HDC=GetDCEx_(GadgetID(1),0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS);контекст с исключением дочерних окон
      SetBkMode_(ikrangadgeta\HDC,#TRANSPARENT);#TRANSPARENT(цвет фона прозрачный,остается нетронутым ),#OPAQUE(сначала красит ячейку текста текущим цветом фона)пока так 

      ikrangadgeta\Fon=CreateSolidBrush_($00FFFFFF);фон экрана по умолчанию
      ikrangadgeta\ControlFon=CreateSolidBrush_($3DFFFC);фон контролов
      
      ikrangadgeta\Shrift=CreateFont_(24,0,0,0,0,0,0,0,#RUSSIAN_CHARSET,0,0,#CLEARTYPE_QUALITY,0,"Lucida Console");создаем логический шрифт по умолчанию
     If ikrangadgeta\Shrift=0;дескриптор не получен(Шрифт не создан)
       HandleError(0,"Невозможно создать шрифт для Панели Блок схема")
      ; Goto NOSHRIFT
     Else
       SelectObject_(ikrangadgeta\HDC,ikrangadgeta\Shrift);установить шрифт в контекст окна рисования текста
     EndIf 
    
  
  
  
  
  
     Canvas_calbak(0,#WM_CREATE,0,0)
     

     Static  s.s{10}
     For i=0 To 1000
       
           Customgadget(i,i*100,i*25,100,25,"privet")

     Next
  
      
 HideWindow(0,0)

      ;
EndIf
EndIf
EndProcedure
formy(0)


Repeat
 Select WaitWindowEvent()
  Case #PB_Event_CloseWindow
    Break
    
    
    
 EndSelect  
ForEver
End

UseSQLiteDatabase()

Procedure CheckDatabaseUpdate(Database, Query$)
  ;DatabaseUpdate(Database, "BEGIN TRANSACTION;")
  Result = DatabaseUpdate(Database, Query$)
  If Result = 0
    Debug DatabaseError()
  EndIf
  ;DatabaseUpdate(Database, "END TRANSACTION;")
  ProcedureReturn Result
EndProcedure

W = 5000 ; Ширина поля
H = 5000 ; Высота поля
O = 100000 ; Количество оъектов

If OpenDatabase(0, ":memory:", "", "")
  
  CheckDatabaseUpdate(0, "CREATE TABLE tObject (NObject INT, X1 INT, Y1 INT, X2 INT, Y2 INT)")
  CheckDatabaseUpdate(0, "CREATE INDEX iObject ON tObject (NObject, X1, Y1, X2, Y2)")
  
  For i = 1 To O
    
    Ow = Random(100,10)
    Oh = Random(100,10)
    Ox = Random(W-Ow,0)
    Oy = Random(H-Oh,0)
    Req1.s = "INSERT INTO tObject (NObject,X1, Y1, X2, Y2) VALUES ("
    Req2.s = Str(i) + "," 
    Req2.s = Req2 + Str(Ox) + ","
    Req2.s = Req2 + Str(Oy) + ","
    Req2.s = Req2 + Str(Ox+Ow-1) + ","
    Req2.s = Req2 + Str(Oy+Oh-1) + ")"
    
    CheckDatabaseUpdate(0, Req1+Req2)
    
  Next  
  
  x = Random(W-1,0)
  y = Random(H-1,0)
  SetDatabaseLong(0,0,x)
  SetDatabaseLong(0,1,x)
  SetDatabaseLong(0,2,y)
  SetDatabaseLong(0,3,y)
  L = 0
  StartTime.q = ElapsedMilliseconds()
  If DatabaseQuery(0, "SELECT NObject FROM tObject WHERE (X1 <= ?) AND (X2 >= ?) AND (Y1 <= ?) AND (Y2 >= ?) ORDER BY NObject ")
    
    While NextDatabaseRow(0)
      L = GetDatabaseLong(0, 0)
    Wend
    
    FinishDatabaseQuery(0)
  EndIf
  ;Debug "===="
  MessageRequester("Information", Str(L) + "=" + Str( ElapsedMilliseconds() - StartTime), #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
  ;ElapsedMilliseconds() - StartTime 
  CloseDatabase(0)
Else
  Debug "Can't open database !"
EndIf

Procedure Set_object(count1)
  ReDim koordinaty.koordinaty(count1)
  ReDim Stroka.s(count1)

Structure koordinaty
X.i
Y.i
X1.i
Y1.i
EndStructure
Global count.i
Global Dim koordinaty.koordinaty(0)
Global Dim Stroka.s(0)

Procedure Set_object(count1)
  ReDim koordinaty.koordinaty(count1)
  ReDim Stroka.s(count1)
Protected i.i
count=count1
For i=0 To count
koordinaty(i)\X=i
koordinaty(i)\X1=i+100
koordinaty(i)\Y=i
koordinaty(i)\Y1=i+100
Stroka(i)=Str(i)
Next
EndProcedure

Procedure.i poisk(*massiv.koordinaty,x,y,countt);для теста 
 Protected r.i=*massiv
  countt*16
countt+*massiv
cikl:
If x>*massiv\X And x<*massiv\X1 And y>*massiv\Y And y<*massiv\Y1
  *massiv-r
  *massiv/16
  ProcedureReturn *massiv
Else  
  If *massiv<>countt
    *massiv+16
    Goto cikl
  Else 
    ProcedureReturn -1
  EndIf
EndIf
EndProcedure




Set_object(1000000)


TimeS.q = ElapsedMilliseconds()
  index.l= poisk(@koordinaty(),count+50,count+50,count)
ArrTime.q = ElapsedMilliseconds() - TimeS

MessageRequester("Тест","index  "+Str(index)+" stroka "+Stroka.s(index)+"  время теста  "+Str(ArrTime))

Procedure.i poisk3(*massiv,x,y,countt);для теста
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
;{;
 !cmp qword  [p.v_countt],0
 !jz vyhod56
 ;
 !mov qword rax,[p.p_massiv];64 битта стек и наш countt можно(поменять на тип Global count.q)
 !sal qword [p.v_countt],4
 !add qword [p.v_countt],rax
 !mov dword ebx,[p.v_x];как интегер 32бит(может быстрей поиск будет да и массив x,y.интегер)
 !mov dword edx,[p.v_y];
 !jmp r45556
!ckl7774:
!add qword rax,16
!cmp qword rax,[p.v_countt]
!jz vyhod5
!r45556:
 !cmp dword ebx,[rax]
 !jl ckl7774
 !cmp dword ebx,[rax+8]
 !jg ckl7774
 !cmp dword edx,[rax+4]
 !jl ckl7774
 !cmp dword edx,[rax+12]
 !jg ckl7774
 !sub qword rax,[p.p_massiv]
 !cmp qword rax,0
 !jz f65447
 !sar qword rax,4
 !f65447:
 ProcedureReturn
 !vyhod56:
 ProcedureReturn -1
;};
CompilerElseIf  #PB_Compiler_Processor = #PB_Processor_x86
;{;
 !cmp dword  [p.v_countt],0
 !jz vyhod5
 ;
 !mov dword eax,[p.p_massiv]
 !sal dword [p.v_countt],4
 !add dword [p.v_countt],eax
 !mov dword ebx,[p.v_x]
 !mov dword edx,[p.v_y]
 !jmp r4555
!ckl777:
!add dword eax,16
!cmp dword eax,[p.v_countt]
!jz vyhod5
!r4555:
 !cmp dword ebx,[eax]
 !jl ckl777
 !cmp dword ebx,[eax+8]
 !jg ckl777
 !cmp dword edx,[eax+4]
 !jl ckl777
 !cmp dword edx,[eax+12]
 !jg ckl777
 !sub dword eax,[p.p_massiv]
 !cmp dword eax,0
 !jz f6544
 !sar dword eax,4
 !f6544:
 ProcedureReturn
 !vyhod5:
 ProcedureReturn -1
 ;};
CompilerEndIf
EndProcedure