Mastering Visual Basic 6/mastvb6.iso/leadtools/ocx32.lt/Main.frm

Visual Basic Form | 1998-06-26 | 11.9 KB | 376 lines

VERSION 5.00
Object = "{00100063-B1BA-11CE-ABC6-F5B2E79D9E3F}#1.0#0"; "LTDLG10N.OCX"
Begin VB.MDIForm Main
   Appearance      =   0  'Flat
   BackColor       =   &H8000000C&
   Caption         =   "LEAD Visual Basic Drawing Demo Program"
   ClientHeight    =   2595
   ClientLeft      =   2280
   ClientTop       =   2280
   ClientWidth     =   7785
   Icon            =   "Main.frx":0000
   LinkTopic       =   "MDIForm1"
   Begin LEADDlgLibCtl.LEADDlg LEADDlg1
      Left            =   600
      Top             =   480
      Angle           =   0
      AngleFlag       =   -1  'True
      NewWidth        =   0
      NewHeight       =   0
      MaxFileSize     =   0
      LoadCompressed  =   -1  'True
      LoadRotated     =   -1  'True
      Change          =   0
      SaveMulti       =   0
      PageNumber      =   1
      Effect          =   2000
      Grain           =   5
      Delay           =   20
      MaxPass         =   1
      Transparent     =   0   'False
      WandWidth       =   2
      GradientStyle   =   1000
      GradientSteps   =   256
      Transition      =   1000
      Shape           =   1000
      ShapeBackStyle  =   1
      ShapeFillStyle  =   0
      ShapeBorderStyle=   1
      ShapeBorderWidth=   1
      ShapeInnerStyle =   0
      ShapeInnerWidth =   0
      ShapeOuterStyle =   0
      ShapeOuterWidth =   0
      ShadowXDepth    =   5
      ShadowYDepth    =   5
      SampleText      =   "LEADTOOLS!"
      TextStyle       =   1
      TextAlign       =   4
      TextWordWrap    =   -1  'True
      TextUseForegroundImage=   0   'False
      FileDlgFlags    =   0
      FileDialogTitle =   "LEADTOOLS Common Dialog"
      FileName        =   ""
      Filter          =   $"Main.frx":030A
      FilterIndex     =   0
      InitialDir      =   ""
      UIFlags         =   0
      ShowHelpButton  =   0   'False
      PreviewEnabled  =   -1  'True
      EnableMethodErrors=   -1  'True
      LowBit          =   1
      HighBit         =   11
      LowValue        =   0
      HighValue       =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Times New Roman"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   255
      ForeColor       =   16711680
      StartColor      =   255
      EndColor        =   16711680
      TransparentColor=   0
      WandColor       =   255
      ShapeBorderColor=   0
      ShapeInnerHiliteColor=   16777215
      ShapeInnerShadowColor=   0
      ShapeOuterHiliteColor=   16777215
      ShapeOuterShadowColor=   0
      ShadowColor     =   0
      TextColor       =   16711680
      TextHiliteColor =   16777215
   End
   Begin VB.Menu MenuFile
      Caption         =   "&File"
      Begin VB.Menu OpenFile
         Caption         =   "&Open..."
         Index           =   1
      End
      Begin VB.Menu SaveFile
         Caption         =   "&Save..."
         Index           =   2
      End
      Begin VB.Menu s0
         Caption         =   "-"
      End
      Begin VB.Menu Exit
         Caption         =   "E&xit"
         Index           =   3
      End
      Begin VB.Menu s1
         Caption         =   "-"
      End
      Begin VB.Menu About
         Caption         =   "&About"
         Index           =   4
      End
   End
   Begin VB.Menu MenuObject
      Caption         =   "&Object"
      Begin VB.Menu ObjectSelect
         Caption         =   "&Ellipse"
         Index           =   0
      End
      Begin VB.Menu ObjectSelect
         Caption         =   "&Line"
         Index           =   1
      End
      Begin VB.Menu ObjectSelect
         Caption         =   "&Rectangle"
         Index           =   2
      End
   End
   Begin VB.Menu MenuColor
      Caption         =   "&Color"
      Begin VB.Menu ColorSelect
         Caption         =   "&Black"
         Index           =   0
      End
      Begin VB.Menu ColorSelect
         Caption         =   "B&lue"
         Index           =   1
      End
      Begin VB.Menu ColorSelect
         Caption         =   "&Green"
         Index           =   2
      End
      Begin VB.Menu ColorSelect
         Caption         =   "&Red"
         Index           =   3
      End
      Begin VB.Menu ColorSelect
         Caption         =   "&White"
         Index           =   4
      End
   End
   Begin VB.Menu MenuThickness
      Caption         =   "&Thickness..."
   End
   Begin VB.Menu MenuDraw
      Caption         =   "&Action"
      Begin VB.Menu EnableSelect
         Caption         =   "&Disable Action"
         Index           =   0
      End
      Begin VB.Menu EnableSelect
         Caption         =   "Draw &Objects"
         Index           =   1
      End
      Begin VB.Menu EnableSelect
         Caption         =   "&Copy Area"
         Index           =   2
      End
      Begin VB.Menu EnableSelect
         Caption         =   "&Paste"
         Index           =   3
      End
      Begin VB.Menu EnableSelect
         Caption         =   "&Zoom In On Selection"
         Index           =   4
      End
   End
   Begin VB.Menu MenuWindow
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin VB.Menu Cascade
         Caption         =   "&Cascade"
         Index           =   181
      End
      Begin VB.Menu Tile
         Caption         =   "&Tile"
         Index           =   182
      End
      Begin VB.Menu ArrangeIcons
         Caption         =   "Arrange &Icons"
         Index           =   183
      End
      Begin VB.Menu CloseAll
         Caption         =   "Close &All"
         Index           =   184
      End
   End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub About_Click(Index As Integer)
  AboutFrm.Show 1
