form1.frm

把Picture中的图片保存为Gif格式 把bmp文件保存为gif文件

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8385
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8340
   FillStyle       =   0  'Solid
   LinkTopic       =   "Form1"
   PaletteMode     =   2  'Custom
   ScaleHeight     =   8385
   ScaleWidth      =   8340
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox Check1 
      Caption         =   "Save transparent"
      Height          =   495
      Left            =   5280
      TabIndex        =   5
      Top             =   5520
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      FillStyle       =   0  'Solid
      Height          =   3120
      Left            =   0
      ScaleHeight     =   3120
      ScaleWidth      =   8685
      TabIndex        =   4
      Top             =   60
      Width           =   8685
   End
   Begin VB.CommandButton Command1 
      Caption         =   "转换"
      Height          =   375
      Left            =   6960
      TabIndex        =   3
      Top             =   5400
      Width           =   1275
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      Height          =   495
      Left            =   0
      ScaleHeight     =   435
      ScaleWidth      =   8175
      TabIndex        =   1
      Top             =   4800
      Width           =   8235
      Begin VB.Label Label1 
         Caption         =   "Label1"
         Height          =   195
         Left            =   180
         TabIndex        =   2
         Top             =   60
         Width           =   675
      End
   End
   Begin VB.PictureBox Picture3 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   2760
      Left            =   0
      ScaleHeight     =   2760
      ScaleWidth      =   8685
      TabIndex        =   0
      Top             =   2520
      Width           =   8685
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'欢迎你下载使用本代码，本份代码由程序太平洋提供下载学习之用
'声明:
'1.本站所有代码的版权归原作者所有，如果你使用了在本站下载的源代码
'  引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果！
'2.若本站在代码上有侵权之处请您与站长联系，站长会及时更正。
'网站：http://www.dapha.net
'论坛：http://www.5ivb.net
'Email:[e-mail]
'CopyRight 2001-2005 By dapha.net
'整理时间：2004-1-17 1:40:03

Dim WithEvents cGif As GIF
Attribute cGif.VB_VarHelpID = -1

Private Sub cGif_Progress(ByVal Percents As Integer)
    Dim lEnd As Long
    lEnd = Picture2.Width * Percents / 100
    Picture2.Line (0, 0)-(lEnd, Picture1.Height), vbBlue, BF
    Picture2.CurrentX = lPos
    If lEnd >= Label1.Left Then Label1.ForeColor = vbWhite
    Label1 = Percents & "%"
End Sub

Private Sub Command1_Click()
    Set cGif = New GIF
    Picture2.Cls
    Label1.ForeColor = vbBlack
    Picture2.Visible = True
    Form1.MousePointer = 11
    Command1.Enabled = False
    Picture1.Picture = Picture1.Image
    Picture1.Refresh
    cGif.SaveGIF Picture1.Picture, App.Path & "\test.gif", Picture1.hDc, CBool(Check1.Value), Picture1.Point(0, 0)
    Form1.MousePointer = 0
    Caption = "Save as GIF demo" & " (output file size " & CInt(FileLen(App.Path & "\test.gif") / 1000) & "K)"
    Command1.Enabled = True
    Picture2.Visible = False
    Picture3.Picture = LoadPicture(App.Path & "\test.gif")
    Set cGif = Nothing
End Sub

Private Sub Form_Load()
    Dim s As String, sFile As String
    sFile = "logo.bmp"
    s = "程序太平洋：文件大小" & CInt(FileLen(sFile) / 1024) & "K"
    Caption = "Save as GIF demo"
    With Label1
        .Height = Picture2.Height
        .AutoSize = True
        .Caption = "0%"
        .BackStyle = 0
        .Move Picture2.Width / 2 - TextWidth("00%") / 2
    End With
    With Picture1
        .AutoRedraw = True
        .FontBold = True
        .Picture = LoadPicture(sFile)
        .CurrentX = Picture1.Width / 2 - .TextWidth(s) / 2 + 480
        .CurrentY = Picture1.Height / 2 - .TextHeight(s) / 2
        .ForeColor = vbRed
    End With
    Picture1.Print s
    Picture2.Visible = False
    Command1.Caption = "&Save as GIF"
End Sub