ficoneditor.class

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

' Gambas class file

PUBLIC Name AS String
PUBLIC Path AS String

PRIVATE $hImage AS Image
PRIVATE $iScale AS Integer
PRIVATE $iScale1 AS Integer

PRIVATE $bModify AS Boolean

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

PRIVATE $bGhost AS Boolean

PRIVATE CONST MAX_UNDO AS Integer = 32
PRIVATE $hUndo[32] AS Image
PRIVATE $iUndo AS Integer

PRIVATE CONST WIDTH_SEL AS Integer = 4

PRIVATE $bSelect AS Boolean
PRIVATE $bPrivate AS Boolean
PRIVATE $XS AS Integer
PRIVATE $YS AS Integer
PRIVATE $WS AS Integer
PRIVATE $HS AS Integer

PRIVATE $hPaste AS Image

STATIC PRIVATE $aZoom AS Integer[]
STATIC PRIVATE $iMaxW AS Integer
STATIC PRIVATE $iMaxH AS Integer
STATIC PRIVATE $hTile AS Picture

STATIC PUBLIC SUB _init()

  $aZoom = [ 1, 2, 3, 4, 6, 8, 12, 16, 24 ]
  $hTile = Picture["img/16/tile.png"]

END


PUBLIC SUB _new(sPath AS String)

  DIM sText AS String

  Path = sPath
  Name = Mid$(sPath, Len(File.Dir(Project.Path)) + 1)

  $iScale = 12

  'ReadConfig

  $hImage = NEW Image
  $hImage.Load(sPath)

  $iMaxW = ME.Width
  $iMaxH = ME.Height
  Project.InitMove(ME)

  $bModify = FALSE

  DrawTitle

  FIconTool.Activate(ME)
  FIconTool.ChangeTool

END

PUBLIC SUB Form_Open()

  RefreshZoom

END


PUBLIC SUB Form_Resize()

  svwIcon.Resize(ME.ClientW, ME.ClientH)
  'dwgIcon.Move(0, 0)

END

PUBLIC SUB dwgIcon_Draw()

  DIM X AS Integer
  DIM Y AS Integer
  DIM XR AS Integer
  DIM YR AS Integer
  DIM SX AS Integer
  DIM SY AS Integer
  DIM DX AS Integer
  DIM DY AS Integer
  DIM C AS Integer
  DIM W AS Integer

  IF NOT $hImage THEN RETURN

  Draw.LineStyle = LINE.None
  'Draw.FillStyle = Fill.CrossDiagonal
  'Draw.FillColor = 0
  'Draw.Rect(Draw.Clip.X, Draw.Clip.Y, Draw.Clip.W, Draw.Clip.H)
  Draw.FillStyle = Fill.Solid
  Draw.Tile($hTile, Draw.Clip.X, Draw.Clip.Y, Draw.Clip.W, Draw.Clip.H)

  IF $iScale > 5 THEN
    Draw.LineStyle = LINE.Solid
    Draw.ForeColor = Color.Gray
    W = $iScale1
  ELSE
    Draw.LineStyle = LINE.None
    W = $iScale
  ENDIF

  SX = Draw.Clip.X \ $iScale
  SY = Draw.Clip.Y \ $iScale
  DX = (Draw.Clip.X + Draw.Clip.W - 1) \ $iScale
  DY = (Draw.Clip.Y + Draw.Clip.H - 1) \ $iScale

  SX = Max(0, SX)
  DX = Min($hImage.Width - 1, DX)

  SY = Max(0, SY)
  DY = Min($hImage.Height - 1, DY)

  YR = SY * $iScale
  FOR Y = SY TO DY
    XR = SX * $iScale
    FOR X = SX TO DX
      C = $hImage[X, Y]
      IF C >= 0 THEN
        Draw.FillColor = C
        Draw.Rect(XR, YR, W, W)
      ENDIF
      XR = XR + $iScale
    NEXT
    YR = YR + $iScale
  NEXT

  IF $bGhost THEN DrawGhost(TRUE)

END


