home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / vb4.shr / Palette.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-09-04  |  9.7 KB  |  333 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Palette"
  5.    ClientHeight    =   2910
  6.    ClientLeft      =   2145
  7.    ClientTop       =   3885
  8.    ClientWidth     =   5535
  9.    Height          =   3600
  10.    Left            =   2085
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   2910
  16.    ScaleWidth      =   5535
  17.    Top             =   3255
  18.    Width           =   5655
  19.    Begin VB.Frame Frame1 
  20.       Caption         =   "Bit Depth"
  21.       Height          =   1575
  22.       Left            =   3360
  23.       TabIndex        =   9
  24.       Top             =   1200
  25.       Width           =   2055
  26.       Begin VB.OptionButton opt24Bit 
  27.          Caption         =   "24 bit"
  28.          Height          =   255
  29.          Left            =   360
  30.          TabIndex        =   13
  31.          Top             =   1200
  32.          Width           =   855
  33.       End
  34.       Begin VB.OptionButton opt8Bit 
  35.          Caption         =   "8 bit"
  36.          Height          =   255
  37.          Left            =   360
  38.          TabIndex        =   12
  39.          Top             =   840
  40.          Width           =   855
  41.       End
  42.       Begin VB.OptionButton opt4Bit 
  43.          Caption         =   "4 bit"
  44.          Height          =   255
  45.          Left            =   360
  46.          TabIndex        =   11
  47.          Top             =   480
  48.          Width           =   855
  49.       End
  50.       Begin VB.Label Label3 
  51.          Caption         =   "Change Bit Depth to:"
  52.          Height          =   255
  53.          Left            =   120
  54.          TabIndex        =   10
  55.          Top             =   240
  56.          Width           =   1815
  57.       End
  58.    End
  59.    Begin ik32Lib.Picbuf Picbuf1 
  60.       Height          =   2775
  61.       Left            =   120
  62.       TabIndex        =   14
  63.       Top             =   0
  64.       Width           =   3135
  65.       _Version        =   65541
  66.       _ExtentX        =   5530
  67.       _ExtentY        =   4895
  68.       _StockProps     =   253
  69.    End
  70.    Begin VB.Label Label7 
  71.       Caption         =   "bit image."
  72.       Height          =   255
  73.       Left            =   4320
  74.       TabIndex        =   8
  75.       Top             =   840
  76.       Width           =   735
  77.    End
  78.    Begin VB.Label lblBitDepth 
  79.       Caption         =   "0"
  80.       Height          =   255
  81.       Left            =   4080
  82.       TabIndex        =   7
  83.       Top             =   840
  84.       Width           =   255
  85.    End
  86.    Begin VB.Label Label4 
  87.       Caption         =   "This is a"
  88.       Height          =   255
  89.       Left            =   3360
  90.       TabIndex        =   6
  91.       Top             =   840
  92.       Width           =   735
  93.    End
  94.    Begin VB.Label lblSystem3 
  95.       Caption         =   "system colors."
  96.       Height          =   255
  97.       Left            =   4440
  98.       TabIndex        =   5
  99.       Top             =   540
  100.       Visible         =   0   'False
  101.       Width           =   1035
  102.    End
  103.    Begin VB.Label lblSystemColors 
  104.       Caption         =   "0"
  105.       Height          =   255
  106.       Left            =   4200
  107.       TabIndex        =   4
  108.       Top             =   540
  109.       Visible         =   0   'False
  110.       Width           =   255
  111.    End
  112.    Begin VB.Label lblsystem2 
  113.       Caption         =   "There are "
  114.       Height          =   255
  115.       Left            =   3360
  116.       TabIndex        =   3
  117.       Top             =   540
  118.       Visible         =   0   'False
  119.       Width           =   735
  120.    End
  121.    Begin VB.Label Label2 
  122.       Caption         =   "times."
  123.       Height          =   255
  124.       Left            =   4140
  125.       TabIndex        =   2
  126.       Top             =   240
  127.       Width           =   495
  128.    End
  129.    Begin VB.Label lblPalCall 
  130.       Caption         =   "0"
  131.       Height          =   255
  132.       Left            =   3900
  133.       TabIndex        =   1
  134.       Top             =   240
  135.       Width           =   255
  136.    End
  137.    Begin VB.Label Label1 
  138.       Caption         =   "The palette event has been"
  139.       Height          =   255
  140.       Left            =   3360
  141.       TabIndex        =   0
  142.       Top             =   0
  143.       Width           =   2115
  144.    End
  145.    Begin MSComDlg.CommonDialog CommonDialog1 
  146.       Left            =   240
  147.       Top             =   120
  148.       _Version        =   65536
  149.       _ExtentX        =   847
  150.       _ExtentY        =   847
  151.       _StockProps     =   0
  152.    End
  153.    Begin VB.Label Label5 
  154.       Caption         =   "called"
  155.       Height          =   195
  156.       Left            =   3360
  157.       TabIndex        =   15
  158.       Top             =   240
  159.       Width           =   615
  160.    End
  161.    Begin VB.Menu mnuFile 
  162.       Caption         =   "&File"
  163.       Begin VB.Menu mnuLoad 
  164.          Caption         =   "&Load Image..."
  165.       End
  166.       Begin VB.Menu mnuSave 
  167.          Caption         =   "&Save Image..."
  168.       End
  169.       Begin VB.Menu mnuSpacer 
  170.          Caption         =   "-"
  171.       End
  172.       Begin VB.Menu mnuExit 
  173.          Caption         =   "E&xit"
  174.          Shortcut        =   ^X
  175.       End
  176.    End
  177.    Begin VB.Menu mnuReload 
  178.       Caption         =   "&Reload"
  179.    End
  180.    Begin VB.Menu mnuPalette 
  181.       Caption         =   "&Palette"
  182.       Begin VB.Menu mnuLoadPal 
  183.          Caption         =   "&Load Palette..."
  184.       End
  185.       Begin VB.Menu mnuSavePal 
  186.          Caption         =   "&Save Palette..."
  187.       End
  188.       Begin VB.Menu mnuSpacer2 
  189.          Caption         =   "-"
  190.       End
  191.       Begin VB.Menu mnuAddSystemColors 
  192.          Caption         =   "&Add System Colors"
  193.          Enabled         =   0   'False
  194.       End
  195.       Begin VB.Menu mnuSetScreenPal 
  196.          Caption         =   "&Realize current palette"
  197.          Enabled         =   0   'False
  198.       End
  199.    End
  200. Attribute VB_Name = "Form1"
  201. Attribute VB_Creatable = False
  202. Attribute VB_Exposed = False
  203. Sub SetInfo()
  204. Select Case Picbuf1.ColorDepth
  205.         Case 4
  206.             lblSystemColors.Visible = False
  207.             lblsystem2.Visible = False
  208.             lblsystem3.Visible = False
  209.             opt4bit.Value = True
  210.             mnuSetScreenPal.Enabled = True
  211.             mnuAddSystemColors.Enabled = False
  212.         Case 8
  213.             lblSystemColors.Caption = Picbuf1.ColorDepth
  214.             lblSystemColors.Visible = True
  215.             lblsystem2.Visible = True
  216.             lblsystem3.Visible = True
  217.             opt8bit.Value = True
  218.             mnuSetScreenPal.Enabled = True
  219.             mnuAddSystemColors.Enabled = True
  220.         Case 24
  221.             lblSystemColors.Visible = False
  222.             lblsystem2.Visible = False
  223.             lblsystem3.Visible = False
  224.             opt24bit.Value = True
  225.             mnuSetScreenPal.Enabled = False
  226.             mnuAddSystemColors.Enabled = False
  227.     End Select
  228.     lblBitDepth.Caption = Picbuf1.ColorDepth
  229. End Sub
  230. Private Sub Form_Load()
  231.     'set picbuf properties
  232.     InitPicbuf Picbuf1, True, "leaves8.pcx"
  233. End Sub
  234. 'Description: This adds the system colors to the
  235. 'current palette.
  236. Private Sub mnuAddSystemColors_Click()
  237.     Picbuf1.AddSystemColors
  238. End Sub
  239. Private Sub ikExit_Click()
  240. End Sub
  241. Private Sub ikLoad_Click()
  242. 'call sub to select a filename
  243. LoadImage Picbuf1, CommonDialog1
  244. End Sub
  245. 'Description: This sub uses the common dialog control
  246. 'to load a palette using the loadpal method.
  247. Private Sub mnuLoadPal_Click()
  248.     CommonDialog1.DialogTitle = "Load Palette"
  249.     CommonDialog1.Filter = "all files|*.*|PAL|*.pal"
  250.     CommonDialog1.FilterIndex = 2
  251.     CommonDialog1.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
  252.     On Error GoTo Cancel_Click
  253.     CommonDialog1.CancelError = True
  254.     CommonDialog1.ShowOpen
  255.     Picbuf1.Filename = CommonDialog1.Filename
  256.     Picbuf1.LoadPal
  257.     Exit Sub
  258. Cancel_Click:
  259.     If Err.Number = 32755 Then
  260.         Exit Sub
  261.     Else
  262.         MsgBox Err.Description
  263.     End If
  264. End Sub
  265. 'Description: This sub saves a palette using the
  266. 'common dialog control, and the StorePal method.
  267. Private Sub mnuSavePal_Click()
  268.     CommonDialog1.DialogTitle = "Save Palette"
  269.     CommonDialog1.Filter = "all files|*.*|PAL|*.pal"
  270.     CommonDialog1.FilterIndex = 2
  271.     CommonDialog1.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
  272.     On Error GoTo Cancel_Click
  273.     CommonDialog1.CancelError = True
  274.     CommonDialog1.ShowSave
  275.     Picbuf1.Filename = CommonDialog1.Filename
  276.     Picbuf1.StorePal
  277.     Exit Sub
  278. Cancel_Click:
  279.     If Err.Number = 32755 Then
  280.         Exit Sub
  281.     Else
  282.         MsgBox Err.Description
  283.     End If
  284. End Sub
  285. 'Description: Here we set the palette of the image
  286. 'to match that of the screen
  287. Private Sub mnuSetScreenPal_Click()
  288.     Picbuf1.SetScreenPal
  289. End Sub
  290. Private Sub mnuExit_Click()
  291.     ExitProgram
  292. End Sub
  293. Private Sub mnuLoad_Click()
  294.     LoadImage Picbuf1, CommonDialog1
  295. End Sub
  296. 'Description: This sub reloads the image by
  297. 'invoking the load method, with the same filename.
  298. Private Sub mnuReload_Click()
  299.     Picbuf1.Load
  300. End Sub
  301. Private Sub mnuSave_Click()
  302.     SaveImage Picbuf1, CommonDialog1
  303. End Sub
  304. Private Sub opt24bit_Click()
  305. If Picbuf1.ColorDepth <> 24 Then
  306.     Picbuf1.IncreaseColors 24
  307.     SetInfo
  308. End If
  309. End Sub
  310. Private Sub opt4bit_Click()
  311. If Picbuf1.ColorDepth <> 4 Then
  312.     Picbuf1.ReduceColors 16, True, True, True
  313.     SetInfo
  314. End If
  315. End Sub
  316. Private Sub opt8bit_Click()
  317. If Picbuf1.ColorDepth <> 8 Then
  318.     If Picbuf1.ColorDepth = 4 Then
  319.         Picbuf1.IncreaseColors 8
  320.         SetInfo
  321.     Else
  322.         Picbuf1.ReduceColors 256, True, True, True
  323.         SetInfo
  324.     End If
  325. End If
  326. End Sub
  327. Private Sub Picbuf1_Change()
  328.     SetInfo
  329. End Sub
  330. Private Sub Picbuf1_Palette()
  331. lblPalCall.Caption = Val(lblPalCall.Caption) + 1
  332. End Sub
  333.