PC World Komputer 1997 May/Pcwk0597.iso/delphi/imagelib/mainform.frm

Text File | 1995-10-21 | 18KB | 595 lines

VERSION 4.00
Begin VB.Form MainForm
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "ImageLib 3.0 Example"
   ClientHeight    =   6135
   ClientLeft      =   405
   ClientTop       =   735
   ClientWidth     =   8775
   ForeColor       =   &H80000008&
   Height          =   6540
   Icon            =   "MAINFORM.frx":0000
   Left            =   345
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6135
   ScaleWidth      =   8775
   Top             =   390
   Width           =   8895
   Begin VB.CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   375
      Left            =   7800
      TabIndex        =   3
      Top             =   5700
      Width           =   735
   End
   Begin VB.Frame Frame4
      Height          =   590
      Left            =   120
      TabIndex        =   30
      Top             =   5550
      Width           =   8535
      Begin VB.Label Label9
         Caption         =   "Technical Support: Kevin Adams, [e-mail]"
         Height          =   375
         Left            =   3360
         TabIndex        =   32
         Top             =   130
         Width           =   2415
      End
      Begin VB.Label Label8
         Caption         =   "Technical Support: Jan Dekkers [e-mail]"
         Height          =   375
         Left            =   120
         TabIndex        =   31
         Top             =   130
         Width           =   2295
      End
   End
   Begin VB.Frame Frame3
      ClipControls    =   0   'False
      Height          =   2055
      Left            =   5925
      TabIndex        =   22
      Top             =   3480
      Width           =   2775
      Begin VB.Label Label7
         Alignment       =   2  'Center
         BackColor       =   &H00C0C0C0&
         Caption         =   "$89  Royalty Free"
         BeginProperty Font
            name            =   "Arial"
            charset         =   1
            weight          =   700
            size            =   9
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00808000&
         Height          =   225
         Left            =   120
         TabIndex        =   29
         Top             =   1800
         Width           =   2535
      End
      Begin VB.Label Label6
         Alignment       =   2  'Center
         Caption         =   "[phone]"
         Height          =   255
         Left            =   180
         TabIndex        =   28
         Top             =   1560
         Width           =   2415
      End
      Begin VB.Label Label5
         Alignment       =   2  'Center
         Caption         =   "1-800  404-3832"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   1
            weight          =   400
            size            =   13.5
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   240
         TabIndex        =   27
         Top             =   1180
         Width           =   2295
      End
      Begin VB.Label Label4
         Alignment       =   2  'Center
         Caption         =   "To order call"
         Height          =   255
         Left            =   120
         TabIndex        =   26
         Top             =   960
         Width           =   2415
      End
      Begin VB.Label Label3
         Alignment       =   2  'Center
         Caption         =   "Copyright by SkyLine Tools 1995"
         Height          =   255
         Left            =   180
         TabIndex        =   25
         Top             =   720
         Width           =   2415
      End
      Begin VB.Label Label2
         Alignment       =   2  'Center
         Caption         =   "16 Bit Version"
         Height          =   255
         Left            =   840
         TabIndex        =   24
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         Caption         =   "ImageLib 3.0 Professional Edition"
         Height          =   255
         Left            =   160
         TabIndex        =   23
         Top             =   240
         Width           =   2415
      End
   End
   Begin VB.CheckBox Check2
      Caption         =   "PNG Interlaced"
      Height          =   255
      Left            =   7320
      TabIndex        =   21
      Top             =   3210
      Width           =   1415
   End
   Begin VB.CheckBox Check1
      Caption         =   "Read Dithering"
      Height          =   255
      Left            =   5940
      TabIndex        =   20
      Top             =   3210
      Value           =   1  'Checked
      Width           =   1415
   End
   Begin VB.Frame Frame2
      Caption         =   "Write Resolution"
      Height          =   1095
      Left            =   7305
      TabIndex        =   16
      Top             =   2040
      Width           =   1395
      Begin VB.OptionButton Option6
         Caption         =   "True Color"
         Height          =   255
         Left            =   120
         TabIndex        =   19
         Top             =   720
         Width           =   1095
      End
      Begin VB.OptionButton Option5
         Caption         =   "256 Colors"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   480
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.OptionButton Option4
         Caption         =   "16 Colors"
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Read Resolution"
      Height          =   1095
      Left            =   5940
      TabIndex        =   12
      Top             =   2040
      Width           =   1395
      Begin VB.OptionButton Option3
         Caption         =   "True Color"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   720
         Width           =   1095
      End
      Begin VB.OptionButton Option2
         Caption         =   "256 Colors"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   480
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.OptionButton Option1
         Caption         =   "16 Colors"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.CommandButton cmdSavePNG
      Caption         =   "Save P&NG"
      Height          =   375
      Left            =   7320
      TabIndex        =   11
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoadPNG
      Caption         =   "Load &PNG"
      Height          =   375
      Left            =   6000
      TabIndex        =   10
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton cmdSaveBMP
      Caption         =   "Sav&e BMP"
      Height          =   375
      Left            =   7320
      TabIndex        =   9
      Top             =   1200
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoadBMP
      Caption         =   "Load &BMP"
      Height          =   375
      Left            =   6000
      TabIndex        =   8
      Top             =   1200
      Width           =   1335
   End
   Begin VB.CommandButton cmdSavePCX
      Caption         =   "Sa&ve PCX "
      Height          =   375
      Left            =   7320
      TabIndex        =   7
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoadPCX
      Caption         =   "Loa&d PCX"
      Height          =   375
      Left            =   6000
      TabIndex        =   6
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdSaveGIF
      Caption         =   "S&ave GIF"
      Height          =   375
      Left            =   7320
      TabIndex        =   5
      Top             =   480
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoadGIF
      Caption         =   "L&oad GIF"
      Height          =   375
      Left            =   6000
      TabIndex        =   4
      Top             =   480
      Width           =   1335
   End
   Begin VB.CommandButton cmdSaveJPG
      Caption         =   "&Save JPG"
      Height          =   375
      Left            =   7320
      TabIndex        =   2
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoadJPG
      Caption         =   "&Load JPG"
      Height          =   375
      Left            =   6000
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
   Begin VB.PictureBox Picture1
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   8.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   5415
      Left            =   120
      ScaleHeight     =   5355
      ScaleWidth      =   5715
      TabIndex        =   0
      Top             =   120
      Width           =   5775
   End
   Begin MSComDlg.CommonDialog CMDialog1
      Left            =   120
      Top             =   120
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim r As Integer
Dim hdib As Integer
Dim Filename As String
Dim ReadResolution As Integer
Dim WriteResolution As Integer
Dim PNGInterlaced As Integer
Dim ReadDither As Integer
Dim JpegSaveQuality As Integer
Dim JpegSaveSmooth As Integer

