Foxpro и другие приложения

HomeБаза знанийРешенияFoxpro и другие приложения

Вывод данных GENERAL поля обратно в WORD

19 Просмотры /  0 like /  // KID/
Если в GENERAL поле находится объект WORD - данные функции позволяют вывести содержимое поля обратно в ВОРД файл. Решение далеко не полностью мое, поэтому на авторство не претендую. Но все же у меня была такая задача - вдруг кому-нибудь пригодится...
*************************************************  
 * Вывод результатов Дженерал поля в ВОРД - ResultToWord *  
 *************************************************  
  FUNCTION ResultToWord  
    
  cFileFolder = "c:"  
    
  close all  
    
 * CopyGen Demo routine - you can modify this to suit your needs  
 *======================  
    
 ********** Required code before CopyGen is called ********  
  SET LIBRARY TO &Main_pathfoxtools.fll ADDITIVE &&  
 * &&  
  DIMENSION FnNum[7] &&  
  FnNum = -1 &&  
 **********************************************************  
    
    
  PrevSec = SECONDS()  
  use &Main_path_tmp.DBF in 45 shared alias temporary &&c:_tmp.dbf in 0 shared  
  SELECT temporary  
  goto top  
  cNameOfStudent = ALLTRIM(temporary.person)  
    
  sum temporary.bal TO nAllBalls  
    
  SELECT temporary  
  goto 2  
    
    
  scan all  
    
 * QUEST = General field name  
    
  RetVal = CopyGen(DBF("temporary"), recno(), "Quest", "c:"+ALLTRIM(STR(RECNO())) ) && do not use targetfile extension  
    
 *****************************************  
 * формирование ВОРД-документов  
 * если в General поле стоит картинка - то попросту будет создан bmp, gif, jpeg файд  
 *****************************************  
    
  DO CASE  
  CASE RetVal = 0  
 * WAIT WINDOW "File extracted successfully! ("+STR(SECONDS()-PrevSec)+" seconds)";  
 * + CHR(13) + "Press any key to continue......"  
  CASE RetVal = -1  
  WAIT WINDOW "CopyGen demo works only with 1986 dbf file size!" + CHR(13) + "Press any key to continue......"  
  CASE RetVal = -2  
  WAIT WINDOW "File access error - not found or in exclusive use!" + CHR(13) + "Press any key to continue......"  
  CASE RetVal = -3  
  WAIT WINDOW "Incorrect filetype - not FPW/memo or VFP/memo!" + CHR(13) + "Press any key to continue......"  
  CASE RetVal = -4  
  WAIT WINDOW "Specified field not found in DBF file!"  
  CASE RetVal = -5  
  WAIT WINDOW "Specified field is not a general field!"  
  CASE RetVal = -6  
 * WAIT WINDOW "No valid .BMP or .DOC file found inside general field!"  
  ENDCASE  
    
  endscan  
    
 *************************  
 * создаем массив с созданными  
 * выще ВОРД-документами  
 *************************  
    
  n = adir(afiles, cFileFolder + "*.doc")  
    
  oWord = createobject("Word.application")  
  y = oWord.documents.ADD  
    
 **************  
  oRange = oWord.ActiveDocument.Range()  
    
  oword.Selection.Font.Size=12  
  oword.Selection.Font.bold=.t.  
  oword.Selection.ParagraphFormat.Alignment=1  
  oword.Selection.insertafter("Р Е З У Л Ь Т А Т И " + CHR(13) + CHR(13))  
    
  oword.Selection.insertafter(cNameOfStudent + CHR(13))  
    
  oword.Selection.insertafter("ДАТА : " + DTOC(DATE()) + " РОКУ, ЧАС: " + ;  
  TIME() + CHR(13))  
    
  oword.Selection.insertafter(CHR(13))  
    
  oword.Selection.InsertAfter('ЗАГАЛЬНА КIЛЬКIСТЬ : ' + str(nAllBalls))  
    
  END=oword.activedocument.Bookmarks("ENDOFDOC").select  
  oword.Selection.ParagraphFormat.Alignment=0  
    
  With oRange  
  .moveend(6)  
  .collapse(0)  
  .insertafter(chr(13)+chr(13))  
  .collapse(0)  
  EndWith  
    
 ********************  
    
  oword.Selection.Font.Size=11  
  oword.Selection.Font.bold=.t.  
    
  oTable = oWord.ActiveDocument.Tables.Add(oRange,1,4)  
    
  WITH oTable  
    
 * First, put all borders  
  .Borders.InsideLineStyle = .t.  
  .Borders.OutsideLineStyle = .t.  
    
    
 * Put heading text in and set alignment  
    
  .Cell[1,1].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter  
  .Cell[1,2].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter  
  .Cell[1,3].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter  
  .Cell[1,4].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter  
    
  .cell[1,1].Range.InsertAfter('№')  
  .cell[1,1].Width = 30  
  .cell[1,2].Range.InsertAfter('Содержимое ВОРД файла')  
  .cell[1,2].Width = 320  
  .cell[1,3].Range.InsertAfter('Цифровое поле')  
  .cell[1,3].Width = 80  
  .cell[1,4].Range.InsertAfter('Еще одно цифровое поле')  
  .cell[1,4].Width = 40  
  ENDWITH  
 *oWord.visible = .t.  
    
  SELECT temporary  
  goto 2 &&top  
    
  nRowNum = 1  
    
  for i = 1 to n  
    
    
  z = oWord.documents.Open(cFileFolder + aFiles[i,1])  
  z.range.copyAsPicture  
  z.close  
  IF y.paragraphs.Count > 1  
  y.paragraphs.Add  
  ENDIF  
    
  oTable.Rows.Add()  
  oTable.Cell(nRowNum + 1,1).Range.InsertAfter(STR(nRowNum))  
  oTable.Cell(nRowNum + 1,2).Select  
    
 * вставка содержимого файла в один  
  oWord.Selection.paragraphs.Last.Range.Paste  
    
  SELECT temporary  
  goto i + 1  
    
  oTable.Cell(nRowNum + 1,3).Range.InsertAfter(STR(temporary.Answer,8,2))  
  oTable.Cell(nRowNum + 1,4).Range.InsertAfter(STR(temporary.bal))  
    
  nRowNum = nRowNum + 1  
    
  endfor  
  _cliptext = ""  
    
    
  oWord.visible = .t.  
 *wait window "wait..."  
 *oWord.quit  
    
    
  ERASE cFileFolder + "*.doc" && erase doc files  
  SELECT temporary  
  use in temporary  
    
 ********************************************************  
 * END of Вывод результатов теста в ВОРД - ResultToWord *  
 ********************************************************  
    
    
 **************************************************************  
 ********* ****************  
 ********* C O P Y C O N T E N T O F ****************  
 ********* G E N E R A L F I E L D ****************  
 ********* ****************  
 **************************************************************  
  procedure copygen  
  PARAMETER DBFFILE, RECNUM, FIELDNAME, OUTFILE  
  FIELDNAME = ALLTRIM(UPPER(FIELDNAME))  
  PRIVATE DBFHANDLE, MEMOHANDLE, OUTFHANDLE, MBLOCKSIZE, MEMOLEN  
  PRIVATE FIRSTRECPOS, RECORDLEN, MBLOCKSIZE, BLOCKPOS, DBFLEFT  
  PRIVATE FILETYPE, VFP_MEMO, GENFIELD  
  PRIVATE II, IICOUNT, IIREM, TEMPNO, FIELDFOUND  
  DBFHANDLE = LFOPEN(DBFFILE,64)  
  IF DBFHANDLE<0  
  RETURN -2  
  ENDIF  
  FILETYPE = GETVALUE(DBFHANDLE,0,1,1)  
  VFP_MEMO = FILETYPE=48 .AND. BIT(1,GETVALUE(DBFHANDLE,28,1,1))  
  IF FILETYPE<>245 .AND. .NOT. VFP_MEMO  
  = LFCLOSE(DBFHANDLE)  
  RETURN -3  
  ENDIF  
  PRIVATE DBFLEN  
  DBFLEN = LFSEEK(DBFHANDLE,0,2)  
  IF DBFLEN<>1986  
 * = LFCLOSE(DBFHANDLE)  
 * RETURN -1  
  ENDIF  
  FIRSTRECPOS = GETVALUE(DBFHANDLE,8,2,1)  
  RECORDLEN = GETVALUE(DBFHANDLE,10,2,1)  
  FIELDFOUND = .F.  
  GENFIELD = .F.  
  TEMPNO = 32  
  DO WHILE .NOT. FIELDFOUND .AND. TEMPNO TEMPS = GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))  
  IF UPPER(FIELDNAME)=GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))  
  FIELDFOUND = .T.  
  POSINREC = GETVALUE(DBFHANDLE,TEMPNO+12,4,1)  
  GENFIELD = 'G'=GETSTRING(DBFHANDLE,TEMPNO+11,1)  
  ELSE  
  TEMPNO = TEMPNO+32  
  ENDIF  
  ENDDO  
  IF .NOT. FIELDFOUND  
  = LFCLOSE(DBFHANDLE)  
  RETURN -4  
  ENDIF  
  IF .NOT. GENFIELD  
  = LFCLOSE(DBFHANDLE)  
  RETURN -5  
  ENDIF  
  IF VFP_MEMO  
  BLOCKPOS = GETVALUE(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,4,1)  
  ELSE  
  BLOCKPOS = VAL(GETSTRING(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,10))  
  ENDIF  
  = LFCLOSE(DBFHANDLE)  
  DBFLEFT = UPPER(IIF(RAT('.', DBFFILE)>0, LEFT(DBFFILE, RAT('.', DBFFILE)-1), DBFFILE))  
  MEMOHANDLE = LFOPEN(DBFLEFT+'.FPT',64)  
  MBLOCKSIZE = GETVALUE(MEMOHANDLE,6,2,-1)  
  MEMOLEN = GETVALUE(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS+4,4,-1)  
  TEMPS = GETSTRING(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS,128)  
  PRIVATE SIGNATURE, FILEEXT  
  DO CASE  
  CASE CHR(208)+CHR(207)+CHR(17)+CHR(224)$TEMPS  
  SIGNATURE = CHR(208)+CHR(207)+CHR(17)+CHR(224)  
  FILEEXT = '.DOC'  
  CASE 'BM'$TEMPS  
  SIGNATURE = 'BM'  
  FILEEXT = '.BMP'  
  OTHERWISE  
  = LFCLOSE(MEMOHANDLE)  
  RETURN -6  
  ENDCASE  
  = LFSEEK(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS-1+AT(SIGNATURE, TEMPS),0)  
  IICOUNT = INT(MEMOLEN/512)  
  IIREM = MOD(MEMOLEN, 512)  
  IF '.'$OUTFILE  
  OUTFILE = UPPER(IIF(RAT('.', OUTFILE)>0, LEFT(OUTFILE, RAT('.', OUTFILE)-1), OUTFILE))  
  ENDIF  
  OUTFHANDLE = LFCREATE(OUTFILE+FILEEXT)  
  FOR II = 1 TO IICOUNT  
  TEMPS = LFREAD(MEMOHANDLE,512)  
  = LFWRITE(OUTFHANDLE,TEMPS)  
  ENDFOR  
  IF IIREM>0  
  = LFWRITE(OUTFHANDLE,LFREAD(MEMOHANDLE,IIREM))  
  ENDIF  
  = LFCLOSE(MEMOHANDLE)  
  = LFCLOSE(OUTFHANDLE)  
  RETURN 0  
  ENDFUNC  
 *  
  FUNCTION GetValue  
  PARAMETER FILEHANDLE, FILELOC, NBYTES, DIRN  
  = LFSEEK(FILEHANDLE,FILELOC,0)  
  RETURN BYTE2INT(LFREAD(FILEHANDLE,NBYTES),DIRN)  
  ENDFUNC  
 *  
  FUNCTION byte2int  
  PARAMETER STRING, DIRN  
  PRIVATE STRLEN, A, B, RETVAL, I, J  
  RETVAL = 0  
  J = 0  
  A = IIF(DIRN>0, 0, LEN(STRING)-1)  
  B = IIF(DIRN>0, LEN(STRING)-1, 0)  
  FOR I = A TO B STEP DIRN  
  J = J+1  
  RETVAL = ASC(SUBSTR(STRING, J, 1))*256**I+RETVAL  
  ENDFOR  
  RETURN RETVAL  
  ENDFUNC  
 *  
  FUNCTION GetString  
  PARAMETER FILEHANDLE, FILELOC, NBYTES  
  = LFSEEK(FILEHANDLE,FILELOC,0)  
  RETURN LFREAD(FILEHANDLE,NBYTES)  
  ENDFUNC  
 *  
  FUNCTION Bit  
  PARAMETER BITNO, A  
  RETURN INT(MOD(A/2**BITNO, 2))=1  
  ENDFUNC  
 *  
  FUNCTION LFCREATE  
  PARAMETER FNAME, FATTRIB  
  PRIVATE FILEHANDLE  
  PRIVATE PARMS  
  PARMS = PARAMETERS()  
  = REGFUNCTS(1)  
  FILEHANDLE = CALLFN(FNNUM(1),FNAME,IIF(PARMS>2, FATTRIB, 0))  
  IF FILEHANDLE>-1  
  FNNUM[7] = LFSEEK(FILEHANDLE,0,2)  
  = LFSEEK(FILEHANDLE,0,0)  
  ENDIF  
  RETURN FILEHANDLE  
  ENDFUNC  
 *  
  FUNCTION LFOPEN  
  PARAMETER FNAME, FATTRIB  
  PRIVATE FILEHANDLE  
  FILEHANDLE = -1  
  PRIVATE PARMS  
  PARMS = PARAMETERS()  
  = REGFUNCTS(2)  
  FILEHANDLE = CALLFN(FNNUM(2),FNAME,IIF(PARMS=1, 0, FATTRIB))  
  IF FILEHANDLE>-1  
  FNNUM[7] = LFSEEK(FILEHANDLE,0,2)  
  = LFSEEK(FILEHANDLE,0,0)  
  ENDIF  
  RETURN FILEHANDLE  
  ENDFUNC  
 *  
  FUNCTION LFCLOSE  
  PARAMETER FILEHANDLE  
  = REGFUNCTS(3)  
  RETURN CALLFN(FNNUM(3),FILEHANDLE)  
  ENDFUNC  
 *  
  FUNCTION LFREAD  
  PARAMETER FILEHANDLE, BYTESTOREAD  
  PRIVATE READBUF, BYTESREAD  
  BYTESTOREAD = INT(BYTESTOREAD)  
  READBUF = REPLICATE(CHR(0), BYTESTOREAD)  
  = REGFUNCTS(4)  
  BYTESREAD = CALLFN(FNNUM(4),FILEHANDLE,@READBUF,BYTESTOREAD)  
  RETURN READBUF  
  ENDFUNC  
 *  
  FUNCTION LFWRITE  
  PARAMETER FILEHANDLE, WSTRING, BYTESTOWRITE  
  PRIVATE PARMS  
  PARMS = PARAMETERS()  
  = REGFUNCTS(5)  
  RETURN CALLFN(FNNUM(5),FILEHANDLE,WSTRING,IIF(PARMS<3, LEN(WSTRING), BYTESTOWRITE))  
  ENDFUNC  
 *  
  FUNCTION LFSEEK  
  PARAMETER FILEHANDLE, FOFFSET, RELTO  
  PRIVATE PARMS  
  PARMS = PARAMETERS()  
  = REGFUNCTS(6)  
  RETURN CALLFN(FNNUM(6),FILEHANDLE,INT(FOFFSET),IIF(PARMS=3, RELTO, 0))  
  ENDFUNC  
 *  
  FUNCTION LFEOF  
  PARAMETER FILEHANDLE  
  = REGFUNCTS(6) && = REGFUNTCS(6)  
  RETURN CALLFN(FNNUM(6),FILEHANDLE,0,1)>=FNNUM(7)  
  ENDFUNC  
 *  
  PROCEDURE RegFuncts  
  PARAMETER FNID  
  IF FNNUM(FNID)>-1  
  RETURN  
  ENDIF  
  DO CASE  
  CASE FNID=1  
  FNNUM[1] = REGFN("_lcreat","CI","I")  
  CASE FNID=2  
  FNNUM[2] = REGFN("_lopen","CI","I")  
  CASE FNID=3  
  FNNUM[3] = REGFN("_lclose","I","I")  
  CASE FNID=4  
  FNNUM[4] = REGFN("_lread","I@CI","I")  
  CASE FNID=5  
  FNNUM[5] = REGFN("_lwrite","ICI","I")  
  CASE FNID=6  
  FNNUM[6] = REGFN("_llseek","ILI","L")  
  ENDCASE  
  ENDPROC  
 *  
 ***********************

 

Автор: KID
0

Автор публикации

не в сети 22 года

KID

0
Комментарии: 0Публикации: 1Регистрация: 07-02-2003
Оставить комментарий
Главная
Авторизация
*
*
Вход Потеряли пароль ?
Генерация пароля
Получить новый пароль