PUBLIC SUB dwgPaste_Draw()

  DIM X AS Integer
  DIM Y AS Integer
  DIM XR AS Integer
  DIM YR AS Integer
  DIM SX AS Integer
  DIM SY AS Integer
  DIM DX AS Integer
  DIM DY AS Integer
  DIM C AS Integer
  DIM CP AS Integer
  DIM bTrans AS Boolean
  DIM W AS Integer

  IF NOT $hPaste THEN RETURN

  bTrans = FIconTool.GetMode("select") = 0

  Draw.FillX = Draw.FillX - $XS * $iScale
  Draw.FillY = Draw.FillY - $YS * $iScale

  Draw.LineStyle = LINE.None
  'Draw.FillStyle = Fill.CrossDiagonal
  'Draw.FillColor = 0
  'Draw.Rect(Draw.Clip.X, Draw.Clip.Y, Draw.Clip.W, Draw.Clip.H)
  Draw.FillStyle = Fill.Solid

  Draw.Tile($hTile, Draw.Clip.X, Draw.Clip.Y, Draw.Clip.W, Draw.Clip.H)

  IF $iScale > 5 THEN
    Draw.LineStyle = LINE.Solid
    Draw.ForeColor = Color.Gray
    W = $iScale1
  ELSE
    Draw.LineStyle = LINE.None
    W = $iScale
  ENDIF


  SX = Draw.Clip.X \ $iScale
  SY = Draw.Clip.Y \ $iScale
  DX = (Draw.Clip.X + Draw.Clip.W - 1) \ $iScale
  DY = (Draw.Clip.Y + Draw.Clip.H - 1) \ $iScale

  SX = Max(0, SX)
  DX = Min($hPaste.Width - 1, DX)

  SY = Max(0, SY)
  DY = Min($hPaste.Height - 1, DY)

  IF bTrans THEN

    YR = SY * $iScale
    FOR Y = SY TO DY
      XR = SX * $iScale
      FOR X = SX TO DX
        C = $hPaste[X, Y]
        IF C < 0 THEN
          C = $hImage[X + $XS, Y + $YS]
        ENDIF
        IF C >= 0 THEN
        '  IF LC <> C THEN
            Draw.FillColor = C
        '    LC = C
        '  ENDIF
          Draw.Rect(XR, YR, W, W)
        ENDIF
        XR = XR + $iScale
      NEXT
      YR = YR + $iScale
    NEXT

  ELSE

    YR = SY * $iScale
    FOR Y = SY TO DY
      XR = SX * $iScale
      FOR X = SX TO DX
        C = $hPaste[X, Y]
        IF C >= 0 THEN
          Draw.FillColor = C
          Draw.Rect(XR, YR, W, W)
        ENDIF
        XR = XR + $iScale
      NEXT
      YR = YR + $iScale
    NEXT

  ENDIF

  Draw.FillStyle = Fill.None
  Draw.LineStyle = Line.Dot
  Draw.LineWidth = 3
  Draw.Foreground = Color.Black
  Draw.Background = Color.White
  Draw.Transparent = FALSE
  'Draw.Invert = TRUE
  Draw.Rect(1, 1, dwgPaste.Width - 2, dwgPaste.Height - 2)

END


PRIVATE SUB DrawTitle()

  DIM sTitle AS String

  sTitle = File.Name(Path) & " " & $hImage.Width & " x " & $hImage.Height
  IF $bModify THEN sTitle = sTitle & " [" & ("modified") & "]"
  ME.Title = sTitle '& " - " & Project.Name

END


PUBLIC FUNCTION IsModified() AS Boolean

  RETURN $bModify

END


PUBLIC SUB Rename(sNewName AS String, sNewPath AS String)

  Name = sNewName
  Path = sNewPath 'File.Dir(Path) &/ sNewName '& "." & File.Ext(Path)
  DrawTitle

END


PUBLIC FUNCTION Save() AS Boolean

  IF Project.ReadOnly THEN RETURN
  IF NOT $bModify THEN RETURN

  'PRINT "Picture not saved"

  HideSelection

  Save.Begin(Path)

  $hImage.Save(Path)

  Stat(Path)
  IF Stat(Path).Size <= Project.MAX_ICON_SIZE THEN
    Project.ProjectTree[Path].Picture = $hImage.Picture
  ENDIF

  $bModify = FALSE
  DrawTitle
  Save.End()

CATCH

  RETURN Save.Error()

END