Private Sub Check1_Click()
    If Check1.Value = 1 Then ReadDither = 1 Else ReadDither = 0
End Sub

Private Sub Check2_Click()
    If Check2.Value = 1 Then PNGInterlaced = 1 Else PNGInterlaced = 0
End Sub

Private Sub cmdExit_Click()
   End

End Sub

Private Sub cmdLoadBMP_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H1000&
   CMDialog1.Filter = "BMP (*.bmp)|*.bmp"
   CMDialog1.Action = 1

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11

      hdib = 0
      r = rdbmpfiledib(CMDialog1.Filename, ReadResolution, ReadDither, 0, hdib, 0, 1)
      r = OpenClipboard(MainForm.hWnd)
      r = SetClipboardData(8, hdib)  'Paste Device Independent Bitmap to the clipboard.
      r = CloseClipboard()

      Picture1.Picture = Clipboard.GetData(8)

      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdLoadGIF_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H1000&
   CMDialog1.Filter = "GIF (*.gif)|*.gif"
   CMDialog1.Action = 1

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11

      hdib = 0
      r = rdgiffiledib(CMDialog1.Filename, ReadResolution, ReadDither, 0, hdib, 0, 1)
      r = OpenClipboard(MainForm.hWnd)
      r = SetClipboardData(8, hdib)  'Paste Device Independent Bitmap to the clipboard.
      r = CloseClipboard()

      Picture1.Picture = Clipboard.GetData(8)

      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdLoadJPG_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H1000&
   CMDialog1.Filter = "JPEG (*.jpg)|*.jpg"
   CMDialog1.Action = 1

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11

      hdib = 0
      r = rdjpgfiledib(CMDialog1.Filename, ReadResolution, 1, ReadDither, 0, hdib, 0, 1)
      r = OpenClipboard(MainForm.hWnd)
      r = SetClipboardData(8, hdib)  'Paste Device Independent Bitmap to the clipboard.
      r = CloseClipboard()

      Picture1.Picture = Clipboard.GetData(8)

      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdLoadPCX_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H1000&
   CMDialog1.Filter = "PCX (*.pcx)|*.pcx"
   CMDialog1.Action = 1

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11

      hdib = 0
      r = rdpcxfiledib(CMDialog1.Filename, ReadResolution, ReadDither, 0, hdib, 0, 1)
      r = OpenClipboard(MainForm.hWnd)
      r = SetClipboardData(8, hdib)  'Paste Device Independent Bitmap to the clipboard.
      r = CloseClipboard()

      Picture1.Picture = Clipboard.GetData(8)

      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdLoadPNG_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H1000&
   CMDialog1.Filter = "PNG (*.png)|*.png"
   CMDialog1.Action = 1

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11

      hdib = 0
      r = rdpngfiledib(CMDialog1.Filename, ReadResolution, ReadDither, 0, hdib, 0, 1)
      r = OpenClipboard(MainForm.hWnd)
      r = SetClipboardData(8, hdib)  'Paste Device Independent Bitmap to the clipboard.
      r = CloseClipboard()

      Picture1.Picture = Clipboard.GetData(8)

      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdSaveBMP_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H800&
   CMDialog1.Filter = "BMP (*.bmp)|*.bmp"
   CMDialog1.Action = 2

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11
      Clipboard.SetData Picture1.Picture, 8
      r = OpenClipboard(MainForm.hWnd)
      hdib = GetClipboardData(8)
      r = CloseClipboard()

      r = wrbmpfiledib(CMDialog1.Filename, WriteResolution, 0, hdib, 0, 1)
      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdSaveGIF_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H800&
   CMDialog1.Filter = "GIF (*.gif)|*.gif"
   CMDialog1.Action = 2

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11
      Clipboard.SetData Picture1.Picture, 8
      r = OpenClipboard(MainForm.hWnd)
      hdib = GetClipboardData(8)
      r = CloseClipboard()
      r = wrgiffiledib(CMDialog1.Filename, WriteResolution, 0, hdib, 0, 1)
      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdSaveJPG_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H800&
   CMDialog1.Filter = "JPEG (*.jpg)|*.jpg"
   CMDialog1.Action = 2

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11
      Clipboard.SetData Picture1.Picture, 8
      r = OpenClipboard(MainForm.hWnd)
      hdib = GetClipboardData(8)
      r = CloseClipboard()
      r = wrjpegfiledib(CMDialog1.Filename, JpegSaveQuality, JpegSaveSmooth, 0, hdib, 0, 1)
      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdSavePCX_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H800&
   CMDialog1.Filter = "PCX (*.pcx)|*.pcx"
   CMDialog1.Action = 2

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11
      Clipboard.SetData Picture1.Picture, 8
      r = OpenClipboard(MainForm.hWnd)
      hdib = GetClipboardData(8)
      r = CloseClipboard()

      r = wrpcxfiledib(CMDialog1.Filename, WriteResolution, 0, hdib, 0, 1)
      Screen.MousePointer = 0
   End If

