http://www.purebasic.com
https://www.purebasic.fr/english/
And make sure you aren't using the same gadget number for two gadgets.
Don't feel bad, it happens to me all the timeThat was the problem
Code: Select all
;- Simple handling images in scrollgadget
; with some functionality
; graying
; 2color conversion
; syncronization pos pictures in different tab
; #2006 Molchyn
; (PB4Code)
Global Dim PicR(0,0,0)
Global imgW.l ,imgH.l ,imgD.l
Procedure InitVIMG(IMG.l,WidthV.l,HeightV.l,Count.l=0)
If CreateImage(IMG,WidthV,HeightV)
StartDrawing(ImageOutput(IMG))
FrontColor($FFEEEE)
aHeight=HeightV/255
For k=0 To 255
;FrontColor(RGB(k,0, k)) ; a rainbow, from black to pink
Line(0, k, WidthV,aHeight)
Next
StopDrawing()
EndIf
EndProcedure
Procedure InitHIMG(IMG.l,WidthV.l,HeightV.l,Count.l=0)
If CreateImage(IMG,WidthV,HeightV)
StartDrawing(ImageOutput(IMG))
FrontColor($FFFFCC)
aWidtht=WidthV/255
For k=0 To 255
;FrontColor(RGB(255-k,0, k)) ; a rainbow, from black to pink
Line(k, 0, aWidtht,HeightV)
Next
StopDrawing()
EndIf
EndProcedure
;- Window Constants
;
Enumeration
#Window_0
EndEnumeration
;- Gadget Constants
Enumeration
#Panel_0
#String_0
#ScrollArea_0
#ScrollArea_1
#String_R
#Text_r
#String_G
#Text_G
#String_B
#Text_B
#String_DF
#Text_DF
#String_R1
#Text_r1
#String_G1
#Text_G1
#String_B1
#Text_B1
#String_DF1
#Text_DF1
#Image_0
#Image_1
#Image_0V
#Image_0H
#Image_1V
#Image_1H
#Button_Load
#Button_Process
#Button_Process1
EndEnumeration
;PICS index
Enumeration
#I_0
#I_0V
#I_0H
#I_1
#I_1V
#I_1H
EndEnumeration
;- some algorithm stuff
;- Image Plugins
UseJPEGImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
;- IMG stuff
Structure _GI_BITMAPINFO
bmiHeader.BITMAPINFOHEADER
bmiColors.RGBQUAD[1]
EndStructure
Structure _GI_LONG
l.l
EndStructure
Structure _GI_BGR
R.c
G.c
b.c
a.c
EndStructure
Procedure Open_Window_0()
If OpenWindow(#Window_0, 214, 7, 930, 701, "VK converter", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_WindowCentered )
If CreateGadgetList(WindowID(#Window_0))
StringGadget(#String_0, 0, 510, 670, 190, "",#ES_MULTILINE| #ES_AUTOVSCROLL|#WS_VSCROLL|#WS_HSCROLL)
StringGadget(#String_R, 710, 520, 30, 20, "100")
TextGadget(#Text_r, 690, 524, 10, 20, "R")
StringGadget(#String_G, 770, 520, 30, 20, "100")
TextGadget(#Text_G, 750, 524, 10, 20, "G")
StringGadget(#String_B, 830, 520, 30, 20, "100")
TextGadget(#Text_B, 810, 524, 10, 20, "B")
StringGadget(#String_DF, 890, 520, 30, 20, "300")
TextGadget(#Text_DF, 870, 524, 10, 20, "R")
StringGadget(#String_R1, 710, 560, 30, 20, "100")
TextGadget(#Text_r1, 690, 564, 10, 20, "R")
StringGadget(#String_G1, 770, 560, 30, 20, "100")
TextGadget(#Text_G1, 750, 564, 10, 20, "G")
StringGadget(#String_B1, 830, 560, 30, 20, "100")
TextGadget(#Text_B1, 810, 564, 10, 20, "B")
StringGadget(#String_DF1, 890, 560, 30, 20, "300")
TextGadget(#Text_DF1, 870, 564, 10, 20, "R")
ButtonGadget(#Button_Load, 690, 590, 50, 20, "Load")
ButtonGadget(#Button_Process, 750, 590, 50, 20, "Gray it")
ButtonGadget(#Button_Process1, 810, 590, 50, 20, "Trace it")
;- Panel0
PanelGadget(#Panel_0, 0, 0, 910, 510)
AddGadgetItem(#Panel_0, -1, "Pic")
t$="C:\Program Files\pb4\Examples\my\Pic vectorizator\autotrace\1.bmp"
;-
ScrollAreaGadget(#ScrollArea_0, 0, 0, 800, 450, 1600, 900, 10)
ImageGadget(#Image_0, 10, 10, 30, 20, LoadImage(#I_0, t$))
imgW=ImageWidth(0)
imgH=ImageHeight(0)
;Result = CreateImage(1, 200, 10 )
InitVIMG(#I_0V,imgW,10)
ImageGadget(#Image_0V, 10,0, 40, 10, ImageID(#I_0V))
InitHIMG(#I_0H,10,imgH)
ImageGadget(#Image_0H, 0, 10, 10, 20, ImageID(#I_0H))
CloseGadgetList()
AddGadgetItem(#Panel_0, -1, "Conv")
;-
ScrollAreaGadget(#ScrollArea_1, 0, 0, 800, 450, 1600, 900, 10)
ImageGadget(#Image_1, 10, 10, 30, 30, LoadImage(#I_1, t$))
Result = CopyImage(1, 4)
CopyImage(#I_0V,#I_1V)
ImageGadget(#Image_1V, 10, 0, 30, 10, ImageID(#I_1V))
CopyImage(#I_0H,#I_1H)
ImageGadget(#Image_1H, 0, 10, 10, 30, ImageID(#I_1H))
CloseGadgetList()
AddGadgetItem(#Panel_0, -1, "Setup")
CloseGadgetList()
EndIf
EndIf
EndProcedure
Procedure GrayImage(Number)
CopyImage(#I_0,#I_1)
SetGadgetState(#Image_1, ImageID(#I_1)) ; change the picture in the gadget
hBmp = ImageID(Number)
If hBmp
hdc = StartDrawing(ImageOutput(Number))
If hdc
ImageWidth = ImageWidth(Number) : ImageHeight = ImageHeight(Number)
mem = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT,ImageWidth*ImageHeight*4)
If mem
bmi._GI_BITMAPINFO
bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
bmi\bmiHeader\biWidth = ImageWidth
bmi\bmiHeader\biHeight = ImageHeight
bmi\bmiHeader\biPlanes = 1
bmi\bmiHeader\biBitCount = 32
bmi\bmiHeader\biCompression = #BI_RGB
Dim PicR(3,ImageWidth,ImageHeight)
maxxColor=RGB(255,255,255)
Dim ColorTAble.l(maxxColor)
SS$=""
If GetDIBits_(hdc,hBmp,0,ImageHeight(Number),mem,bmi,#DIB_RGB_COLORS) <> 0
*pixels._GI_LONG = mem
*COLORS._GI_BGR = mem
For b.l=1 To ImageHeight
For a.l = 1 To ImageWidth
; color.b = Int((0.299* *COLORS\R) + (0.587* *COLORS\G) + (0.114* *COLORS\B))
;color.b = ((299 * *COLORS\R) + (587* *COLORS\G) + (114* *COLORS\B)) /1000 ; improved by Rings
Color.l = ((2126 * *COLORS\R) + (7152* *COLORS\G) + (722* *COLORS\b)) /10000
*pixels\l = RGB(Color.l,Color.l,Color.l)
PicR(0,a,b)= RGB(Color,Color,Color);*pixels\l
If PicR(0,a,b) <= maxxColor ;And rr(a,b) >0
;SS$+"a:"+Str(a)+ " b:" + Str(b)+ " b:" + Str(rr(a,b))+#CRLF$
ColorTAble.l(PicR(0,a,b))+1
EndIf
*pixels + 4
*COLORS + 4
Next a
;SS$+"a:"+Str(1)+ " b:" + Str(B)+ "<R>" + Str(Red(rr(1,B)))+ "<G>" + Str(Green(rr(1,B)))+ "<B>" + Str(Blue(rr(1,B)))+ "<>" + StrQ(rr(1,B))+ #CRLF$
;SS$+"a:"+Str(1)+ " b:" + Str(b)+ "<>" + Str(rr(1,b))+#CRLF$
Next b
zz=0
For c=0 To maxxColor
If ColorTAble.l(c)>0
zz+1
EndIf
Next
SetGadgetText (#String_0, GetGadgetText (#String_0) + #CRLF$ + "colors: " + Str(zz)+ #CRLF$ +SS$)
If SetDIBits_(hdc,hBmp,0,ImageHeight(Number),mem,bmi,#DIB_RGB_COLORS) <> 0
Result = hBmp
EndIf
EndIf
GlobalFree_(mem)
EndIf
EndIf
StopDrawing()
EndIf
SetGadgetState(#Image_1, ImageID(#I_1))
ProcedureReturn Result
EndProcedure
Procedure DrawHIMG(IMG.l,WidthV.l,HeightV.l,Count.l=0)
If CreateImage(IMG,WidthV,HeightV)
StartDrawing(ImageOutput(IMG))
Box(0, 0, WidthV, HeightV ,$FFEEEE)
StopDrawing()
EndIf
EndProcedure
Procedure DrawVIMG(IMG.l,WidthV.l,HeightV.l,Count.l=0)
If CreateImage(IMG,WidthV,HeightV)
StartDrawing(ImageOutput(IMG))
Box(0, 0, WidthV, HeightV ,$FFEEEE)
If Count =0
coeff.f=25.4/300
mmVert=WidthV*coeff.f
Debug mmVert
Debug coeff
;BackColor($ffffff)
For a=0 To mmVert Step 10
Line(a/coeff,0,0,HeightV,$FF0000)
Next a
EndIf
StopDrawing()
EndIf
EndProcedure
Procedure Loadpic()
Pattern$ = "Jpeg (*.jpg)|*.jpg;*.bmp|All files (*.*)|*.*"
FileName$ = OpenFileRequester ("Open","",Pattern$ ,0)
If LoadImage(#I_0, FileName$)
imgW=ImageWidth(#I_0)
imgH=ImageHeight(#I_0)
imgD = ImageDepth(#I_0)
Dim PicR(3,imgW,imgH)
SetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_InnerWidth ,imgW+10 )
SetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_InnerHeight ,imgH+10 )
SetGadgetState(#Image_0, ImageID(#I_0)) ; change the picture in the gadget
DrawVIMG(#I_0V,imgW,10)
DrawHIMG(#I_0H,10,imgH)
SetGadgetState(#Image_0V, ImageID(#I_0V)) ; change the picture in the gadget
SetGadgetState(#Image_0H, ImageID(#I_0H)) ; change the picture in the gadget
SetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_InnerWidth ,imgW+10 )
SetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_InnerHeight ,imgH+10 )
CopyImage(#I_0,#I_1)
SetGadgetState(#Image_1, ImageID(#I_1)) ; change the picture in the gadget
CopyImage(#I_0V,#I_1V)
CopyImage(#I_0H,#I_1H)
SetGadgetState(#Image_1V, ImageID(#I_1V)) ; change the picture in the gadget
SetGadgetState(#Image_1H, ImageID(#I_1H)) ; change the picture in the gadget
;DisableToolBarButton(0, 1, 0) ; enable the save button
;ResizeWindow(0, -1, -1, ImageWidth(0)+4, ImageHeight(0)+34)
tt$= "ImageWidth " + Str( imgW) + " ";#CRLF$
tt$+ "ImageHeight " + Str( imgH) +" ";#CRLF$
tt$+ "ImageDepth " + Str( imgD) +#CRLF$
tt$+ "WidthDPI " + Str( imgW*25.4/300)+" mm" + " ";#CRLF$
tt$+ "HeightDPI " + Str( imgH*25.4/300)+" mm" +" ";#CRLF$
SetGadgetText (#String_0, tt$)
EndIf
EndProcedure
Procedure SyncPos()
SetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_X,GetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_X))
SetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_Y,GetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_Y))
EndProcedure
Procedure SyncPos1()
SetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_X,GetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_X))
SetGadgetAttribute(#ScrollArea_1,#PB_ScrollArea_Y,GetGadgetAttribute(#ScrollArea_0,#PB_ScrollArea_Y))
EndProcedure
If InitMouse() = 0 Or InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Error", "Can't open DirectX 7", 0)
End
EndIf
Open_Window_0()
;Result = ExamineMouse()
Repeat ; Start of the event loop
Event = WaitWindowEvent() ; This line waits until an event is received from Windows
WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
GadgetID = EventGadget() ; Is it a gadget event?
EventType = EventType() ; The event type
If Event = #PB_Event_Gadget
If GadgetID = #Panel_0
ElseIf GadgetID = #ScrollArea_0
SyncPos1()
ElseIf GadgetID = #ScrollArea_1
SyncPos()
ElseIf GadgetID = #Button_Load
Loadpic()
ElseIf GadgetID = #Button_Process
;IMGcountur(#I_1)
SetGadgetState(#Panel_0, 1)
GrayImage(#I_1)
ElseIf GadgetID = #Button_Process1
IMG1(#I_1)
EndIf
ElseIf Event = #PB_Event_SizeWindow
;Debug "Resize"
EndIf
;
Until Event = #PB_Event_CloseWindow ; End of the event loop
End