Захотел создать канвас

Страница: 1

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

Поделиться105.12.2023 23:58:13

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

Да не просто создать а со своим функционалом.
Вопрос как оптимизировать код чтобы фон менял на отрисовке(картинке битмап) в замен этого?

Код:

 For x=0 To *CustomCanvas\Canvas_Bufer\xy\x1-1
      For y=0 To *CustomCanvas\Canvas_Bufer\xy\y1-1
               ;  Debug Hex(GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y),#PB_Long)
              If GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y)=cvetfona
                   SetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y,fon);перезаписываем пиксель на новый фон
              EndIf 
          Next 
       Next

;
это условно прога

Код:

Macro CanvasSetPixel(HDC,nXPos,nYPos,COLORREF)
  SetPixel_(HDC,nXPos,nYPos, COLORREF)
EndMacro
Macro CanvasGetPixel(HDC,nXPos,nYPos)
  GetPixel_(HDC,nXPos,nYPos)
EndMacro
Macro CanvasDrawLine(HDC,x1,y1,x2,y2)
 pt.POINT;
 MoveToEx_(HDC, x1, y1,@pt);
LineTo_(HDC, x2, y2)
EndMacro
Macro CanvasDrawArc(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
Arc_(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro

Structure xy
  x1.l
  y1.l
EndStructure
Structure Bufer_bitmap
  hdc.i
  xy.xy
  fon_hdc.i
EndStructure
Structure CustomCanvas
  Canvas_id.i
  Canvas_Rect.rect
  Canvas_Bufer.Bufer_bitmap
EndStructure  
  
UseTIFFImageDecoder() 
UseJPEGImageDecoder() 
UseTGAImageDecoder() 
UsePNGImageDecoder()


Global rodnoi_obrabothik_canvasov.i=0
Procedure Canvascalbakk(hwnd,msg,wparam,lparam)
  Protected *CustomCanvas.CustomCanvas
 ;result=CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
 
 
 Select msg
;    Case #WM_PAINT
;ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика


   ;   *CustomCanvas=GetWindowLongPtr_(hwnd,0)
      
     ;Protected hdc= StartDrawing(CanvasOutput(GetWindowLongPtr_(hwnd,#GWL_ID)))

            ;  Protected kistb.i=CreateSolidBrush_($294EEC)
      ;SelectObject_(hdc,kistb)
      ;Rectangle_(hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
          ;BitBlt_(hdc,*CustomCanvas\Canvas_Rect\left,*CustomCanvas\Canvas_Rect\top,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);копирование картинки из контекста окна в память ввиде поля bitmap

 
          ;StopDrawing()
      
      
 ;ProcedureReturn 0
    Case #WM_DESTROY
      Debug "#WM_NCDESTROY"
      Debug hwnd
     *CustomCanvas=GetWindowLongPtr_(hwnd,0);получаем адрес данных
    If *CustomCanvas\Canvas_Bufer\fon_hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\fon_hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\fon_hdc)
    EndIf
    If *CustomCanvas\Canvas_Bufer\hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\hdc)
    EndIf
    
   ; ReleaseDC_(hwnd,*CustomCanvas\Canvas_hdc);удаляем контекст канваса
    
    FreeMemory(*CustomCanvas);удаляем память данных для окна канваса
    ;SetWindowLongPtr_(hwnd,0,0);память очищена и в доп.память окна под адрес данных ставим 0
    ;
    SetWindowLongPtr_(hwnd,#GWL_WNDPROC,rodnoi_obrabothik_canvasov)  
 EndSelect
; ProcedureReturn result;
ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
; ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure

 
ProcedureDLL.i CreateCustomCanvas(windowhwnd,canvas_id,x,y,x1,y1)
 Protected canvashwnd.i
 
 
 canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1);Createcanvas(windowhwnd,0,30,0,450,500,@Canvaskalbak())
 
 If GetClassLongPtr_(canvashwnd,-18)=0;дополнтительная память в классе под окно не выделенна
   SetClassLongPtr_(canvashwnd,-18,8) ;теперь окна канваса создаются с дополнительной памятью
   ;SetClassLongPtr_(canvashwnd,-26,#CS_OWNDC);теперь контекст рисования частный(постоянный)
   ;
   ;пересоздаём окно канваваса уже с нашимии изменениями
   DestroyWindow_(canvashwnd)
   canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1)
 EndIf  
 ;
 If canvashwnd<>0
     If rodnoi_obrabothik_canvasov=0;он изначально один для всех что бы не повторяться с этой операцией
       rodnoi_obrabothik_canvasov=SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     Else
       SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     EndIf
     
    ;структура данных для хранения
     Protected *CustomCanvas.CustomCanvas
     *CustomCanvas=AllocateMemory(SizeOf(CustomCanvas))
     *CustomCanvas\Canvas_id=canvas_id
     *CustomCanvas\Canvas_Rect\left=0
     *CustomCanvas\Canvas_Rect\top=0
     *CustomCanvas\Canvas_Rect\right=x1
     *CustomCanvas\Canvas_Rect\bottom=y1
     ;Protected rect.RECT
     ;GetClientRect_(canvashwnd,*CustomCanvas\Canvas_Rect)
     
     Debug "rect"
     Debug *CustomCanvas\Canvas_Rect\left;*CustomCanvas\Canvas_Rect\left
     Debug *CustomCanvas\Canvas_Rect\top
     Debug *CustomCanvas\Canvas_Rect\right 
     Debug *CustomCanvas\Canvas_Rect\bottom
     ;
     *CustomCanvas\Canvas_Bufer\xy\x1=x1
     *CustomCanvas\Canvas_Bufer\xy\y1=y1
     ;
     Protected hdc.i=GetDC_(canvashwnd);GetDCEx_(canvashwnd,0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS)
     *CustomCanvas\Canvas_Bufer\hdc = CreateCompatibleDC_(hdc);создает контекст устройства памяти (DC), совместимый с указанным устройством
     *CustomCanvas\Canvas_Bufer\fon_hdc=CreateCompatibleDC_(hdc);создает контекст под bitmap фона
     
     Protected hbmMem = CreateCompatibleBitmap_(hdc,x1,y1);создаём объект(шаблон) картинки bitmap
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,hbmMem) ;устанавливаем шаблон для буфера рисования
     Protected hbmMem2 = CreateCompatibleBitmap_(hdc,x1,y1);оказывается первый шаблон хрен заселектишь :(
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,hbmMem2);устанавливаем шаблон для буфера фона
      DeleteObject_(hbmMem);больше шаблон bitmapa не нужен
      DeleteObject_(hbmMem2);больше шаблон bitmapa не нужен
      ReleaseDC_(canvashwnd,hdc)
      
      Protected kistb.i=CreateSolidBrush_($57FFFF);создаём дискриптор кисти для создания битмапа фона
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb)
      FillRect_(*CustomCanvas\Canvas_Bufer\hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем битмап под фон
      FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем битмап под фон
      DeleteObject_(kistb);больше кисть не нужна
      ;копируем начальнай фон в канвас
      Protected hdcccanvasa.i
     hdcccanvasa= StartDrawing(CanvasOutput(canvas_id))
      BitBlt_(hdcccanvasa,0,0,x1,y1,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
     StopDrawing()
      
      ;
      SetWindowLongPtr_(canvashwnd,0,*CustomCanvas);заносим адрес памяти с структурой данных в дополнительную память окна cbWndExtra это не #gwl_userdata
    
    ProcedureReturn canvashwnd
 Else
    ProcedureReturn 0;канвас не создан
EndIf 
EndProcedure


Global *CustomCanvas2.CustomCanvas
Global hdcccanvasa2.i

Structure fon
  byvhiy.l
  stavhiy.l
  CustomCanvas_hdc.i
EndStructure
;Global cvetfona.fon
;Threaded x
;Threaded y
Procedure Thread(*cvetfona.fon)
  Debug 6666
  Debug cvetfona\byvhiy
  Debug *cvetfona\byvhiy
       For x=0 To 249;*CustomCanvas\Canvas_Bufer\xy\x1-1/2;-1
          For y=0 To 499;*CustomCanvas\Canvas_Bufer\xy\y1)
              If GetPixel_(*cvetfona\CustomCanvas_hdc,x,y)=*cvetfona\byvhiy
                   SetPixel_(*cvetfona\CustomCanvas_hdc,x,y,*cvetfona\stavhiy);перезаписываем пиксель на новый фон
             EndIf 
          Next 
        Next
EndProcedure
Procedure Thread2(*cvetfona.fon)
        For x=250 To 499;*CustomCanvas\Canvas_Bufer\xy\x1-1
         For y=0 To 499;*CustomCanvas\Canvas_Bufer\xy\y1-1
               ;  Debug Hex(GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y),#PB_Long)
              If GetPixel_(*cvetfona\CustomCanvas_hdc,x,y)=*cvetfona\byvhiy
                   SetPixel_(*cvetfona\CustomCanvas_hdc,x,y,*cvetfona\stavhiy);перезаписываем пиксель на новый фон
              EndIf 
          Next 
       Next 
EndProcedure
Procedure.i SetCanvasFon(id,fon.l)
  Protected canvashwnd.i=GadgetID(id)
  Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес данных
  Protected kistb.l=CreateSolidBrush_(fon)
  ;SetDCBrushColor(hdc,COLORREF);задает для цвета кисти текущего контекста
  ;Debug GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BRUSH)
  
  Protected cvetfona.l= GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)
  Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb)
  
   ;cvetfona\stavhiy=fon
  ; cvetfona\byvhiy= GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0);GetDCBrushColor_(*CustomCanvas\Canvas_Bufer\fon_hdc)
   ;cvetfona\CustomCanvas_hdc=*CustomCanvas\Canvas_Bufer\hdc
  ;Debug cvetfona
  ;Debug "cvetfona  "+Hex(cvetfona)
 ; Rectangle_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
  
    FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb)
    ;
   ; x1=GetDeviceCaps_(*CustomCanvas\Canvas_Bufer\hdc,#HORZRES)
    ;y1=GetDeviceCaps_(*CustomCanvas\Canvas_Bufer\hdc,#VERTRES)
   ; Debug *CustomCanvas\Canvas_Bufer\xy\x1
   ; Debug *CustomCanvas\Canvas_Bufer\xy\y1
    ;GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BRUSH)
  ; BITMAP.BITMAP
   ; GetObject_(GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP), SizeOf(BITMAP), @BITMAP)
  ;  Debug BITMAP\bmWidth
  ;  Debug BITMAP\bmHeight
  ;  Debug BITMAP\bmBitsPixel
  ;  Debug BITMAP\bmBits
  ;  BITMAPINFO.BITMAPINFO
    
    ;BITMAPINFO\bmiHeader\biPlanes=1
    ;BITMAPINFO\bmiHeader\biBitCount=32
   ; BITMAPINFO\bmiHeader\biSize=SizeOf(BITMAPINFO)
  ;  lpvBits.l=0
  ;  GetDIBits_(*CustomCanvas\Canvas_Bufer\hdc,GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP),0,0,@lpvBits,@BITMAPINFO,#DIB_RGB_COLORS)
;Debug BITMAPINFO\bmiColors\
    
  ;  Debug BITMAPINFO\bmiHeader\biBitCount;Указывает количество бит на пиксель (bpp)
  ;  Debug BITMAPINFO\bmiHeader\biSizeImage
  ;  Debug BITMAPINFO\bmiHeader\biXPelsPerMeter
 ;   Debug BITMAPINFO\bmiHeader\biYPelsPerMeter
 ;   Debug BITMAPINFO\bmiHeader\biYPelsPerMeter
   ;lpvBits = AllocateMemory(1000000)
 ;  If GetDIBits_(*CustomCanvas\Canvas_Bufer\hdc,GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP),0,500,@lpvBits,@BITMAPINFO,#DIB_RGB_COLORS)<>0
  ;  Debug lpvBits
 ;   For i=118 To 500 Step 4
  ;    Debug Hex(PeekL(lpvBits+i))
 ;   Next   
 ;   EndIf
  ; FreeMemory(lpvBits)
    
    For x=0 To *CustomCanvas\Canvas_Bufer\xy\x1-1
      For y=0 To *CustomCanvas\Canvas_Bufer\xy\y1-1
               ;  Debug Hex(GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y),#PB_Long)
              If GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y)=cvetfona
                   SetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y,fon);перезаписываем пиксель на новый фон
              EndIf 
          Next 
       Next
    
  ;CreateThread(@Thread(),@cvetfona)
  ;CreateThread(@Thread2(),@cvetfona)
    
    
    
     
    ;  GdiTransparentBlt_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,fon)

   ;Protected  SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
    
  ; SetROP2_(*CustomCanvas\Canvas_Bufer\hdc,#R2_NOTMASKPEN|#R2_NOTXORPEN)
  ; Rectangle_(*CustomCanvas\Canvas_Bufer\hdc,0, 0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom)
   
    ;BitBlt_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCINVERT)
    ;SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
    
    ;BitBlt_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
    
   ; FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb)
    
    ;
    ;Debug *CustomCanvas\Canvas_id
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
    
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
 
    StopDrawing()
    DeleteObject_(kistb);больше кисть не нужна
EndProcedure
Procedure CanvasCLS();clear
    BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
EndProcedure
  
ProcedureDLL.i StartCanvasDrawing(canvashwnd)
 *CustomCanvas2.CustomCanvas = GetWindowLongPtr_(canvashwnd,0)
  hdcccanvasa2 = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
  ProcedureReturn *CustomCanvas2\Canvas_Bufer\hdc
EndProcedure

ProcedureDLL StopCanvasDrawing()
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
  StopDrawing()
