VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.UserControl ArmPict 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin MSComctlLib.ImageList img 
      Left            =   4080
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   16711935
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ArmPict.ctx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ArmPict.ctx":0128
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ArmPict.ctx":023A
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlg 
      Left            =   4080
      Top             =   960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "*.jpg"
      Filter          =   "JPEG *.jpg, *.jpeg|*.jpg;*.jpeg|GIF *.gif|*.gif|*.jpg, *.jpeg, *.gif|*.jpg;*.jpeg;*.gif"
   End
   Begin MSComctlLib.Toolbar tlb 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   4800
      _ExtentX        =   8467
      _ExtentY        =   741
      ButtonWidth     =   609
      ButtonHeight    =   582
      Appearance      =   1
      ImageList       =   "img"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   3
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Properties"
            ImageIndex      =   3
            Style           =   1
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox pic 
      Height          =   2775
      Left            =   240
      ScaleHeight     =   2715
      ScaleWidth      =   4395
      TabIndex        =   0
      Top             =   480
      Width           =   4455
      Begin VB.Frame frm 
         BorderStyle     =   0  'None
         Height          =   1575
         Left            =   360
         TabIndex        =   2
         Top             =   840
         Visible         =   0   'False
         Width           =   3015
         Begin VB.TextBox txt_Name 
            Height          =   285
            Left            =   120
            TabIndex        =   4
            Top             =   110
            Width           =   2775
         End
         Begin VB.Label lbl_File 
            AutoSize        =   -1  'True
            Caption         =   "File"
            Height          =   195
            Left            =   120
            TabIndex        =   6
            Top             =   650
            Width           =   240
         End
         Begin VB.Label lbl_Info 
            AutoSize        =   -1  'True
            Caption         =   "Info"
            Height          =   195
            Left            =   120
            TabIndex        =   5
            Top             =   400
            Width           =   270
         End
      End
      Begin VB.Label lbl_Name 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "Picture name"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Left            =   1200
         TabIndex        =   3
         Top             =   480
         Visible         =   0   'False
         Width           =   1125
      End
   End
End
Attribute VB_Name = "ArmPict"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private ms_FullFileName As String
Private ms_FileName As String
Private ms_PicName As String
Private mb_ReadOnly As Boolean
Private ml_Width As Long
Private ml_Height As Long
Private ml_PicSize As Long
Private ml_PicIndex As Long
Private mb_PicNameChanged As Boolean
Private mb_PicChanged As Boolean
Private mb_ShowName As Boolean

Private Const C_SEP As String = "ой"


Public Event ValidatePicName(ByRef as_Name As String, ByRef ab_Valid As Boolean)

Function Load_A_Com() As Boolean

  mb_ReadOnly = True
  PicIndex = 0
  mb_PicChanged = False
  Call SetInfo
End Function

Function Unload_A_Com() As Boolean

End Function

Property Let ReadOnly(ab_Value As Boolean)
  mb_ReadOnly = ab_Value
End Property

Property Get ReadOnly() As Boolean
  ReadOnly = mb_ReadOnly
End Property

Property Let ToolBarVisible(ab_Value As Boolean)
  If Not mb_ReadOnly Then
    tlb.Visible = ab_Value
    Call UserControl_Resize
  End If
End Property

Property Get ToolBarVisible() As Boolean
  ToolBarVisible = tlb.Visible
End Property

Property Get FileName() As String
  FileName = ms_FileName
End Property

Property Get FullFileName()
    FullFileName = ms_FullFileName
End Property

Private Sub lbl_Name_Click()
  ToolBarVisible = True
End Sub

Private Sub pic_Click()
  ToolBarVisible = True
End Sub

Private Sub txt_Name_GotFocus()
  ToolBarVisible = True
End Sub

Private Sub txt_Name_Change()
  mb_PicNameChanged = True
End Sub

Private Sub txt_Name_LostFocus()
  ToolBarVisible = False
  InfoVisible = False
End Sub

Private Sub UserControl_LostFocus()
  ToolBarVisible = False
End Sub

Private Sub UserControl_GotFocus()
  ToolBarVisible = True
End Sub

Private Sub pic_LostFocus()
  ToolBarVisible = False
End Sub

Public Function Load(as_FileName As String) As Boolean
  Load = LoadInternal(as_FileName)
  mb_PicChanged = False
End Function

