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

Страница: 1

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

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

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

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

Код:

 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 часов
Последний визит:
04.01.2025 20:48:25

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

Код:

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 23:04:58

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

Пока по первому пути пошёл и изначально изменил с структурой пока отложил да и походу надо вообще контекст рисования переделать сразу на дибсекцию.
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)

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

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

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

Код:

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;};

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

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

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)

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

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 218
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 9 часов
Последний визит:
Сегодня 05:42:49

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

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

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

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

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

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

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

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

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

Автор: AZJIO
Активный участник
Зарегистрирован: 07.08.2020
Приглашений: 0
Сообщений: 1312
Уважение: [+20/-0]
Позитив: [+15/-0]
Провел на форуме:
27 дней 3 часа
Последний визит:
Вчера 15:39:24

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

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 3131
Уважение: [+100/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 13 дней
Последний визит:
Вчера 23:55:51

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

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

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

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

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

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

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

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

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

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 218
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 9 часов
Последний визит:
Сегодня 05:42:49

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)

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 3131
Уважение: [+100/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 13 дней
Последний визит:
Вчера 23:55:51

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

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

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

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

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 218
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 9 часов
Последний визит:
Сегодня 05:42:49

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

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

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

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 3131
Уважение: [+100/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 13 дней
Последний визит:
Вчера 23:55:51

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

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

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 218
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 9 часов
Последний визит:
Сегодня 05:42:49

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

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)

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

Автор: Пётр
Активный участник
Зарегистрирован: 14.06.2009
Приглашений: 0
Сообщений: 3131
Уважение: [+100/-5]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
2 месяца 13 дней
Последний визит:
Вчера 23:55:51

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

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

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

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

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

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

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

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

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

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

Автор: useful
Активный участник
Зарегистрирован: 01.08.2020
Приглашений: 0
Сообщений: 218
Уважение: [+4/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 9 часов
Последний визит:
Сегодня 05:42:49

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

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

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

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

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

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

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

Код:

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 страница 19 из 19

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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