!==================================================================================
! Класс для сохранения wmf-файлов в rtf.
! Вячеслав Черников, г.Рязань, 2013г.
!==================================================================================

                     MEMBER

   INCLUDE('fsWmfToRtf.INC')
   INCLUDE('WINEQU.INC')

   MAP
     MODULE('Windows API')
       WriteFile(UNSIGNED,*?,ULONG,*ULONG,*OVERLAPPED),BOOL,PASCAL,RAW,NAME('WriteFile')
       CreateFile(*CSTRING,ULONG=GENERIC_READ+GENERIC_WRITE,ULONG=0,ULONG=0,ULONG=CREATE_ALWAYS,ULONG=FILE_FLAG_RANDOM_ACCESS,UNSIGNED=0),UNSIGNED,PASCAL,RAW,NAME('CreateFileA')
       CloseFile(UNSIGNED),SIGNED,PROC,PASCAL,NAME('CloseHandle')
       GetFileSize(UNSIGNED,*ULONG),ULONG,PASCAL,NAME('GetFileSize')
       ReadFile(UNSIGNED,LONG,ULONG,*ULONG,LONG),BOOL,PASCAL,RAW,NAME('ReadFile')
     END
   END

MyPictRTF       QUEUE, TYPE     !список картинок для вывода в rtf
PictName            STRING(128) !наименование файла 
PictNumStart        LONG        !начало записей в детализации
PictNumEND          LONG        !завершение записей в детализации
END

MyPictDetRTF       QUEUE, TYPE  !образы картинок для вывода в rtf
PictDetStr         STRING(512)  !строка с детализацией 
END

!===================================================================================
!
! Конструктор класса
!
FsWmfToRtf.Construct PROCEDURE
    CODE


    SELF.PictRTF      &= new(MyPictRTF)     !список картинок для вывода в rtf
    SELF.PictDetRTF   &= new(MyPictDetRTF)  !образы картинок для вывода в rtf

!===================================================================================
!
! Деструктор класса
!
FsWmfToRtf.Destruct PROCEDURE
   CODE
      SELF.Kill

      if ~(SELF.PictRTF &= NULL)
         free(SELF.PictRTF)
         free(SELF.PictDetRTF)

         dispose(SELF.PictRTF)         !список картинок для вывода в rtf
         dispose(SELF.PictDetRTF)      !образы картинок для вывода в rtf
      end

!===================================================================================
! Инициализация класса
!
FsWmfToRtf.Init PROCEDURE 
      CODE

         if SELF.Active=1
            return 
         end

         SELF.Active=1

!===================================================================================
! Деактивация класса
!
FsWmfToRtf.Kill PROCEDURE
      CODE
   if SELF.Active=0
      return
   end

   SELF.Active=0

!===================================================================================
!
! Сформировать образ картинки для вывода в RTF
!
FsWmfToRtf.MakePictRTF PROCEDURE (Pict) 
loc:szFile          CSTRING(FILE:MaxFileName)
loc:hFile           LONG
loc:dwSize          UNSIGNED
loc:lpFileSizeHigh  ULONG
loc:dwBytesRead     ULONG
loc:bRead           BOOL
loc:buf             &CSTRING