EndProcedure 
Procedure.i CanvasOpenFileImage(Canvas_id);открытие файла и загрузка в канвас
  file$ = OpenFileRequester("Open File","","*.PNG|*.PNG*|*.GIF|*.GIF*|*.JPG|*.JPG*|*.BMP|*.BMP*|All files|*.*",1)
  
  Debug file$
  LoadImage(0, file$)
  
  SetGadgetAttribute(Canvas_id, #PB_Canvas_Image, ImageID(0))
  
  hdc=StartDrawing(CanvasOutput(Canvas_id))
  
  
  BitBlt_(hdc, 0, 0, imgW, imgH, hDC, 0, 0, #SRCCOPY)
  
  StopDrawing()
  
EndProcedure

If OpenWindow(0, 0, 0,1200, 600, "CustomCanvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  CreateCustomCanvas(WindowID(0),0,10,10,500,500)
 ;  SetCanvasFon(0,$29D4EC)
   CreateCustomCanvas(WindowID(0),1,600,10,450,400)
  ; SetCanvasFon(1,$29D4EC)
   ;OpenFileImage(0)
  
Else
  End
EndIf

;--------предварительные данные(рисунок) для теста
hdc=StartCanvasDrawing(GadgetID(0))
 For i=0 To 100
   CanvasSetPixel(hdc,20,i,$00CFC1)
   CanvasSetPixel(hdc,21,i,$00CFC1)
   CanvasSetPixel(hdc,22,i,$00CFC1)
   CanvasSetPixel(hdc,23,i,$00CFC1)
   CanvasSetPixel(hdc,24,i,$00CFC1)
   CanvasSetPixel(hdc,25,i,$00CFC1)
   
   CanvasDrawLine(hdc,100,i+50,300,i)
   
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;------------
;проверка на установку фона
SetCanvasFon(0,$F666FF)



  ;{;Обработчик сообщений
 Repeat
  Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow;{;
     
         End
     
;};
   Case #PB_Event_Gadget
     Select EventGadget()
       Case 0
         
 
    EndSelect
      
      
  EndSelect
 ForEver;};

Поделиться208.01.2024 12:59:06

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

Столкнулся с этим теперь думаю либо первый цвет трансформить для сравнения с буфером либо попробовать структуру для буфера как сделать что бы в ней уже изменённое получалось.

Код:

l.l=16777047;цвет в буфере после GetDIBits_()
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"
l=$57FFFF;цвет по Color Picker и Getpixel_(), R=255,G=255,B=87 , COLORREF=0x00bbggrr
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"

;хотел посмотреть что после функции RGB(),Вобщем хрень какая то
l2.l=RGB(Red(87),Green(255),Blue(255))
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"
l2=RGB(Red(255),Green(255),Blue(87))
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"


Debug RGB(Blue(87),Green(255),Red(255))

Отредактировано Sergeihik (08.01.2024 13:02:13)

Поделиться308.01.2024 22:45:11

Автор: Webarion
Активный участник
Откуда: Москва
Зарегистрирован: 19.12.2021
Приглашений: 0
Сообщений: 223
Уважение: [+5/-0]
Позитив: [+20/-1]
Пол: Мужской
Возраст: 41 [1983-06-03]
Провел на форуме:
7 дней 23 часа
Последний визит:
08.10.2024 23:45:27

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

Столкнулся с этим теперь думаю либо первый цвет трансформить для сравнения с буфером либо попробовать структуру для буфера как сделать что бы в ней уже изменённое получалось.

Отредактировано Sergeihik (Сегодня 13:02:13)

Всё там правильно:

Код:

Debug Red(87)
Debug Green(255)
Debug Blue(255)

Если это действительно нужно, указывайте в Red(n), Green(n), Blue(n), полный цвет, а не только отдельный байт цвета:

Код:

l.l=$FFFF57 ; = 16777047 ; цвет в буфере после GetDIBits_()
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"
l=$57FFFF;цвет по Color Picker и Getpixel_(), R=255,G=255,B=87 , COLORREF=0x00bbggrr
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"

l2.l=RGB(Red($FFFF57),Green($FFFF57),Blue($FFFF57))
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"
l2=RGB(Red($57FFFF),Green($57FFFF),Blue($57FFFF))
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"

Debug RGB(Blue($FFFF57),Green($FFFF57),Red($FFFF57))

Ну или вот так:

Код:

l.l=16777047;цвет в буфере после GetDIBits_()
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"
l=$57FFFF;цвет по Color Picker и Getpixel_(), R=255,G=255,B=87 , COLORREF=0x00bbggrr
Debug PeekB(@l)
Debug PeekB(@l+1)
Debug PeekB(@l+2)
Debug PeekB(@l+3)
Debug "========"

l2.l=RGB(87,255,255)
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"
l2=RGB(255,255,87)
Debug PeekB(@l2)
Debug PeekB(@l2+1)
Debug PeekB(@l2+2)
Debug PeekB(@l2+3)
Debug "========"

Debug RGB(87,255,255)

Отредактировано Webarion (13.01.2024 02:04:06)

Поделиться408.01.2024 23:04:58

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

Пока по первому пути пошёл и изначально изменил с структурой пока отложил да и походу надо вообще контекст рисования переделать сразу на дибсекцию.
Ps ;скорость уже приемлемая для смены фона,его же не так часто предполагается менять

Код:

Macro CanvasSetPixel(HDC,nXPos,nYPos,COLORREF)
  SetPixel_(HDC,nXPos,nYPos, COLORREF)
EndMacro
Macro CanvasGetPixel(HDC,nXPos,nYPos)
  GetPixel_(HDC,nXPos,nYPos)
EndMacro
Macro CanvasDrawLine(HDC,x1,y1,x2,y2)
 pt.POINT;
 MoveToEx_(HDC, x1, y1,@pt);
LineTo_(HDC, x2, y2)
EndMacro
Macro CanvasDrawArc(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
Arc_(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro
Procedure.l RGBrearrange(l.l)
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],16;кольцевой сдвиг 
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],8;кольцевой сдви
  ProcedureReturn l
EndProcedure
Structure xy
  x1.l
  y1.l
EndStructure
Structure Bufer_bitmap
  hdc.i
  xy.xy
  fon_hdc.i
EndStructure
Structure CustomCanvas
  Canvas_id.i
  Canvas_Rect.rect
  Canvas_Bufer.Bufer_bitmap
EndStructure  
  
UseTIFFImageDecoder() 
UseJPEGImageDecoder() 
UseTGAImageDecoder() 
UsePNGImageDecoder()


Global rodnoi_obrabothik_canvasov.i=0
Procedure Canvascalbakk(hwnd,msg,wparam,lparam)
  Protected *CustomCanvas.CustomCanvas
 ;result=CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
 
 
 Select msg
;    Case #WM_PAINT
;ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика


   ;   *CustomCanvas=GetWindowLongPtr_(hwnd,0)
      
     ;Protected hdc= StartDrawing(CanvasOutput(GetWindowLongPtr_(hwnd,#GWL_ID)))

            ;  Protected kistb.i=CreateSolidBrush_($294EEC)
      ;SelectObject_(hdc,kistb)
      ;Rectangle_(hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
          ;BitBlt_(hdc,*CustomCanvas\Canvas_Rect\left,*CustomCanvas\Canvas_Rect\top,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);копирование картинки из контекста окна в память ввиде поля bitmap

 
          ;StopDrawing()
      
      
 ;ProcedureReturn 0
    Case #WM_DESTROY
      Debug "#WM_NCDESTROY"
      Debug hwnd
     *CustomCanvas=GetWindowLongPtr_(hwnd,0);получаем адрес данных
    If *CustomCanvas\Canvas_Bufer\fon_hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\fon_hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\fon_hdc)
    EndIf
    If *CustomCanvas\Canvas_Bufer\hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\hdc)
    EndIf
    
   ; ReleaseDC_(hwnd,*CustomCanvas\Canvas_hdc);удаляем контекст канваса
    
    FreeMemory(*CustomCanvas);удаляем память данных для окна канваса
    ;SetWindowLongPtr_(hwnd,0,0);память очищена и в доп.память окна под адрес данных ставим 0
    ;
    SetWindowLongPtr_(hwnd,#GWL_WNDPROC,rodnoi_obrabothik_canvasov)  
 EndSelect
; ProcedureReturn result;
ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
; ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure

 
ProcedureDLL.i CreateCustomCanvas(windowhwnd,canvas_id,x,y,x1,y1)
 Protected canvashwnd.i
 
 
 canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1);Createcanvas(windowhwnd,0,30,0,450,500,@Canvaskalbak())
 
 If GetClassLongPtr_(canvashwnd,-18)=0;дополнтительная память в классе под окно не выделенна
   SetClassLongPtr_(canvashwnd,-18,8) ;теперь окна канваса создаются с дополнительной памятью
   ;SetClassLongPtr_(canvashwnd,-26,#CS_OWNDC);теперь контекст рисования частный(постоянный)
   ;
   ;пересоздаём окно канваваса уже с нашимии изменениями
   DestroyWindow_(canvashwnd)
   canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1)
 EndIf  
 ;
 If canvashwnd<>0
     If rodnoi_obrabothik_canvasov=0;он изначально один для всех что бы не повторяться с этой операцией
       rodnoi_obrabothik_canvasov=SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     Else
       SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     EndIf
     
    ;структура данных для хранения
     Protected *CustomCanvas.CustomCanvas
     *CustomCanvas=AllocateMemory(SizeOf(CustomCanvas))
     *CustomCanvas\Canvas_id=canvas_id
     *CustomCanvas\Canvas_Rect\left=0
     *CustomCanvas\Canvas_Rect\top=0
     *CustomCanvas\Canvas_Rect\right=x1
     *CustomCanvas\Canvas_Rect\bottom=y1
     ;Protected rect.RECT
     ;GetClientRect_(canvashwnd,*CustomCanvas\Canvas_Rect)
     
    ; Debug "rect"
    ; Debug *CustomCanvas\Canvas_Rect\left;*CustomCanvas\Canvas_Rect\left
    ; Debug *CustomCanvas\Canvas_Rect\top
    ; Debug *CustomCanvas\Canvas_Rect\right 
    ; Debug *CustomCanvas\Canvas_Rect\bottom
     ;
     *CustomCanvas\Canvas_Bufer\xy\x1=x1
     *CustomCanvas\Canvas_Bufer\xy\y1=y1
     ;
     Protected hdc.i=GetDC_(canvashwnd);GetDCEx_(canvashwnd,0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS)
     *CustomCanvas\Canvas_Bufer\hdc = CreateCompatibleDC_(hdc);создает контекст устройства памяти (DC), совместимый с указанным устройством
     *CustomCanvas\Canvas_Bufer\fon_hdc=CreateCompatibleDC_(hdc);создает контекст под bitmap фона
     
     Protected hbmMem = CreateCompatibleBitmap_(hdc,x1,y1);создаём объект(шаблон) картинки bitmap
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,hbmMem) ;устанавливаем шаблон для буфера рисования
     Protected hbmMem2 = CreateCompatibleBitmap_(hdc,x1,y1);оказывается первый шаблон хрен заселектишь :(
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,hbmMem2);устанавливаем шаблон для буфера фона
      DeleteObject_(hbmMem);больше шаблон bitmapa не нужен
      DeleteObject_(hbmMem2);больше шаблон bitmapa не нужен
      ReleaseDC_(canvashwnd,hdc)
      
      Protected kistb.i=CreateSolidBrush_($57FFFF);создаём дискриптор кисти для создания битмапа фона
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb)
      FillRect_(*CustomCanvas\Canvas_Bufer\hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем битмап под фон
      FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем битмап под фон
      DeleteObject_(kistb);больше кисть не нужна
      ;копируем начальнай фон в канвас
      Protected hdcccanvasa.i
     hdcccanvasa= StartDrawing(CanvasOutput(canvas_id))
      BitBlt_(hdcccanvasa,0,0,x1,y1,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
     StopDrawing()
      
      ;
      SetWindowLongPtr_(canvashwnd,0,*CustomCanvas);заносим адрес памяти с структурой данных в дополнительную память окна cbWndExtra это не #gwl_userdata
    
    ProcedureReturn canvashwnd
 Else
    ProcedureReturn 0;канвас не создан
EndIf 
EndProcedure


Global *CustomCanvas2.CustomCanvas
Global hdcccanvasa2.i

Structure fon
  byvhiy.l
  stavhiy.l
  CustomCanvas_hdc.i
EndStructure
Global cvetfona.fon
Threaded x
Threaded y
Procedure Thread(*cvetfona.fon)
  Debug 6666
  Debug cvetfona\byvhiy
  Debug *cvetfona\byvhiy
       For x=0 To 249;*CustomCanvas\Canvas_Bufer\xy\x1-1/2;-1
          For y=0 To 499;*CustomCanvas\Canvas_Bufer\xy\y1)
              If GetPixel_(*cvetfona\CustomCanvas_hdc,x,y)=*cvetfona\byvhiy
                   SetPixel_(*cvetfona\CustomCanvas_hdc,x,y,*cvetfona\stavhiy);перезаписываем пиксель на новый фон
             EndIf 
          Next 
        Next
EndProcedure
Procedure Thread2(*cvetfona.fon)
        For x=250 To 499;*CustomCanvas\Canvas_Bufer\xy\x1-1
         For y=0 To 499;*CustomCanvas\Canvas_Bufer\xy\y1-1
               ;  Debug Hex(GetPixel_(*CustomCanvas\Canvas_Bufer\hdc,x,y),#PB_Long)
              If GetPixel_(*cvetfona\CustomCanvas_hdc,x,y)=*cvetfona\byvhiy
                   SetPixel_(*cvetfona\CustomCanvas_hdc,x,y,*cvetfona\stavhiy);перезаписываем пиксель на новый фон
              EndIf 
          Next 
       Next 
EndProcedure
Procedure.l Getpixel(hdc,x,y)
  Protected bits.i
  Protected bitmap.BITMAP
  Protected bitmapinfo.bitmapinfo
  
  Protected hbm=GetCurrentObject_(hdc,#OBJ_BITMAP);получаем дескриптор битмапа из контекста памяти для рисования
  GetObject_(hbm,SizeOf(BITMAP),@bitmap);получаем параметры битмапа
   
 If x<0 And x>bitmap\bmWidth Or y<0 And y>bitmap\bmHeight
   ProcedureReturn -1
 EndIf 
   
   bitmapinfo\bmiHeader\biWidth=bitmap\bmWidth;
   bitmapinfo\bmiHeader\biHeight=bitmap\bmHeight;
   bitmapinfo\bmiHeader\biPlanes=bitmap\bmPlanes;
   bitmapinfo\bmiHeader\biBitCount=bitmap\bmBitsPixel;количество битов на пиксель
   bitmapinfo\bmiHeader\biCompression=#BI_RGB;
   bitmapinfo\bmiHeader\biSizeImage=0;;Указывает размер изображения в байтах
   bitmapinfo\bmiHeader\biXPelsPerMeter=1000;1;
   bitmapinfo\bmiHeader\biYPelsPerMeter=1000;1;
   bitmapinfo\bmiHeader\biClrUsed=0;
   bitmapinfo\bmiHeader\biClrImportant=0;
   bitmapinfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER);bitmapinfo\bmiHeader

  Protected memhdc=CreateCompatibleDC_(hdc);получаем совместимый контекст памяти
   hbm=CreateDIBSection_(hdc, @bitmapinfo, #DIB_RGB_COLORS, @bits, #Null, #Null);получаем шаблон битмапа в DIBSection
   SelectObject_(memhdc,hbm);установка в контекст памяти шаблона
   BitBlt_(memhdc,0,0,bitmapinfo\bmiHeader\biWidth,bitmapinfo\bmiHeader\biHeight,hdc, 0, 0,#SRCCOPY);коп. в контекст рисунок
 Protected *bait_na_piksil.long=(((bitmap\bmWidth * bitmap\bmPlanes * bitmap\bmBitsPixel + 15) >> 4) << 1) * bitmap\bmHeight;расчёт памяти под байты
  *bait_na_piksil+ bits
  *bait_na_piksil-(bitmapinfo\bmiHeader\biBitCount/8);последний пиксель
  *bait_na_piksil-(x*y)
  
  Protected cvet.l=*bait_na_piksil\l
  DeleteObject_(hbm);больше битмап не нужен
  DeleteDC_(memhdc);больше временный контекст памяти не нужен
ProcedureReturn cvet
EndProcedure
Procedure.l SetCanvasFon(id,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected kistb.l=CreateSolidBrush_(newfon);кисть для нового фона
  ;SetDCBrushColor(hdc,COLORREF);задает цвет кисти в текущем контексте
  ;Debug GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BRUSH)
  
 Protected predydushii_cvetfona.l= RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0));цвет установленного ранее фона в контексте под фон с перекодировкой
  ;для прямого просмотра буфера в CreateDIBSection_()
 newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
  ;================
  
  Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb);установка нового фона в контекст фона
  FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закраска контекста для фона новым фоном
 
  ;===============
  Protected bits.i
  Protected bitmap.BITMAP
  Protected bitmapinfo.bitmapinfo
  
  Protected hbm=GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP);получаем дескриптор битмапа из контекста памяти для рисования
  GetObject_(hbm,SizeOf(BITMAP),@bitmap);получаем параметры битмапа
   
;{;
;{;  
   bitmapinfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER);bitmapinfo\bmiHeader
   bitmapinfo\bmiHeader\biWidth=bitmap\bmWidth;
   bitmapinfo\bmiHeader\biHeight=bitmap\bmHeight;
   bitmapinfo\bmiHeader\biPlanes=bitmap\bmPlanes;
   bitmapinfo\bmiHeader\biBitCount=bitmap\bmBitsPixel;количество битов на пиксель
   bitmapinfo\bmiHeader\biCompression=#BI_RGB;
   bitmapinfo\bmiHeader\biSizeImage=0;;Указывает размер изображения в байтах
   bitmapinfo\bmiHeader\biXPelsPerMeter=1000;1;
   bitmapinfo\bmiHeader\biYPelsPerMeter=1000;1;
   bitmapinfo\bmiHeader\biClrUsed=0;
   bitmapinfo\bmiHeader\biClrImportant=0;


  Protected memhdc=CreateCompatibleDC_(*CustomCanvas\Canvas_Bufer\hdc);получаем совместимый контекст памяти
   hbm=CreateDIBSection_(hdc, @bitmapinfo, #DIB_RGB_COLORS, @bits, #Null, #Null);получаем шаблон битмапа в DIBSection
  SelectObject_(memhdc,hbm);установка в контекст памяти шаблона
  BitBlt_(memhdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);коп. в контекст рисунок

;};===============
;{;;выделяем память под массив цвета пикселей .копируем туда цвета из битмапа но это если буфер памяти создать и туда скопировать
  ;а мы будем работать напрямую с котекстом CreateDIBSection_()
  Protected bait_na_piksil.l=(((bitmap\bmWidth * bitmap\bmPlanes * bitmap\bmBitsPixel + 15) >> 4) << 1) * bitmap\bmHeight;расчёт памяти под байты
  ;или по сути их количества в контесте CreateDIBSection_()
 ; Debug bait_na_piksil
;  *cvet=AllocateMemory(bait_na_piksil)
 ; GetDIBits_(memhdc,hbm,0,bitmapinfo\bmiHeader\biHeight,*cvet,@bitmapinfo,#DIB_RGB_COLORS);получить из контекста в буфер биты цвета
  
 ; For *i.long=*cvet To *cvet+6000-4 Step 4;для теста
   ; Debug *i\l
   ; If *i\l=predydushii_cvetfona
   ;   *i\l=newfon
   ; EndIf
    
 ; Next
 ; FreeMemory(*cvet)
  
 ; Debug "---------" 
; For i=0 To 500;для теста
 ;  Debug GetPixel_(memhdc,0,i)
; Next
  For *i.long=bits To bits+bait_na_piksil-4 Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
      *i\l=newfon
   EndIf
  Next
 
;};
;};  
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
   ; BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,memhdc, 0, 0,#SRCCOPY)
    
    StopDrawing()
;копируем в котекст памяти куда рисуем
  BitBlt_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,memhdc, 0, 0,#SRCCOPY)
  
;удаляем созданый контекст памяти и объекты кисти и битмапа  
  DeleteObject_(kistb);больше кисть не нужна(контекст под фон закрашен
  DeleteObject_(hbm);больше битмап не нужен
  DeleteDC_(memhdc) ;больше временный контекст памяти не нужен
  ProcedureReturn predydushii_cvetfona
EndProcedure
Procedure CanvasCLS();clear
    BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
EndProcedure
  
ProcedureDLL.i StartCanvasDrawing(canvashwnd)
 *CustomCanvas2.CustomCanvas = GetWindowLongPtr_(canvashwnd,0)
  hdcccanvasa2 = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
  ProcedureReturn *CustomCanvas2\Canvas_Bufer\hdc
EndProcedure

ProcedureDLL StopCanvasDrawing()
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
  StopDrawing()
EndProcedure 


If OpenWindow(0, 0, 0,1200, 600, "CustomCanvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  CreateCustomCanvas(WindowID(0),0,10,10,500,500)
 ;  SetCanvasFon(0,$29D4EC)
   CreateCustomCanvas(WindowID(0),1,600,10,450,400)
  ; SetCanvasFon(1,$29D4EC)
   ;OpenFileImage(0)
  
Else
  End
EndIf

;--------предварительные данные(рисунок) для теста
hdc=StartCanvasDrawing(GadgetID(0))
 For i=0 To 100
   CanvasSetPixel(hdc,20,i,$00CFC1)
   CanvasSetPixel(hdc,21,i,$00CFC1)
   CanvasSetPixel(hdc,22,i,$00CFC1)
   CanvasSetPixel(hdc,23,i,$00CFC1)
   CanvasSetPixel(hdc,24,i,$00CFC1)
   CanvasSetPixel(hdc,25,i,$00CFC1)
   
   CanvasDrawLine(hdc,100,i+50,300,i)
   
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;------------
;проверка на установку фона
SetCanvasFon(0,$F666FF)
;тест
For i=0 To 100
SetCanvasFon(0,i*i+$F666FF)
Delay(100)
Next
For i=0 To 100
SetCanvasFon(1,i*i+$F666FF)
Delay(100)
Next
  ;{;Обработчик сообщений
 Repeat
  Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow;{;
     
         End
     
;};
   Case #PB_Event_Gadget
     Select EventGadget()
       Case 0
         
 
    EndSelect
      
      
  EndSelect
 ForEver;};

Отредактировано Sergeihik (08.01.2024 23:09:31)

Поделиться509.01.2024 00:22:41

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

Вот переделал,с самым первым кодом конечно скорость в разы выше

Код:

Macro CanvasSetPixel(HDC,nXPos,nYPos,COLORREF)
  SetPixel_(HDC,nXPos,nYPos, COLORREF)
EndMacro
Macro CanvasGetPixel(HDC,nXPos,nYPos)
  GetPixel_(HDC,nXPos,nYPos)
EndMacro
Macro CanvasDrawLine(HDC,x1,y1,x2,y2)
 pt.POINT;
 MoveToEx_(HDC, x1, y1,@pt);
LineTo_(HDC, x2, y2)
EndMacro
Macro CanvasDrawArc(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
Arc_(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro
Procedure.l RGBrearrange(l.l)
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],16;кольцевой сдвиг 
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],8;кольцевой сдви
  ProcedureReturn l
EndProcedure

Structure xy
  x1.l
  y1.l
EndStructure
Structure Bufer_bitmap
  hdc.i
  bits.i
  xy.xy
  fon_hdc.i
  fon_bits.i
EndStructure
Structure CustomCanvas
  Canvas_id.i
  Canvas_Rect.rect
  Canvas_Bufer.Bufer_bitmap
EndStructure  
  
UseTIFFImageDecoder() 
UseJPEGImageDecoder() 
UseTGAImageDecoder() 
UsePNGImageDecoder()

Global rodnoi_obrabothik_canvasov.i=0
Procedure Canvascalbakk(hwnd,msg,wparam,lparam)
  Protected *CustomCanvas.CustomCanvas
 ;result=CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
 
 
 Select msg
;    Case #WM_PAINT
;ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика


   ;   *CustomCanvas=GetWindowLongPtr_(hwnd,0)
      
     ;Protected hdc= StartDrawing(CanvasOutput(GetWindowLongPtr_(hwnd,#GWL_ID)))

            ;  Protected kistb.i=CreateSolidBrush_($294EEC)
      ;SelectObject_(hdc,kistb)
      ;Rectangle_(hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
          ;BitBlt_(hdc,*CustomCanvas\Canvas_Rect\left,*CustomCanvas\Canvas_Rect\top,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);копирование картинки из контекста окна в память ввиде поля bitmap

 
          ;StopDrawing()
      
      
 ;ProcedureReturn 0
    Case #WM_DESTROY
      Debug "#WM_NCDESTROY"
      Debug hwnd
     *CustomCanvas=GetWindowLongPtr_(hwnd,0);получаем адрес данных
    If *CustomCanvas\Canvas_Bufer\fon_hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\fon_hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\fon_hdc)
    EndIf
    If *CustomCanvas\Canvas_Bufer\hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\hdc)
    EndIf
    
   ; ReleaseDC_(hwnd,*CustomCanvas\Canvas_hdc);удаляем контекст канваса
    
    FreeMemory(*CustomCanvas);удаляем память данных для окна канваса
    ;SetWindowLongPtr_(hwnd,0,0);память очищена и в доп.память окна под адрес данных ставим 0
    ;
    SetWindowLongPtr_(hwnd,#GWL_WNDPROC,rodnoi_obrabothik_canvasov)  
 EndSelect
; ProcedureReturn result;
ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
; ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure

ProcedureDLL.i CreateCustomCanvas(windowhwnd,canvas_id,x,y,x1,y1)
 Protected canvashwnd.i
 
 canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1);Createcanvas(windowhwnd,0,30,0,450,500,@Canvaskalbak())
 
 If GetClassLongPtr_(canvashwnd,-18)=0;дополнтительная память в классе под окно не выделенна
   SetClassLongPtr_(canvashwnd,-18,8) ;теперь окна канваса создаются с дополнительной памятью
   ;SetClassLongPtr_(canvashwnd,-26,#CS_OWNDC);теперь контекст рисования частный(постоянный)
   ;
   ;пересоздаём окно канваваса уже с нашимии изменениями
   DestroyWindow_(canvashwnd)
   canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1)
 EndIf  
 ;
 If canvashwnd<>0
     If rodnoi_obrabothik_canvasov=0;он изначально один для всех что бы не повторяться с этой операцией
       rodnoi_obrabothik_canvasov=SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     Else
       SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     EndIf
     
    ;структура данных для хранения
     Protected *CustomCanvas.CustomCanvas
     *CustomCanvas=AllocateMemory(SizeOf(CustomCanvas))
     *CustomCanvas\Canvas_id=canvas_id
     *CustomCanvas\Canvas_Rect\left=0
     *CustomCanvas\Canvas_Rect\top=0
     *CustomCanvas\Canvas_Rect\right=x1
     *CustomCanvas\Canvas_Rect\bottom=y1
     ;Protected rect.RECT
     ;GetClientRect_(canvashwnd,*CustomCanvas\Canvas_Rect)
     ;
     ;Debug "rect"
     ;Debug *CustomCanvas\Canvas_Rect\left;*CustomCanvas\Canvas_Rect\left
     ;Debug *CustomCanvas\Canvas_Rect\top
     ;Debug *CustomCanvas\Canvas_Rect\right 
     ;Debug *CustomCanvas\Canvas_Rect\bottom
     ;
     *CustomCanvas\Canvas_Bufer\xy\x1=x1
     *CustomCanvas\Canvas_Bufer\xy\y1=y1
     ;
     Protected hdc.i=GetDC_(canvashwnd);GetDCEx_(canvashwnd,0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS)
     *CustomCanvas\Canvas_Bufer\hdc = CreateCompatibleDC_(hdc);создаем контекст устройства памяти для рисованя, совместимый с указанным устройством
     *CustomCanvas\Canvas_Bufer\fon_hdc=CreateCompatibleDC_(hdc);создаем контекст памяти под фон
     
      Protected bi.BITMAPINFO
      ZeroMemory_(@bi, SizeOf(bi));
      bi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER);
      bi\bmiHeader\biCompression = #BI_RGB;
      bi\bmiHeader\biBitCount = 32;
      bi\bmiHeader\biPlanes = 1;
      bi\bmiHeader\biWidth = x1;
      bi\bmiHeader\biHeight = y1;
      bi\bmiHeader\biSizeImage = x1 * y1 * 4;
      bi\bmiHeader\biXPelsPerMeter=1000;1;
      bi\bmiHeader\biYPelsPerMeter=1000;1;
      bi\bmiHeader\biClrUsed=0;
      bi\bmiHeader\biClrImportant=0;
     Protected hbmMem = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\bits, #Null, #Null)
     SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,hbmMem) ;устанавливаем шаблон для буфера рисования
     ;
      ;Protected hbmMem2 = CreateCompatibleBitmap_(hdc,x1,y1);оказывается первый шаблон хрен заселектишь :(
      Protected hbmMem2 = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\fon_hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\fon_bits, #Null, #Null);
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,hbmMem2);устанавливаем шаблон для буфера фона
      DeleteObject_(hbmMem);больше шаблон bitmapa не нужен
      DeleteObject_(hbmMem2);больше шаблон bitmapa не нужен
      ReleaseDC_(canvashwnd,hdc)
      
      Protected kistb.i=CreateSolidBrush_($57FFFF);создаём дискриптор кисти для записи фона в контексты
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb)
      FillRect_(*CustomCanvas\Canvas_Bufer\hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем контекст под рисование
      FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем контекст под фон
      DeleteObject_(kistb);больше кисть не нужна
      ;копируем начальнай фон в канвас
      Protected hdcccanvasa.i
     hdcccanvasa = StartDrawing(CanvasOutput(canvas_id))
      BitBlt_(hdcccanvasa,0,0,x1,y1,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
     StopDrawing()
      ;
      SetWindowLongPtr_(canvashwnd,0,*CustomCanvas);заносим адрес памяти с структурой данных в дополнительную память окна cbWndExtra это не #gwl_userdata
    
    ProcedureReturn canvashwnd
 Else
    ProcedureReturn 0;канвас не создан
EndIf 
EndProcedure

Global *CustomCanvas2.CustomCanvas
Global hdcccanvasa2.i

Procedure.l SetCanvasFon(id,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected kistb.l=CreateSolidBrush_(newfon);кисть для нового фона
  ;SetDCBrushColor(hdc,COLORREF);задает цвет кисти в текущем контексте
  ;Debug GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BRUSH)
  
 Protected predydushii_cvetfona.l= RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0));цвет установленного ранее фона в контексте под фон с перекодировкой
  ;для прямого просмотра буфера в CreateDIBSection_()
 newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
  ;================
  Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb);установка нового фона в контекст фона
  FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закраска контекста для фона новым фоном
 
  ;===============
 ; Protected bits.i
  ;Protected bitmap.BITMAP
  
  ;Protected hbm=GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP);получаем дескриптор битмапа из контекста памяти для рисования
  ;GetObject_(hbm,SizeOf(BITMAP),@bitmap);получаем параметры битмапа
   
;{;
;{;;выделяем память под массив цвета пикселей .копируем туда цвета из битмапа но это если буфер памяти создать и туда скопировать
  ;а мы будем работать напрямую с котекстом CreateDIBSection_()
  ;Protected bait_na_piksil.l=(((bitmap\bmWidth * bitmap\bmPlanes * bitmap\bmBitsPixel + 15) >> 4) << 1) * bitmap\bmHeight;расчёт памяти под байты
  Protected bait_na_piksil.l=*CustomCanvas\Canvas_Bufer\xy\x1 * *CustomCanvas\Canvas_Bufer\xy\y1 * 4;расчёт памяти под байты
  ;или по сути их количества в контесте CreateDIBSection_()
 ; Debug bait_na_piksil

  For *i.long=*CustomCanvas\Canvas_Bufer\bits To *CustomCanvas\Canvas_Bufer\bits+bait_na_piksil-4 Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
      *i\l=newfon
   EndIf
  Next
 
;};
;};  
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
   ; BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    
    StopDrawing()
;копируем в котекст памяти куда рисуем
  BitBlt_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,memhdc, 0, 0,#SRCCOPY)
  
;удаляем созданый контекст памяти и объекты кисти и битмапа  
  DeleteObject_(kistb);больше кисть не нужна(контекст под фон закрашен
  ProcedureReturn predydushii_cvetfona
EndProcedure
Procedure CanvasCLS();clear
    BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
EndProcedure
  
ProcedureDLL.i StartCanvasDrawing(canvashwnd)
 *CustomCanvas2.CustomCanvas = GetWindowLongPtr_(canvashwnd,0)
  hdcccanvasa2 = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
  ProcedureReturn *CustomCanvas2\Canvas_Bufer\hdc
EndProcedure

ProcedureDLL StopCanvasDrawing()
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
  StopDrawing()
EndProcedure 
Procedure.i CanvasOpenFileImage(Canvas_id);открытие файла и загрузка в канвас
  file$ = OpenFileRequester("Open File","","*.PNG|*.PNG*|*.GIF|*.GIF*|*.JPG|*.JPG*|*.BMP|*.BMP*|All files|*.*",1)
  
  Debug file$
  LoadImage(0, file$)
  
  SetGadgetAttribute(Canvas_id, #PB_Canvas_Image, ImageID(0))
  
  hdc=StartDrawing(CanvasOutput(Canvas_id))
  
  
  BitBlt_(hdc, 0, 0, imgW, imgH, hDC, 0, 0, #SRCCOPY)
  
  StopDrawing()
  
EndProcedure

If OpenWindow(0, 0, 0,1200, 600, "CustomCanvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  CreateCustomCanvas(WindowID(0),0,10,10,500,500)
 ;  SetCanvasFon(0,$29D4EC)
   CreateCustomCanvas(WindowID(0),1,600,10,450,400)
  ; SetCanvasFon(1,$29D4EC)
   ;OpenFileImage(0)
  
Else
  End
EndIf

;--------предварительные данные(рисунок) для теста
hdc=StartCanvasDrawing(GadgetID(0))
 For i=0 To 100
   CanvasSetPixel(hdc,20,i,$00CFC1)
   CanvasSetPixel(hdc,21,i,$00CFC1)
   CanvasSetPixel(hdc,22,i,$00CFC1)
   CanvasSetPixel(hdc,23,i,$00CFC1)
   CanvasSetPixel(hdc,24,i,$00CFC1)
   CanvasSetPixel(hdc,25,i,$00CFC1)
   
   CanvasDrawLine(hdc,100,i+50,300,i)
   
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;------------
;проверка на установку фона
SetCanvasFon(0,$F666FF)
;SetCanvasFon(1,$2266FF)

;тест
For i=0 To 100
SetCanvasFon(0,i*i+$F666FF)
Next
For i=0 To 100
SetCanvasFon(1,i*i+$F666FF)
Next
















  ;{;Обработчик сообщений
 Repeat
  Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow;{;
     
         End
     
;};
   Case #PB_Event_Gadget
     Select EventGadget()
       Case 0
         
 
    EndSelect
      
      
  EndSelect
 ForEver;};

Поделиться610.01.2024 03:20:00

Автор: Webarion
Активный участник
Откуда: Москва
Зарегистрирован: 19.12.2021
Приглашений: 0
Сообщений: 223
Уважение: [+5/-0]
Позитив: [+20/-1]
Пол: Мужской
Возраст: 41 [1983-06-03]
Провел на форуме:
7 дней 23 часа
Последний визит:
08.10.2024 23:45:27

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

Вот переделал,с самым первым кодом конечно скорость в разы выше

Отлично! Если, уверен, что это стабильно под винду, это здорово! Но, вот когда, сделаешь, под каждую платформу, будет совсем форевер!

Поделиться711.01.2024 00:45:06

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

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

Отлично! Если, уверен, что это стабильно под винду, это здорово! Но, вот когда, сделаешь, под каждую платформу, будет совсем форевер!

Мне и под винду хватит,теперь когда есть прямой доступ к пикселям то опять будут изменения с удалением ненужных функций и дополнений.

Код:

UseTIFFImageDecoder() 
UseJPEGImageDecoder() 
UseTGAImageDecoder() 
UsePNGImageDecoder()
Structure xy
  x1.w
  y1.w
EndStructure
Structure Bufer_bitmap
  hdc.i
  start_hdc_bits.i
  end_hdc_bits.i
  hdcxy.xy
  fon_hdc.i
  start_fon_bits.i
  end_fon_bits.i
EndStructure
Structure CustomCanvas
  Canvas_id.i
  Canvas_Rect.rect
  Canvas_Bufer.Bufer_bitmap
EndStructure
;================================
Global *CustomCanvas2.CustomCanvas
Global hdcccanvasa2.i
;================================
Macro CanvasApiSetPixel(HDC,nXPos,nYPos,COLORREF)
  SetPixel_(HDC,nXPos,nYPos, COLORREF)
EndMacro
Macro CanvasApiGetPixel(HDC,nXPos,nYPos)
  GetPixel_(HDC,nXPos,nYPos)
EndMacro
Macro CanvasDrawLine(HDC,x1,y1,x2,y2)
 pt.POINT;
 MoveToEx_(HDC, x1, y1,@pt);
 LineTo_(HDC, x2, y2)
EndMacro
Macro CanvasDrawArc(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
Arc_(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro

ProcedureDLL.l RGBrearrange(l.l)
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],16;кольцевой сдвиг 
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],8;кольцевой сдви
  ProcedureReturn l
EndProcedure

;
ProcedureDLL.l CanvasIdMemSetPixel(id,nXPos,nYPos,COLORREF)
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
; 
  If nXPos<0 Or nXPos>*CustomCanvas\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas\Canvas_Bufer\hdcxy\y1
    ;вне окна контекста
    ProcedureReturn 0
  Else
    COLORREF= RGBrearrange(COLORREF)
    Protected *cvet.long
    If y>-1
       nYPos=(*CustomCanvas\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    Else
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure
ProcedureDLL.l CanvasIdMemGetPixel(id,nXPos,nYPos)
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров  
;
  If nXPos<0 Or nXPos>*CustomCanvas\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas\Canvas_Bufer\hdcxy\y1
     ;вне окна контекста
    ProcedureReturn 0
  Else
    Protected *cvet.long
    If y=0
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    Else
      nYPos=(*CustomCanvas\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    EndIf
  EndIf
EndProcedure
 ;
ProcedureDLL.l CanvasMemSetPixel(nXPos,nYPos,COLORREF)
; 
  If nXPos<0 Or nXPos>*CustomCanvas2\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas2\Canvas_Bufer\hdcxy\y1
    ;вне окна контекста
    ProcedureReturn 0
  Else
    COLORREF= RGBrearrange(COLORREF)
    Protected *cvet.long
    If y>-1
       nYPos=(*CustomCanvas2\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    Else
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure
ProcedureDLL.l CanvasMemGetPixel(nXPos,nYPos)
;
  If nXPos<0 Or nXPos>*CustomCanvas2\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas2\Canvas_Bufer\hdcxy\y1
     ;вне окна контекста
    ProcedureReturn 0
  Else
    Protected *cvet.long
    If y=0
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    Else
      nYPos=(*CustomCanvas2\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    EndIf
  EndIf
EndProcedure
  
ProcedureDLL.l SetCanvasIdFon(id,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected kistb.l=CreateSolidBrush_(newfon);кисть для нового фона(теперь не нужна нам как и SelectObject и FillRect(заполним пиксели цветом напрямую)
 Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits
 Protected predydushii_cvetfona.l=*i\l;получаем предыдущий цвет фона
 ;Protected predydushii_cvetfona.l= RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0));цвет установленного ранее фона в контексте под фон с перекодировкой
  ;для прямого просмотра буфера в CreateDIBSection_()
 newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
 
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
 ;Debug "CanvasIdMemGetPixel  "+Str(RGBrearrange(CanvasIdMemGetPixel(id,0,0)))
  ;================
 ; Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb);установка нового фона в контекст фона
 ; FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закраска контекста для фона новым фоном
   cikl:;установки нового фона
     *i\l=newfon
   If *i<*CustomCanvas\Canvas_Bufer\end_fon_bits
     *i+4
     Goto cikl
   EndIf  
  ;===============
 ; Protected bits.i
  ;Protected bitmap.BITMAP
  ;Protected hbm=GetCurrentObject_(*CustomCanvas\Canvas_Bufer\hdc,#OBJ_BITMAP);получаем дескриптор битмапа из контекста памяти для рисования
  ;GetObject_(hbm,SizeOf(BITMAP),@bitmap);получаем параметры битмапа
;{;;выделяем память под массив цвета пикселей .копируем туда цвета из битмапа но это если буфер памяти создать и туда скопировать
  ;а мы будем работать напрямую с котекстом CreateDIBSection_()
  ;Protected bait_na_piksil.l=(((bitmap\bmWidth * bitmap\bmPlanes * bitmap\bmBitsPixel + 15) >> 4) << 1) * bitmap\bmHeight;расчёт памяти под байты
  ;Protected bait_na_piksil.l=*CustomCanvas\Canvas_Bufer\xy\x1 * *CustomCanvas\Canvas_Bufer\xy\y1 * 4;расчёт памяти под байты
  ;или по сути их количества в контесте CreateDIBSection_()
 ; Debug bait_na_piksil
  For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
     ;Debug *i\l
     *i\l=newfon
   EndIf
  Next
;};  
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
;копируем в котекст памяти куда рисуем
  ;BitBlt_(*CustomCanvas\Canvas_Bufer\hdc,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
;удаляем созданый контекст памяти и объекты кисти и битмапа  
  DeleteObject_(kistb);больше кисть не нужна(контекст под фон закрашен
  ProcedureReturn predydushii_cvetfona
EndProcedure
ProcedureDLL CanvasCLS();clear
    BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
EndProcedure
  
ProcedureDLL.i StartCanvasDrawing(canvashwnd)
 *CustomCanvas2.CustomCanvas = GetWindowLongPtr_(canvashwnd,0)
  hdcccanvasa2 = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
  ProcedureReturn *CustomCanvas2\Canvas_Bufer\hdc
EndProcedure
ProcedureDLL StopCanvasDrawing()
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
  StopDrawing()
EndProcedure 

Global rodnoi_obrabothik_canvasov.i=0
Procedure Canvascalbakk(hwnd,msg,wparam,lparam)
  Protected *CustomCanvas.CustomCanvas
 ;result=CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
 
 
 Select msg
;    Case #WM_PAINT
;ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика


   ;   *CustomCanvas=GetWindowLongPtr_(hwnd,0)
      
     ;Protected hdc= StartDrawing(CanvasOutput(GetWindowLongPtr_(hwnd,#GWL_ID)))

            ;  Protected kistb.i=CreateSolidBrush_($294EEC)
      ;SelectObject_(hdc,kistb)
      ;Rectangle_(hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
          ;BitBlt_(hdc,*CustomCanvas\Canvas_Rect\left,*CustomCanvas\Canvas_Rect\top,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);копирование картинки из контекста окна в память ввиде поля bitmap

 
          ;StopDrawing()
      
      
 ;ProcedureReturn 0
    Case #WM_DESTROY
      Debug "#WM_NCDESTROY"
      Debug hwnd
     *CustomCanvas=GetWindowLongPtr_(hwnd,0);получаем адрес данных
    If *CustomCanvas\Canvas_Bufer\fon_hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\fon_hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\fon_hdc)
    EndIf
    If *CustomCanvas\Canvas_Bufer\hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\hdc)
    EndIf
    
   ; ReleaseDC_(hwnd,*CustomCanvas\Canvas_hdc);удаляем контекст канваса
    
    FreeMemory(*CustomCanvas);удаляем память данных для окна канваса
    ;SetWindowLongPtr_(hwnd,0,0);память очищена и в доп.память окна под адрес данных ставим 0
    ;
    SetWindowLongPtr_(hwnd,#GWL_WNDPROC,rodnoi_obrabothik_canvasov)  
 EndSelect
; ProcedureReturn result;
ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
; ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure
ProcedureDLL.i CreateCustomCanvas(windowhwnd,canvas_id,x,y,x1,y1)
 Protected canvashwnd.i
 
 canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1);Createcanvas(windowhwnd,0,30,0,450,500,@Canvaskalbak())
 
 If GetClassLongPtr_(canvashwnd,-18)=0;дополнтительная память в классе под окно не выделенна
   SetClassLongPtr_(canvashwnd,-18,8) ;теперь окна канваса создаются с дополнительной памятью
   ;SetClassLongPtr_(canvashwnd,-26,#CS_OWNDC);теперь контекст рисования частный(постоянный)
   ;
   ;пересоздаём окно канваваса уже с нашимии изменениями
   DestroyWindow_(canvashwnd)
   canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1)
 EndIf  
 ;
 If canvashwnd<>0
     If rodnoi_obrabothik_canvasov=0;он изначально один для всех что бы не повторяться с этой операцией
       rodnoi_obrabothik_canvasov=SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     Else
       SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     EndIf
     
    ;структура данных для хранения
     Protected *CustomCanvas.CustomCanvas
     *CustomCanvas=AllocateMemory(SizeOf(CustomCanvas))
     *CustomCanvas\Canvas_id=canvas_id
     *CustomCanvas\Canvas_Rect\left=0
     *CustomCanvas\Canvas_Rect\top=0
     *CustomCanvas\Canvas_Rect\right=x1
     *CustomCanvas\Canvas_Rect\bottom=y1
     ;Protected rect.RECT
     ;GetClientRect_(canvashwnd,*CustomCanvas\Canvas_Rect)
     ;
     ;Debug "rect"
     ;Debug *CustomCanvas\Canvas_Rect\left;*CustomCanvas\Canvas_Rect\left
     ;Debug *CustomCanvas\Canvas_Rect\top
     ;Debug *CustomCanvas\Canvas_Rect\right 
     ;Debug *CustomCanvas\Canvas_Rect\bottom
     ;
     *CustomCanvas\Canvas_Bufer\hdcxy\x1=x1
     *CustomCanvas\Canvas_Bufer\hdcxy\y1=y1
     ;
     Protected hdc.i=GetDC_(canvashwnd);GetDCEx_(canvashwnd,0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS)
     *CustomCanvas\Canvas_Bufer\hdc = CreateCompatibleDC_(hdc);создаем контекст устройства памяти для рисованя, совместимый с указанным устройством
     *CustomCanvas\Canvas_Bufer\fon_hdc=CreateCompatibleDC_(hdc);создаем контекст памяти под фон
     
      Protected bi.BITMAPINFO
      ZeroMemory_(@bi, SizeOf(bi));
      bi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER);
      bi\bmiHeader\biCompression = #BI_RGB;
      bi\bmiHeader\biBitCount = 32;
      bi\bmiHeader\biPlanes = 1;
      bi\bmiHeader\biWidth = x1;
      bi\bmiHeader\biHeight = y1;
      bi\bmiHeader\biSizeImage = x1 * y1 * 4;
      bi\bmiHeader\biXPelsPerMeter=1000;1;
      bi\bmiHeader\biYPelsPerMeter=1000;1;
      bi\bmiHeader\biClrUsed=0;
      bi\bmiHeader\biClrImportant=0;
     Protected hbmMem = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\start_hdc_bits, #Null, #Null)
     *CustomCanvas\Canvas_Bufer\end_hdc_bits=*CustomCanvas\Canvas_Bufer\start_hdc_bits+bi\bmiHeader\biSizeImage-4
     SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,hbmMem) ;устанавливаем шаблон для буфера рисования
     ;
      ;Protected hbmMem2 = CreateCompatibleBitmap_(hdc,x1,y1);оказывается первый шаблон хрен заселектишь :(
      Protected hbmMem2 = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\fon_hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\start_fon_bits, #Null, #Null);
      *CustomCanvas\Canvas_Bufer\end_fon_bits=*CustomCanvas\Canvas_Bufer\start_fon_bits+bi\bmiHeader\biSizeImage-4
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,hbmMem2);устанавливаем шаблон для буфера фона
      DeleteObject_(hbmMem);больше шаблон bitmapa не нужен
      DeleteObject_(hbmMem2);больше шаблон bitmapa не нужен
      ReleaseDC_(canvashwnd,hdc)
      
      Protected kistb.i=CreateSolidBrush_($57FFFF);создаём дискриптор кисти для записи фона в контексты
      SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,kistb)
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb)
      FillRect_(*CustomCanvas\Canvas_Bufer\hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем контекст под рисование
      FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закрашиваем контекст под фон
      DeleteObject_(kistb);больше кисть не нужна
      ;копируем начальнай фон в канвас
      Protected hdcccanvasa.i
     hdcccanvasa = StartDrawing(CanvasOutput(canvas_id))
      BitBlt_(hdcccanvasa,0,0,x1,y1,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
     StopDrawing()
      ;
      SetWindowLongPtr_(canvashwnd,0,*CustomCanvas);заносим адрес памяти с структурой данных в дополнительную память окна cbWndExtra это не #gwl_userdata
    
    ProcedureReturn canvashwnd
 Else
    ProcedureReturn 0;канвас не создан
EndIf 
EndProcedure






Procedure.i CanvasOpenFileImage(Canvas_id);открытие файла и загрузка в канвас
  file$ = OpenFileRequester("Open File","","*.PNG|*.PNG*|*.GIF|*.GIF*|*.JPG|*.JPG*|*.BMP|*.BMP*|All files|*.*",1)
  
  Debug file$
  LoadImage(0, file$)
  
  SetGadgetAttribute(Canvas_id, #PB_Canvas_Image, ImageID(0))
  
  hdc=StartDrawing(CanvasOutput(Canvas_id))
  
  
  BitBlt_(hdc, 0, 0, imgW, imgH, hDC, 0, 0, #SRCCOPY)
  
  StopDrawing()
  
EndProcedure

If OpenWindow(0, 0, 0,1200, 600, "CustomCanvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  CreateCustomCanvas(WindowID(0),0,10,10,500,500)
 ;  SetCanvasFon(0,$29D4EC)
   CreateCustomCanvas(WindowID(0),1,600,10,450,400)
  ; SetCanvasFon(1,$29D4EC)
   ;OpenFileImage(0)
  
Else
  End
EndIf

;--------предварительные данные(рисунок) для теста
hdc=StartCanvasDrawing(GadgetID(0))
 For i=0 To 100
   CanvasApiSetPixel(hdc,20,i,$00CFC1)
   CanvasApiSetPixel(hdc,21,i,$00CFC1)
   CanvasApiSetPixel(hdc,22,i,$00CFC1)
   CanvasApiSetPixel(hdc,23,i,$00CFC1)
   CanvasApiSetPixel(hdc,24,i,$00CFC1)
   CanvasApiSetPixel(hdc,25,i,$00CFC1)
   
   CanvasDrawLine(hdc,100,i+50,300,i)
   
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;------------
;проверка на установку фона
SetCanvasIdFon(0,$F666FF)
;SetCanvasFon(1,$2266FF)
hdc=StartCanvasDrawing(GadgetID(1))
 For i=0 To 100
   CanvasApiSetPixel(hdc,20,i,$00CFC1)
   CanvasApiSetPixel(hdc,21,i,$00CFC1)
   CanvasApiSetPixel(hdc,22,i,$00CFC1)
   CanvasApiSetPixel(hdc,23,i,$00CFC1)
   CanvasApiSetPixel(hdc,24,i,$00CFC1)
   CanvasApiSetPixel(hdc,25,i,$00CFC1)
   
   CanvasDrawLine(hdc,100,i+50,300,i)
   
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;тест
For i=0 To 100
SetCanvasIdFon(0,i*i+$F666FF)
Next
For i=0 To 100
SetCanvasIdFon(1,i*i+$5677)
Next
;проверка что цвет меняется
SetCanvasIdFon(1,$57FFFF)














  ;{;Обработчик сообщений
 Repeat
  Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow;{;
     
         End
     
;};
   Case #PB_Event_Gadget
     Select EventGadget()
       Case 0
         
 
    EndSelect
      
      
  EndSelect
 ForEver;};

Отредактировано Sergeihik (11.01.2024 01:10:50)

Поделиться811.01.2024 08:38:24

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 191
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
8 дней 12 часов
Последний визит:
Вчера 12:32:04

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

Мне и под винду хватит,теперь когда есть прямой доступ к пикселям то опять будут изменения с удалением ненужных функций и дополнений.

Никогда не пойму тех кому "и под винду хватит" использующих purebasic.
Почему не использовать инструменты от мелкомягких?
Если ключевое слово basic то freebasic.
Связаться с автором https://sourceforge.net/projects/guiwindow9/ и дорабатывать canvas в своё удовольствие.

Поделиться911.01.2024 13:12:29

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

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

Никогда не пойму тех кому "и под винду хватит" использующих purebasic.
Почему не использовать инструменты от мелкомягких?
Если ключевое слово basic то freebasic.
Связаться с автором https://sourceforge.net/projects/guiwindow9/ и дорабатывать canvas в своё удовольствие.

Так как не программист и время вечно не хватает то изучать дополнительно другую операционную систему и программировать под неё нет некакого желания.а канвас да гляну приду с работы.

Поделиться1011.01.2024 13:40:58

Автор: AZJIO
Активный участник
Зарегистрирован: 07.08.2020
Приглашений: 0
Сообщений: 1050
Уважение: [+15/-0]
Позитив: [+13/-0]
Провел на форуме:
21 день 12 часов
Последний визит:
Вчера 22:22:01

Sergeihik
Не жалею, что Linux изучал и пару тройку лет сидел чисто на линуксе. Сейчас на мак хотелось бы компилировать, но как я понимаю нужен отдельный диск для мака. Чтобы попробовать Linux скачай образ ISO, и запусти его с флешки, сейчас много линуксовых сборок грузится прям с ISO. И можно даже установить таким образом с флешки, рекомендую Mint (20.3). Установит Grub2 и пропишет Windows автоматически.

Поделиться1111.01.2024 17:12:05

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

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

Если ключевое слово basic то freebasic.

Это конструктор "сделай сам".
По сути только компилятор. ИДЕ нужно искать стороннюю, отладчик самому прикручивать, про кроссплатформенные библиотеки вообще молчу. Для винды писать на WinAPI? Это на любителя. Проще на C++ тоже самое сделать.

Поделиться1211.01.2024 17:17:30

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

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

Никогда не пойму тех кому "и под винду хватит" использующих purebasic.
Почему не использовать инструменты от мелкомягких?
Если ключевое слово basic то freebasic.
Связаться с автором https://sourceforge.net/projects/guiwindow9/ и дорабатывать canvas в своё удовольствие.

А если проц от Intel то надо какой не будьть их Fortran на linux учить?
Откуда такие выводы "Если ключевое слово basic то freebasic."?,Может Qbasic или ещё какой basic?

Поделиться1311.01.2024 17:48:54

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 191
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
8 дней 12 часов
Последний визит:
Вчера 12:32:04

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

Откуда такие выводы

Я имел ввиду именно библиотеку window9, она в части win основана на api мелкомягких, придерживается стиля purebasic и написана автором для freebasic
http://freebasic.ucoz.com/forum/3-602-1
https://users.freebasic-portal.de/freeb … start.html

Во всём остальном для системы от мелкомягких думаю уместно и использовать инструменты от мелкомягких коих много.

P.s. вопрос: до моего сообщения не знали о существовании w9 от Станислава?

Отредактировано useful (11.01.2024 17:52:41)

Поделиться1411.01.2024 18:25:09

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

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

для системы от мелкомягких думаю уместно и использовать инструменты от мелкомягких

Почти все они для .NET
VS нативный код компилирует только для C++ и нужно писать на WinAPI.

Поделиться1511.01.2024 18:31:16

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 191
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
8 дней 12 часов
Последний визит:
Вчера 12:32:04

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

и нужно писать на WinAPI.

Так автор тему завёл именно конкретно об этом

Поделиться1611.01.2024 19:17:56

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

useful, код не целиком на WinAPI, а только частично.

Поделиться1712.01.2024 00:23:13

Автор: Webarion
Активный участник
Откуда: Москва
Зарегистрирован: 19.12.2021
Приглашений: 0
Сообщений: 223
Уважение: [+5/-0]
Позитив: [+20/-1]
Пол: Мужской
Возраст: 41 [1983-06-03]
Провел на форуме:
7 дней 23 часа
Последний визит:
08.10.2024 23:45:27

Мне очень интересно, на сколько быстрее от натива, будет работать ваш пример, в отрисовке, сбалансированного двоичного дерева поиска, особенно на "больших данных". Мой пример в нативе:

Код:

; AVLTree
; Описание ...: Реализация алгоритма АВЛ дерава для PureBasic
; Автор ......: Webarion
; Версия .....: 1.1b
; Примечание .: Здесь, ещё не оптимизировано, более простое удаление пользовательских данных из узла.
;             : Пользователь, должен сам позаботиться об их удалении

DeclareModule AVLTree
  
  EnableExplicit ; на этапе не релизных версий
  
  ;- STRUCTURES
  Structure Node 
    Key.i
    *Left.Node
    *Right.Node
    Height.b
    *Data
  EndStructure 
  
  ;- DECLARES
  Declare New(Key.i, *Data)
  Declare Insert(*Node.Node, Key.i, *Data)
  Declare Remove(*Root.Node, Key.i)
  Declare Find(*Node.Node, Key.i)
  
EndDeclareModule

Module AVLTree
  
  ;- INTERNAL PROCEDURES
  Procedure _Max(A.b, B.b)
    If A > B : ProcedureReturn A : EndIf
    ProcedureReturn B
  EndProcedure
  
  Procedure.b _Height(*Node.Node) 
    If *Node : ProcedureReturn *Node\Height : EndIf 
    ProcedureReturn 0
  EndProcedure
  
  Procedure _RightRotate(*Y.Node) 
    Protected *X.Node   = *Y\Left
    Protected *Tmp.Node = *X\Right
    *X\Right = *Y
    *Y\Left  = *Tmp
    *Y\Height = _Max(_Height(*Y\Left), _Height(*Y\Right)) + 1
    *X\Height = _Max(_Height(*X\Left), _Height(*X\Right)) + 1
    ProcedureReturn *X
  EndProcedure
  
  Procedure _LeftRotate(*X.Node) 
    Protected *Y.Node   = *X\Right
    Protected *Tmp.Node = *Y\Left
    *Y\Left  = *X
    *X\Right = *Tmp
    *X\Height = _Max(_Height(*X\Left), _Height(*X\Right)) + 1 
    *Y\Height = _Max(_Height(*Y\Left), _Height(*Y\Right)) + 1
    ProcedureReturn *Y
  EndProcedure 
  
  Procedure _LeftRightRotation(*Raiz.Node)
    *Raiz\Left = _LeftRotate(*Raiz\Left)
    ProcedureReturn _RightRotate(*Raiz)
  EndProcedure
  
  Procedure _RightLeftRotation(*Raiz.Node)
    *Raiz\Right = _RightRotate(*Raiz\Right)
    ProcedureReturn _LeftRotate(*Raiz)
  EndProcedure
  
  Procedure.b _BalanceFactor(*Node.Node) 
    If *Node : ProcedureReturn _Height(*Node\Left) - _Height(*Node\Right) : EndIf
    ProcedureReturn 0
  EndProcedure
  
  Procedure _MinKeyNode(*Node.Node) 
    Protected *Current.Node = *Node
    While *Current\Left
      *Current = *Current\Left 
    Wend
    ProcedureReturn *Current
  EndProcedure
  
  ;- USER PROCEDURES
  Procedure New(Key.i, *Data)
    Protected *Node.Node = AllocateStructure(Node)
    *Node\Key = Key
    *Node\Height = 1
    *Node\Data  = *Data
    ProcedureReturn *Node
  EndProcedure
  
  Procedure Insert(*Node.Node, Key.i, *Data)
    If Not *Node : ProcedureReturn New(Key, *Data) : EndIf
    If Key < *Node\Key 
      *Node\Left = Insert(*Node\Left, Key, *Data)
    ElseIf Key > *Node\Key 
      *Node\Right = Insert(*Node\Right, Key, *Data)
    Else
      *Node\Data  = *Data
      ProcedureReturn *Node
    EndIf
    *Node\Height = 1 + _Max(_Height(*Node\Left), _Height(*Node\Right))
    Protected Balance.b = _BalanceFactor(*Node)
    If Balance > 1  And Key < *Node\Left\Key  : ProcedureReturn _RightRotate(*Node) : EndIf
    If Balance < -1 And Key > *Node\Right\Key : ProcedureReturn _LeftRotate(*Node)  : EndIf
    If Balance > 1  And Key > *Node\Left\Key
      *Node\Left = _LeftRotate(*Node\Left)
      ProcedureReturn _RightRotate(*Node)
    EndIf
    If Balance < -1 And Key < *Node\Right\Key
      *Node\Right = _RightRotate(*Node\Right)
      ProcedureReturn _LeftRotate(*Node)
    EndIf
    ProcedureReturn *Node
  EndProcedure
  
  Procedure Remove(*Root.Node, Key.i)
    If Not *Root : ProcedureReturn *Root : EndIf
    If(*Root\Key > Key) 
      *Root\Left = Remove(*Root\Left, Key)
      If Abs(_BalanceFactor(*Root)) >= 2
        If _BalanceFactor(*Root\Right) = 1 : *Root = _RightLeftRotation(*Root) : Else : *Root = _LeftRotate(*Root) : EndIf
      EndIf
    ElseIf(*Root\Key < Key) 
      *Root\Right = Remove(*Root\Right, Key)
      If Abs(_BalanceFactor(*Root)) >= 2
        If _BalanceFactor(*Root\Left) = -1 : *Root = _LeftRightRotation(*Root) : Else : *Root = _RightRotate(*Root) : EndIf
      EndIf
    Else 
      Protected *Tmp.Node = 0
      If Not *Root\Left Or Not *Root\Right
        If *Root\Left : *Tmp = *Root\Left : Else : *Tmp = *Root\Right : EndIf
        FreeStructure(*Root)
        ProcedureReturn *Tmp
      EndIf
      *Tmp = _MinKeyNode(*Root\Right)
      *Root\Key  = *Tmp\Key
      *Root\Right = Remove(*Root\Right, *Root\Key)
      If Abs(_BalanceFactor(*Root)) >= 2
        If _BalanceFactor(*Root\Left) = -1 : *Root = _LeftRightRotation(*Root) : Else :  *Root = _RightRotate(*Root) : EndIf
      EndIf
    EndIf
    *Root\Height = _Max(_Height(*Root\Right), _Height(*Root\Left)) + 1
    ProcedureReturn *Root
  EndProcedure 
  
  Procedure Find(*Node.Node, Key.i)
    If Not *Node : ProcedureReturn 0 : EndIf
    Static *LastFind.Node = 0
    If *LastFind And *LastFind\Key = Key
      ProcedureReturn *LastFind
    EndIf
    If Key < *Node\Key
      ProcedureReturn Find(*Node\Left, Key)
    ElseIf Key > *Node\Key
      ProcedureReturn Find(*Node\Right, Key)
    EndIf
    *LastFind = *Node
    ProcedureReturn *Node
  EndProcedure
  
  DisableExplicit
  
EndModule


;- *** EXAMPLE *** 
CompilerIf #PB_Compiler_IsMainFile
  
  EnableExplicit
  
  Enumeration DrawingType ; как рисовать. 2DDrawing или Vector
    #DrawingVector        ; это для красоты
    #Drawing2D            ; это для скорости
  EndEnumeration
  
  Structure MyData ; мои личные данные, которые буду использовать в АВЛ дереве
    Data.i
    ColorNode.l
  EndStructure
  
  
  Global FontID = FontID(LoadFont(#PB_Any, "Courrier New", 6))
  ; отрисовка
  Procedure _Draw(Canvas, *tree.AVLTree::Node, TypeDraw.a = 0, OldX.d = 0, OldY = 0, x.d = 0, y = 20, C.d = 0, Pos.b = 0, NodeColor = $FF000000, Rec.a = 0)
    If Not Rec 
      If TypeDraw = #DrawingVector
        StartVectorDrawing(CanvasVectorOutput(Canvas))
        VectorSourceColor($FFFFFFFF)
        FillVectorOutput()
      Else
        StartDrawing(CanvasOutput(Canvas))
        DrawingMode(#PB_2DDrawing_Default)
        Box(0, 0, OutputWidth(), OutputHeight())
      EndIf
    EndIf
    Define OW.d
    If TypeDraw = #DrawingVector
      ResetCoordinates()
      OW.d = VectorOutputWidth()
    Else
      OW.d = OutputWidth()
    EndIf
    
    Define hOW = OW/2
    If x = 0 
      x = hOW : OldX = x
    EndIf
    If C = 0 
      C = hOW - 20
    EndIf
    If x <> OldX
      If TypeDraw = #DrawingVector
        MovePathCursor(OldX, OldY)
        AddPathLine(x, y)
        VectorSourceColor(NodeColor)
        StrokePath(1, #PB_Path_RoundCorner)
      Else
        LineXY(OldX, OldY, x, y, NodeColor)
      EndIf
    EndIf
    With *tree
      C / 2
      If C < 1 : C = 1 : EndIf
      Protected *MyData.MyData = *tree\Data
      If Not *MyData\ColorNode
        NodeColor = RGBA(Random(220,50), Random(220,50), Random(220,50), 255)
        *MyData\ColorNode = NodeColor
      Else
        NodeColor = *MyData\ColorNode
      EndIf
      
      If \Left
        _Draw(Canvas, \Left, TypeDraw, x, y, x-C, y+33, C, -1, NodeColor, Rec + 1)
      EndIf
      If \Right
        _Draw(Canvas, \Right, TypeDraw, x, y, x+C, y+33, C, 1, NodeColor, Rec + 1)
      EndIf
      
      Protected Text$ = Str(\Key), tW = 0, tH = 0
      
      If TypeDraw = #DrawingVector
        tW = VectorTextWidth(Text$) : tH = VectorTextHeight(Text$)
        AddPathCircle(x, y, 3)
        VectorSourceColor($FF0000FF)  
        FillPath()
      Else
        tW = TextWidth(Text$) : tH = TextHeight(Text$)
        Circle(x, y, 3, $FF0000FF) 
      EndIf
      
      If Rec = 0
        Pos = -tW/2
      ElseIf Rec < 5 And Pos = -1
        Pos = -tW
      ElseIf Rec = 5 And Pos = -1
        Pos = 5
      Else
        Pos = 0
      EndIf
      
      If TypeDraw = #DrawingVector
        VectorFont(FontID)
        If Rec = 6
          VectorFont(FontID, 6)
        EndIf 
        If Rec < 7 
          MovePathCursor(x + Pos, y - 11)
          VectorSourceColor($FF000000)
          DrawVectorText(Text$)
        EndIf         
      Else
        If Rec < 7
          DrawingFont(FontID)
          DrawingMode(#PB_2DDrawing_Transparent)
          DrawText(x + Pos, y - 11, Text$, 0)
        EndIf 
      EndIf
    EndWith
    If Not Rec
      If Not TypeDraw
        StopVectorDrawing()
      Else
        StopDrawing()
      EndIf
    EndIf
  EndProcedure
  
  ;- User Variables
  Define DrawMethod = #DrawingVector ; для большей скорости отрисовки, использовать #Drawing2D
  
  Define Count = 0, TypeDraw$ = "2DDrawing"
  If #PB_Compiler_Debugger ; для медленной демонстрации построения дерева, запустить с отладчиком
    Count = 254
    If DrawMethod = #DrawingVector
      TypeDraw$ = "Vector"
    EndIf
  Else ; для более быстрой демонстрации, без отладчика
    If DrawMethod = #Drawing2D
      Count = 131068
    Else
      Count = 16382
      TypeDraw$ = "Vector"
    EndIf
  EndIf
  
  ;- OpenWindow
  If OpenWindow(0, 0, 0, 900, 600, "АВЛ дерево. " + Str(Count) + " узл. Демонстрация добавления = " + Str(#PB_Compiler_Debugger) + ". Тип рисования: " + TypeDraw$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    CanvasGadget(0, 10, 10, 880, 580)
    
    Define *AVLTree.AVLTree::Node = 0, Key
    
    Define *MyData.MyData = 0
    For Key = 0 To Count
      *MyData.MyData = AllocateStructure(MyData) ; создаём структуру личных данных
      *MyData\Data = Key ; и просто пишем ключ, для последующей проверки
      *AVLTree = AVLTree::Insert(*AVLTree, Key, *MyData) ; создаём узел, соответствующий ключу
      If #PB_Compiler_Debugger ; рисование в реальном времени, только при включенном отладчике, иначе "большие данные" будут рисоваться очень долго
        _Draw(0, *AVLTree, DrawMethod, 0, 10)
      EndIf
    Next
    
    ; TODO если личные данные, являются указателями на выделенную память или структуру,
    ; для их правильного удаления, сначала нужно найти ключ, а потом, самостоятельно удалить эти данные.
    ; В этой версии, пока так. Remove удаляет только узел. Так как неизвестно, какой тип данных использует пользователь
    AVLTree::Remove(*AVLTree, 31) ; поэтому в этих двух строках, есть утечка памяти - так как пользовательские данные не удаляются
    AVLTree::Remove(*AVLTree, 18)
    
    _Draw(0, *AVLTree, DrawMethod, 0, 10)
    
    Define.q t1, t2
    t1 = ElapsedMilliseconds()
    Define *Find.AVLTree::Node = AVLTree::Find(*AVLTree, Count)
    t2 = ElapsedMilliseconds()-t1
    
    If *Find
      *MyData = *Find\Data
      MessageRequester("Поиск последнего ключа", "Найден ключ: " + Str(*Find\Key) + #CRLF$ + 
                                                  "Указатель на данные: " + Str(*MyData) + #CRLF$ + 
                                                  "Подтверждение в данных: " + Str(*MyData\Data) + #CRLF$ + 
                                                  "Время поиска: " + Str(t2))
    Else
      MessageRequester("Поиск ключа", "Указынный ключ не найден")
    EndIf
    
    
    
    Repeat
      Define Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    
  EndIf
  
  DisableExplicit
  
CompilerEndIf

Отредактировано Webarion (12.01.2024 04:29:20)

Поделиться1813.01.2024 07:29:40

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 191
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
8 дней 12 часов
Последний визит:
Вчера 12:32:04

Господатоварищи, я отталкивался от

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

... Мне и под винду хватит, ...

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

... Так как не программист ...

и в такой постановке нативный результат компиляции или в байткод под net вообще не принципиально, главное, что результат будет получен.
Net для систем от мелкомягких считай нативно уже сейчас а в перспективе выхода за пределы x86 точно.

С какой целью вы отталкиваетесь от своих нужд и представлений о том, что обсуждается в этой теме?

p.s. Мне кажется, что мелкомягкие со своей экосистемой NET идут по пути https://ru.wikipedia.org/wiki/IBM_System_i
которая начиналась как as/400 и у неё "нативный" только микрокод, за все годы железо менялось многократно а софт работает тот же,
который начали писать на эмуляторе ещё до того как первое железное воплощение появилось. Т.е. под новую железку переписывается только самый нижний слой софта.

Отредактировано useful (13.01.2024 08:32:43)

Поделиться1913.01.2024 13:58:57

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 2997
Уважение: [+97/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 10 дней
Последний визит:
Вчера 18:39:54

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

за все годы железо менялось многократно а софт работает тот же

На современной винде (10 / 11) можно запустить многий софт, работающий на Win95 и ни какой перекомпиляции не потребуется.

Поделиться2013.01.2024 14:04:45

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

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

P.s. вопрос: до моего сообщения не знали о существовании w9 от Станислава?

Отредактировано useful (11.01.2024 17:52:41)

Нет не знал,думаю можно идеи подчеркнуть будет от туда.

Поделиться2113.01.2024 16:14:13

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 191
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
8 дней 12 часов
Последний визит:
Вчера 12:32:04

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

На современной винде (10 / 11) можно запустить многий софт, работающий на Win95 и ни какой перекомпиляции не потребуется.

Даже не смешно. Я ведь речь веду о примере в котором железо в принципе не совместимо на самом нижнем уровне. Это абсолютно не сравнимо с совместимостью снизу вверх для x86.
Когда в 70-80хх прошлого века появилась TIMI («Technology Independent Machine Interface», под которую и тогда и сейчас компилится софт, вообще не существовало ни одной железки её реализующей.
OS/400 разрабатывалась и отлаживалась на эмуляторе и вышла одновременно с первой железной реализацией. В последующем нижний слой железа естественно многократно за столько лет менялся ПРИНЦИПИАЛЬНО.
И мне кажется развивая NET мелкомягкие именно по такому пути и пойдут.

Отредактировано useful (13.01.2024 16:32:21)

Поделиться2228.01.2024 10:39:16

Автор: Sergeihik
Активный участник
Зарегистрирован: 27.07.2021
Приглашений: 0
Сообщений: 184
Уважение: [+3/-3]
Позитив: [+0/-0]
Провел на форуме:
2 дня 19 часов
Последний визит:
20.11.2024 02:00:10

Вобщем код преображаю по немногу,хочу ещё сделать фон чтобы картинкой можно было загружать.

Код:

UseTIFFImageDecoder() 
UseJPEGImageDecoder() 
UseTGAImageDecoder() 
UsePNGImageDecoder()
Structure xy
  x1.w
  y1.w
EndStructure
Structure Bufer_bitmap
  hdc.i
  start_hdc_bits.i
  end_hdc_bits.i
  hdcxy.xy
  fon_hdc.i
  start_fon_bits.i
  end_fon_bits.i
EndStructure
Structure CustomCanvas
  Canvas_id.i
  Canvas_hwnd.i
  Canvas_Rect.rect
  Canvas_Bufer.Bufer_bitmap
EndStructure
;================================
Global *CustomCanvas2.CustomCanvas
Global hdcccanvasa2.i
;================================
;================================
Structure _PATRECT
x.i; // x-coord of upper-left rectangle corner
y.i; // y-coord of upper-left rectangle corner
cx.i; // width of rectangle
cy.i; // height of rectangle
HBRUSH.i ; // brush handle
EndStructure
Structure r
  r.a
  g.a
  b.a
  a.a
EndStructure  
Structure rgba
StructureUnion 
   x.r
  rgba.l
EndStructureUnion
EndStructure
Macro CanvasApiSetPixel(HDC,nXPos,nYPos,COLORREF)
  SetPixel_(HDC,nXPos,nYPos, COLORREF)
EndMacro
Macro CanvasApiGetPixel(HDC,nXPos,nYPos)
  GetPixel_(HDC,nXPos,nYPos)
EndMacro
Macro CanvasApiSetPixelV(HDC,x,y,COLORREF)
  SetPixelV_(HDC,x,y COLORREF)
EndMacro
;------
Macro CanvasMoveToEx(hdc,x,y,lpout_POINT)
;обновляет текущую позицию до указанной точки и при необходимости возвращает предыдущую позицию
 MoveToEx_(hdc,x,y,lpout_POINT)
EndMacro
Macro CanvasLineDDA(xStart,yStart,xEnd,yEnd,lpProc_LINEDDAPROC,lp_Data)
;определяет, какие пиксели должны быть выделены для линии, определенной указанными начальной и конечной точками.
 LineDDA_(xStart,yStart,xEnd,yEnd,lpProc_LINEDDAPROC,lp_Data)
EndMacro
Macro CanvasLineTo(HDC,x,y)
;рисует линию от текущей позиции до указанной точки, но не включает ее
 LineTo_(HDC,x,y)
EndMacro
Macro CanvasDrawLine(HDC,x1,y1,x2,y2)
 pt.POINT;
 MoveToEx_(HDC, x1, y1,@pt);
 LineTo_(HDC, x2, y2)
EndMacro
;------
Macro CanvasPie(hdc,left,top,right,bottom,xr1,yr1,xr2,yr2)
;рисует круговую клиновую форму, ограниченную пересечением эллипса и двух радиалей.
;Круговая диаграмма создается с помощью текущего пера и заполняется с помощью текущей кисти
Pie_(hdc,left,top,right,bottom,xr1,yr1,xr2,yr2)
EndMacro
Macro CanvasDrawArc(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
Arc_(HDC,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro
Macro CanvasDrawArcTo(HDC,left,top,right,bottom,xr1,yr1,xr2,yr2)
ArcTo_(HDC,left,top,right,bottom,xr1,yr1,xr2,yr2)
EndMacro
Macro CanvasDrawAngleArc(HDC,x1,y1,x2,r,StartAngle,SweepAngle)
;рисует сегмент линии и дугу. Сегмент линии отрисовывается от текущей позиции до начала дуги.
;Дуга рисуется по периметру окружности с заданным радиусом и центром. Длина дуги определяется заданными углами начала и развертки
AngleArc_(HDC,x1,y1,x2,r,StartAngle,SweepAngle)
EndMacro
Macro CanvasChord(hdc,x1,y1,x2,y2,x3,y3,x4,y4)
;рисует аккорд (область, ограниченную пересечением эллипса и сегмента линии, называемого секантом).
;Аккорд задается с помощью текущего пера и заполняется с помощью текущей кисти.
Chord_(hdc,x1,y1,x2,y2,x3,y3,x4,y4)
EndMacro
Macro CanvasSetArcDirection(hdc,dir)
;задает направление рисования, которое будет использоваться для дуговых и прямоугольных функций.
;#AD_COUNTERCLOCKWISE Рисунки, нарисованные против часовой стрелки.
;#AD_CLOCKWISE Рисунки, нарисованные по часовой стрелке.
SetArcDirection_(hdc, dir)
EndMacro
Macro CanvasEllipse(hdc,left,top,right,bottom)
;рисует эллипс. Центр эллипса — это центр указанного ограничивающего прямоугольника.
;Эллипс выделен с помощью текущего пера и заполняется с помощью текущей кисти
Ellipse_(hdc,left,top,right,bottom)
EndMacro
;------

;===========
ProcedureDLL.l RGBrearrange(l.l)
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],16;кольцевой сдвиг 
!ror word [p.v_l],8;кольцевой сдвиг 
!ror dword [p.v_l],8;кольцевой сдви
  ProcedureReturn l
EndProcedure
;=============================
;для операций загрузки выгрузки
;получить структуру канваса 
ProcedureDLL.i GetDataCanvasid(id) 
  
EndProcedure
;загрузить данные в структуру канваса
ProcedureDLL.i SetDataCanvasid(id) 
  
EndProcedure
;=============================
ProcedureDLL.i DialogSetCanvasFon(id)
 Protected window_hwnd.i = OpenWindow(#PB_Any, 0, 0,300, 300, "Выбор фона",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If window_hwnd<>0
 Protected Button_hwnd.i=ButtonGadget(#PB_Any,215,265,75,25,"Применить")
;{;гаджеты для цвета фона окна
TextGadget(#PB_Any, 50,  100, 100, 20,"Цвет фона")
Protected vyvod_fona_okna=TextGadget(#PB_Any, 180,  100, 100, 20,"")
;
TextGadget(#PB_Any, 5,  120, 10, 20,"R")
Protected tr=TextGadget(#PB_Any, 18,  120, 20, 20,"")
Protected r=TrackBarGadget(#PB_Any, 40,120, 250, 20, 0, 255)
;
TextGadget(#PB_Any, 5,  145, 10, 20,"G")
Protected tg=TextGadget(#PB_Any, 18,145, 20, 20,"")
Protected g=TrackBarGadget(#PB_Any, 40,145, 250, 20, 0, 255)
;
TextGadget(#PB_Any, 5,  170, 10, 20,"B")
Protected tb=TextGadget(#PB_Any, 18,170, 20, 20,"")
Protected b=TrackBarGadget(#PB_Any, 40,170, 250, 20, 0, 255)
;};
;{;получаем из контекста цвет фона окна
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(GadgetID(id),0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits
 Protected cvetfona.l=*i\l;получаем предыдущий цвет фона
 Protected fon_okna.rgba
 fon_okna\rgba=*i\l
 SetGadgetText(vyvod_fona_okna,"$"+Hex(cvetfona))

;Debug GetDCBrushColor_(hdc)
;color_fon_okna\rgba=GetStockObject_(#DC_BRUSH)
;Debug color_fon_okna\rgba
SetGadgetText(tr,"$"+Hex(fon_okna\x\r))
SetGadgetState(r,fon_okna\x\r)
;*a+1
SetGadgetText(tg,"$"+Hex(fon_okna\x\g))
SetGadgetState(g,fon_okna\x\g)
;*a+1
SetGadgetText(tb,"$"+Hex(fon_okna\x\b))
SetGadgetState(b,fon_okna\x\b)
;};
Else
  ProcedureReturn 0
EndIf
Protected predydushii_cvetfona.l=cvetfona
Protected hdcccanvasa.i
Protected cvet.l
;обработчик
Repeat
 Select WaitWindowEvent() 
   Case #PB_Event_Gadget
     Select EventGadget()
;{;установка цвета Фона окна
      Case r
         predydushii_cvetfona=fon_okna\rgba;*i\l;получаем предыдущий цвет фона
         fon_okna\x\r=GetGadgetState(r)
         SetGadgetText(tr,"$"+Hex(fon_okna\x\r))
         SetGadgetText(vyvod_fona_okna,"$"+Hex(fon_okna\rgba))
;==========
;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона        
podprograma:
  cvet=fon_okna\rgba
  For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4
   If *i\l=predydushii_cvetfona
     *i\l=cvet;fon_okna\rgba
   EndIf
  Next
    hdcccanvasa = StartDrawing(CanvasOutput(id))
     ;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
      BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
;==========
      Case g
         predydushii_cvetfona=fon_okna\rgba;*i\l;получаем предыдущий цвет фона
         fon_okna\x\g=GetGadgetState(g)
         SetGadgetText(tg,"$"+Hex(fon_okna\x\g))
         SetGadgetText(vyvod_fona_okna,"$"+Hex(fon_okna\rgba)) 
        Goto podprograma
      Case b  
         predydushii_cvetfona=fon_okna\rgba;*i\l;получаем предыдущий цвет фона
         fon_okna\x\b=GetGadgetState(b)
         SetGadgetText(tb,"$"+Hex(fon_okna\x\b))
         SetGadgetText(vyvod_fona_okna,"$"+Hex(fon_okna\rgba))
        Goto podprograma
      Case Button_hwnd
      For *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits To *CustomCanvas\Canvas_Bufer\end_fon_bits Step 4
      *i\l=fon_okna\rgba
      Next
      CloseWindow(window_hwnd)
      ProcedureReturn 1
;};
    EndSelect
   Case #PB_Event_CloseWindow;{;
    CloseWindow(window_hwnd)
    ;DestroyWindow_(window_hwnd)
    For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4
     If *i\l=predydushii_cvetfona
      *i\l=cvetfona
     EndIf
    Next
    hdcccanvasa = StartDrawing(CanvasOutput(id))
     ;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
      BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
    ProcedureReturn 0
;};  
 EndSelect
ForEver
EndProcedure
;
ProcedureDLL.i DialogCanvasScale(id)
Protected window_hwnd.i = OpenWindow(#PB_Any, 0, 0,300, 300, "Palette",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 If window_hwnd<>0
  Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(GadgetID(id),0);получаем адрес структуры наших контекстов памяти и их параметров 
  ;Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits  
 EndIf   
;извлекает текущий графический режим для указанного контекста устройства
 If GetGraphicsMode_(*CustomCanvas\Canvas_Bufer\hdc)=#GM_COMPATIBLE
   SetGraphicsMode_(*CustomCanvas\Canvas_Bufer\hdc,#GM_ADVANCED);установить расширенный режим
 EndIf
 Protected PFLOAT.f
 ;извлекает ограничение miter для указанного контекста устройства
 ;Ограничение митеров используется при рисовании геометрических линий с митерными соединениями
 ;извлекает предел скоса для указанного контекста устройства
 ;Предел скоса используется при рисовании геометрических линий, имеющих соединения под углом
 Debug GetMiterLimit_(*CustomCanvas\Canvas_Bufer\hdc,@PFLOAT)
 Debug StrF(PFLOAT)
 
;обработчик
Repeat
 Select WaitWindowEvent() 
   Case #PB_Event_Gadget
     Select EventGadget()
;{;
         
;};
    EndSelect
   Case #PB_Event_CloseWindow;{;
    CloseWindow(window_hwnd)

    ProcedureReturn 0
;};  
 EndSelect
ForEver 
 
EndProcedure
ProcedureDLL.i DialogCanvasTestDrawing(id)
  
EndProcedure 
;
ProcedureDLL.l CanvasIdMemSetPixel(id,nXPos,nYPos,COLORREF)
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
; 
  If nXPos<0 Or nXPos>*CustomCanvas\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas\Canvas_Bufer\hdcxy\y1
    ;вне окна контекста
    ProcedureReturn 0
  Else
    COLORREF= RGBrearrange(COLORREF)
    Protected *cvet.long
    If y>-1
       nYPos=(*CustomCanvas\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    Else
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure
ProcedureDLL.l CanvasIdMemGetPixel(id,nXPos,nYPos)
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров  
;
  If nXPos<0 Or nXPos>*CustomCanvas\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas\Canvas_Bufer\hdcxy\y1
     ;вне окна контекста
    ProcedureReturn 0
  Else
    Protected *cvet.long
    If y=0
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    Else
      nYPos=(*CustomCanvas\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    EndIf
  EndIf
EndProcedure
 ;
ProcedureDLL.l CanvasMemSetPixel(nXPos,nYPos,COLORREF)
; 
  If nXPos<0 Or nXPos>*CustomCanvas2\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas2\Canvas_Bufer\hdcxy\y1
    ;вне окна контекста
    ProcedureReturn 0
  Else
    COLORREF= RGBrearrange(COLORREF)
    Protected *cvet.long
    If y>-1
       nYPos=(*CustomCanvas2\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    Else
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      *cvet\l=COLORREF
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure
ProcedureDLL.l CanvasMemGetPixel(nXPos,nYPos)
;
  If nXPos<0 Or nXPos>*CustomCanvas2\Canvas_Bufer\hdcxy\x1 Or nYPos<0 Or nYPos>*CustomCanvas2\Canvas_Bufer\hdcxy\y1
     ;вне окна контекста
    ProcedureReturn 0
  Else
    Protected *cvet.long
    If y=0
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    Else
      nYPos=(*CustomCanvas2\Canvas_Bufer\hdcxy\x1*4)*(nYPos-1)
      *cvet=*CustomCanvas2\Canvas_Bufer\end_hdc_bits-nYPos-(nXPos*4)
      ProcedureReturn RGBrearrange(*cvet\l)
    EndIf
  EndIf
EndProcedure
;====установка фона которым также можно функциями CanvasCLS() очистить контекст памяти
ProcedureDLL.l SetCanvasFon(newfon);
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected *i.long=*CustomCanvas2\Canvas_Bufer\start_fon_bits
 Protected predydushii_cvetfona.l=*i\l;получаем предыдущий цвет фона

   cikl:;установки нового фона
     *i\l=newfon
   If *i<*CustomCanvas2\Canvas_Bufer\end_fon_bits
     *i+4
     Goto cikl
   EndIf  
  ;===============
  For *i.long=*CustomCanvas2\Canvas_Bufer\start_hdc_bits To *CustomCanvas2\Canvas_Bufer\end_hdc_bits Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
     *i\l=newfon
   EndIf
  Next
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
  ProcedureReturn predydushii_cvetfona
EndProcedure
ProcedureDLL.l SetCanvasIdFon(id,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits
 Protected predydushii_cvetfona.l=*i\l;получаем предыдущий цвет фона
 ;newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],16;кольцевой сдвиг 
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],8;кольцевой сдви
;
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
 ;Debug "CanvasIdMemGetPixel  "+Str(RGBrearrange(CanvasIdMemGetPixel(id,0,0)))
  ;================
 ; Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb);установка нового фона в контекст фона
 ; FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закраска контекста для фона новым фоном
   cikl:;установки нового фона
     *i\l=newfon
   If *i<*CustomCanvas\Canvas_Bufer\end_fon_bits
     *i+4
     Goto cikl
   EndIf  
  ;===============
  For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
     *i\l=newfon
   EndIf
  Next
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
  ProcedureReturn predydushii_cvetfona
EndProcedure
ProcedureDLL.l SetCanvasHwndFon(canvashwnd,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров 
 Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits
 Protected predydushii_cvetfona.l=*i\l;получаем предыдущий цвет фона
 ;newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],16;кольцевой сдвиг 
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],8;кольцевой сдви
;
   cikl:;установки нового фона
     *i\l=newfon
   If *i<*CustomCanvas\Canvas_Bufer\end_fon_bits
     *i+4
     Goto cikl
   EndIf  
  ;===============
  For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
     *i\l=newfon
   EndIf
  Next
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
  ProcedureReturn predydushii_cvetfona
EndProcedure
ProcedureDLL.l SetCanvasDataFon(*CustomCanvas.CustomCanvas,newfon.l)
  If newfon>16777215 Or newfon<0;только три байта цвета иначе происходит сбой
    ProcedureReturn -1
  EndIf
;===========
 Protected *i.long=*CustomCanvas\Canvas_Bufer\start_fon_bits
 Protected predydushii_cvetfona.l=*i\l;получаем предыдущий цвет фона
 ;newfon=RGBrearrange(newfon);новый фон для установки в буфер напрямую в таблицу цветов пикселей
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],16;кольцевой сдвиг 
!ror word [p.v_newfon],8;кольцевой сдвиг 
!ror dword [p.v_newfon],8;кольцевой сдви
;
 ;Debug "GetPixel_  "+Str(RGBrearrange(GetPixel_(*CustomCanvas\Canvas_Bufer\fon_hdc,0,0)))
 ;Debug "CanvasIdMemGetPixel  "+Str(RGBrearrange(CanvasIdMemGetPixel(id,0,0)))
  ;================
 ; Protected HBRUSH.l =SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,kistb);установка нового фона в контекст фона
 ; FillRect_(*CustomCanvas\Canvas_Bufer\fon_hdc,*CustomCanvas\Canvas_Rect,kistb);закраска контекста для фона новым фоном
   cikl:;установки нового фона
     *i\l=newfon
   If *i<*CustomCanvas\Canvas_Bufer\end_fon_bits
     *i+4
     Goto cikl
   EndIf  
  ;===============
  For *i.long=*CustomCanvas\Canvas_Bufer\start_hdc_bits To *CustomCanvas\Canvas_Bufer\end_hdc_bits Step 4;если предыдущий цвет пикселя у фона контекста совпадает то меняем на новый пиксель фона
   If *i\l=predydushii_cvetfona
     *i\l=newfon
   EndIf
  Next
    Protected hdcccanvasa.i
    hdcccanvasa = StartDrawing(CanvasOutput(*CustomCanvas\Canvas_id))
;копируем в контекст вывода канваса окна (хотя у него тоже буфер в памяти :))  
    BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
    StopDrawing()
  ProcedureReturn predydushii_cvetfona
EndProcedure
;=============Очистка контекста
ProcedureDLL CanvasCLS();clear для рисования по startdrawing-stop очистка контекста памяти
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
EndProcedure
ProcedureDLL CanvasIdCLS(id);clear по id
 Protected canvashwnd.i=GadgetID(id);контекст окна канваса для копирование в него контекста памяти куда рисуем
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров  
 Protected hdcccanvasa.i=StartDrawing(CanvasOutput(id))
 BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
 StopDrawing()
EndProcedure
ProcedureDLL CanvasHwndCLS(canvashwnd);clear по hwnd
 Protected *CustomCanvas.CustomCanvas=GetWindowLongPtr_(canvashwnd,0);получаем адрес структуры наших контекстов памяти и их параметров  
 Protected hdcccanvasa.i=StartDrawing(CanvasOutput(id))
 BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
 StopDrawing()
EndProcedure
ProcedureDLL CanvasDataCLS(*CustomCanvas.CustomCanvas);clear по hwnd
 Protected hdcccanvasa.i=StartDrawing(CanvasOutput(*CustomCanvas\Canvas_id))
 BitBlt_(hdcccanvasa,0,0,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\fon_hdc, 0, 0,#SRCCOPY)
 StopDrawing()
EndProcedure
;============

;Вывод контекста памяти в контекст окна
ProcedureDLL.i StartCanvasDrawing(canvashwnd)
 *CustomCanvas2.CustomCanvas = GetWindowLongPtr_(canvashwnd,0)
  hdcccanvasa2 = StartDrawing(CanvasOutput(*CustomCanvas2\Canvas_id))
  ProcedureReturn *CustomCanvas2\Canvas_Bufer\hdc
EndProcedure
ProcedureDLL StopCanvasDrawing()
  BitBlt_(hdcccanvasa2,0,0,*CustomCanvas2\Canvas_Rect\right,*CustomCanvas2\Canvas_Rect\bottom,*CustomCanvas2\Canvas_Bufer\hdc, 0, 0,#SRCCOPY)
  StopDrawing()
EndProcedure 

Global rodnoi_obrabothik_canvasov.i=0
Procedure Canvascalbakk(hwnd,msg,wparam,lparam)
  Protected *CustomCanvas.CustomCanvas
 ;result=CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
 
 
 Select msg
;    Case #WM_PAINT
;ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика


   ;   *CustomCanvas=GetWindowLongPtr_(hwnd,0)
      
     ;Protected hdc= StartDrawing(CanvasOutput(GetWindowLongPtr_(hwnd,#GWL_ID)))

            ;  Protected kistb.i=CreateSolidBrush_($294EEC)
      ;SelectObject_(hdc,kistb)
      ;Rectangle_(hdc,0,0,*CustomCanvas\Canvas_Bufer\xy\x1,*CustomCanvas\Canvas_Bufer\xy\y1)
          ;BitBlt_(hdc,*CustomCanvas\Canvas_Rect\left,*CustomCanvas\Canvas_Rect\top,*CustomCanvas\Canvas_Rect\right,*CustomCanvas\Canvas_Rect\bottom,*CustomCanvas\Canvas_Bufer\hdc, 0, 0,#SRCCOPY);копирование картинки из контекста окна в память ввиде поля bitmap

 
          ;StopDrawing()
      
      
 ;ProcedureReturn 0
    Case #WM_DESTROY
      Debug "#WM_NCDESTROY"
      Debug hwnd
     *CustomCanvas=GetWindowLongPtr_(hwnd,0);получаем адрес данных
    If *CustomCanvas\Canvas_Bufer\fon_hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\fon_hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\fon_hdc)
    EndIf
    If *CustomCanvas\Canvas_Bufer\hdc<>0;если контекст получен был
      ;DeleteObject_(*CustomCanvas\Canvas_Bufer\hdc);удаляем контекст
      DeleteDC_(*CustomCanvas\Canvas_Bufer\hdc)
    EndIf
    
   ; ReleaseDC_(hwnd,*CustomCanvas\Canvas_hdc);удаляем контекст канваса
    
    FreeMemory(*CustomCanvas);удаляем память данных для окна канваса
    ;SetWindowLongPtr_(hwnd,0,0);память очищена и в доп.память окна под адрес данных ставим 0
    ;
    SetWindowLongPtr_(hwnd,#GWL_WNDPROC,rodnoi_obrabothik_canvasov)  
 EndSelect
; ProcedureReturn result;
ProcedureReturn CallWindowProc_(rodnoi_obrabothik_canvasov, hWnd, Msg, wParam, lParam);перерисовка с родного обработчика
; ProcedureReturn DefWindowProc_(hwnd,msg,wParam,lParam)
EndProcedure
;Создание контекста памяти для рисования и фона
ProcedureDLL.i CreateCustomCanvas(windowhwnd,canvas_id,x,y,x1,y1,flag.l=0)
 Protected canvashwnd.i
 canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1,flag);Createcanvas(windowhwnd,0,30,0,450,500,@Canvaskalbak())
 If GetClassLongPtr_(canvashwnd,-18)=0;дополнтительная память в классе под окно не выделенна
   SetClassLongPtr_(canvashwnd,-18,8) ;теперь окна канваса создаются с дополнительной памятью
   ;SetClassLongPtr_(canvashwnd,-26,#CS_OWNDC);теперь контекст рисования частный(постоянный)
   ;пересоздаём окно канваваса уже с нашимии изменениями
   DestroyWindow_(canvashwnd)
   canvashwnd=CanvasGadget(canvas_id,x,y,x1,y1)
 EndIf  
 ;
 If canvashwnd<>0
     If rodnoi_obrabothik_canvasov=0;он изначально один для всех что бы не повторяться с этой операцией
       rodnoi_obrabothik_canvasov=SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     Else
       SetWindowLongPtr_(canvashwnd,#GWLP_WNDPROC,@Canvascalbakk())
       SetWindowLongPtr_(canvashwnd,#GWL_ID,canvas_id)
     EndIf
    ;структура данных для хранения
     Protected *CustomCanvas.CustomCanvas
     *CustomCanvas=AllocateMemory(SizeOf(CustomCanvas))
     *CustomCanvas\Canvas_id=canvas_id
     *CustomCanvas\Canvas_hwnd=canvashwnd
     *CustomCanvas\Canvas_Rect\left=0
     *CustomCanvas\Canvas_Rect\top=0
     *CustomCanvas\Canvas_Rect\right=x1
     *CustomCanvas\Canvas_Rect\bottom=y1
     ;Protected rect.RECT
     ;GetClientRect_(canvashwnd,*CustomCanvas\Canvas_Rect)
     ;Debug "rect"
     ;Debug *CustomCanvas\Canvas_Rect\left;*CustomCanvas\Canvas_Rect\left
     ;Debug *CustomCanvas\Canvas_Rect\top
     ;Debug *CustomCanvas\Canvas_Rect\right 
     ;Debug *CustomCanvas\Canvas_Rect\bottom
     ;
     *CustomCanvas\Canvas_Bufer\hdcxy\x1=x1
     *CustomCanvas\Canvas_Bufer\hdcxy\y1=y1
     ;
     Protected hdc.i=GetDC_(canvashwnd);GetDCEx_(canvashwnd,0,#DCX_CACHE|#DCX_CLIPCHILDREN|#DCX_CLIPSIBLINGS)
     *CustomCanvas\Canvas_Bufer\hdc = CreateCompatibleDC_(hdc);создаем контекст устройства памяти для рисованя, совместимый с указанным устройством
     *CustomCanvas\Canvas_Bufer\fon_hdc=CreateCompatibleDC_(hdc);создаем контекст памяти под фон
     ;
      Protected bi.BITMAPINFO
      ZeroMemory_(@bi, SizeOf(bi));
      bi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER);
      bi\bmiHeader\biCompression = #BI_RGB;
      bi\bmiHeader\biBitCount = 32;
      bi\bmiHeader\biPlanes = 1;
      bi\bmiHeader\biWidth = x1;
      bi\bmiHeader\biHeight = y1;
      bi\bmiHeader\biSizeImage = x1 * y1 * 4;
      bi\bmiHeader\biXPelsPerMeter=1000;1;
      bi\bmiHeader\biYPelsPerMeter=1000;1;
      bi\bmiHeader\biClrUsed=0;
      bi\bmiHeader\biClrImportant=0;
     Protected hbmMem = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\start_hdc_bits, #Null, #Null)
     *CustomCanvas\Canvas_Bufer\end_hdc_bits=*CustomCanvas\Canvas_Bufer\start_hdc_bits+bi\bmiHeader\biSizeImage-4
     SelectObject_(*CustomCanvas\Canvas_Bufer\hdc,hbmMem) ;устанавливаем шаблон для буфера рисования
     ;
      ;Protected hbmMem2 = CreateCompatibleBitmap_(hdc,x1,y1);оказывается первый шаблон хрен заселектишь :(
      Protected hbmMem2 = CreateDIBSection_(*CustomCanvas\Canvas_Bufer\fon_hdc, @bi, #DIB_RGB_COLORS, @*CustomCanvas\Canvas_Bufer\start_fon_bits, #Null, #Null);
      *CustomCanvas\Canvas_Bufer\end_fon_bits=*CustomCanvas\Canvas_Bufer\start_fon_bits+bi\bmiHeader\biSizeImage-4
      SelectObject_(*CustomCanvas\Canvas_Bufer\fon_hdc,hbmMem2);устанавливаем шаблон для буфера фона
      DeleteObject_(hbmMem);больше шаблон bitmapa не нужен
      DeleteObject_(hbmMem2);больше шаблон bitmapa не нужен
      ReleaseDC_(canvashwnd,hdc)
  ;================================
     SetCanvasDataFon(*CustomCanvas,$57FFFF);установка фона по данным структуры
   ;=================================
      ;
      SetWindowLongPtr_(canvashwnd,0,*CustomCanvas);заносим адрес памяти с структурой данных в дополнительную память окна cbWndExtra это не #gwl_userdata
       ;SetCanvasHwndFon(canvashwnd,$57456F)
       ;SetCanvasIdFon(canvas_id,$57FFFF)
    ProcedureReturn canvashwnd
 Else
    ProcedureReturn 0;канвас не создан
EndIf 
EndProcedure
;Настройка контекста памяти для рисования

Procedure.i CanvasOpenFileImage(Canvas_id);открытие файла и загрузка в канвас
  file$ = OpenFileRequester("Open File","","*.PNG|*.PNG*|*.GIF|*.GIF*|*.JPG|*.JPG*|*.BMP|*.BMP*|All files|*.*",1)
  
  Debug file$
  LoadImage(0, file$)
  
  SetGadgetAttribute(Canvas_id, #PB_Canvas_Image, ImageID(0))
  
  hdc=StartDrawing(CanvasOutput(Canvas_id))
  
  
  BitBlt_(hdc, 0, 0, imgW, imgH, hDC, 0, 0, #SRCCOPY)
  
  StopDrawing()
  
EndProcedure

If OpenWindow(0, 0, 0,1200, 600, "CustomCanvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
  CreateCustomCanvas(WindowID(0),0,10,10,500,500)
 ;  SetCanvasFon(0,$29D4EC)
   CreateCustomCanvas(WindowID(0),1,600,10,450,400)
  ; SetCanvasFon(1,$29D4EC)
   ;OpenFileImage(0)
  
Else
  End
EndIf

;--------предварительные данные(рисунок) для теста
hdc=StartCanvasDrawing(GadgetID(0))
 For i=0 To 100
   CanvasApiSetPixel(hdc,20,i,$00CFC1)
   CanvasApiSetPixel(hdc,21,i,$00CFC1)
   CanvasApiSetPixel(hdc,22,i,$00CFC1)
   CanvasApiSetPixel(hdc,23,i,$00CFC1)
   CanvasApiSetPixel(hdc,24,i,$00CFC1)
   CanvasApiSetPixel(hdc,25,i,$00CFC1)
   CanvasDrawLine(hdc,100,i+50,300,i)
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;------------
;проверка на установку фона
SetCanvasIdFon(0,$F666FF)
;SetCanvasFon(1,$2266FF)
hdc=StartCanvasDrawing(GadgetID(1))
 For i=0 To 100
   CanvasApiSetPixel(hdc,20,i,$00CFC1)
   CanvasApiSetPixel(hdc,21,i,$00CFC1)
   CanvasApiSetPixel(hdc,22,i,$00CFC1)
   CanvasApiSetPixel(hdc,23,i,$00CFC1)
   CanvasApiSetPixel(hdc,24,i,$00CFC1)
   CanvasApiSetPixel(hdc,25,i,$00CFC1)
   CanvasDrawLine(hdc,100,i+50,300,i)
   CanvasDrawArc(hdc,200,200,400+i,400+i,300,300,200,200)
   Next
StopCanvasDrawing()
;тест
;For i=0 To 100
;SetCanvasIdFon(0,i*i+$F666FF)
;Next
;For i=0 To 100
;SetCanvasIdFon(1,i*i+$5677)
;Next
;проверка что цвет меняется
;SetCanvasIdFon(1,$57FFFF)

;Debug GetPixelFormat_(GetDC_(GadgetID(0)))
;hdc=StartDrawing(CanvasOutput(0))
;Debug GetPixelFormat_(hdc)
;StopDrawing()

DialogSetCanvasFon(0)
DialogCanvasScale(0)

;{;Обработчик сообщений
 Repeat
  Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow;{;
     
         End
     
;};
   Case #PB_Event_Gadget
     Select EventGadget()
       Case 0
         
 
    EndSelect
      
      
  EndSelect
 ForEver;};

Страница: 1

PureBasic - форум

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

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

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

Захотел создать канвас

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

Поделиться105.12.2023 23:58:13

Поделиться208.01.2024 12:59:06

Поделиться308.01.2024 22:45:11

Поделиться408.01.2024 23:04:58

Поделиться509.01.2024 00:22:41

Поделиться610.01.2024 03:20:00

Поделиться711.01.2024 00:45:06

Поделиться811.01.2024 08:38:24

Поделиться911.01.2024 13:12:29

Поделиться1011.01.2024 13:40:58

Поделиться1111.01.2024 17:12:05

Поделиться1211.01.2024 17:17:30

Поделиться1311.01.2024 17:48:54

Поделиться1411.01.2024 18:25:09

Поделиться1511.01.2024 18:31:16

Поделиться1611.01.2024 19:17:56

Поделиться1712.01.2024 00:23:13

Поделиться1813.01.2024 07:29:40

Поделиться1913.01.2024 13:58:57

Поделиться2013.01.2024 14:04:45

Поделиться2113.01.2024 16:14:13

Поделиться2228.01.2024 10:39:16