; Код, преобразующий два спец.изображения в анаглифное 3D  
; Требования к изображениям:  
; Фотографируем первый снимок со штатива или подставки затем  
; не меняя настроек камеры осторожно перемещаем её строго вправо на 2-3 см и фотографируем  
; ещё раз. Первый снимок будет "левым", второй соответственно "правым".  
; Запускаем код, загружаем фото, жмем кнопку "Анаглиф" и наслаждаемся результатом.  
; Код PureBasic v.4.4-4.5 ( нужна поддержка AlphaBlend)  
; Автор kvitaliy, июнь 2010 г.  

;{- Enumerations / DataSections  
;{ Windows  
Enumeration  
  #Window_0  
EndEnumeration  
;}  
;{ Gadgets  
Enumeration  
  #Image_0  
  #Image_2  
  #Button_3  
  #Button_4  
  #Button_5  
   
EndEnumeration  
;}  
Define.l Event, EventWindow, EventGadget, EventType, EventMenu  
;}  

UseJPEGImageDecoder()  
UseTGAImageDecoder()  
UseTIFFImageDecoder()  
UsePNGImageDecoder()  
UseJPEGImageEncoder()  

Procedure OpenWindow_Window_0()  
  If OpenWindow(#Window_0, 431, 128, 678, 300, "Два 2D в анаглиф", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)  
  ImageGadget(#Image_0, 0, 40, 310, 210, 0, #PB_Image_Border)  
  ImageGadget(#Image_2, 350, 40, 310, 210, 0, #PB_Image_Border)  
  ButtonGadget(#Button_3, 5, 10, 115, 20, "Левое изобр")  
  ButtonGadget(#Button_4, 535, 10, 115, 20, "Правое изобр.")  
  ButtonGadget(#Button_5, 250, 10, 160, 20, "Анаглиф")  
   
  EndIf  
EndProcedure  

OpenWindow_Window_0()  

;{- Event loop  
Repeat  
  Event = WaitWindowEvent()  
  Select Event  
  ; ///////////////////  
  Case #PB_Event_Gadget  
  EventGadget = EventGadget()  
  EventType = EventType()  
  If EventGadget = #Button_3  
  FileName$ = OpenFileRequester("Открыть левое изображение", "", "All supported formats|*.bmp;*.jpg;*.tif;*.tga;*.png", 0)  
  If FileName$  
  CurrentDir$ = GetPathPart(FileName$)  
  LoadImage(0, FileName$)  
  wid = ImageWidth(0)  
  hei = ImageHeight(0)  
  Mass1=wid*hei  
  Dim pixels1(Mass1)  
   
  CopyImage(0, 1)  
  ResizeImage(1, 310, 210)  
  SetGadgetState(#Image_0, ImageID(1)) ; Пропорции могут быть нарушены - это контроль, не влияет на конечный результат!  
   
  EndIf  
   
   
  ElseIf EventGadget = #Button_4  
  FileName$ = OpenFileRequester("Открыть правое изображение", "", "All supported formats|*.bmp;*.jpg;*.tif;*.tga;*.png", 0)  
  If FileName$  
  CurrentDir$ = GetPathPart(FileName$)  
  LoadImage(2, FileName$)  
  wid1 = ImageWidth(2)  
  hei1 = ImageHeight(2)  
  CopyImage(2, 3)  
  ResizeImage(3, 310, 210)  
  SetGadgetState(#Image_2, ImageID(3))  
   
  EndIf  
  ElseIf EventGadget = #Button_5  
  p1=0:p2=0  
  ;***********1- й рисунок обрабатываем************  
  If IsImage(0) And IsImage(2)  
  Debug " Есть рисунки"  
  If wid > wid1: wid=wid1:EndIf  
  If hei > hei1: hei=hei1:EndIf  
  If StartDrawing(ImageOutput(0))  
  Debug " Есть старт"  
  For h= 0 To hei - 1  
  For w= 0 To wid - 1  
   
  redPoint=Red(Point(w, h))  
  Plot(w,h,RGB(redPoint,0,0))  
  pixels1(p1)=redPoint  
  p1+1  
   
  Next  
   
  Next  
  Debug p1  
  StopDrawing()  
  EndIf  
  CopyImage(0, 1)  
  ResizeImage(1, 310, 210)  
  SetGadgetState(#Image_0, ImageID(1)) ;  
  ;**********2-й рисунок обрабатываем************  
   
  If StartDrawing(ImageOutput(2))  
  For h= 0 To hei1 - 1  
  For w= 0 To wid1 - 1  
   
  GrPoint=Green(Point(w, h))  
  BlPoint=Blue(Point(w, h))  
  Plot(w,h,RGB(0,GrPoint,BlPoint))  
  p2+1  
  Next  
   
  Next  
  Debug p2  
  StopDrawing()  
  EndIf  
  CopyImage(2, 3)  
  ResizeImage(3, 310, 210)  
  SetGadgetState(#Image_2, ImageID(3))  
   
  ;************Слияние**********  
  p1=0  
   
   
  If StartDrawing(ImageOutput(2))  
  DrawingMode(#PB_2DDrawing_AlphaBlend)  
  For h= 0 To hei - 1  
  For w= 0 To wid - 1  
  Plot(w,h,RGBA(pixels1(p1),0,0,125))  
  p1+1  
  Next  
  Next  
  StopDrawing()  
  EndIf  
  CopyImage(2, 3)  
  ResizeImage(3, 310, 210)  
  SetGadgetState(#Image_2, ImageID(3))  
  If SaveImage(2,GetTemporaryDirectory()+"Anaglyph.jpg",#PB_ImagePlugin_JPEG,8);SaveImage(2,"c:\Anaglyph.bmp",#PB_ImagePlugin_BMP,0,32)  
  MessageRequester("Запись","Успешно")  
  RunProgram(GetTemporaryDirectory()+"Anaglyph.jpg")  
  EndIf  
   
  EndIf  
   
  Else  
  MessageRequester("Ошибка!","Изображения должны быть загружены!")  
  EndIf  
   
  ; ////////////////////////  
  Case #PB_Event_CloseWindow  
  EventWindow = EventWindow()  
  If EventWindow = #Window_0  
  CloseWindow(#Window_0)  
  Break  
  EndIf  
  EndSelect  
ForEver  
;  
;}