loc:i   long
loc:j   long
loc:k   long
loc:ok  byte
loc:dl  long
loc:dlS long
loc:flagWMFzag  byte
   CODE

      if SELF.Active=0 
         return
      end  

      loc:ok=0
      loop loc:i=1 to records(SELF.PictRTF)  !ищем в числе сформированных
         get(SELF.PictRTF,loc:i)
         if SELF.PictRTF.PictName=Pict
            loc:ok=1
            break
         end
      end
      if loc:ok=1   !картинка найдена
         return
      end 

      loc:ok=0
      if sub(Pict,2,1)<>':' and sub(Pict,1,1)<>'/'  !полный путь до файла не задан
         if SELF.UserPath<>''
            loc:szFile=clip(SELF.UserPath) & '\' & Pict
         end
      else
         loc:szFile=Pict
      end
      if sub(Pict,2,1)<>':' and sub(Pict,1,1)<>'/'  !полный путь до файла не задан
         loc:szFile=clip(longpath()) & '\' & loc:szFile
      end
      loc:hFile = CreateFile(loc:szFile,GENERIC_READ,0,0,OPEN_EXISTING,0,0)  !чтение из файла
      if loc:hFile <> INVALID_HANDLE_VALUE
         loc:dwSize = GetFileSize(loc:hFile,loc:lpFileSizeHigh)
         if loc:dwSize > 0
            loc:buf &= new(CSTRING(loc:dwSize))    !создаем буфер для содержимого файла
            loc:bRead = ReadFile(loc:hFile,ADDRESS(loc:buf),SIZE(loc:buf),loc:dwBytesRead,0)
            loc:ok=1
         end
         CloseFile(loc:hFile)
      end
      if loc:ok=0
         return 
      end  

      clear(SELF.PictRTF)
      SELF.PictRTF.PictName=Pict

      loc:flagWMFzag=0   !признак наличия заголовка в wmf
      clear(SELF.PictDetRTF)
      loc:k=0
      loop loc:j=1 to 4
        if loc:k=0
           SELF.PictDetRTF.PictDetStr=SELF.BYTETOHEX(val(loc:buf[loc:j]),1)
        else
           SELF.PictDetRTF.PictDetStr=sub(SELF.PictDetRTF.PictDetStr,1,loc:k) & SELF.BYTETOHEX(val(loc:buf[loc:j]),1)
        end
        loc:k+=2
      end
      if SELF.PictDetRTF.PictDetStr='d7cdc69a'  !найден признак наличия заголовка в первых 4 байтах
         loc:flagWMFzag=1
      end

      loc:dl=0
      loop 
         loc:dlS=256
         if loc:dl+loc:dlS>loc:dwSize
            loc:dlS=loc:dwSize-loc:dl
         end
         clear(SELF.PictDetRTF)
         loc:k=0
         loop loc:j=loc:dl+1 to (loc:dl+loc:dlS)
            if loc:dl=0 and loc:j<23 and loc:flagWMFzag=1  !пропускаем заголовок wmf (первые 22 байта)
               cycle 
            end 
            if loc:k=0
               SELF.PictDetRTF.PictDetStr=SELF.BYTETOHEX(val(loc:buf[loc:j]),1)
            else
               SELF.PictDetRTF.PictDetStr=sub(SELF.PictDetRTF.PictDetStr,1,loc:k) & SELF.BYTETOHEX(val(loc:buf[loc:j]),1)
            end
            loc:k+=2
         end
         add(SELF.PictDetRTF)
         if SELF.PictRTF.PictNumStart=0
            SELF.PictRTF.PictNumStart=pointer(SELF.PictDetRTF)
         end 
         SELF.PictRTF.PictNumEnd=pointer(SELF.PictDetRTF)
         loc:dl+=loc:dlS
         if loc:dl>=loc:dwSize
            break
         end
      end

      add(SELF.PictRTF)

      clear(loc:buf)
      dispose(loc:buf)

!===================================================================================
!
! Преобразовать байт в 16 вид
!
FsWmfToRtf.ByteToHex FUNCTION (BYTE in, BYTE LowerCase)
Out              STRING(2),AUTO
HEX              &STRING,AUTO
HexDigitsUp      STRING('0123456789ABCDEF')
HexDigitsLow     STRING('0123456789abcdef')

  CODE
  IF LowerCase
    HEX &= HexDigitsLow
  ELSE
    HEX &= HexDigitsUp
  END
  Out[1] = HEX [BSHIFT(in, -4) + 1]
  Out[2] = HEX [BAND(in, 0FH) + 1]
  RETURN Out

