home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1997 February
/
PCWK0297.iso
/
envelop
/
envelop.5
/
Tools
/
Arsenal
/
tools
/
readero
/
readero.eto
< prev
next >
Wrap
Text File
|
1996-07-08
|
10KB
|
325 lines
Type EroExplorer From Form
Type imgPicture From Image
Dim bitmap1 As New Bitmap
End Type
Dim lbFileContents As New ListBox
Dim txtFileName As New TextBox
Dim btnReadFile As New Button
Dim binfile As New BinaryFile
Type lblImageStats From Label
Dim font1 As New Font
End Type
Dim cbFit As New CheckBox
Dim Label1 As New Label
Dim Label2 As New Label
Dim Label3 As New Label
Type menubar1 From MenuBar
Dim Popup1 As New PopupMenu
Dim Popup2 As New PopupMenu
End Type
Dim helpfile As New HelpFile
Dim SampleName As String
Dim SampleDir As String
' METHODS for object: EroExplorer
Sub btnReadFile_Click()
If txtFileName.Text = "" Then
InfoBox.Message("Warning", "No ERO filename has been specified.")
Else
Dim nextId As Long
' Clear the ResID list
lbFileContents.Clear
' Read the filename into the BinaryFile object
ResIdReader.Reset(txtFileName.Text)
' Populate the list with ResID numbers
Do
nextId = ResIdReader.NextResId()
If (nextId <> -1) Then lbFileContents.AddItem(nextId)
Loop While nextId <> -1
' Select the first ResID on the list
lbFileContents.ListIndex = 0
End If
End Sub
Sub cbFit_Click()
If cbFit.Value Then
imgPicture.ResizeMode = "Fit"
imgPicture.InitCropRect
Else
imgPicture.ResizeMode = "Clip"
imgPicture.ScaleX = 1.0
imgPicture.ScaleY = 1.0
End If
End Sub
Sub Destruct()
helpfile.Quit
End Sub
Sub ExitApplication_Click
helpfile.Quit
UnloadForm
End Sub
Sub HelpContents_Click()
helpfile.Contents
End Sub
Function HelpContents_Enable() As Integer
HelpContents_Enable = helpfile.Exists
End Function
Sub InitHelpFile
helpfile.FileName = SampleDir & SampleName & ".hlp"
End Sub
Sub lbFileContents_Click()
imgPicture.Picture.LoadType = "MemoryBased"
imgPicture.Picture.FileName = txtFileName.Text
imgPicture.Picture.ResId = lbFileContents.List(lbFileContents.ListIndex)
' Configure the image control to show "fitted" image or 1:1 scale image.
cbFit_Click()
imgPicture.Refresh
lblImageStats.Text = imgPicture.Picture.Width & " x " & imgPicture.Picture.Height & " x " & imgPicture.Picture.NumColors
End Sub
Sub OpenEROFile_Click()
Dim openDlg as new OpenDialog
openDlg.DefaultExtension = "ero"
openDlg.FileMustExist = False
openDlg.Filter = "Envelop Text Resource files (*.ero)|*.ero|All files (*.*)|*.*|"
openDlg.NoChangeDir = True
openDlg.Title = "Choose Envelop Text Resource File"
If openDlg.Execute = IDOK Then
txtFileName.Text = openDlg.FileName
btnReadFile_Click
End If
End Sub
Sub Preload
SetSampleDir
InitHelpFile
ResetApplication_Click
Show
End Sub
Sub ResetApplication_Click()
' Clear and reset the contents of the ERO Explorer
txtFileName.Text = ""
lbFileContents.Clear
lblImageStats.Text = ""
cbFit.Value = False
imgPicture.Picture.LoadType = "FileBased"
imgPicture.Picture.FileName = ""
imgPicture.Refresh
End Sub
Sub Resize()
Dim Border As Integer
Border = 150
btnReadFile.Left = ScaleWidth - btnReadFile.Width - Border
txtFileName.Width = btnReadFile.Left - txtFileName.Left - Border
lbFileContents.Height = ScaleHeight - lbFileContents.Top - Border
imgPicture.Width = ScaleWidth - imgPicture.Left - Border
imgPicture.Height = ScaleHeight - imgPicture.Top - Border
cbFit.Left = imgPicture.Left + imgPicture.Width - cbFit.Width
lblImageStats.Width = cbFit.Left - lblImageStats.Left
lblImageStats.Refresh
txtFileName.Refresh
End Sub
Sub SaveAsBinary
ModuleManager.ModuleContaining(Me).SaveAs(SampleDir & SampleName & ".ebo", False)
End Sub
Sub SaveAsBitmapFile_Click()
Dim saveasDlg As New SaveAsDialog
saveasDlg.DefaultExtension = "bmp"
saveasDlg.Filter = "Bitmap files (*.bmp)|*.bmp|All files (*.*)|*.*|"
saveasDlg.NoChangeDir = True
saveasDlg.Title = "Select Bitmap File"
If saveasDlg.Execute = IDOK Then
imgPicture.Picture.SaveAs(saveasDlg.FileName)
End If
End Sub
Sub SaveAsText
ModuleManager.ModuleContaining(Me).SaveAs(SampleDir & SampleName & ".eto", True)
End Sub
Sub SetSampleDir()
' The purpose of this routine is to set "SampleDir", a string containing
' the directory from which the application was loaded. This may be useful
' in the event any data must be saved from the application and File objects
' were used and possibly changed our current directory.
Dim m As ObjectModule
Dim f As New File
m = ModuleManager.ModuleContaining(Me)
f.FileName = m.FileName
SampleDir = f.Path
SampleName = f.Name
End Sub
End Type
Type ResIdReader
Dim BinFile As New BinaryFile
' METHODS for object: ResIdReader
Function NextResId() As Long
dim tempInteger As Integer
dim tempLong As Long
If (Not BinFile.IsOpen()) Then NextResId = -1 : Exit Function
NextResId = BinFile.Position
If (BinFile.ReadLong(tempLong) && tempLong = &H1020304) Then
If (BinFile.ReadLong(tempLong) && tempLong = 99) Then
' Read Length
If (BinFile.ReadLong(tempLong)) Then
' We have successfully advanced to another position
BinFile.Position = BinFile.Position + tempLong
Exit Function
End If
End If
End If
' Did not advance
NextResId = -1
BinFile.Close()
End Function
Sub Reset(fname as String)
BinFile.FileName = fname
BinFile.OpenReadOnly()
End Sub
End Type
Type EROReader From Application
Dim AccessControl As New ACL
End Type
Begin Code
' Reconstruction commands for object: EroExplorer
'
With EroExplorer
.Caption := "ERO Explorer"
.Move(1770, 1530, 8220, 6570)
.DefaultButton := EroExplorer.btnReadFile
.MenuBar := EroExplorer.menubar1
.SampleName := "readero"
.SampleDir := "C:\envelop\arsenal\apps\readero\"
With .imgPicture
.Caption := "imgPicture"
.ZOrder := 9
.Move(2850, 1125, 5100, 4605)
.AutoInitCropRect := False
.Picture := EroExplorer.imgPicture.bitmap1
.ResizeMode := "Clip"
.ScaleX := 1
.ScaleY := 1
With .bitmap1
.Persistent := False
End With 'EroExplorer.imgPicture.bitmap1
End With 'EroExplorer.imgPicture
With .lbFileContents
.Caption := "lbFileContents"
.ZOrder := 8
.Move(150, 1125, 2565, 4590)
.Sorted := False
End With 'EroExplorer.lbFileContents
With .txtFileName
.ZOrder := 7
.Move(1200, 150, 5700, 375)
End With 'EroExplorer.txtFileName
With .btnReadFile
.Caption := "Read"
.ZOrder := 6
.Move(7050, 150, 900, 375)
End With 'EroExplorer.btnReadFile
With .binfile
.FileName := "w:\source\envelop\envelop1.ero"
End With 'EroExplorer.binfile
With .lblImageStats
.ForeColor := 0
.Font := EroExplorer.lblImageStats.font1
.ZOrder := 5
.Move(4200, 750, -3450, 300)
With .font1
.FaceName := "Arial"
.Size := 9.000000
.Bold := False
.Italic := False
.Strikethru := False
End With 'EroExplorer.lblImageStats.font1
End With 'EroExplorer.lblImageStats
With .cbFit
.Caption := "Fit"
.ZOrder := 4
.Move(7350, 750, 600, 300)
End With 'EroExplorer.cbFit
With .Label1
.Caption := "Bitmap Size:"
.ForeColor := 16711680
.ZOrder := 3
.Move(2850, 750, 1275, 300)
End With 'EroExplorer.Label1
With .Label2
.Caption := "ERO File:"
.ForeColor := 16711680
.ZOrder := 2
.Move(150, 225, 975, 300)
End With 'EroExplorer.Label2
With .Label3
.Caption := "ResID List:"
.ForeColor := 16711680
.ZOrder := 1
.Move(150, 750, 1125, 300)
End With 'EroExplorer.Label3
With .menubar1
.InsertPopup(EroExplorer.menubar1.Popup1, "&File", -1)
.InsertPopup(EroExplorer.menubar1.Popup2, "&Help", -1)
With .Popup1
.InsertItem("OpenEROFile", "&Open", -1)
.InsertItem("SaveAsBitmapFile", "&Save As", -1)
.InsertSeparator(-1)
.InsertItem("ResetApplication", "&Reset", -1)
.InsertSeparator(-1)
.InsertItem("ExitApplication", "&Exit", -1)
End With 'EroExplorer.menubar1.Popup1
With .Popup2
.InsertItem("HelpContents", "&Contents", -1)
End With 'EroExplorer.menubar1.Popup2
End With 'EroExplorer.menubar1
With .helpfile
.FileName := "C:\envelop\arsenal\apps\readero\readero.hlp"
End With 'EroExplorer.helpfile
End With 'EroExplorer
' Reconstruction commands for object: ResIdReader
'
With ResIdReader
With .BinFile
End With 'ResIdReader.BinFile
End With 'ResIdReader
' Reconstruction commands for object: EROReader
'
With EROReader
.ModulePath := "base.ebo;win32.ebo;dialogs.ebo;tools.ebo;readero.eto"
.ProjectFileName := "C:\envelop\arsenal\apps\readero\readero.epj"
.MainForm := EroExplorer
.Path := "C:\envelop\arsenal\apps\readero\"
.EXEName := "readero"
With .AccessControl
.ObjectAccess := "R,W,C,M,P"
End With 'EROReader.AccessControl
End With 'EROReader
End Code