Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
ClickMapGadget.bas
| Uploader: |  Muttonhead |
| Datum/Zeit: | 07.09.2014 09:55:53 |
declare function AddClickMapGadget (event as EventHandle ptr,PosX as integer,PosY as integer,filename as string="") as Gadget ptr
declare function CMGActions(gad as Gadget ptr,action as integer) as integer
declare sub DrawClickMapGadget (gad as Gadget ptr)
declare function GetClickMapColor (gad as gadget ptr) as integer
'Steuerungsvariablen
'Ctrl(15) angeklickte Farbnummer aus der MaskenBMP (ohne Transparenz)
function AddClickMapGadget (event as EventHandle ptr,PosX as integer,PosY as integer,filename as string="") as Gadget ptr
dim as integer ImgWidth,ImgHeight,ff=freefile
open filename for binary as #ff
get #ff, 19, ImgWidth
get #ff, 23, ImgHeight
close #ff
function=0
dim as Gadget ptr gad
gad=event->GadgetList->AppendNew (GadgetType)
if gad then
gad->event=event
gad->sel=0
gad->act=0
gad->posx=PosX
gad->posy=PosY
gad->gadw=ImgWidth
gad->gadh=ImgHeight
if filename>"" then
gad->Unselected=imagecreate(ImgWidth,ImgHeight)
bload filename,gad->Unselected
end if
gad->DoDraw =@DrawClickMapGadget
gad->DoAction =@CMGActions
gad->DoUpdate =@DrawClickMapGadget
gad->SaveBackGround
function=gad
end if
end function
function CMGActions(gad as Gadget ptr,action as integer) as integer
function=0
select case action
case GADGET_HIT 'Control grad frisch gedrückt
case GADGET_HOLD 'Control wird gehalten, Maus über dem Control
case GADGET_HOLDOFF 'Control wird gehalten, Maus neben dem Control
case GADGET_RELEASE 'Control regulär losgelassen
gad->Ctrl(0)=MOUSEX - gad->posx
gad->Ctrl(1)=MOUSEY - gad->posy
gad->Ctrl(15)=point(gad->Ctrl(0),gad->Ctrl(1),gad->Unselected) and &H00FFFFFF'angeklickte Farbe sichern
function=1
case GADGET_RELEASEOFF 'Control losgelassen, dabei ist Maus neben dem Control
case GADGET_KEYBOARD 'Keyboardauswertung
case GADGET_KEYBOARDOFF'Abbruch Keyboardauswertung
end select
end function
sub DrawClickMapGadget (gad as Gadget ptr)
end sub
function GetClickMapColor (gad as gadget ptr) as integer
function=gad->Ctrl(15)
end function