!===================================================================================
!
! Сохранить в файле
!
FsWmfToRtf.Save    FUNCTION ()
ASCIIFile  FILE,DRIVER('ASCII'),PRE(ARF),CREATE
Record     RECORD,PRE()
rec    STRING(1024)
     END
   END

loc:err     byte
loc:errStr  string(128)
loc:date    long
loc:clock   long

loc:i       long
loc:j       long

loc:w       real
loc:h       real

  CODE

    if SELF.Active=0 
       return('Класс не активизирован!')
    end

    loc:err=0

    do outRTF_r

    case loc:err
      of 1
        loc:errStr='Не задано имя rtf-файла!' 
      of 2
        loc:errStr='Не могу открыть файл ' &  SELF.FileNameRTF
      else
        loc:errStr=''
    end

    return(loc:errStr)

outRTF_r  routine   !вывод в rtf

   if SELF.FileNameRTF=''
      loc:err=1
      exit
   end 
   if sub(lower(SELF.FileNameRTF),len(clip(SELF.FileNameRTF))-3,4)<>'.rtf'
      SELF.FileNameRTF=clip(SELF.FileNameRTF) & '.rtf'
   end 

   if exists(SELF.FileNameRTF)
      remove(SELF.FileNameRTF)
   end

   ASCIIFile{PROP:NAME}=SELF.FileNameRTF
   create(ASCIIFile)
   open(ASCIIFile)
   if error()
      loc:err=2
      exit
   end

   loc:date=today()
   loc:clock=clock()

   arf:rec='{{\rtf1\ansi\deff0'
   add(ASCIIFile)
   arf:rec='{{\fonttbl{{\f0\fcharset204 Arial;}}'
   add(ASCIIFile)
   arf:rec='{{\colortbl \red0\green0\blue0;}'
   add(ASCIIFile)
   arf:rec='{{\info{{\title Форма}{{\author ФинСофт}' & |
           '{{\creatim\yr' & year(loc:date) & '\mo' & format(month(loc:date),@n02) & '\dy' & format(day(loc:date),@n02) & |
           '\hr' & sub(format(loc:clock,@t01),1,2) & '\min' & sub(format(loc:clock,@t01),4,2) & '}' & | 
           '{{\*\windowcaption Форма}}'
   add(ASCIIFile)
   if SELF.FlagLand=0
      loc:w = round(8252*1440/1000,1)
      loc:h = round(11688*1440/1000,1)-900
   else
      loc:h = round(8252*1440/1000,1)-900
      loc:w = round(11688*1440/1000,1)
   end 
   arf:rec='\paperw' & loc:w & '\paperh' & loc:h & '\margl0\margr0\margt0\margb0\sectd\psz256\viewkind1\viewscale100\viewzk0'
   add(ASCIIFile)

   loop loc:i=1 to records(SELF.PictRTF)
      get(SELF.PictRTF,loc:i)

      arf:rec='\par\pard\phmrg\pvmrg'
      !arf:rec='\pard\plain\phmrg\pvmrg'
      arf:rec=clip(arf:rec) & '\posx0\posy' & (loc:i-1)*loc:h & '\overlay{{{{\pict\wmetafile8\picwgoal' & loc:w & '\pichgoal' & loc:h
      add(ASCIIFile)

      loop loc:j=SELF.PictRTF.PictNumStart to SELF.PictRTF.PictNumEnd
         get(SELF.PictDetRTF,loc:j)
         arf:rec=SELF.PictDetRTF.PictDetStr
         add(ASCIIFile)
      end

      arf:rec='}}'
      add(ASCIIFile)

      if loc:i<records(SELF.PictRTF)
         arf:rec='\par\pard\plain'
         add(ASCIIFile)
         arf:rec='\par\page'
         add(ASCIIFile)
      end
   end

   arf:rec='\par }'
   add(ASCIIFile)
   close(ASCIIFile)

   free(SELF.PictRTF)
   free(SELF.PictDetRTF)