ficontool.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

' Gambas class file

STATIC PRIVATE $cColor AS NEW Integer[]
STATIC PRIVATE $hTile AS Picture

PRIVATE $hCurrent AS FIconEditor

PRIVATE $hLast AS ToolButton
PRIVATE $hTool AS ToolButton

PRIVATE $X AS Integer
PRIVATE $Y AS Integer
PRIVATE $X2 AS Integer
PRIVATE $Y2 AS Integer
PRIVATE $iColor AS Integer

PRIVATE $iForeground AS Integer
PRIVATE $iBackground AS Integer

PRIVATE CONST COORD_HIDE AS Integer = 1048576
PRIVATE $iLastCoordX AS Integer
PRIVATE $iLastCoordY AS Integer

PRIVATE $cMode AS NEW Collection
PRIVATE $iMouse AS Integer

STATIC PUBLIC SUB _init()

  DIM sColor AS String

  FOR EACH sColor IN Split("000000,FFFFFF,0000FF,00FF00,FF0000,00FFFF,FFFF00,FF00FF,7F7F7F,BFBFBF,00007F,007F00,7F0000,007F7F,7F7F00,7F007F,3F3F3F,FF8000,43C7FF")
    $cColor.Add(Val("&H" & sColor & "&"))
  NEXT

END


PUBLIC SUB _new()

  DIM sText AS String
  DIM hCtrl AS Control

  $cMode["flip"] = 0
  $cMode["rect"] = 0
  $cMode["circle"] = 0
  $cMode["fill"] = 0
  $cMode["select"] = 0
  $cMode["move"] = 0

  $hTool = btnMove
  '$hTool.Border = Border.Sunken
  $hTool.Value = TRUE

  $iBackground = Color.White
  $iForeground = Color.Black

  $iLastCoordX = COORD_HIDE
  $iLastCoordY = COORD_HIDE

  FOR EACH hCtrl IN ME.Children
    IF hCtrl.Tag THEN hCtrl.Design = TRUE
  NEXT

  $hTile = Picture["img/16/tile.png"]

  Config.LoadWindow(ME, "/FIconTool")

  btnSave.Enabled = NOT Project.ReadOnly

END


PUBLIC SUB Activate(hEditor AS FIconEditor)

  $hCurrent = hEditor

END


PUBLIC SUB DeActivate(hEditor AS FIconEditor)

  IF $hCurrent <> hEditor THEN RETURN
  $hCurrent = NULL
  ME.Hide

END


PUBLIC SUB btnTool_MouseDown()

  LAST.Value = TRUE
  'LAST.Border = Border.Sunken

END

PRIVATE SUB ChangeMode(hImage AS ToolButton, sMode AS String, sLstPict AS String, sLstToolTip AS String)

  DIM iMode AS Integer
  DIM aLstPict AS String[]
  DIM aLstToolTip AS String[]

  aLstPict = Split(sLstPict)
  aLstToolTip = Split(sLstToolTip)

  iMode = ($cMode[sMode] + 1) MOD aLstPict.Count

  hImage.Picture = Picture["img/16" &/ aLstPict[iMode] & ".png"]
  hImage.ToolTip = aLstToolTip[iMode]

  $cMode[sMode] = iMode

END


