Bildgröße begrenzen

[Raimund]

Hi Entwickler,

hoffe auf Eure Hilfe.
Habe zwei Möglichkeiten für ein Import von Bildern.

1. Declare Function NEMGetFile Lib "nnotesws" ( wHandle As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String ) As Integer

'Declaration

Sub Click(Source As Button)
    'Declare variables...
     Dim workspace As New NotesUIWorkspace
     Dim uidoc As NotesUIDocument
     Dim szFileName As String*256
     Dim szTitle As String
     Dim szFilter As String
     
     Dim szSelectedFile As String
     
'Set values...
     
     szFilename = Chr(0)
     szTitle = "Open File"
     szFilter = "All Files |*.*|JEPG|*.jpg|GIF|*.gif|"  
     If NEMGetFile( 0, szFileName, szFilter, szTitle) <> 0 Then
           
           szSelectedFile = szFileName
           
           Set uidoc = workspace.CurrentDocument
           Call uidoc.GotoField( "Picture" )
           Call uidoc.Import("JPEG Image",szSelectedFile)
           
     End If
End Sub

2. @Command([EditGotoField]; "Bild");
@Command([FileImport])


Jetzt das Problem. Wie kann ich jetzt das Format begrenzen? Also z.B. max 150 x 200 pixel?


Vielen Dank

Gruß
Raimund

[eknori]

geht nicht; wenn doch, korrigiert mich.
Kannst du nur nachträglich über die Bildeigenschaften.

eknori

[Raimund]

Hi Enkori, Hi Entwickler,

habe noch ein Script für den Bilder-Import.
Es müsste doch hier die Möglichkeit geben, die Breite und Höhe abzufragen.

Vielleicht hat jemand von Euch eine Idee?