End Sub

Private Sub cmdSavePNG_Click()
   CMDialog1.Filename = ""
   CMDialog1.Flags = &H800&
   CMDialog1.Filter = "PNG (*.png)|*.png"
   CMDialog1.Action = 2

   If CMDialog1.Filename <> "" Then
      Screen.MousePointer = 11
      Clipboard.SetData Picture1.Picture, 8
      r = OpenClipboard(MainForm.hWnd)
      hdib = GetClipboardData(8)
      r = CloseClipboard()

      r = wrpngfiledib(CMDialog1.Filename, WriteResolution, PNGInterlaced, 0, hdib, 0, 1)
      Screen.MousePointer = 0
   End If

End Sub

Private Sub Form_Load()
    ReadResolution = 8
    WriteResolution = 8
    PNGInterlaced = 0
    ReadDither = 1
    JpegSaveQuality = 95    '0 to 100 (poor to good)
    JpegSaveSmooth = 10     '0 to 100 (none to full)
End Sub

Private Sub Option1_Click()
    ReadResolution = 4
End Sub

Private Sub Option2_Click()
    ReadResolution = 8
End Sub

Private Sub Option3_Click()
    ReadResolution = 24
End Sub

Private Sub Option4_Click()
    WriteResolution = 4
End Sub

Private Sub Option5_Click()
    WriteResolution = 8
End Sub

Private Sub Option6_Click()
    WriteResolution = 24
End Sub