frmpalette.frm

Visual Basic image processing. Mainly it occupies some filters to detect some prperties of image. Re

VERSION 5.00
Begin VB.Form frmPalette 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Palette"
   ClientHeight    =   5070
   ClientLeft      =   6510
   ClientTop       =   3975
   ClientWidth     =   6000
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmPalette.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5070
   ScaleWidth      =   6000
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   4
      Top             =   480
      Width           =   1275
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   4680
      TabIndex        =   3
      Top             =   60
      Width           =   1275
   End
   Begin VB.PictureBox picPalette 
      AutoRedraw      =   -1  'True
      Height          =   4515
      Left            =   60
      ScaleHeight     =   4455
      ScaleWidth      =   4455
      TabIndex        =   2
      Top             =   480
      Width           =   4515
   End
   Begin VB.ComboBox cboPalette 
      Height          =   315
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   60
      Width           =   2595
   End
   Begin VB.Label lblPalette 
      Caption         =   "Palette:"
      Height          =   315
      Left            =   60
      TabIndex        =   1
      Top             =   120
      Width           =   915
   End
End
Attribute VB_Name = "frmPalette"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_sSelected As String
Private m_bCancel As Boolean
Private m_sName() As String
Private m_sFIle() As String
Private m_iCount As Long
Private m_cPal As New cPalette

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Public Property Get FileName() As String
   FileName = m_sSelected
End Property
Public Property Get Cancelled() As Boolean
   Cancelled = m_bCancel
End Property

Private Sub LoadPalette()
On Error GoTo LoadPaletteError
   picPalette.Cls
   If m_cPal.LoadFromFile(m_sSelected) Then
      RenderPalette
   End If
   Exit Sub
LoadPaletteError:
   MsgBox "Error trying to load palette:" & Err.Description
   Exit Sub
End Sub

Private Sub RenderPalette()
Dim iPal As Long
Dim x As Long, y As Long
Dim lHDC As Long
Dim hBR As Long
Dim tR As RECT
   lHDC = picPalette.hdc
   x = 3: y = 3
   For iPal = 1 To m_cPal.Count
      tR.Left = x: tR.Right = tR.Left + 14
      tR.Top = y: tR.Bottom = tR.Top + 14
      hBR = CreateSolidBrush(RGB(m_cPal.Red(iPal), m_cPal.Green(iPal), m_cPal.Blue(iPal)))
      FillRect lHDC, tR, hBR
      DeleteObject hBR
      x = x + 18
      If (x > 290) Then
         x = 3
         y = y + 18
      End If
   Next iPal
   picPalette.Refresh
End Sub

Private Sub SortPalette()
   ' Todo...
   RenderPalette
End Sub

Private Sub cboPalette_Click()
   If (cboPalette.ListIndex > -1) Then
      m_sSelected = m_sFIle(cboPalette.ItemData(cboPalette.ListIndex))
      LoadPalette
   End If
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   If (cboPalette.ListIndex < 0) Then
      MsgBox "Please choose a palette.", vbInformation
   Else
      m_bCancel = False
      Unload Me
   End If
End Sub

Private Sub Form_Load()
Dim i As Long

   m_bCancel = True
   
   ReDim m_sName(1 To 1) As String
   ReDim m_sFIle(1 To 1) As String
   m_iCount = 1
   m_sName(1) = "Internet Explorer 256 Colour Palette"
   m_sFIle(1) = App.Path & "\216ie.pal"

   For i = 1 To m_iCount
      cboPalette.AddItem m_sName(i)
      cboPalette.ItemData(cboPalette.NewIndex) = i
   Next i
   cboPalette.ListIndex = 0
   
End Sub