Sub Click(Source As Button)
     Dim session As New NotesSession
     Dim db As NotesDatabase
     Dim workspace As New NotesUIWorkspace
     Dim uidoc As NotesUIDocument
     Dim doc As NotesDocument
     Dim rtitem As NotesRichTextItem
     Dim object As NotesEmbeddedObject
     Dim filename As String
     Dim ImageType As String
     Dim ImageHeight As String
     Dim ImageWidth As String
     Dim ImageDepth As String
     
     ' Open a dialogbox and allow users to select from a list of files
     ' NB: PNG is missing from here as Notes can't import PNG image types.
     files = workspace.OpenFileDialog(True, "File List", "Supported Images|*.jpg;*.bmp;*.gif", "C:\")
     If Isempty(files) Then Exit Sub            ' Exit if the user selects the Cancel button
     Forall FileList In files                               ' Loop through the list of files selected
           Filename = Filelist                        ' Get the current filename
           ' GetImageProperties returns an array of ImageType, height, width and bit-depth
           imgProps = GetImageProperties(Filename)
           ImageType = imgProps(0)            ' Get the image type, BMP-GIF-JPEG-PNG
           ImageHeight = imgProps(1)      ' Get the image height
           ImageWidth = imgProps(2)      ' Get the image width
           ImageDepth = imgProps(3)      ' Get the image bit-depth
           
           ' Now, we will create a new document and attach the selected image to it.
           Set db = session.CurrentDatabase                                    ' Get the current database
           Set doc = New NotesDocument( db )                              ' Create a new Notes Doc
           Set rtitem = New NotesRichTextItem( doc, "Image" )      ' Create a new richtext item
           Set object = rtitem.EmbedObject       ( EMBED_ATTACHMENT, "", filename) ' Attach the file to it
           doc.Form = "ImageSize"                              ' Set the form name
           doc.HEIGHT = Cint(ImageHeight)                  ' Write the height
           doc.Width = Cint(ImageWidth)                  ' Write the width
           doc.colordepth = Cint(ImageDepth)            ' Write the colour depth
           doc.filesize = Filelen(filename)                  ' Write the filename
           Call doc.Save( True, True )                        ' Save the backend document
           ' Once we have attached the image, we can open the document in the front-end and
           ' import the same file so we have a preview version.
           Set uidoc = workspace.EditDocument( True, doc )      ' Open the backend doc in the UI
           Call uidoc.GotoField( "ImageView" )                                    ' Make the ImageView field the focus
           
           Select Case Imagetype                                                      ' Select which image type this file is
           Case "GIF":
                 Call uidoc.Import("GIF Image",filename)                        ' Import the GIF image into the field
                 Call uidoc.fieldsettext("ImageType", "GIF Image")      ' Set the Image type field
           Case "JPEG":
                 Call uidoc.Import("JPEG Image",filename)                  ' Import the JPEG image into the field
                 Call uidoc.fieldsettext("ImageType", "JPEG Image")      ' Set the Image type field
           Case "PNG":
                 ' NB: This will never happen as Notes doesn't import PNG files although it's there if we need it
                 Call uidoc.Import("PNG Image",filename)                  ' Import the PNG image into the field
                 Call uidoc.fieldsettext("ImageType", "PNG Image")      ' Set the Image type field
           Case "BMP":
                 Call uidoc.Import("BMP Image",filename)                  ' Import the BMP image into the field
                 Call uidoc.fieldsettext("ImageType", "BMP Image")      ' Set the Image type field
           End Select
           
           Call uidoc.FieldSetText("Filename", filename)      ' Set the filename field
           
           uidoc.CollapseAllSections      ' Collapse the preview section
           uidoc.save                              ' Save the UI Doc
           uidoc.close                              ' Close the UI Doc
     End Forall                  ' loop through any of the remaining files
End Sub


Gruß
Raimund

[eknori]

wenn du jetzt auch noch den Code für die Funktion

GetImageProperties

hast, könnte man sogar was damit anfangen  

[Raimund]

Hi Enkori,

sicher doch.

1. Declarations:

Const BUFFERSIZE = 32638
Const itUNKNOWN = 0
Const itGIF = 1
Const       itJPEG = 2
Const       itPNG = 3
Const       itBMP = 4

Dim ImageProps(3) As String

Dim m_Width As Long
Dim m_Height As Long
Dim m_Depth As Variant
Dim m_imagetype As Integer
Dim ImageType As String
Dim iFN As Integer
Dim lPos As Long
Dim MybBuf As Variant
Dim myByte As Variant
Dim bBuf() As Variant

2. Mult:

Private Function Mult(lsb As Variant, msb As Variant) As Long
     Mult = lsb + (msb * Clng(256))
End Function

3. GetImageProperties:

Function GetImageProperties(ImageFileName As String)
     filename = ImageFileName
     
    ' Set all properties to default values
     m_Width = 0
     m_Height = 0
     m_Depth = 0
     m_ImageType = itUNKNOWN
     
     ' Read the first 32k of the image file into a buffer
     ' NB - this is a LotusScript limitation and 32K may not be enough
     ' to read a JPEG's image data but it probably will.
     Redim bBuf(BUFFERSIZE)
     
     lpos = 0
     iFN = Freefile
     Open FileName For Binary As iFN
     idx = 0
     Do While Not Eof( iFN ) And idx < BUFFERSIZE
           bBuf(idx) = Asc(Inputb( 1 , ifn ))
           idx = idx + 1
     Loop
     Close iFn
     
     If bBuf(0) = 127 And bBuf(1) = 80 And bBuf(2) = 78 Then
           m_ImageType = itPNG                  ' this is a PNG file
           ImageType = "PNG"
           Select Case bBuf(25)                        ' get bit depth
           Case 0
                 m_Depth = bBuf(24)                  ' greyscale
           Case 2
                 m_Depth = bBuf(24) * 3            ' RGB encoded
           Case 3
                 m_Depth = 8                              ' Palette based, 8 bpp
           Case 4
                 m_Depth = bBuf(24) * 2            ' greyscale with alpha
           Case 6
                 m_Depth = bBuf(24) * 4             ' RGB encoded with alpha
            ' This value is outside of it's normal range, so we'll assume  that this is not a valid file
           Case Else                  
                 m_ImageType = itUNKNOWN
           End Select
           
           If m_ImageType Then                               ' if the image is valid then      
                 m_Width = Mult(bBuf(19), bBuf(18))  ' get the width
                 m_Height = Mult(bBuf(23), bBuf(22)) ' get the height
           End If
     End If
     
     If bBuf(0) = 71 And bBuf(1) = 73 And bBuf(2) = 70 Then    ' this is a GIF file
           m_ImageType = itGIF
           ImageType = "GIF"
           m_Width = Mult(bBuf(6), bBuf(7))            ' get the width
           m_Height = Mult(bBuf(8), bBuf(9))            ' get the height
           m_Depth = (bBuf(10) And 7) + 1                  ' get bit depth
     End If
     
     If bBuf(0) = 66 And bBuf(1) = 77 Then            ' this is a BMP file
           m_ImageType = itBMP
           ImageType = "BMP"
           m_Width = Mult(bBuf(18), bBuf(19))            ' get the width
           m_Height = Mult(bBuf(22), bBuf(23))            ' get the height
           m_Depth = bBuf(28)                                    ' get bit depth
     End If
     
     If m_ImageType = itUNKNOWN Then  ' if the file is not one of the above type then check to see if it is a JPEG file            
           Do
                   ' loop through looking for the byte sequence FF,D8,FF  which marks the begining of a JPEG file
                   ' lPos will be left at the postion of the start
                 If (bBuf(lPos) = &HFF And bBuf(lPos + 1) = &HD8 And bBuf(lPos + 2) = &HFF) _
                 Or (lPos >= BUFFERSIZE - 10) Then Exit Do
                      ' move our pointer up
                 lPos = lPos + 1      
           Loop
           
           lPos = lPos + 2
           If lPos >= BUFFERSIZE - 10 Then Exit Function
           Do
               ' loop through the markers until we find the one starting with FF,C0 which is the block containing the
               ' image information            
                 Do
                       ' loop until we find the beginning of the next marker
                       If bBuf(lPos) = &HFF And bBuf(lPos + 1) _
                       <> &HFF Then Exit Do
                       lPos = lPos + 1
                       If (lPos >= BUFFERSIZE - 10) Then Exit Function
                 Loop
                 ' move pointer up
                 lPos = lPos + 1
                 
                 Select Case bBuf(lPos)
                 Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF
                    ' we found the right block
                       Exit Do
                 End Select
                 
                 lPos = lPos + Mult(bBuf(lPos + 2), bBuf(lPos + 1))        ' otherwise keep looking
                 If lPos >= BUFFERSIZE - 10 Then Exit Function             'check for end of buffer
           Loop
           
         ' If we've gotten this far it is a JPEG and we are ready to grab the information.
           m_ImageType = itJPEG
           ImageType = "JPEG"
           m_Height = Mult(bBuf(lPos + 5), bBuf(lPos + 4))      ' get the height
           m_Width = Mult(bBuf(lPos + 7), bBuf(lPos + 6))      ' get the width
           m_Depth = bBuf(lPos + 8) * 8                                    ' get the color depth
     End If
     
     'GetImageProperties = ImageType+","+Cstr(m_height)+"," & Cstr(m_width)+"," & Cstr(m_depth)
     ImageProps(0) = ImageType
     ImageProps(1) = Cstr(m_height)
     ImageProps(2) = Cstr(m_width)
     ImageProps(3) = Cstr(m_depth)
     GetImageProperties = ImageProps
End Function


Gruß

Raimund

[eknori]

Hallo Raimund,

erstmal danke, aber das bringt nix, da man zwar wunderbar Höhe und Breite auslesen kann, die Eigenschaften können aber nicht GESETZT werden.

Hab eben noch was auf Notes.net gelesen.
Danach kann man das mit Irfan View lösen. Da gibt es wohl die Möglichkeit, über die Kommandozeile ein Bild in der Größe zu verändern.

werds mir mal in die ToDo Liste schreiben.

eknori

[Raimund]

Hi Enkori,

vielen Dank.
Würde mich freuen, wenn es die Möglichkeit geben würde.


Gruß
Raimund