PUBLIC SUB btnTool_MouseUp()

  DIM hLast AS ToolButton
  DIM bCommand AS Boolean
  DIM bUp AS Boolean

  hLast = LAST

  bCommand = TRUE

  SELECT CASE hLast.Tag

    CASE "zoom"

      IF Mouse.Left THEN
        $hCurrent.ZoomIn
      ELSE IF Mouse.Right THEN
        $hCurrent.ZoomOut
      ENDIF

    CASE "save"

      $hCurrent.Save

    CASE "undo"

      $hCurrent.Undo

    CASE "clear"

      $hCurrent.Clear

    CASE "swap"

      $hCurrent.SwapColor(Mouse.Left)

    CASE "paste"

      $hCurrent.DoPaste
      hLast.Value = FALSE
      IF $hTool <> btnSelect THEN
        $hLast = btnSelect
        RevertTool
      ENDIF
      RETURN

    CASE "flip"

      IF Mouse.Left THEN
        $hCurrent.DoFlip
      ELSE
        ChangeMode(btnFlip, "flip", "flip-h,flip-v,rotate,rotate-back", ("Horizontal flip,Vertical flip,Rotate clockwise,Rotate counter-clockwise"))
      ENDIF

    DEFAULT
      bCommand = FALSE

  END SELECT

  IF bCommand THEN
    'hLast.Border = Border.None
    hLast.Value = FALSE
    RETURN
  ENDIF

  'IF Button = 1 OR hLast <> $hTool THEN

  'ELSE

    SELECT CASE hLast.Tag

      CASE "rect"
        IF Mouse.Right THEN
          ChangeMode(btnRect, "rect", "square,square-f,square-fr", ("Rectangle,Filled rectangle,Filled delimited rectangle"))
        ENDIF

      CASE "circle"
        IF Mouse.Right THEN
          ChangeMode(btnCircle, "circle", "circle,circle-f,circle-fr", ("Ellipse,Filled ellipse,Filled delimited ellipse"))
        ENDIF

      CASE "fill"
        IF Mouse.Right THEN
          ChangeMode(btnFill, "fill", "fill,fill-alt", ("Flood fill,Patterned flood fill"))
        ENDIF

      CASE "select"
        IF Mouse.Left THEN
          IF hLast = $hTool THEN
            IF NOT $hCurrent.HasSelection() THEN
              $hCurrent.SelectAll
            ELSE
              $hCurrent.HideSelection
            ENDIF
          ELSE
            $hCurrent.HideSelection
          ENDIF
        ELSE IF Mouse.Right THEN
          ChangeMode(btnSelect, "select", "frame,frame-opaque", ("Select and transparent paste,Select and opaque paste"))
          $hCurrent.RefreshPaste
        ENDIF

      'CASE "move"
      '
      '  IF Button AND Mouse.Right THEN
      '    ChangeMode(imgMove, "move", "scroll,move",("Move,Translate"))
      '  ENDIF

    END SELECT

  'ENDIF

  $hLast = $hTool
  $hTool = hLast

  IF $hLast THEN
    IF $hLast <> $hTool THEN
      '$hLast.Border = Border.None
      $hLast.Value = FALSE
    ENDIF
  ENDIF

  ChangeTool

END


PUBLIC SUB ChangeTool()

  $hTool.Value = TRUE
  '$hTool.Border = Border.Sunken

  IF $hTool <> $hLast AND $hLast <> NULL THEN
    IF $hLast.Tag = "select" THEN
      $hCurrent.HideSelection
    ENDIF
  ENDIF

  SELECT $hTool.Tag

    CASE "move"
      SetIcon(Mouse.SizeAll)

    CASE "pen"
      SetIcon(Mouse.Arrow)

    CASE ELSE
      SetIcon(Mouse.Cross)

  END SELECT

END


PUBLIC SUB RevertTool()

  '$hTool.Border = Border.None
  $hTool.Value = FALSE
  $hTool = $hLast
  '$hTool.Border = Border.Sunken
  $hTool.Value = TRUE
  ChangeTool

END



PUBLIC SUB dwgColor_Draw()

  DIM X AS Integer
  DIM Y AS Integer
  DIM RX AS Integer
  DIM RY AS Integer
  DIM C AS Integer
  DIM CC AS Integer

  Draw.LineStyle = LINE.Solid

  FOR Y = 0 TO 4
    RX = 0
    FOR X = 0 TO 3
      IF C < $cColor.Count THEN
        CC = $cColor[C]
      ELSE
        CC = -1
      ENDIF
      INC C
      RedrawColor(CC, RX, RY, 25, 25)
      RX = RX + 24
    NEXT
    RY = RY + 24
  NEXT

END

PUBLIC SUB dwgColor_MouseDown()

  DIM C AS Integer

  C = (Mouse.Y \ 24) * 4 + (Mouse.X \ 24)

  IF C < $cColor.Count THEN
    C = $cColor[C]
  ELSE
    C = -1
  ENDIF

  IF Mouse.Left THEN
    $iForeground = C
  ELSE
    $iBackground = C
  ENDIF

  RefreshColor

