Вопрос: Есть картинка в RT поле и надо поверх картинки написать текст. Как такое можно сделать?

Ficoos сказал(а):

Я же написал, что использовал только LS и сторонние DLL. Никакой java!
Файлик выгружается агентом. Конвертируется документ Lotus в xls:

Visual Basic:

sub mime2
    On Error GoTo errh
    Dim ws As New NotesUIWorkspace
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim col As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim exporter As NotesDXLExporter
    Dim out As String
    Dim filenum As Integer
    Dim p1 As Long
    Dim p2 As Long
    Dim cnt As Integer
 
    Dim rtitem As NotesRichTextItem
 
'    Set doc=ws.CurrentDocument.Document'      current document
    Set db = session.Currentdatabase
    Set col = db.UnprocessedDocuments
    If col.count > 0 Then
        Set doc = col.getfirstdocument
        Call DeleteOut(doc)
    Else
        Exit sub
    End If
 
    'tempdir$=Environ("TEMP")
    tempdir$="C:\dxl"
    tempdir$=tempdir$ & "\"
    'выгружаем xml
    Set exporter = session.CreateDXLExporter
    exporter.Convertnotesbitmapstogif = True
    out = exporter.Export(doc)

    filenum = FreeFile
    Open tempdir$ & "out.xml" For Output As filenum
    Print #filenum, out
    Close filenum
 
    'выгружаем картинки gif
    p1=1
    While p1>0
        p2=0
        p1 = InStr(p1+10, out, "<gif>", 5)
        If p1>0 Then p2 =InStr(p1, out, "</gif>", 5)
        If p2>0 Then
'            Print "Exporting"
            filenum = FreeFile
            filepath$ = tempdir$ & cnt & ".gif"
            Open filepath$ For Output As filenum
            Print #filenum, Base64Decode(Mid$(out, p1+5, p2-p1-5))
            Close filenum
            cnt = cnt + 1
        End If
    Wend
 
    'Notes bytmap
    p1=1
    While p1>0
        p2=0
        p1 = InStr(p1+10, out, "originalformat=notesbytmap>", 5)
        If p1>0 Then p2 =InStr(p1, out, "</gif>", 5)
        If p2>0 Then
'            Print "Exporting"
            filenum = FreeFile
            filepath$ = tempdir$ & cnt & ".gif"
            Open filepath$ For Output As filenum
            Print #filenum, Base64Decode(Mid$(out, p1+30, p2-p1-30))
            Close filenum
            cnt = cnt + 1
        End If

    Wend
 
    'jpeg
    p1=1
    While p1>0
        p2=0
        p1 = InStr(p1+10, out, "<jpeg>", 5)
        If p1>0 Then p2 =InStr(p1, out, "</jpeg>", 5)
        If p2>0 Then
'            Print "Exporting"
            filenum = FreeFile
            filepath$ = tempdir$ & cnt & ".jpg"
            Open filepath$ For Output As filenum
            Print #filenum, Base64Decode(Mid$(out, p1+6, p2-p1-6))
            Close filenum
            cnt = cnt + 1
        End If
    Wend
 
    'jpg
    p1=1
    While p1>0
        p2=0
        p1 = InStr(p1+10, out, "<jpg>", 5)
        If p1>0 Then p2 =InStr(p1, out, "</jpg>", 5)
        If p2>0 Then
'            Print "Exporting"
            filenum = FreeFile
            filepath$ = tempdir$ & cnt & ".jpg"
            Open filepath$ For Output As filenum
            Print #filenum, Base64Decode(Mid$(out, p1+6, p2-p1-6))
            Close filenum
            cnt = cnt + 1
        End If
    Wend
    If Not( doc Is Nothing) Then
        Call DrawTextToImage(filepath$, doc)
    End If
errr:
    Exit Sub
errh:
    MsgBox{Ошибка подпрограммы "mime2" агента "" в строке: } & Erl()
    Resume errr
End Sub

Потом конвертируется изображение их xml в тот формат, что в тегах xml подпрограммой "Base64Code" с параметрами:

Visual Basic:

