home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format 117
/
af117a.adf
/
archives
/
af117a1.lzx
/
Fiasco_2.2
/
Databases
/
PictureDatabase
/
AddPicture.frx
next >
Wrap
Text File
|
1998-09-22
|
4KB
|
214 lines
/* addpicture.frx
* Adds a new picture entry to Fiasco's picture database
* Copyright © 1996-1997 Nils Bandener
* $VER: addpicture_frx 6.4 (6.10.97)
*/
Options Results
Options Failat 21
Parse Arg FileName
scriptname = "AddPicture"
fiasco_port = address()
Signal on Syntax
Signal on Halt
Signal on Break_C
Signal on Failure
LockGUI
/*
* Constant values
*/
DTFieldsInRecord = 8
if FileName = "" then
do
/*
* if no name is given, request
* the name
*/
RequestFile 'Title "Select picture" Noicons ProjectRelative Var Filename'
end
if FileName ~= "" then do
CountRecords var numrecs
/*
* Initialize these vars to
* remember the field and
* record number
*/
fieldnumber = 0
recordnumber = 0
if numrecs > 0 then
do
do i = 1 to numrecs
GetField "Cnt" Record i
cnt = result
if result ~= DTFieldsInRecord then
do
k = 1
do while k <= DTFieldsInRecord & fieldnumber = 0
GetField "Name_" || k Record i
if result = "" then do
fieldnumber = k
recordnumber = i
end
k = k + 1
end
end
end
end
if recordnumber = 0 | fieldnumber = 0 then
do
/*
* No record had a free field.
* Create a new record
*/
AddRecord record numrecs
numrecs = numrecs + 1
recordnumber = numrecs
fieldnumber = 1
cnt = 0
end
GetField "Key" record recordnumber
Key = Result
tnname = 'TN/TN_' || Key || '_' || Cnt
/*
* "__in_archive__" is a magic path component used
* by ScanDir.rexx to seperate the dos path and the path
* in an archive.
*/
archive = pos("/__in_archive__/", FileName)
if archive ~= 0 then
do
ArcName = left(FileName, archive - 1)
NameInArc = substr(FileName, archive + 16)
Address Command 'lha >nil: <nil: x "' || ArcName || '" "' || NameInArc || '" t:'
if rc = 0 then
do
ExtractedName = "t:" || NameInArc
Address Command 'createthumbnail "' || ExtractedName || '" "' || tnname || '"'
end
oldrc = rc /* Preserve rc */
Address Command 'delete >nil: "' || ExtractedName || '" quiet'
if pos("/", NameInArc) ~= 0 then
do
Address Command 'delete >nil: "t:' || substr(NameInArc, pos("/", NameInArc) - 1) || '" all'
end
rc = oldrc
end
else
do
Address Command 'createthumbnail "' || FileName || '" "' || tnname || '"'
end
if rc = 0 then
do
SetField "Name_" || fieldnumber Record recordnumber FileName
SetField "DT_" || fieldnumber record recordnumber '"' || tnname || '"'
cnt = cnt + 1
SetField "Cnt" Record recordnumber cnt
width = -1
height = -1
depth = -1
colors = -1
if Open("f", "t:thumbnaildata", "read") then
do
l = ReadLn("f")
parse var l "Width" width "Height" height "Depth" depth "Colors" colors
call Close("f")
end
SetField "Width_" || fieldnumber Record recordnumber width
SetField "Height_" || fieldnumber Record recordnumber height
SetField "Colors_" || fieldnumber Record recordnumber colors
end
end
bail_out:
Address Value fiasco_port
UnlockGUI
ResetStatus
exit
syntax:
failure:
if show("Ports", fiasco_port) then
do
Address Value fiasco_port
RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title "' || scriptname || '"'
end
else
do
say "Error" rc "in line" sigl ":" errortext(rc)
say "Enter to continue"
pull dummy
end
call bail_out
halt:
break_c:
if show("Ports", fiasco_port) then
do
Address Value fiasco_port
RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"'
end
else
do
say "*** Break"
say "Enter to continue"
pull dummy
end
call bail_out