home *** CD-ROM | disk | FTP | other *** search
- /*
- @B AddToLabelDataBase @P@ICopyright Gold Disk Inc., July, 1992
- This Genie allows you to add an entry to an existing label database.
- Please refer to clip or pic supplied for more information.
- */
-
- call SafeEndEdit.rexx()
- units = ppm_GetUnits()
- cr = '0a'x
-
- pgdir = readini.rexx("PG")
-
- do forever
-
- labeltype = ppm_Inform(3,"Would you like to add a Dot Matrix label or a Laser Label?", "Cancel", "Dot Matrix", "Laser")
-
- if labeltype = 0 then exit_msg()
-
- if labeltype = 1 then
- do
-
- form = "Part Number"cr"Label Type"cr"Label Height"cr"Label Width"cr"Num. Columns"cr"Carrier Width"cr"Horizontal Pitch"cr"Vertical Pitch"
-
- form = ppm_GetForm("Enter Label Specifications..", 20, form)
- if form = '' then exit_msg()
-
- parse var form pnum '0a'x type '0a'x lheight '0a'x lwid '0a'x cols '0a'x cwidth '0a'x hpitch '0a'x vpitch
-
- if ~(datatype(lheight, n) & datatype(lwid, n) & datatype(cols, n) & datatype(cwidth,n) & datatype(hpitch, n) & datatype(vpitch, n)) then exit_msg("Invalid entry")
-
- if units ~= 1 then
- do
- lheight = ppm_ConvertUnits(units, 1, lheight)
- lwid = ppm_ConvertUnits(units, 1, lwid)
- cwidth = ppm_ConvertUnits(units, 1, cwidth)
- hpitch = ppm_ConvertUnits(units, 1, hpitch)
- vpitch = ppm_ConvertUnits(units, 1, vpitch)
- end
-
- line = pnum';'type';'lheight';'lwid';'cols';'cwidth';'hpitch';'vpitch
-
- filename = ppm_GetFileName("Select label database..", pgdir, "")
- if filename = '' then exit_msg()
-
- if ~open(file, filename, r) then exit_msg("Unable to open file: "filename)
- fline = readln(file)
- if pos('MATRIX', fline) = 0 then exit_msg("This is not a Dot Matrix Label Database..")
-
- call seek(file, 0, e)
- call writeln(file, line)
- call close(file)
- call ppm_Inform(1,"Finished..",)
- end
- else
- do
-
- form = "Part Number"cr"Label Type"cr"Label Height"cr"Label Width"cr"Num. Columns"cr"Num. Rows"cr"Top Margin"cr"Side Margin"cr"Horizontal Pitch"cr"Vertical Pitch"
-
- form = ppm_GetForm("Enter Label Specifications..", 20, form)
- if form = '' then exit_msg()
-
- parse var form pnum '0a'x type '0a'x lheight '0a'x lwid '0a'x cols '0a'x rows '0a'x tmarg '0a'x smarg '0a'x hpitch '0a'x vpitch
-
- if ~(datatype(lheight, n) & datatype(lwid, n) & datatype(cols, n) & datatype(rows,n) & datatype(tmarg, n) & datatype(smarg, n) & datatype(hpitch, n) & datatype(vpitch, n)) then exit_msg("Invalid entry")
-
- if units ~= 1 then
- do
- lheight = ppm_ConvertUnits(units, 1, lheight)
- lwid = ppm_ConvertUnits(units, 1, lwid)
- tmarg = ppm_ConvertUnits(units, 1, tmarg)
- smarg = ppm_ConvertUnits(units, 1, smarg)
- hpitch = ppm_ConvertUnits(units, 1, hpitch)
- vpitch = ppm_ConvertUnits(units, 1, vpitch)
- end
-
- line = pnum';'type';'lheight';'lwid';'cols';'rows';'tmarg';'smarg';'hpitch';'vpitch
-
- filename = ppm_GetFileName("Select label database..", pgdir, "")
- if filename = '' then exit_msg()
-
- if ~open(file, filename, r) then exit_msg("Unable to open file: "filename)
- fline = readln(file)
- if pos('LASER', fline) = 0 then exit_msg("This is not a Laser Label Database..")
- call seek(file, 0, e)
- call writeln(file, line)
- call close(file)
-
- call ppm_Inform(1,"Finished..",)
- end
- end
-
- exit_msg()
-
- exit_msg: procedure expose units
- do
- parse arg message
-
- if message ~= '' then call ppm_Inform(1,message,)
- call ppm_SetUnits(units)
- exit
- end
-
-
-
-
-