Das Notes Forum
Domino 9 und frühere Versionen => Entwicklung => Thema gestartet von: Raimund am 03.07.02 - 12:17:19
-
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
-
geht nicht; wenn doch, korrigiert mich.
Kannst du nur nachträglich über die Bildeigenschaften.
eknori
-
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
-
wenn du jetzt auch noch den Code für die Funktion
GetImageProperties
hast, könnte man sogar was damit anfangen ;D ;D
-
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
-
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
-
Hi Enkori,
vielen Dank.
Würde mich freuen, wenn es die Möglichkeit geben würde.
Gruß
Raimund