Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

ClickMapGadget.bas

Uploader:MitgliedMuttonhead
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