End Sub
Private Sub ArrangeIcons_Click(Index As Integer)
  Main.Arrange 3
End Sub
Private Sub Cascade_Click(Index As Integer)
  Main.Arrange 0
End Sub
Private Sub CloseAll_Click(Index As Integer)
  While gNumChildren > 0
    Unload Main.ActiveForm
  Wend
End Sub
Private Sub ColorSelect_Click(Index As Integer)
  Main.ActiveForm.DrawColor = Index
End Sub
Private Sub EnableSelect_Click(Index As Integer)
  Select Case (Index)
  Case 0
    DrawMenu = "Disabled"
    Main.ActiveForm.UndoZoom
    Main.ActiveForm.Caption = Main.ActiveForm.FileName + "  (" + CStr(Main.ActiveForm.Lead1.BitmapWidth) + " x " + CStr(Main.ActiveForm.Lead1.BitmapHeight) + " - " + CStr(Main.ActiveForm.Lead1.BitmapBits) + " BPP)"
  Case 1
    DrawMenu = "Object"
  Case 2
    DrawMenu = "Copy"
  Case 3
    DrawMenu = "Paste"
  Case 4
    DrawMenu = "ZoomIn"
  Case Else
    DrawMenu = "Disabled"
  End Select
  Main.EnableSelect(0).CHECKED = False
  Main.EnableSelect(1).CHECKED = False
  Main.EnableSelect(2).CHECKED = False
  Main.EnableSelect(3).CHECKED = False
  Main.EnableSelect(4).CHECKED = False
  Main.EnableSelect(Index).CHECKED = True
End Sub
Private Sub Exit_Click(Index As Integer)
  End
End Sub
Private Sub MDIForm_Load()
  left = 20 * Screen.TwipsPerPixelX
  top = 20 * Screen.TwipsPerPixelY
  Width = Screen.Width - 40 * Screen.TwipsPerPixelX
  Height = Screen.Height - 40 * Screen.TwipsPerPixelY
  MenuFile.Enabled = True
  SaveFile(2).Enabled = False
  MenuObject.Enabled = False
  MenuColor.Enabled = False
  MenuThickness.Enabled = False
  MenuDraw.Enabled = False
  MenuWindow.Enabled = False
  Main.EnableSelect(0).CHECKED = True
  DrawMenu = "Disabled"
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
  End
End Sub
Private Sub MenuColor_Click()
  For i = 0 To 4
    ColorSelect(i).CHECKED = False
  Next
  ColorSelect(Main.ActiveForm.DrawColor).CHECKED = True
End Sub
Private Sub MenuObject_Click()
  For i = 0 To 2
    ObjectSelect(i).CHECKED = False
  Next
  ObjectSelect(Main.ActiveForm.DrawObject).CHECKED = True
End Sub
Private Sub MenuThickness_Click()
  Dim fOK As Integer
  Dim nValue As Integer
  Dim fChecked As Integer
  Load GetValueFrm
  GetValueInitTheForm "PEN THICKNESS", "Pixels:", 15, 1, Main.ActiveForm.ViewFactor, 3, 1, False
  GetValueFrm.Show 1
  GetValueGetUserSelections fOK, nValue, fChecked
  Unload GetValueFrm
  If fOK Then
    Main.ActiveForm.ViewFactor = nValue
  End If