Private Function LoadInternal(as_FileName As String) As Boolean
Dim ld_Scale As Double
Dim lo_pic As StdPicture
Dim ld_Height As Double, ld_Width As Double
Dim lo_fs As Object
Dim lo_File As Object

  Call Clear
  If as_FileName = "" Then
    Call dlg.ShowOpen
    as_FileName = dlg.FileName
  End If
  If as_FileName <> "" Then
    Set lo_fs = CreateObject("Scripting.FileSystemObject")
    If lo_fs.FileExists(as_FileName) Then
      Set lo_File = lo_fs.GetFile(as_FileName)
      ms_FileName = lo_File.Name
      ms_FullFileName = as_FileName
      ml_PicSize = lo_File.Size
      Set lo_File = Nothing
      Set lo_fs = Nothing
      
      pic.AutoRedraw = True 'set needed properties
      pic.Cls 'clear picture box
      ToolBarVisible = False
      InfoVisible = False
      
      Set lo_pic = LoadPicture(as_FileName)
      ml_Width = ScaleX(lo_pic.Width, vbHimetric, vbPixels)
      ml_Height = ScaleY(lo_pic.Height, vbHimetric, vbPixels)
  
      ld_Scale = 1
      ld_Width = pic.ScaleX(lo_pic.Width)
      ld_Height = pic.ScaleY(lo_pic.Height)
      
      If ld_Width > Width Then
        ld_Scale = Width / ld_Width
        If ld_Scale * ld_Height > Height Then
          ld_Scale = Height / ld_Height
        End If
      ElseIf ld_Height > Height Then
        ld_Scale = Height / ld_Height
        If ld_Scale * ld_Width > Width Then
          ld_Scale = Width / ld_Width
        End If
      End If
      ld_Width = ld_Scale * ld_Width
      ld_Height = ld_Scale * ld_Height
      
      Call pic.PaintPicture(lo_pic, (Width - ld_Width) / 2, (Height - ld_Height) / 2, ld_Width, ld_Height)
      Call SetInfo
    End If
  End If
End Function

Public Function Save(as_Name As String) As Boolean
  Call SavePicture(pic.Picture, as_Name)
End Function

Public Function Clear()
  Set pic.Picture = Nothing
  ms_FileName = ""
  ml_Height = 0
  ml_Width = 0
  ml_PicSize = 0
  Call SetInfo
End Function

Private Sub tlb_ButtonClick(ByVal Button As MSComctlLib.Button)
  If Not mb_ReadOnly Then
    Select Case Button.Index
    Case 1
      mb_PicChanged = True
      Call LoadInternal("")
    Case 2
      mb_PicChanged = True
      Clear
    Case 3
      InfoVisible = (Button.value = tbrPressed)
    End Select
  End If
End Sub

Public Property Get PicWidth() As Long
  PicWidth = ml_Width
End Property

Public Property Get PicHeight() As Long
  PicHeight = ml_Height
End Property

Public Property Get PicSize() As Long
  PicSize = ml_PicSize
End Property

Public Property Let PicIndex(al_Index As Long)
  ml_PicIndex = al_Index
  PicName = "Picture " & al_Index
End Property

Public Property Get PicIndex() As Long
  PicIndex = ml_PicIndex
End Property

Public Property Get PicChanged() As Boolean
  PicChanged = mb_PicChanged
End Property

Public Property Get PicNameChanged() As Boolean
  PicNameChanged = mb_PicNameChanged
End Property

Private Function ValidatePicName(as_Name As String) As Boolean
Dim lb_Valid As Boolean

  lb_Valid = True
  RaiseEvent ValidatePicName(as_Name, lb_Valid)
  ValidatePicName = lb_Valid
End Function

Public Property Let PicName(as_Name As String)
  ms_PicName = as_Name
  lbl_Name.Caption = as_Name
  lbl_Name.Visible = (as_Name <> "") And mb_ShowName
  txt_Name.Text = as_Name
  mb_PicNameChanged = False
End Property

Public Property Get PicName() As String
  PicName = ms_PicName
End Property

Public Property Let ShowName(ByVal ab_Value As Boolean)
    mb_ShowName = ab_Value
    lbl_Name.Visible = (lbl_Name.Caption <> "") And ab_Value
End Property
Public Property Get ShowName() As Boolean
    ShowName = mb_ShowName
End Property

Public Property Let InfoVisible(ab_Value As Boolean)
  frm.Visible = ab_Value
  If ab_Value Then
    txt_Name.Text = PicName
  Else
    tlb.Buttons(3).value = tbrUnpressed
    If mb_PicNameChanged Then
      If ValidatePicName(txt_Name.Text) Then
        PicName = txt_Name.Text
      End If
    End If
  End If
End Property

Public Property Get InfoVisible() As Boolean
  InfoVisible = frm.Visible
End Property

Private Sub SetInfo()
  lbl_Info.Caption = PicWidth & "x" & PicHeight & " - " & (PicSize \ 1024) & " kB"
  lbl_File.Caption = ms_FileName
End Sub

Private Sub UserControl_Resize()

  tlb.Top = 0
  pic.Left = 0
  pic.Width = Width
  If ToolBarVisible Then
    pic.Top = tlb.Top + tlb.Height
    pic.Height = Height - pic.Top
  Else
    pic.Top = 0
    pic.Height = Height
  End If
  lbl_Name.Left = (pic.Width - lbl_Name.Width) / 2
  lbl_Name.Top = (pic.Height - lbl_Name.Height) / 2
  
  frm.Left = 0
  frm.Top = 0
  frm.Height = pic.Height
  frm.Width = pic.Width
  
  txt_Name.Width = (frm.Width - 2 * txt_Name.Left)
End Sub

Public Property Let Charset(ByVal al_Charset As Long)
    txt_Name.Font.Charset = al_Charset
    lbl_Name.Font.Charset = al_Charset
  
End Property



