git.sesse.net Git - vlc/blob - doc/skins/curve_maker/Bezier.frm

   1 VERSION 5.00\r
   2 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"\r
   3 Begin VB.Form ppal \r
   4    AutoRedraw      =   -1  'True\r
   5    BackColor       =   &H00FFFFFF&\r
   6    Caption         =   "VLC skin Curve Maker"\r
   7    ClientHeight    =   7140\r
   8    ClientLeft      =   165\r
   9    ClientTop       =   450\r
  10    ClientWidth     =   10440\r
  11    Icon            =   "Bezier.frx":0000\r
  12    LinkTopic       =   "Form1"\r
  13    ScaleHeight     =   476\r
  14    ScaleMode       =   3  'Pixel\r
  15    ScaleWidth      =   696\r
  16    StartUpPosition =   2  'CenterScreen\r
  17    Begin VB.PictureBox Pict \r
  18       AutoSize        =   -1  'True\r
  19       BorderStyle     =   0  'None\r
  20       Height          =   975\r
  21       Left            =   2640\r
  22       ScaleHeight     =   65\r
  23       ScaleMode       =   3  'Pixel\r
  24       ScaleWidth      =   73\r
  25       TabIndex        =   4\r
  26       Top             =   1800\r
  27       Visible         =   0   'False\r
  28       Width           =   1095\r
  29    End\r
  30    Begin VB.PictureBox toolbox \r
  31       Align           =   1  'Align Top\r
  32       BorderStyle     =   0  'None\r
  33       Height          =   900\r
  34       Left            =   0\r
  35       ScaleHeight     =   900\r
  36       ScaleWidth      =   10440\r
  37       TabIndex        =   0\r
  38       Top             =   0\r
  39       Width           =   10440\r
  40       Begin VB.HScrollBar Size \r
  41          Height          =   255\r
  42          Left            =   4920\r
  43          Max             =   5\r
  44          Min             =   1\r
  45          TabIndex        =   3\r
  46          Top             =   480\r
  47          Value           =   1\r
  48          Width           =   2655\r
  49       End\r
  50       Begin VB.HScrollBar Color \r
  51          Height          =   255\r
  52          Left            =   4920\r
  53          Max             =   15\r
  54          TabIndex        =   2\r
  55          Top             =   120\r
  56          Width           =   2655\r
  57       End\r
  58       Begin VB.TextBox Result \r
  59          Height          =   615\r
  60          Left            =   120\r
  61          Locked          =   -1  'True\r
  62          MultiLine       =   -1  'True\r
  63          TabIndex        =   1\r
  64          Top             =   120\r
  65          Width           =   4575\r
  66       End\r
  67    End\r
  68    Begin MSComDlg.CommonDialog Cmd \r
  69       Left            =   7560\r
  70       Top             =   120\r
  71       _ExtentX        =   847\r
  72       _ExtentY        =   847\r
  73       _Version        =   327680\r
  74    End\r
  75    Begin VB.Menu m_file \r
  76       Caption         =   "&File"\r
  77       Begin VB.Menu m_load \r
  78          Caption         =   "Load..."\r
  79       End\r
  80       Begin VB.Menu m_saveas \r
  81          Caption         =   "Save as..."\r
  82       End\r
  83       Begin VB.Menu m_sep1 \r
  84          Caption         =   "-"\r
  85       End\r
  86       Begin VB.Menu m_quit \r
  87          Caption         =   "Quit"\r
  88       End\r
  89    End\r
  90    Begin VB.Menu m_picture \r
  91       Caption         =   "Picture"\r
  92       Begin VB.Menu m_loadpicture \r
  93          Caption         =   "Load..."\r
  94       End\r
  95    End\r
  96    Begin VB.Menu m_tool \r
  97       Caption         =   "Tool"\r
  98       Visible         =   0   'False\r
  99       Begin VB.Menu m_addpoint \r
 100          Caption         =   "AddPoint"\r
 101       End\r
 102       Begin VB.Menu m_center \r
 103          Caption         =   "Center"\r
 104       End\r
 105    End\r
 106    Begin VB.Menu m_point \r
 107       Caption         =   "Point"\r
 108       Visible         =   0   'False\r
 109       Begin VB.Menu m_deletept \r
 110          Caption         =   "Delete"\r
 111       End\r
 112    End\r
 113 End\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
 119 Dim xe As Single\r
 120 Dim ye As Single\r
 121 Dim Sel As Long\r
 122 \r
 123 Dim MouseX As Long\r
 124 Dim MouseY As Long\r
 125 Dim SelectPt As Long\r
 126 Dim PictureFile As String\r
 127 Dim CurveFile As String\r
 128 \r
 129 Dim OffsetX As Long\r
 130 Dim OffsetY As Long\r
 131 Sub form_draw()\r
 132 Dim i As Long\r
 133 Me.Cls\r
 134 \r
 135 \r
 136 BitBlt ppal.hdc, OffsetX, OffsetY, Pict.Width, Pict.Height, imgDC, 0, 0, SRCCOPY\r
 137 \r
 138 \r
 139 If MaxPt < 0 Then Exit Sub\r
 140 Call bezier_draw(40, OffsetX, OffsetY)\r
 141 \r
 142 Me.DrawWidth = 1\r
 143 For i = 0 To MaxPt\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
 145 Next i\r
 146 Me.DrawWidth = Size.Value\r
 147 \r
 148 End Sub\r
 149 \r
 150 \r
 151 \r
 152 \r
 153 \r
 154 \r
 155 \r
 156 \r
 157 Sub RefreshResult()\r
 158 Dim i As Long\r
 159 \r
 160 Result.Text = "abs="""\r
 161 For i = 0 To MaxPt\r
 162     If i > 0 Then Result.Text = Result.Text & ","\r
 163     Result.Text = Result.Text & Pt(i).x\r
 164 Next i\r
 165 Result.Text = Result.Text & """" & Chr$(13) & Chr$(10) & "ord="""\r
 166 For i = 0 To MaxPt\r
 167     If i > 0 Then Result.Text = Result.Text & ","\r
 168     Result.Text = Result.Text & Pt(i).y\r
 169 Next i\r
 170 Result.Text = Result.Text & """"\r
 171 \r
 172 End Sub\r
 173 \r
 174 Private Sub Color_Change()\r
 175 form_draw\r
 176 \r
 177 End Sub\r
 178 \r
 179 Private Sub Form_Load()\r
 180 PictureFile = "none"\r
 181 MaxPt = -1\r
 182 OffsetX = 0\r
 183 OffsetY = 0\r
 184 'Pict.Width = 0\r
 185 'Pict.Height = 0\r
 186 Call m_center_Click\r
 187 \r
 188 End Sub\r
 189 \r
 190 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)\r
 191 Dim i As Long\r
 192 \r
 193 If Button = 2 Then\r
 194     For i = 0 To MaxPt\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
 197                 SelectPt = i + 1\r
 198                 Me.PopupMenu m_point\r
 199                 Exit Sub\r
 200             End If\r
 201         End If\r
 202     Next i\r
 203     MouseX = x\r
 204     MouseY = y\r
 205     Me.PopupMenu m_tool\r
 206 ElseIf Button = 1 Then\r
 207     For i = 0 To MaxPt\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
 210                 SelectPt = i + 1\r
 211                 Exit Sub\r
 212             End If\r
 213         End If\r
 214     Next i\r
 215     SelectPt = 0\r
 216     Me.MousePointer = 5\r
 217     MouseX = x\r
 218     MouseY = y\r
 219 End If\r
 220 \r
 221 End Sub\r
 222 \r
 223 \r
 224 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)\r
 225 \r
 226 If Button = 1 Then\r
 227     If SelectPt > 0 Then\r
 228         Pt(SelectPt - 1).x = x - OffsetX\r
 229         Pt(SelectPt - 1).y = y - OffsetY\r
 230         form_draw\r
 231     Else\r
 232         OffsetX = OffsetX - (x - MouseX)\r
 233         OffsetY = OffsetY - (y - MouseY)\r
 234         MouseX = x\r
 235         MouseY = y\r
 236         form_draw\r
 237     End If\r
 238 ElseIf Button = 0 Then\r
 239     For i = 0 To MaxPt\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
 242                 SelectPt = i + 1\r
 243                 Me.MousePointer = 10\r
 244                 Exit Sub\r
 245             End If\r
 246         End If\r
 247     Next i\r
 248     Me.MousePointer = 0\r
 249 End If\r
 250 \r
 251 End Sub\r
 252 \r
 253 \r
 254 Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)\r
 255 If Button = 1 Then\r
 256     If SelectPt > 0 Then\r
 257         SelectPt = 0\r
 258         form_draw\r
 259         Call RefreshResult\r
 260     End If\r
 261     Me.MousePointer = 0\r
 262 End If\r
 263 \r
 264 End Sub\r
 265 \r
 266 Private Sub m_addpoint_Click()\r
 267 MaxPt = MaxPt + 1\r
 268 Call make_pt(MaxPt, MouseX - OffsetX, MouseY - OffsetY)\r
 269 Call form_draw\r
 270 \r
 271 Call RefreshResult\r
 272 \r
 273 End Sub\r
 274 \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
 278 form_draw\r
 279 \r
 280 End Sub\r
 281 \r
 282 Private Sub m_deletept_Click()\r
 283 Dim i As Long\r
 284 MaxPt = MaxPt - 1\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
 288 Next\r
 289 form_draw\r
 290 Call RefreshResult\r
 291 \r
 292 End Sub\r
 293 \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
 303 Cmd.ShowOpen\r
 304 \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
 309     Get #1, , l\r
 310     PictureFile = Space$(l)\r
 311     Get #1, , PictureFile\r
 312     Get #1, , OffsetX\r
 313     Get #1, , OffsetY\r
 314     Get #1, , MaxPt\r
 315     For i = 0 To MaxPt\r
 316         Get #1, , Pt(i).x\r
 317         Get #1, , Pt(i).y\r
 318     Next i\r
 319 Close #1\r
 320 If PictureFile <> "none" Then Pict.Picture = LoadPicture(PictureFile)\r
 321 Call form_draw\r
 322 Call RefreshResult\r
 323 \r
 324 End Sub\r
 325 \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
 334 Cmd.ShowOpen\r
 335 \r
 336 If Not F.FileExists(Cmd.filename) Then Exit Sub\r
 337 PictureFile = Cmd.filename\r
 338 Pict.Picture = LoadPicture(Cmd.filename)\r
 339 \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
 345 \r
 346 Call m_center_Click\r
 347 \r
 348 End Sub\r
 349 \r
 350 \r
 351 Private Sub m_quit_Click()\r
 352 End\r
 353 \r
 354 End Sub\r
 355 \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
 365 Cmd.ShowSave\r
 366 \r
 367 CurveFile = Cmd.filename\r
 368 \r
 369 Dim i As Long\r
 370 Open CurveFile For Binary As #1\r
 371     Put #1, , CLng(Len(PictureFile))\r
 372     Put #1, , PictureFile\r
 373     Put #1, , OffsetX\r
 374     Put #1, , OffsetY\r
 375     Put #1, , MaxPt\r
 376     For i = 0 To MaxPt\r
 377         Put #1, , Pt(i).x\r
 378         Put #1, , Pt(i).y\r
 379     Next i\r
 380 Close #1\r
 381 \r
 382 error:\r
 383 \r
 384 End Sub\r
 385 \r
 386 \r
 387 Private Sub Size_Change()\r
 388 Me.DrawWidth = Size.Value\r
 389 form_draw\r
 390 \r
 391 End Sub\r