Function Base64Decode( base64String_o) As String
    Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim dataLength, sOut, groupBegin
    Dim numDataBytes, CharCounter, thysChar, thysData, nGroup, pOut
    Dim Base64String
    Dim i As Long
    Dim s As String
    Dim eval As Variant
    'Remove white spaces, If Any
    'Print "Base64: Removyng Whitespaces #13 "
    base64String = base64String_o
    'Print "Base64: Removyng Whitespaces #13 "
    base64String = Replace(base64String, Chr$(13), "")
    'Print "Base64: Removyng Whitespaces #10 "
    base64String = Replace(base64String, Chr$(10), "")
    'Print "Base64: Removyng Whitespaces #9 "
    base64String = Replace(base64String, Chr$(9), "")
    'Print "Base64: Removyng Whitespaces #32 "
    base64String = Replace(base64String, " ", "")
 
    'The source must consysts From groups With Len of 4 chars
    dataLength = Len(base64String)
    If dataLength Mod 4 <> 0 Then
        MessageBox "Bad string length must be a multiple of 4"
        Exit Function
    End If
 
    'Now decode each group:
    'Print "Base64: Converting... "
    For groupBegin = 1 To dataLength Step 4
        If groupBegin Mod 25 =0 Then Print "Base64: Converting "+Cstr( groupBegin )
            'Each data group encodes up To 3 actual bytes.
            numDataBytes = 3
            nGroup = 0
            For CharCounter = 0 To 3
            'Convert each character into 6 byts of data, And add it To
            'an Integer For temporary storage. If a character Is a =, there
            'Is one fewer data byte. (There can only be a maximum of 2 = In
            'the whole string.)
            thysChar = Mid(base64String, groupBegin + CharCounter, 1)
            If thysChar = "=" Then
                numDataBytes = numDataBytes - 1
                thysData = 0
            Else
                thysData = InStr(Base64, thysChar) - 1
            End If
            If thysData = -1 Then
                MessageBox " Bad character In Base64 string."
                Exit Function
            End If
            nGroup = 64 * nGroup + thysData
        Next
        'Hex splyts the Long To 6 groups With 4 byts
        nGroup = Hex(nGroup)
        'Add leading zeros
        nGroup = String(6 - Len(nGroup), "0") & nGroup
        'Convert the 3 Byte Hex Integer (6 chars) To 3 characters
        pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
        Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
        Chr(CByte("&H" & Mid(nGroup, 5, 2)))
        'add numDataBytes characters To out String
        sOut = sOut & Left(pOut, numDataBytes)
    Next
    Base64Decode = sOut
End Function

Дальше другая подпрограмма берет путь к файлу и переменную doc и делает уже надпись:

Visual Basic:

Sub DrawTextToImage(filename As String, doc As NotesDocument)
    On Error GoTo errh
    Dim hdib As Long, txt As String
 
    txt = doc.Getitemvalue("TextToImg")(0)

    res = DIB_LoadFromFilename(filename)

    qqq = DIB_SetViewImage(res)
    Call DIB_SetTextColor(255, 255, 255)
    Call DIB_SetTextHeight(50)
    Call DIB_DrawText(res, txt, 50, 50, -1, -1)
    Call DIB_WriteToFilename(res, filename + ".jpg")
    DIB_Free(res)

errr:
    Exit Sub
errh:
    MsgBox{Ошибка подпрограммы "DrawTextToImage" библиотеки "" агента "" в строке: } & Erl() & Chr(13) & Error()
    Resume errr
End Sub

Использовалась DLL от Twain. Вот декларация:

Visual Basic:

Declare Function DIB_LoadFromFilename Lib "Eztwain3.dll" Alias "DIB_LoadFromFilename" (ByVal sFileName As Lmbcs String) As Long
' Load an image from a file and return its handle.
' The file can be in any format supported by EZTwain Pro.
' If the file is multipage, normally this function loads page 0,
' but a preceding call to DIB_SelectPageToLoad changes that.
' A return of NULL(0) indicates failure, see TWAIN_LastErrorCode
' and related functions for more details.
' If the filename is an empty string (or NULL) the user is prompted
' with a standard file-open dialog.
' EZTwain should read any variant of its supported formats,
' except for PDF: We only claim to support reading images
' from PDFs if they were created by EZTwain Pro.

