mirror of
https://code.videolan.org/videolan/vlc
synced 2024-09-08 11:26:59 +02:00
70ff1f1695
- doc/skins/curve_maker: files for a VB project for easy Bezier curves creation - share/skins/default: a default skin. It's an awful one made for testing purposes, you'll be warned...
392 lines
9.1 KiB
Plaintext
392 lines
9.1 KiB
Plaintext
VERSION 5.00
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
|
|
Begin VB.Form ppal
|
|
AutoRedraw = -1 'True
|
|
BackColor = &H00FFFFFF&
|
|
Caption = "VLC skin Curve Maker"
|
|
ClientHeight = 7140
|
|
ClientLeft = 165
|
|
ClientTop = 450
|
|
ClientWidth = 10440
|
|
Icon = "Bezier.frx":0000
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 476
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 696
|
|
StartUpPosition = 2 'CenterScreen
|
|
Begin VB.PictureBox Pict
|
|
AutoSize = -1 'True
|
|
BorderStyle = 0 'None
|
|
Height = 975
|
|
Left = 2640
|
|
ScaleHeight = 65
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 73
|
|
TabIndex = 4
|
|
Top = 1800
|
|
Visible = 0 'False
|
|
Width = 1095
|
|
End
|
|
Begin VB.PictureBox toolbox
|
|
Align = 1 'Align Top
|
|
BorderStyle = 0 'None
|
|
Height = 900
|
|
Left = 0
|
|
ScaleHeight = 900
|
|
ScaleWidth = 10440
|
|
TabIndex = 0
|
|
Top = 0
|
|
Width = 10440
|
|
Begin VB.HScrollBar Size
|
|
Height = 255
|
|
Left = 4920
|
|
Max = 5
|
|
Min = 1
|
|
TabIndex = 3
|
|
Top = 480
|
|
Value = 1
|
|
Width = 2655
|
|
End
|
|
Begin VB.HScrollBar Color
|
|
Height = 255
|
|
Left = 4920
|
|
Max = 15
|
|
TabIndex = 2
|
|
Top = 120
|
|
Width = 2655
|
|
End
|
|
Begin VB.TextBox Result
|
|
Height = 615
|
|
Left = 120
|
|
Locked = -1 'True
|
|
MultiLine = -1 'True
|
|
TabIndex = 1
|
|
Top = 120
|
|
Width = 4575
|
|
End
|
|
End
|
|
Begin MSComDlg.CommonDialog Cmd
|
|
Left = 7560
|
|
Top = 120
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 327680
|
|
End
|
|
Begin VB.Menu m_file
|
|
Caption = "&File"
|
|
Begin VB.Menu m_load
|
|
Caption = "Load..."
|
|
End
|
|
Begin VB.Menu m_saveas
|
|
Caption = "Save as..."
|
|
End
|
|
Begin VB.Menu m_sep1
|
|
Caption = "-"
|
|
End
|
|
Begin VB.Menu m_quit
|
|
Caption = "Quit"
|
|
End
|
|
End
|
|
Begin VB.Menu m_picture
|
|
Caption = "Picture"
|
|
Begin VB.Menu m_loadpicture
|
|
Caption = "Load..."
|
|
End
|
|
End
|
|
Begin VB.Menu m_tool
|
|
Caption = "Tool"
|
|
Visible = 0 'False
|
|
Begin VB.Menu m_addpoint
|
|
Caption = "AddPoint"
|
|
End
|
|
Begin VB.Menu m_center
|
|
Caption = "Center"
|
|
End
|
|
End
|
|
Begin VB.Menu m_point
|
|
Caption = "Point"
|
|
Visible = 0 'False
|
|
Begin VB.Menu m_deletept
|
|
Caption = "Delete"
|
|
End
|
|
End
|
|
End
|
|
Attribute VB_Name = "ppal"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Dim xe As Single
|
|
Dim ye As Single
|
|
Dim Sel As Long
|
|
|
|
Dim MouseX As Long
|
|
Dim MouseY As Long
|
|
Dim SelectPt As Long
|
|
Dim PictureFile As String
|
|
Dim CurveFile As String
|
|
|
|
Dim OffsetX As Long
|
|
Dim OffsetY As Long
|
|
Sub form_draw()
|
|
Dim i As Long
|
|
Me.Cls
|
|
|
|
|
|
BitBlt ppal.hdc, OffsetX, OffsetY, Pict.Width, Pict.Height, imgDC, 0, 0, SRCCOPY
|
|
|
|
|
|
If MaxPt < 0 Then Exit Sub
|
|
Call bezier_draw(40, OffsetX, OffsetY)
|
|
|
|
Me.DrawWidth = 1
|
|
For i = 0 To MaxPt
|
|
Me.Line (OffsetX + Pt(i).x - 6, OffsetY + Pt(i).y - 6)-(OffsetX + Pt(i).x + 6, OffsetY + Pt(i).y + 6), QBColor(Color.Value), B
|
|
Next i
|
|
Me.DrawWidth = Size.Value
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Sub RefreshResult()
|
|
Dim i As Long
|
|
|
|
Result.Text = "abs="""
|
|
For i = 0 To MaxPt
|
|
If i > 0 Then Result.Text = Result.Text & ","
|
|
Result.Text = Result.Text & Pt(i).x
|
|
Next i
|
|
Result.Text = Result.Text & """" & Chr$(13) & Chr$(10) & "ord="""
|
|
For i = 0 To MaxPt
|
|
If i > 0 Then Result.Text = Result.Text & ","
|
|
Result.Text = Result.Text & Pt(i).y
|
|
Next i
|
|
Result.Text = Result.Text & """"
|
|
|
|
End Sub
|
|
|
|
Private Sub Color_Change()
|
|
form_draw
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
PictureFile = "none"
|
|
MaxPt = -1
|
|
OffsetX = 0
|
|
OffsetY = 0
|
|
'Pict.Width = 0
|
|
'Pict.Height = 0
|
|
Call m_center_Click
|
|
|
|
End Sub
|
|
|
|
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
Dim i As Long
|
|
|
|
If Button = 2 Then
|
|
For i = 0 To MaxPt
|
|
If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
|
|
If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
|
|
SelectPt = i + 1
|
|
Me.PopupMenu m_point
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
Next i
|
|
MouseX = x
|
|
MouseY = y
|
|
Me.PopupMenu m_tool
|
|
ElseIf Button = 1 Then
|
|
For i = 0 To MaxPt
|
|
If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
|
|
If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
|
|
SelectPt = i + 1
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
Next i
|
|
SelectPt = 0
|
|
Me.MousePointer = 5
|
|
MouseX = x
|
|
MouseY = y
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
|
|
If Button = 1 Then
|
|
If SelectPt > 0 Then
|
|
Pt(SelectPt - 1).x = x - OffsetX
|
|
Pt(SelectPt - 1).y = y - OffsetY
|
|
form_draw
|
|
Else
|
|
OffsetX = OffsetX - (x - MouseX)
|
|
OffsetY = OffsetY - (y - MouseY)
|
|
MouseX = x
|
|
MouseY = y
|
|
form_draw
|
|
End If
|
|
ElseIf Button = 0 Then
|
|
For i = 0 To MaxPt
|
|
If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
|
|
If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
|
|
SelectPt = i + 1
|
|
Me.MousePointer = 10
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
Next i
|
|
Me.MousePointer = 0
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
|
|
If Button = 1 Then
|
|
If SelectPt > 0 Then
|
|
SelectPt = 0
|
|
form_draw
|
|
Call RefreshResult
|
|
End If
|
|
Me.MousePointer = 0
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub m_addpoint_Click()
|
|
MaxPt = MaxPt + 1
|
|
Call make_pt(MaxPt, MouseX - OffsetX, MouseY - OffsetY)
|
|
Call form_draw
|
|
|
|
Call RefreshResult
|
|
|
|
End Sub
|
|
|
|
Private Sub m_center_Click()
|
|
OffsetX = (Me.ScaleWidth - Pict.Width) / 2
|
|
OffsetY = (Me.ScaleHeight - Pict.Height - toolbox.Height) / 2
|
|
form_draw
|
|
|
|
End Sub
|
|
|
|
Private Sub m_deletept_Click()
|
|
Dim i As Long
|
|
MaxPt = MaxPt - 1
|
|
For i = SelectPt - 1 To MaxPt
|
|
Pt(i).x = Pt(i + 1).x
|
|
Pt(i).y = Pt(i + 1).y
|
|
Next
|
|
form_draw
|
|
Call RefreshResult
|
|
|
|
End Sub
|
|
|
|
Private Sub m_load_Click()
|
|
Dim F As FileSystemObject
|
|
Set F = New FileSystemObject
|
|
Cmd.filename = CurveFile
|
|
Cmd.CancelError = False
|
|
Cmd.DialogTitle = "Open Curve"
|
|
Cmd.Filter = "Fichier VLC curve |*.curve.vlc"
|
|
Cmd.FilterIndex = 0
|
|
Cmd.InitDir = App.Path
|
|
Cmd.ShowOpen
|
|
|
|
If Not F.FileExists(Cmd.filename) Then Exit Sub
|
|
CurveFile = Cmd.filename
|
|
Dim i As Long, l As Long
|
|
Open CurveFile For Binary As #1
|
|
Get #1, , l
|
|
PictureFile = Space$(l)
|
|
Get #1, , PictureFile
|
|
Get #1, , OffsetX
|
|
Get #1, , OffsetY
|
|
Get #1, , MaxPt
|
|
For i = 0 To MaxPt
|
|
Get #1, , Pt(i).x
|
|
Get #1, , Pt(i).y
|
|
Next i
|
|
Close #1
|
|
If PictureFile <> "none" Then Pict.Picture = LoadPicture(PictureFile)
|
|
Call form_draw
|
|
Call RefreshResult
|
|
|
|
End Sub
|
|
|
|
Private Sub m_loadpicture_Click()
|
|
Dim F As FileSystemObject
|
|
Set F = New FileSystemObject
|
|
Cmd.CancelError = False
|
|
Cmd.DialogTitle = "Open picture"
|
|
Cmd.Filter = "Fichier bitmap |*.bmp"
|
|
Cmd.FilterIndex = 0
|
|
Cmd.InitDir = App.Path
|
|
Cmd.ShowOpen
|
|
|
|
If Not F.FileExists(Cmd.filename) Then Exit Sub
|
|
PictureFile = Cmd.filename
|
|
Pict.Picture = LoadPicture(Cmd.filename)
|
|
|
|
Dim HBitmap As Long
|
|
HBitmap = LoadImage(0, Cmd.filename, 0, 0, 0, 16)
|
|
imgDC = CreateCompatibleDC(0)
|
|
SelectObject imgDC, HBitmap
|
|
Pict.AutoSize = True
|
|
|
|
Call m_center_Click
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub m_quit_Click()
|
|
End
|
|
|
|
End Sub
|
|
|
|
Private Sub m_saveas_Click()
|
|
Dim F As FileSystemObject
|
|
Set F = New FileSystemObject
|
|
On Error GoTo error
|
|
Cmd.CancelError = True
|
|
Cmd.DialogTitle = "Save Curve"
|
|
Cmd.Filter = "Fichier VLC curve |*.curve.vlc"
|
|
Cmd.FilterIndex = 0
|
|
Cmd.InitDir = App.Path
|
|
Cmd.ShowSave
|
|
|
|
CurveFile = Cmd.filename
|
|
|
|
Dim i As Long
|
|
Open CurveFile For Binary As #1
|
|
Put #1, , CLng(Len(PictureFile))
|
|
Put #1, , PictureFile
|
|
Put #1, , OffsetX
|
|
Put #1, , OffsetY
|
|
Put #1, , MaxPt
|
|
For i = 0 To MaxPt
|
|
Put #1, , Pt(i).x
|
|
Put #1, , Pt(i).y
|
|
Next i
|
|
Close #1
|
|
|
|
error:
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Size_Change()
|
|
Me.DrawWidth = Size.Value
|
|
form_draw
|
|
|
|
End Sub
|