PUBLIC SUB dwgIcon_MouseDown()

  DIM X AS Integer
  DIM Y AS Integer

  X = Mouse.X
  Y = Mouse.Y

  WITH FIconTool

    SELECT .GetTool()

      CASE "move"
        $X = Mouse.ScreenX + svwIcon.ScrollX
        $Y = Mouse.ScreenY + svwIcon.ScrollY

      CASE "pen"
        SetUndo
        $X = -1
        $Y = -1
        $iColor = .GetColor(Mouse.Button)
        dwgIcon_MouseMove()

      CASE "line", "rect", "circle", "fill"
        SetUndo
        $X = X \ $iScale
        $Y = Y \ $iScale
        $X2 = $X
        $Y2 = $Y
        $iColor = .GetColor(Mouse.Button)

      CASE "select"

        $X = X \ $iScale
        $Y = Y \ $iScale
        $X2 = $X
        $Y2 = $Y

        '$bSelect = FALSE
        'RefreshSelect

      CASE "pipette"
        X = X \ $iScale
        Y = Y \ $iScale

        .SetForeground($hImage[X, Y])

    END SELECT

    DrawGhost

    SELECT .GetTool()

      CASE "line", "rect", "circle"
        dwgIcon_MouseMove()

    END SELECT

  END WITH

END

PUBLIC SUB dwgIcon_MouseMove()

  DIM C AS Integer
  DIM X AS Integer
  DIM Y AS Integer
  DIM NX AS Integer
  DIM NY AS Integer

  X = Mouse.X
  Y = Mouse.Y

  WITH FIconTool

    .RefreshCoord(X \ $iScale, Y \ $iScale)

    IF NOT (Mouse.Left OR Mouse.Right) THEN RETURN

    DrawGhost

    IF .GetTool() <> "move" THEN

      UpdateScroll(X, Y)

    ENDIF

    X = X \ $iScale
    Y = Y \ $iScale

    SELECT .GetTool()

      CASE "move"
        svwIcon.Scroll($X - Mouse.ScreenX, $Y - Mouse.ScreenY)

      CASE "pen"
        IF X <> $X OR Y <> $Y THEN
          IF $X < 0 AND $Y < 0 THEN
            DrawPoint(X, Y, $iColor)
          ELSE
            DrawLine($X, $Y, X, Y, $iColor)
          ENDIF
          $X = X
          $Y = Y
        ENDIF

      CASE "line", "rect", "circle", "select"
        IF X <> $X2 OR Y <> $Y2 THEN
          $X2 = X
          $Y2 = Y
          IF .GetTool() = "select" THEN
            HideSelection
            $bSelect = TRUE
          ENDIF
        ENDIF

    END SELECT

    DrawGhost

  END WITH

END


PUBLIC SUB dwgIcon_MouseUp()

  WITH FIconTool

    DrawGhost

    SELECT CASE .GetTool()

      CASE "pipette"
        .RevertTool

      CASE "line"
        DrawLine($X, $Y, $X2, $Y2, $iColor)

      CASE "rect"
        DrawRect(Min($X, $X2), Min($Y, $Y2), Abs($X - $X2) + 1, Abs($Y - $Y2) + 1, $iColor)

      CASE "circle"
        DrawEllipse(Min($X, $X2), Min($Y, $Y2), Abs($X - $X2) + 1, Abs($Y - $Y2) + 1, $iColor)

      CASE "select"
        IF $X2 <> $X OR $Y2 <> $Y THEN
          $X = Max(0, Min($hImage.Width - 1, $X))
          $Y = Max(0, Min($hImage.Width - 1, $Y))
          $X2 = Max(0, Min($hImage.Width - 1, $X2))
          $Y2 = Max(0, Min($hImage.Width - 1, $Y2))

          $XS = Min($X, $X2)
          $YS = Min($Y, $Y2)
          $WS = Abs($X - $X2) + 1
          $HS = Abs($Y - $Y2) + 1
          $bPrivate = TRUE
          ShowSelection
        ELSE
          IF NOT $bPrivate THEN DoPaste
          HideSelection
        ENDIF

      CASE "fill"
        FloodFill($X, $Y, $iColor)

    END SELECT

  END WITH

END


PRIVATE SUB RefreshZoom()

  ME.Resize(Min($iMaxW, $hImage.Width * $iScale + (ME.Width - ME.ClientW) + 8), Min($iMaxH, $hImage.Height * $iScale + (ME.Height - ME.ClientH) + 8))
  $iScale1 = $iScale + 1

  'dwgIcon.Hide
  dwgIcon.Resize($hImage.Width * $iScale, $hImage.Height * $iScale)
  'RefreshSelect
  RefreshAllImage

  IF dwgPaste.Visible THEN
    dwgPaste.Move($XS * $iScale, $YS * $iScale, $hPaste.Width * $iScale, $hPaste.Height * $iScale)
  ENDIF

END


PRIVATE SUB RefreshImage(X AS Integer, Y AS Integer, W AS Integer, H AS Integer)

  X = X * $iScale
  Y = Y * $iScale
  W = W * $iScale
  H = H * $iScale

  dwgIcon.Refresh(X - 1, Y - 1, W + 2, H + 2)