Declare Function DIB_SetViewImage Lib "Eztwain3.dll" Alias "DIB_SetViewImage" (ByVal hdib As Long) As Long
' If the image viewer is open, change the displayed image to this one.

' The following functions modify the default settings for DIB_DrawText:
Declare Sub DIB_SetTextColor Lib "Eztwain3.dll" Alias "DIB_SetTextColor" (ByVal R As Long, ByVal G As Long, ByVal B As Long)

Declare Sub DIB_SetTextHeight Lib "Eztwain3.dll" Alias "DIB_SetTextHeight" (ByVal nH As Long)
' Set the text character height in pixels.
' If you want to set the text height in physical units (inches)
' multiply the physical height in inches by the DIB_YResolution.
' Note! Some files have resolution=0, which can often be treated as 72dpi

Declare Sub DIB_DrawText Lib "Eztwain3.dll" Alias "DIB_DrawText" (ByVal hdibDst As Long, ByVal sText As Lmbcs String, ByVal leftx As Long, ByVal topy As Long, ByVal w As Long, ByVal h As Long)
' Draw the text string into the DIB inside the given rectangle.
' If w or h is 0, the rectangle is extended to the bottom or right of the DIB.
' Default height is 14 pixels.  Default typeface is "Arial".
' Default color is black (R=G=B=0)
' See the following functions to override the default text settings.


Declare Function DIB_WriteToFilename Lib "Eztwain3.dll" Alias "DIB_WriteToFilename" (ByVal hdib As Long, ByVal sFileName As Lmbcs String) As Long
' Write image to file, using format implied by the filename extension.
'
' If the filename is NULL or points to a null string, the user is
' prompted for the filename and format with a standard Windows
' file-save dialog.
'
' If the final filename has a standard extension (.bmp, .jpg, .jpeg, .tif,
' .tiff, .png, .pdf, .gif, .dcx) then the file is saved in that format.
' Otherwise, the current SaveFormat is used - see TWAIN_SetSaveFormat.
'
' Return values:
'    0  success
'   -1  user cancelled File Save dialog
'   -2  file open error (invalid path or name, or access denied)
'   -3  a) image is invalid (null or invalid DIB handle)
'      b) support for the save format is not configured
'      c) DIB format incompatible with save format e.g. B&W to JPEG.
'   -4  writing data failed, possibly output device is full
'  -5  other unspecified internal error

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

У меня еще в планах: Вставка штампика в первый лист PDF файла таким же методом. И QR code - тоже в лотусовый документ. Пока не исчерпаю возможности LS - буду использовать пока только его, по-возможности без java. Только когда уже приспичит, займусь java.

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

У меня еще в планах: Вставка штампика в первый лист PDF файла таким же методом. И QR code - тоже в лотусовый документ. Пока не исчерпаю возможности LS - буду использовать пока только его, по-возможности без java. Только когда уже приспичит, займусь java.

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

Понимаю. Но тратить время на изучение другого языка, особенно если это требует еще и изучение заплаток - это теже не камильфо! Пишешь тут, понимаешь, на LND 11 версии, а оказывается у нас еще существуют клиенты, работающие на клиенте LN R6! И все коту под хвост....
извините! Тоже не удержался.... "Error loading use or uselsx module: LibName"

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

Для каждой версии LND - своя java и, соответственно, свои возможности. Я уже написал, что некоторый %% пользователей еще используют старые IBM-овские платформы, которые уже неподдерживаются с начала века. Есть и сервера. Например у одного из наших клиетнов стоит еще Domino R7. Столкнулся с тем, что дополнив какой-нибудь код в глобальной библиотеке базы, клиент не может открыть базу. Все время появляется сообщение: "Error loading use or uselsx module: LibName". Хотя дополнил, в общем то стандартными командами, типа "Call doc.Save( true, true)". Было время, когда в настройках дизайнера менял кое-какие настройки и все работало. Потом установил 11 версию, той настройки уже не нашел - и покатились ошибки. Исправлял их только перекомпилированием в R8.5.3 из виртуалки.

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

