)The result can be seen here - the code has (at least) the following problems:
• moving the mouse shows "in" in the status bar even when the mouse is few pixels out of the image area over the scroll bars (Win XP)
• shrinking the window allows to do a height where not all buttons have enough space (see WindowBounds)
• resizing the windows in general does a "slow" redraw which doesn't look very pretty
• a grabbed image doesn't show exact the pixel under the mouse pointer in it's center
Michael
And here's the source code - maybe it's useful, even there are still some things to fix (see above)
Code: Select all
; Define
EnableExplicit
UseJPEGImageDecoder()
Structure RectangleTyp
x.l
y.l
right.l
bottom.l
EndStructure
Structure MouseTyp
x.l
y.l
EndStructure
Global MouseXY.MouseTyp; Mauskoordinaten
Global x,y; Mauskoordinaten
Global OldX,OldY; letzte Koordinaten (Mausposition)
Global WinID; Handle
Global WinX,WinY; Fenstergröße
Global Rectangle.RectangleTyp
Global MagicX,MagicY; Differenz zwischen Fenster- und Gadgetkoordinaten
#Zoom=3
Global ZoomX,ZoomY; Fenstergröße-Zoom
Global Z00MX,Z00MY; Fenstergröße-Zoom in Image-Pixel
Global ZoomZ; Zwischenraum
Global AreaX,AreaY; Größe des Scrollbereichs
Global ScrollX,ScrollY; Breite und Höhe der Scrollbalken
Global StatusY; Höhe der Statuszeile
Global ImageID; Handle
Global ImageX,ImageY; Größe der Bitmap
Global ImageA,ImageB; Größe der Bitmap
Global ButtonY; Knopfhöhe
Global FontID; Handle für die Image-Schrift
Global Quit
Global PositionSet; 0,1,2
Enumeration
#Win
#StatusBar
#Image
#ImageTemp
#ZoomImages
#ImageA
#ImageB
#ImageField
#ImageData
#ZoomGadgets
#ZoomA
#ZoomB
#SetPosA
#SetPosB
#MakeMap
#Quit
#Font
EndEnumeration
#Orange=$4080FF
#PositionClear="Click here..."
#PositionSet="Set position now..."
#Coordinates="Coordinates"
; EndDefine
Procedure Min(x,y)
If x<y
ProcedureReturn x
Else
ProcedureReturn y
EndIf
EndProcedure
Procedure Max(x,y)
If x>y
ProcedureReturn x
Else
ProcedureReturn y
EndIf
EndProcedure
Procedure GetXY()
GetCursorPos_(@MouseXY)
x=MouseXY\x-WindowX(#Win)-MagicX
y=MouseXY\y-WindowY(#Win)-MagicY
EndProcedure
Procedure NormalizeXY()
x+GetGadgetAttribute(#ImageField,#PB_ScrollArea_X)
y+GetGadgetAttribute(#ImageField,#PB_ScrollArea_Y)
EndProcedure
Procedure ClrImage(n,s.s,color=#White)
CreateImage(#ZoomImages+n,ZoomX,ZoomY)
StartDrawing(ImageOutput(#ZoomImages+n))
DrawingFont(FontID)
DrawText((ZoomX-TextWidth(s))>>1,(ZoomY-TextHeight(s))>>1,s,color)
StopDrawing()
SetGadgetState(#ZoomGadgets+n,ImageID(#ZoomImages+n))
EndProcedure
Procedure SetImage(n,x,y,color=#Orange)
Protected Image
If x<0 Or y<0
CreateImage(#ZoomImages+n,Z00MX,Z00MY)
GrabImage(#Image,#ImageTemp,Max(0,x),Max(0,y),Z00MX+Min(0,x),Z00MY+Min(0,y))
StartDrawing(ImageOutput(#ZoomImages+n))
DrawImage(ImageID(#ImageTemp),-Min(0,x),-Min(0,y))
StopDrawing()
Else
GrabImage(#Image,#ZoomImages+n,x,y,Z00MX,Z00MY)
EndIf
ResizeImage(#ZoomImages+n,ZoomX,ZoomY,#PB_Image_Raw)
StartDrawing(ImageOutput(#ZoomImages+n))
LineXY(ZoomX>>1,0,ZoomX>>1,ZoomY,color)
LineXY(0,ZoomY>>1,ZoomX,ZoomY>>1,color)
StopDrawing()
SetGadgetState(#ZoomGadgets+n,ImageID(#ZoomImages+n))
EndProcedure
Procedure Init()
WinX=720
WinY=480
ButtonY=25
ZoomX=150
ZoomY=150
Z00MX=ZoomX/#Zoom
Z00MY=ZoomY/#Zoom
ZoomZ=(WinY-StatusY-ZoomY<<1-ButtonY<<2)>>1; |A|+|z|B|+|z|+|+|
FontID=LoadFont(#Font,"Trebuchet MS",12)
ImageID=LoadImage(#Image,"C:\Dokumente und Einstellungen\Michael\Eigene Dateien\Eigene Bilder\2000·00 - Weltreise\2000.01.01 - IMG0003.jpg")
ImageX=ImageWidth(#Image)
ImageY=ImageHeight(#Image)
; ~~~~~~~~~~~~~~
WinID=OpenWindow(#Win,0,0,WinX,WinY,"Oregon Maps",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
If WinID
CreateStatusBar(#StatusBar,WinID)
AddStatusBarField(50)
AddStatusBarField(50)
AddStatusBarField(50)
AddStatusBarField(50)
AddStatusBarField(50)
AddStatusBarField(50)
AddStatusBarField(2000)
StatusY=StatusBarHeight(#StatusBar)
AreaX=WinX
AreaY=WinY-StatusY
ScrollAreaGadget(#ImageField,0,0,AreaX-ZoomX,AreaY,ImageX,ImageY,16)
ImageGadget(#ImageData,0,0,ImageX,ImageY,ImageID,#SS_NOTIFY)
CloseGadgetList()
ImageGadget(#ZoomA,WinX-ZoomX,0,ZoomX,ZoomY,0,#SS_NOTIFY|#PB_Image_Border)
ImageGadget(#ZoomB,WinX-ZoomX,ZoomY+ButtonY+ZoomZ,ZoomX,ZoomY,0,#SS_NOTIFY|#PB_Image_Border)
ButtonGadget(#SetPosA,WinX-ZoomX,ZoomY,ZoomX,ButtonY,#Coordinates)
ButtonGadget(#SetPosB,WinX-ZoomX,ZoomY<<1+ZoomZ+ButtonY,ZoomX,ButtonY,#Coordinates)
ButtonGadget(#MakeMap,WinX-ZoomX,WinY-StatusY-ButtonY<<1,ZoomX,ButtonY,"Make Map")
ButtonGadget(#Quit,WinX-ZoomX,WinY-StatusY-ButtonY,ZoomX,ButtonY,"Quit")
ScrollX=GetSystemMetrics_(#SM_CXVSCROLL); Breite Scrollbalken
ScrollY=GetSystemMetrics_(#SM_CYHSCROLL); Höhe Scrollbalken
GetWindowRect_(GadgetID(#ImageField),@Rectangle)
MagicX=Rectangle\x-WindowX(#Win)
MagicY=Rectangle\y-WindowY(#Win)
AreaX-ZoomX+ScrollX
AreaY-ScrollY
WindowBounds(#Win,ZoomX<<2,ZoomY<<1+ButtonY<<2+StatusY,2000,2000); +MagicY?
;SmartWindowRefresh(#Win,#True)
ClrImage(1,#PositionClear)
ClrImage(2,#PositionClear)
HideWindow(#Win,0)
ProcedureReturn #True
EndIf
EndProcedure
Procedure Main()
Init()
Repeat
Select WaitWindowEvent(100)
Case #PB_Event_Gadget,#PB_Event_Gadget
Select EventGadget()
Case #ImageData
If PositionSet
GetXY()
NormalizeXY()
SetImage(PositionSet,x-Z00MX>>1,y-Z00MY>>1,#White)
EndIf
PositionSet=0
Case #ZoomA
PositionSet=1
ClrImage(PositionSet,#PositionSet,#Orange)
Case #ZoomB
PositionSet=2
ClrImage(PositionSet,#PositionSet,#Orange)
Case #Quit
Quit=#True
EndSelect
Case #PB_Event_CloseWindow
Quit=#True
Case #PB_Event_SizeWindow
WinX=WindowWidth(#Win)
WinY=WindowHeight(#Win)
AreaX=WinX-ZoomX-ScrollX
AreaY=WinY-StatusY-ScrollY
ZoomZ=(WinY-StatusY-Zoomy<<1-ButtonY<<2)>>1
ResizeGadget(#ImageField,#PB_Ignore,#PB_Ignore,WinX-ZoomX,WinY-StatusY)
ResizeGadget(#ZoomA,WinX-ZoomX,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#ZoomB,WinX-ZoomX,ZoomY+ButtonY+ZoomZ,#PB_Ignore,#PB_Ignore)
ResizeGadget(#SetPosA,WinX-ZoomX,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#SetPosB,WinX-ZoomX,ZoomY<<1+ZoomZ+ButtonY,#PB_Ignore,#PB_Ignore)
ResizeGadget(#MakeMap,WinX-ZoomX,WinY-StatusY-ButtonY<<1,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Quit,WinX-ZoomX,WinY-StatusY-ButtonY,#PB_Ignore,#PB_Ignore)
Default
GetXY()
StatusBarText(#StatusBar,2,"X: "+Str(x))
StatusBarText(#StatusBar,3,"Y: "+Str(y))
If (x-OldX) Or (y-OldY)
OldX=x
OldY=y
If x>=0 And x<=AreaX And y>=0 And y<=AreaY
NormalizeXY()
If PositionSet
SetImage(PositionSet,x-Z00MX>>1,y-Z00MY>>1)
EndIf
StatusBarText(#StatusBar,4,"In")
StatusBarText(#StatusBar,0,"X: "+Str(x))
StatusBarText(#StatusBar,1,"Y: "+Str(y))
;Debug "Mouse over image gadget!"
Else
StatusBarText(#StatusBar,4,"Out")
StatusBarText(#StatusBar,0,"X: -")
StatusBarText(#StatusBar,1,"Y: -")
EndIf
EndIf
EndSelect
Until Quit
EndProcedure
Main()