END


PRIVATE SUB RefreshAllImage()

  dwgIcon.Refresh(svwIcon.ScrollX, svwIcon.ScrollY, svwIcon.ClientW, svwIcon.ClientH)

END



PUBLIC SUB Modify(OPTIONAL bReset AS Boolean)

  IF Project.ReadOnly THEN RETURN
  IF $bModify <> bReset THEN RETURN

  $bModify = NOT bReset
  DrawTitle

END


PUBLIC SUB dwgIcon_Leave()

  FIconTool.HideCoord

END


PRIVATE SUB SetPixel(X AS Integer, Y AS Integer, C AS Integer)

  IF C = -2 THEN
    IF $hImage[X, Y] >= 0 THEN
      $hImage[X, Y] = &HFFFFFF& - $hImage[X, Y]
      Modify
    ENDIF
  ELSE
    $hImage[X, Y] = C
    Modify
  ENDIF

END


PRIVATE SUB DrawPoint(X AS Integer, Y AS Integer, C AS Integer)

  SetPixel(X, Y, C)
  RefreshImage(X, Y, 1, 1)

END


PRIVATE SUB DrawLine(X1 AS Integer, Y1 AS Integer, X2 AS Integer, Y2 AS Integer, C AS Integer)

  DIM X AS Integer
  DIM Y AS Integer
  DIM DX AS Float
  DIM DY AS Float
  DIM D AS Integer
  DIM XX AS Float
  DIM YY AS Float
  DIM LX AS Integer
  DIM LY AS Integer
  DIM bCalc AS Boolean

  D = Max(Abs(X2 - X1), Abs(Y2 - Y1), 1)

  DX = (X2 - X1) / D
  DY = (Y2 - Y1) / D

  'PRINT "-------"
  'PRINT "D ="; D; " DX ="; DX; " "; Sgn(DX); " DY ="; DY; " "; Sgn(DY)

  X = X1
  Y = Y1

  DO
    'PRINT "X ="; X; " Y ="; Y

    DrawPoint(X, Y, C)

    IF X = X2 AND Y = Y2 THEN BREAK

    bCalc = FALSE

    DO

      XX = XX + DX
      YY = YY + DY

      IF Abs(XX) > 0.5 THEN
        X = X + Sgn(DX)
        XX = XX - Sgn(DX)
        bCalc = TRUE
      ENDIF

      IF Abs(YY) > 0.5 THEN
        Y = Y + Sgn(DY)
        YY = YY - Sgn(DY)
        bCalc = TRUE
      ENDIF

    LOOP UNTIL bCalc

  LOOP

END

PRIVATE SUB DrawRect(X AS Integer, Y AS Integer, W AS Integer, H AS Integer, C AS Integer, OPTIONAL iMode AS Integer = -1)

  DIM XX AS Integer
  DIM YY AS Integer

  WITH FIconTool

    IF iMode < 0 THEN iMode = .GetMode("rect")

    IF iMode > 0 THEN

      IF iMode = 2 THEN C = .OtherColor(C)

      FOR XX = X TO X + W - 1
        FOR YY = Y TO Y + H - 1
          SetPixel(XX, YY, C)
        NEXT
      NEXT

    ENDIF

    IF iMode <> 1 THEN

      IF iMode = 2 THEN C = .OtherColor(C)

      FOR XX = X TO X + W - 1
        SetPixel(XX, Y, C)
        SetPixel(XX, Y + H - 1, C)
      NEXT

      FOR YY = Y + 1 TO Y + H - 2
        SetPixel(X, YY, C)
        SetPixel(X + W - 1, YY, C)
      NEXT

    ENDIF

    RefreshImage(X, Y, W, H)

  END WITH

END


PRIVATE SUB DrawEllipse(X AS Integer, Y AS Integer, W AS Integer, H AS Integer, C AS Integer)

  DIM hTemp AS NEW Picture
  DIM hImage AS Image
  DIM XX AS Integer
  DIM YY AS Integer
  DIM C2 AS Integer

  WITH FIconTool

    'hTemp.Type = Picture.Bitmap
    hTemp.Resize(W, H)
    hTemp.Fill(0)

    Draw.Begin(hTemp)

    SELECT CASE .GetMode("circle")

      CASE 0
        Draw.LineStyle = LINE.Solid
        Draw.ForeColor = 1
        Draw.FillStyle = Fill.None

      CASE 1
        Draw.LineStyle = LINE.None
        Draw.FillStyle = Fill.Solid
        Draw.FillColor = 1