End Sub
Private Sub ObjectSelect_Click(Index As Integer)
  Main.ActiveForm.DrawObject = Index
End Sub
Private Sub OpenFile_Click(Index As Integer)
    Dim Frm As New ViewFrm
    Static FileName As String
    Dim nBits As Integer
    Dim fPaintWL As Integer
    On Error GoTo ErrorOpen
    LEADDlg1.FileDlgFlags = 0
    LEADDlg1.Filter = "Graphics|*.cmp;*.jpg;*.jff;*.jtf;*.bmp;*.tif;*.tga;*.pcx;*.cal;*.mac;*.img;*.msp;*.wpg;*.wpg;*.ras;*.pct;*.pcd;*.eps;*.wmf;*.gif;*.png"
    LEADDlg1.DialogTitle = "Open File"
    LEADDlg1.UIFlags = DLG_FO_MULTIPAGE + DLG_FO_FILEINFO + DLG_FO_SHOWPREVIEW + DLG_FO_SHOWSTAMP + DLG_FO_95STYLE
    LEADDlg1.FileOpen hWnd
    FileName = LEADDlg1.FileName
    Screen.MousePointer = HOURGLASS
    gDitheringType = 0
    gPaintFixed = PAINTPALETTE_AUTO
    gBitonalType = BITONALSCALING_NORMAL
    Load Frm
    ViewerInitTheForm Frm, FileName, FileName, 0, False
    ' Let windows process messages to avoid a double paint after loading
    DoEvents
    'Load the selected file
    Frm.FileName = FileName
    Frm.Lead1.Load FileName, 0, LEADDlg1.PageNumber, 1
    Frm.ViewFactor = 3
    Frm.Lead1.AutoRepaint = True
    Screen.MousePointer = DEFAULT
Exit Sub
ErrorOpen:
    If Err.Number = ERROR_DLG_CANCELED Then
        'Do nothing if this is just a Cancel.
    Else
        Screen.MousePointer = DEFAULT
        Unload Frm
        MsgBox Err.Source + " " + CStr(Err.Number) + Chr(13) + Err.Description
    End If
End Sub
Private Sub SaveFile_Click(Index As Integer)
    Dim fOK As Boolean
    Static FileName As String
    Static nSaveIdx As Integer
    Dim nBits As Integer
    Dim nFormat As Integer
    Dim nQFactor As Integer
    Dim fMultipage As Boolean
    Dim fStamp As Boolean
    Dim nStampWidth%, nStampHeight%, nStampBits%
    On Error GoTo ErrorSave
    LEADDlg1.FileDlgFlags = 0
    LEADDlg1.UIFlags = DLG_FS_95STYLE + DLG_FS_MULTIPAGE + DLG_FS_STAMP + DLG_FS_QFACTOR
    LEADDlg1.SaveFormatFlags = DLG_FS_ALL
    LEADDlg1.FileSave hWnd
    FileName = LEADDlg1.FileName
    nFormat = LEADDlg1.SaveFormat
    nBits = LEADDlg1.SaveBitsPerPixel
    nQFactor = LEADDlg1.SaveQFactor
    fMultipage = LEADDlg1.SaveMulti
    fStamp = LEADDlg1.SaveWithStamp
    nStampBits = LEADDlg1.SaveStampBits
    nStampWidth = LEADDlg1.SaveStampWidth
    nStampHeight = LEADDlg1.SaveStampHeight
    Main.ActiveForm.Lead1.SaveInterlaced = LEADDlg1.SaveInterlaced
    Screen.MousePointer = HOURGLASS
    If LEADDlg1.SaveWithStamp = True Then
      nOldScaleMode = Main.ActiveForm.Lead1.ScaleMode
      Main.ActiveForm.Lead1.ScaleMode = 3
      Main.ActiveForm.Lead1.SaveWithStamp FileName, nFormat, nBits, nQFactor, nStampWidth, nStampHeight, nStampBits
      Main.ActiveForm.Lead1.ScaleMode = nOldScaleMode
    Else
      Main.ActiveForm.Lead1.Save FileName, nFormat, nBits, nQFactor, fMultipage
    End If
    Screen.MousePointer = DEFAULT
Exit Sub
ErrorSave:
    If Err.Number = ERROR_DLG_CANCELED Then
        'Do nothing if this is just a Cancel.
    Else
        Screen.MousePointer = DEFAULT
        MsgBox Err.Source + " " + CStr(Err.Number) + Chr(13) + Err.Description
    End If
End Sub
Private Sub Tile_Click(Index As Integer)
  Main.Arrange 2
End Sub