Commit 1bf70e1e authored by Benoît Minisini's avatar Benoît Minisini

PictureBox is now implemented in Gambas.

[GB.GTK]
* NEW: Remove PictureBox control.

[GB.GTK3]
* NEW: Remove PictureBox control.

[GB.GUI.BASE]
* NEW: PictureBox is now implemented in Gambas.
* NEW: PictureBox: Image is a new property that allows to display an Image instead of a Picture.
* NEW: PictureBox: Mode is a new property that defines how the image fills the control.

[GB.QT4]
* NEW: Remove PictureBox control.

[GB.QT5]
* NEW: Remove PictureBox control.
parent 7e2ccb7c
' Gambas class file
Inherits DrawingArea
Property Alignment As Integer
Property AutoResize As Boolean
Property Padding As Integer
Property Border As Integer
Property Stretch As Boolean
Private Function Alignment_Read() As Integer
End
Private Sub Alignment_Write(Value As Integer)
End
Private Function AutoResize_Read() As Boolean
End
Private Sub AutoResize_Write(Value As Boolean)
End
Private Function Padding_Read() As Integer
End
Private Sub Padding_Write(Value As Integer)
End
Private Function Border_Read() As Integer
End
Private Sub Border_Write(Value As Integer)
End
Private Function Stretch_Read() As Boolean
End
Private Sub Stretch_Write(Value As Boolean)
End
' Gambas class file
Export
Inherits DrawingArea
Public Const _Properties As String = "*,-Arrangement,-Spacing,-Margin,-Indent,-Invert,-NoBackground,-Tablet,-Cached,-Focus,Padding{Range:0;64},Picture,Stretch,AutoResize,Alignment{Align.*}=TopLeft,Border{Border.None;Plain;Sunken;Raised;Etched},Mode{PictureBox.Normal;Fill;Cover;Contain;Repeat}"
Public Const _DefaultEvent As String = "MouseDown"
Public Const _DefaultSize As String = "16,16"
Public Const _IsContainer As Boolean = False
Public Const _Group As String = "Form"
Property Picture As Picture
Property Image As Image
Property Alignment As Integer
Property AutoResize As Boolean
Property Padding As Integer
Property Border As Integer
Property Stretch As Boolean
Property Mode As Integer
Public Enum Normal, Fill, Cover, Contain, {Repeat}
Static Private $hDefault As Image
Private $hObs As Observer
Private $iAlign As Integer = Align.TopLeft
Private $iPadding As Integer
Private $iBorder As Integer
Private $iMode As Integer
Private $hPicture As Picture
Private $hImage As Image
Private $bAutoResize As Boolean
Private $bStretch As Boolean
Public Sub _new()
$hObs = New Observer(Me) As "DrawingArea"
End
Private Function Alignment_Read() As Integer
Return $iAlign
End
Private Sub Alignment_Write(Value As Integer)
If $iAlign = Value Then Return
$iAlign = Value
Me.Refresh
End
Private Function AutoResize_Read() As Boolean
Return $bAutoResize
End
Private Sub GetPadding() As Integer
Dim P As Integer
P = $iPadding
Select Case $iBorder
Case Border.Plain
Inc P
Case Border.Raised, Border.Sunken
P += Style.FrameWidth
End Select
Return P
End
Private Sub UpdateSize()
Dim W As Integer
Dim H As Integer
Dim P As Integer
If Me.Design Then Return
If Not $bAutoResize Then Return
If $hImage Then
W = $hImage.W
H = $hImage.H
Else If $hPicture Then
W = $hPicture.W
H = $hPicture.H
Endif
If W And If H Then
P = GetPadding() * 2
Me.Resize(W + P, H + P)
Endif
End
Private Sub AutoResize_Write(Value As Boolean)
If $bAutoResize = Value Then Return
$bAutoResize = Value
UpdateSize
End
Private Function Padding_Read() As Integer
Return $iPadding
End
Private Sub Padding_Write(Value As Integer)
If $iPadding = Value Then Return
$iPadding = Value
Me.Refresh
End
Private Function Border_Read() As Integer
Return $iBorder
End
Private Sub Border_Write(Value As Integer)
If $iBorder = Value Then Return
$iBorder = Value
UpdateSize
Me.Refresh
End
Private Function Stretch_Read() As Boolean
Return $bStretch
End
Private Sub Stretch_Write(Value As Boolean)
If $bStretch = Value Then Return
$bStretch = Value
Me.Refresh
End
Private Function Mode_Read() As Integer
Return $iMode
End
Private Sub Mode_Write(Value As Integer)
If $iMode = Value Then Return
$iMode = Value
Me.Refresh
End
Private Function Picture_Read() As Picture
Return $hPicture
End
Private Sub Picture_Write(Value As Picture)
$hPicture = Value
UpdateSize
End
Private Function Image_Read() As Image
Return $hImage
End
Private Sub Image_Write(Value As Image)
$hImage = Value
UpdateSize
End
Public Sub DrawingArea_Draw()
Dim W As Integer
Dim H As Integer
Dim WW As Integer
Dim P As Integer
Dim HH As Integer
Dim SX As Float
Dim SY As Float
Dim S As Float
Dim X As Integer
Dim Y As Integer
Dim XX As Integer
Dim YY As Integer
Dim iMode As Integer
If $hImage Then
W = $hImage.W
H = $hImage.H
Else If $hPicture Then
W = $hPicture.W
H = $hPicture.H
Endif
If $iBorder Then Style.PaintPanel(0, 0, Paint.W, Paint.H, $iBorder)
If W = 0 Or If H = 0 Then
If Me.Design Then
If Not $hDefault Then $hDefault = Image.Load("picturebox.png")
Paint.DrawImage($hDefault, Desktop.Scale, Desktop.Scale)
Endif
Stop Event
Return
Endif
P = GetPadding()
If $bAutoResize Then
GoSub PAINT_IMAGE
Stop Event
Return
Endif
WW = Me.W - P * 2
HH = Me.H - P * 2
If $bStretch Then
iMode = Fill
Else
iMode = $iMode
Endif
Select Case iMode
Case Normal, {Repeat}
Case Fill
W = WW
H = HH
Case Cover, Contain
SX = WW / W
SY = HH / H
If $iMode = Cover Then
S = Max(SX, SY)
Else
S = Min(SX, SY)
Endif
W *= S
H *= S
End Select
If Align.IsLeft($iAlign) Then
X = 0
Else If Align.IsRight($iAlign) Then
X = WW - W
Else
X = (WW - W) \ 2
Endif
If Align.IsTop($iAlign) Then
Y = 0
Else If Align.IsBottom($iAlign) Then
Y = HH - H
Else
Y = (HH - H) \ 2
Endif
If iMode = {Repeat} Then
XX = X - CInt(Ceil(X / W)) * W
YY = Y - CInt(Ceil(Y / H)) * H
For X = XX To WW Step W
For Y = YY To HH Step H
GoSub PAINT_IMAGE
Next
Next
Else
GoSub PAINT_IMAGE
Endif
Stop Event
Return
PAINT_IMAGE:
If $hImage Then
Paint.DrawImage($hImage, X + P, Y + P, W, H)
Else
Paint.DrawPicture($hPicture, X + P, Y + P, W, H)
Endif
Return
End
' Gambas class file
Inherits Task
Private $sDir As String
Private $iSize As Integer
Private $aPreview As String[]
Public Sub _new(sDir As String, iSize As Integer, aPreview As String[])
$sDir = sDir
$iSize = iSize
$aPreview = aPreview
End
Private Sub PrintIcon(sFile As String, hImage As Image)
Dim hIcon As Image
Dim sTemp As String
hIcon = New Image(hImage.W + 4, hImage.H + 4, Color.Transparent)
Paint.Begin(hIcon)
Paint.AntiAlias = False
Paint.LineWidth = 2
Paint.Rectangle(0, 0, hIcon.W, hIcon.H)
Paint.Background = Color.Gray
Paint.Stroke
Paint.End
hIcon.DrawImage(hImage, 2, 2)
sTemp = File.SetExt(Temp$(), "png")
hIcon.Save(sTemp)
Print sFile; "\t"; sTemp
End
Public Sub Main()
Dim sFile As String
Dim sExt As String
Dim sPath As String
Dim hImage As Image
Dim hSvgImage As SvgImage
Application.Priority += 10
For Each sFile In $aPreview
sPath = $sDir &/ sFile
sExt = LCase(File.Ext(sFile))
If sExt = "jpg" Or If sExt = "jpeg" Or If sExt = "png" Or If sExt = "gif" Or If sExt = "bmp" Or If sExt = "xpm" Then
If Stat(sPath).Size > 4194304 Then Continue
Try hImage = Image.Load(sPath)
If Error Then Continue
If Not (hImage.Width = $iSize And hImage.Height = $iSize) Then
If hImage.Width > hImage.Height Then
hImage = hImage.Stretch($iSize, ($iSize * hImage.Height) \ hImage.Width)
Else
hImage = hImage.Stretch(($iSize * hImage.Width) \ hImage.Height, $iSize)
Endif
Endif
PrintIcon(sFile, hImage)
Else If sExt = "svg" Or If sExt = "svgz" Then
Try hSvgImage = SvgImage.Load(sPath)
If Error Then Continue
If hSvgImage.Width > hSvgImage.Height Then
hSvgImage.Resize($iSize, $iSize * hSvgImage.Height / hSvgImage.Width)
Else
hSvgImage.Resize($iSize * hSvgImage.Width / hSvgImage.Height, $iSize)
Endif
hImage = New Image(hSvgImage.Width, hSvgImage.Height, Color.Transparent)
Paint.Begin(hImage)
hSvgImage.Paint()
Paint.End
PrintIcon(sFile, hImage)
Endif
Next
Print "."
Do
Sleep 3600
Loop
End
' Gambas class file
Class DesktopMime
Static Private $cCache As New Collection
Private $sDir As String
Private $aList As String[]
Private $dDate As Date
Private $dLastModified As Date
Private $cStat As New Collection
Private $cIcon As New Collection
Private $cIsDir As New Collection
Private $iLock As Integer
Static Public Sub _get(sDir As String) As DirCache
Dim hCache As DirCache
If Right(sDir) <> "/" Then sDir &= "/"
hCache = $cCache[sDir]
If Not hCache Then
hCache = New DirCache(sDir)
$cCache[sDir] = hCache
Endif
Return hCache
End
Static Public Sub Exit()
$cCache = Null
End
Public Sub _new(sDir As String)
$sDir = sDir
End
Public Sub Clear()
$dDate = Null
End
Private Sub CheckValid() As Boolean
Dim dLastModified As Date
If $iLock Then Return
dLastModified = Stat($sDir).LastModified
If IsNull($dLastModified) Or If dLastModified > $dLastModified Or If Now >= DateAdd($dDate, gb.Second, 5) Then
$dDate = Now
$dLastModified = dLastModified
$cStat.Clear
$aList = Null
Endif
End
Public Sub Invalidate()
$dLastModified = Null
$dDate = Null
End
Public Sub GetInfo(sFile As String) As Stat
Dim hInfo As Stat
If CheckValid() Then Return
If sFile = "" Then sFile = "/"
hInfo = $cStat[sFile]
If Not hInfo Then
'Debug sFile
hInfo = Stat($sDir &/ sFile)
$cStat[sFile] = hInfo
Endif
Return hInfo
End
Public Sub IsDir(sFile As String) As Boolean
If CheckValid() Then Return
If sFile = "" Then sFile = "/"
If Not $cIsDir.Exist(sFile) Then
$cIsDir[sFile] = IsDir($sDir &/ sFile)
Endif
Return $cIsDir[sFile]
End
Public Sub GetMimeIcon(sFile As String, iSize As Integer) As Image
Dim hIcon As Image
If CheckValid() Then Return
hIcon = $cIcon[sFile & ":" & CStr(iSize)]
If Not hIcon Then
Try hIcon = DesktopMime.FromFile($sDir &/ sFile).GetIcon(iSize)
$cIcon[sFile & ":" & CStr(iSize)] = hIcon
Endif
Return hIcon
End
Public Sub GetFiles() As String[]
If CheckValid() Then Return New String[]
If Not $aList Then
'Debug
$aList = Dir($sDir).Sort(gb.Natural)
Endif
Return $aList
End
Public Sub Lock()
If $iLock = 0 Then CheckValid
Inc $iLock
End
Public Sub Unlock()
Dec $iLock
End
This diff is collapsed.
' Gambas module file
Public Sub GotoNext(hCtrl As Control, Optional bSelect As Boolean)
Dim hTextBox As TextBox
hCtrl = hCtrl.Next
If hCtrl And If Object.Type(hCtrl) <> "TextBox" Then
hCtrl = hCtrl.Next
Endif
If hCtrl Then
hTextBox = hCtrl
hCtrl.SetFocus
hCtrl.Pos = 0
If bSelect Then hCtrl.SelectAll
Endif
End
Public Sub GotoPrevious(hCtrl As Control, Optional bSelect As Boolean)
Dim hTextBox As TextBox
hCtrl = hCtrl.Previous
If hCtrl And If Object.Type(hCtrl) <> "TextBox" Then
hCtrl = hCtrl.Previous
Endif
If hCtrl Then
hTextBox = hCtrl
hCtrl.SetFocus
hCtrl.Pos = hCtrl.Length
If bSelect Then hCtrl.SelectAll
Endif
End
Public Sub ManageKeyPress(sCar As String, aTextBox As Object[])
Dim hLast As TextBox = Last
If Asc(Key.Text) >= 32 And Asc(Key.Text) < 127 Then
If Not IsDigit(Key.Text) Then
If InStr(sCar, Key.Text) Then
Help.GotoNext(Last)
Endif
Stop Event
Return
Endif
Else If Key.Code = Key.Home Then
aTextBox[0].SelectAll
aTextBox[0].SetFocus
Stop Event
Else If Key.Code = Key.End Then
aTextBox[2].SelectAll
aTextBox[2].SetFocus
Stop Event
Else If Key.Code = Key.Left Then
If hLast.Pos = 0 Then GotoPrevious(Last)
Else If Key.Code = Key.Right Then
If hLast.Pos = hLast.Length Then GotoNext(Last)
Endif
End
Public Sub CheckFileName(sName As String) As String
If Not sName Then Return ("A file or directory name cannot be void.")
If InStr(sName, "/") Then Return ("The '/' character is forbidden inside file or directory names.")
End
../../../app/src/gambas3/img/control/picturebox.png
\ No newline at end of file
/***************************************************************************
CPictureBox.cpp
CMovieBox.cpp
(c) 2004-2006 - Daniel Campos Fernández <dcamposf@gmail.com>
(c) 2018 Benoît Minisini <g4mba5@gmail.com>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
......@@ -21,119 +22,19 @@
***************************************************************************/
#define __CPICTUREBOX_CPP
#define __CMOVIEBOX_CPP
#include "main.h"
#include "gambas.h"
#include "widgets.h"
#include "CPictureBox.h"
#include "CMovieBox.h"
#include "CPicture.h"
#include "CContainer.h"