Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [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