2 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
\r
4 AutoRedraw = -1 'True
\r
5 BackColor = &H00FFFFFF&
\r
6 Caption = "VLC skin Curve Maker"
\r
11 Icon = "Bezier.frx":0000
\r
14 ScaleMode = 3 'Pixel
\r
16 StartUpPosition = 2 'CenterScreen
\r
17 Begin VB.PictureBox Pict
\r
19 BorderStyle = 0 'None
\r
23 ScaleMode = 3 'Pixel
\r
30 Begin VB.PictureBox toolbox
\r
31 Align = 1 'Align Top
\r
32 BorderStyle = 0 'None
\r
40 Begin VB.HScrollBar Size
\r
50 Begin VB.HScrollBar Color
\r
58 Begin VB.TextBox Result
\r
62 MultiLine = -1 'True
\r
68 Begin MSComDlg.CommonDialog Cmd
\r
75 Begin VB.Menu m_file
\r
77 Begin VB.Menu m_load
\r
80 Begin VB.Menu m_saveas
\r
81 Caption = "Save as..."
\r
83 Begin VB.Menu m_sep1
\r
86 Begin VB.Menu m_quit
\r
90 Begin VB.Menu m_picture
\r
92 Begin VB.Menu m_loadpicture
\r
96 Begin VB.Menu m_tool
\r
99 Begin VB.Menu m_addpoint
\r
100 Caption = "AddPoint"
\r
102 Begin VB.Menu m_center
\r
106 Begin VB.Menu m_point
\r
109 Begin VB.Menu m_deletept
\r
114 Attribute VB_Name = "ppal"
\r
115 Attribute VB_GlobalNameSpace = False
\r
116 Attribute VB_Creatable = False
\r
117 Attribute VB_PredeclaredId = True
\r
118 Attribute VB_Exposed = False
\r
125 Dim SelectPt As Long
\r
126 Dim PictureFile As String
\r
127 Dim CurveFile As String
\r
129 Dim OffsetX As Long
\r
130 Dim OffsetY As Long
\r
136 BitBlt ppal.hdc, OffsetX, OffsetY, Pict.Width, Pict.Height, imgDC, 0, 0, SRCCOPY
\r
139 If MaxPt < 0 Then Exit Sub
\r
140 Call bezier_draw(40, OffsetX, OffsetY)
\r
144 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
\r
146 Me.DrawWidth = Size.Value
\r
157 Sub RefreshResult()
\r
160 Result.Text = "abs="""
\r
162 If i > 0 Then Result.Text = Result.Text & ","
\r
163 Result.Text = Result.Text & Pt(i).x
\r
165 Result.Text = Result.Text & """" & Chr$(13) & Chr$(10) & "ord="""
\r
167 If i > 0 Then Result.Text = Result.Text & ","
\r
168 Result.Text = Result.Text & Pt(i).y
\r
170 Result.Text = Result.Text & """"
\r
174 Private Sub Color_Change()
\r
179 Private Sub Form_Load()
\r
180 PictureFile = "none"
\r
186 Call m_center_Click
\r
190 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
\r
195 If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
\r
196 If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
\r
198 Me.PopupMenu m_point
\r
205 Me.PopupMenu m_tool
\r
206 ElseIf Button = 1 Then
\r
208 If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
\r
209 If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
\r
216 Me.MousePointer = 5
\r
224 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
\r
227 If SelectPt > 0 Then
\r
228 Pt(SelectPt - 1).x = x - OffsetX
\r
229 Pt(SelectPt - 1).y = y - OffsetY
\r
232 OffsetX = OffsetX - (x - MouseX)
\r
233 OffsetY = OffsetY - (y - MouseY)
\r
238 ElseIf Button = 0 Then
\r
240 If Pt(i).x + OffsetX > x - 5 And Pt(i).x + OffsetX < x + 5 Then
\r
241 If Pt(i).y + OffsetY > y - 5 And Pt(i).y + OffsetY < y + 5 Then
\r
243 Me.MousePointer = 10
\r
248 Me.MousePointer = 0
\r
254 Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
\r
256 If SelectPt > 0 Then
\r
261 Me.MousePointer = 0
\r
266 Private Sub m_addpoint_Click()
\r
268 Call make_pt(MaxPt, MouseX - OffsetX, MouseY - OffsetY)
\r
275 Private Sub m_center_Click()
\r
276 OffsetX = (Me.ScaleWidth - Pict.Width) / 2
\r
277 OffsetY = (Me.ScaleHeight - Pict.Height - toolbox.Height) / 2
\r
282 Private Sub m_deletept_Click()
\r
285 For i = SelectPt - 1 To MaxPt
\r
286 Pt(i).x = Pt(i + 1).x
\r
287 Pt(i).y = Pt(i + 1).y
\r
294 Private Sub m_load_Click()
\r
295 Dim F As FileSystemObject
\r
296 Set F = New FileSystemObject
\r
297 Cmd.filename = CurveFile
\r
298 Cmd.CancelError = False
\r
299 Cmd.DialogTitle = "Open Curve"
\r
300 Cmd.Filter = "Fichier VLC curve |*.curve.vlc"
\r
301 Cmd.FilterIndex = 0
\r
302 Cmd.InitDir = App.Path
\r
305 If Not F.FileExists(Cmd.filename) Then Exit Sub
\r
306 CurveFile = Cmd.filename
\r
307 Dim i As Long, l As Long
\r
308 Open CurveFile For Binary As #1
\r
310 PictureFile = Space$(l)
\r
311 Get #1, , PictureFile
\r
320 If PictureFile <> "none" Then Pict.Picture = LoadPicture(PictureFile)
\r
326 Private Sub m_loadpicture_Click()
\r
327 Dim F As FileSystemObject
\r
328 Set F = New FileSystemObject
\r
329 Cmd.CancelError = False
\r
330 Cmd.DialogTitle = "Open picture"
\r
331 Cmd.Filter = "Fichier bitmap |*.bmp"
\r
332 Cmd.FilterIndex = 0
\r
333 Cmd.InitDir = App.Path
\r
336 If Not F.FileExists(Cmd.filename) Then Exit Sub
\r
337 PictureFile = Cmd.filename
\r
338 Pict.Picture = LoadPicture(Cmd.filename)
\r
340 Dim HBitmap As Long
\r
341 HBitmap = LoadImage(0, Cmd.filename, 0, 0, 0, 16)
\r
342 imgDC = CreateCompatibleDC(0)
\r
343 SelectObject imgDC, HBitmap
\r
344 Pict.AutoSize = True
\r
346 Call m_center_Click
\r
351 Private Sub m_quit_Click()
\r
356 Private Sub m_saveas_Click()
\r
357 Dim F As FileSystemObject
\r
358 Set F = New FileSystemObject
\r
359 On Error GoTo error
\r
360 Cmd.CancelError = True
\r
361 Cmd.DialogTitle = "Save Curve"
\r
362 Cmd.Filter = "Fichier VLC curve |*.curve.vlc"
\r
363 Cmd.FilterIndex = 0
\r
364 Cmd.InitDir = App.Path
\r
367 CurveFile = Cmd.filename
\r
370 Open CurveFile For Binary As #1
\r
371 Put #1, , CLng(Len(PictureFile))
\r
372 Put #1, , PictureFile
\r
387 Private Sub Size_Change()
\r
388 Me.DrawWidth = Size.Value
\r