END

PRIVATE SUB RefreshColor()

  dwgForeground.Refresh
  dwgBackground.Refresh

END

PUBLIC SUB SetForeground(iColor AS Integer)

  $iForeground = iColor
  RefreshColor

END

PUBLIC SUB SetBackground(iColor AS Integer)

  $iBackground = iColor
  RefreshColor

END



PRIVATE SUB RedrawColor(iColor AS Integer, X AS Integer, Y AS Integer, W AS Integer, H AS Integer)

  IF iColor >= 0 THEN
    Draw.FillStyle = Fill.Solid
    Draw.FillColor = iColor
    Draw.Rect(X, Y, W + 1, H + 1)
  ELSE IF iColor = -1 THEN
    Draw.FillX = X
    Draw.FillY = Y
    Draw.Tile($hTile, X, Y, W + 1, H + 1)
    Draw.FillStyle = Fill.None
    Draw.FillColor = Color.Black
    Draw.Rect(X, Y, W, H)
  ELSE
    Draw.FillStyle = Fill.Solid
    Draw.FillColor = Color.Black
    Draw.Rect(X, Y, W, H)
    Draw.FillColor = Color.White
    Draw.Rect(X + W \ 2, Y, W \ 2 + 1, H \ 2 + 1)
    Draw.Rect(X, Y + H \ 2, W \ 2 + 1, H \ 2 + 1)
  ENDIF

END


PUBLIC SUB dwgForeground_Draw()

  Draw.LineStyle = LINE.None 'LINE.Solid
  RedrawColor($iForeground, 0, 0, dwgForeground.Width, dwgForeground.Height)

END


PUBLIC SUB dwgBackground_Draw()

  Draw.LineStyle = LINE.None 'LINE.Solid
  RedrawColor($iBackground, 0, 0, dwgBackground.Width, dwgBackground.Height)

END


PUBLIC FUNCTION GetColor(iButton AS Integer) AS Integer

  IF iButton = 1 THEN
    RETURN $iForeground
  ELSE
    RETURN $iBackground
  ENDIF

END


PUBLIC SUB RefreshCoord(X AS Integer, Y AS Integer)

  IF X <> $iLastCoordX OR Y <> $iLastCoordY THEN
    $iLastCoordX = X
    $iLastCoordY = Y
    IF X = COORD_HIDE OR Y = COORD_HIDE THEN
      lblCoord.Text = ""
    ELSE
      lblCoord.Text = Subst("&1 x &2", X, Y)
    ENDIF
  ENDIF

END


PUBLIC SUB HideCoord()

  RefreshCoord(COORD_HIDE, COORD_HIDe)

END


PUBLIC SUB dwgForeground_MouseUp()

  Dialog.Color = $iForeground
  IF Dialog.SelectColor() THEN RETURN

  $iForeground = Dialog.Color
  RefreshColor

END

PUBLIC SUB dwgBackground_MouseUp()

  Dialog.Color = $iBackground
  IF Dialog.SelectColor() THEN RETURN

  $iBackground = Dialog.Color
  RefreshColor

END

PUBLIC SUB imgExchange_MouseDown()

  SWAP $iForeground, $iBackground
  RefreshColor

END


PUBLIC FUNCTION OtherColor(C AS Integer) AS Integer

  IF C = $iBackground THEN
    RETURN $iForeground
  ELSE
    RETURN $iBackground
  ENDIF

END


PUBLIC FUNCTION GetMode(sFunc AS String) AS Integer

  RETURN $cMode[sFunc]

END


PUBLIC FUNCTION GetTool() AS String

  RETURN $hTool.Tag

END


PUBLIC SUB Form_Hide()

  Config.SaveWindow(ME, "/FIconTool")

END

PRIVATE SUB SetIcon(iMouse AS Integer)

  $iMouse = iMouse
  $hCurrent.Form_Enter

END

PUBLIC FUNCTION GetMouse() AS Integer

  RETURN $iMouse

END