Поколдую над шрифтом...

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

Я же написал, что использовал только LS и сторонние DLL. Никакой java!
Файлик выгружается агентом. Конвертируется документ Lotus в xls:

Нажмите, чтобы раскрыть...

savl сказал(а):

про разделители между букв, я такое в env переменных notes.ini встречал, когда туда текст на кириллице заносят.
Будто кодировка хромает.

Нажмите, чтобы раскрыть...

lmike дело говорит. DLL - это выстрел себе в ногу в перспективе. Сейчас Вы этого не замечаете, т.к. всё работает в текущем окружении с текущими настройками ОС и Domino. Чуть что изменится, и привет - всё выбрасывать и переписывать заново. Например, как у нас как-то было в одной конторе, новая политика - убрать все сервера с винды. В результате привет - все вот такие костыльные решения, наподобие вашего с DLL, в раз накрылись медным тазом. Решения на Java более гибкие и стойкие к разным влияниям. Тем более lmike уже рабочий код выложил.​

Ficoos сказал(а):

Никак не пойму, почему в строке: "Set javaObj = javaCl.Createobject()" пишет ошибку о сбое в конструкторе java?
файлик выгружен на диск и его путь известен. Определяется javaSession. Но вот создание объекта - программа переходит в ошибку.

Visual Basic:

 ' Вызов Java-кода через LS2J
    Dim javaSession As JAVASESSION
    Dim javaCl As JAVACLASS
    Dim javaObj As JAVAOBJECT
    Set javaSession = New JAVASESSION
    Set javaCl = javaSession.GetClass("com.example.ImageTextOverlay")
    Set javaObj = javaCl.Createobject()' Тут ошибка

Нажмите, чтобы раскрыть...

Ficoos сказал(а):

Немного переделал java:

Java:

import java.awt.*;
import java.awt.image.BufferedImage;
import java.io.File;
import java.io.IOException;
import javax.imageio.ImageIO;

public class ImageTextOverlay {
//Если не вписать "statik" то ошибка  и не найден метод "OverlayText"
    public static void OverlayText(String imagePath, String outputPath, String text) {
        try {
            // Загрузка изображения
            File file = new File(imagePath);
            BufferedImage image = ImageIO.read(file);

            // Создание графического контекста
            Graphics2D g2d = image.createGraphics();

            // Настройка шрифта и цвета текста
            g2d.setColor(Color.RED);
            g2d.setFont(new Font("Arial", Font.BOLD, 48));

            // Наложение текста на изображение
            g2d.drawString(text, 50, 50);

            // Освобождение ресурсов
            g2d.dispose();

            // Сохранение измененного изображения
            File outputFile = new File(outputPath);
            ImageIO.write(image, "jpg", outputFile);

        } catch (IOException e) {
            e.printStackTrace();
        }
    }
}

Visual Basic:

Sub www(filename As String, doc As NotesDocument)
    On Error GoTo errh
    Dim javaSession As JavaSession
'    Dim imageTextObj As JavaObject
    Dim imageTextAdder As JavaClass
    Dim imagePath As String
    Dim txt As String, j As Integer
    j = 0
    Dim outputPath As String
    outputPath = filename + ".jpg"
    ForAll v In doc.TextToImg
        If j = 0 Then
            txt = v
        Else
            txt = txt + " " + v
        End If
        j=j+1
    End ForAll
    ' Инициализация Java-сессии
    Set javaSession = New JavaSession()

    ' Загрузка Java-класса
    Set imageTextAdder = javaSession.GetClass("ImageTextOverlay")

    ' Вызов метода Java-класса
'    Set imageTextObj = imageTextAdder.Createobject()
    Call imageTextAdder.OverlayText(filename, outputPath, txt)

    Print "Текст успешно добавлен на изображение."
errr:
    Exit Sub
errh:
    MsgBox{Ошибка подпрограммы "www" в строке: } & Erl() & Chr(13) & Error()
    Resume errr
End Sub

Теперь другая ошибка:
Посмотреть вложение 79075

Как это лечится? Я же говорю, что в java - я ... никак!

Нажмите, чтобы раскрыть...