store up to 8 images in a memo or character field

[Silvio.Falconi]

.

[Silvio.Falconi]

.

[karinha]

Buen día. No pude reproducir el problema. La función es muy buena.

Good Morning. I was unable to reproduce the problem. The function is very good.

Quizás, si crea un ejemplo completo y crea un .ZIP y lo publica en MegaUpload(), será posible reproducir la falla.

Perhaps, if you create a complete example and create a .ZIP and post it to MegaUpload() it will be possible to reproduce the failure.

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
#include "constant.ch"

#define DLGCOLOR1  nRgb(240,249,255)
#define DLGCOLOR2  nRgb( 250,250,245)
#define DLGCOLOR3  nRgb( 245,245,235)
#define DLGCOLOR4  nRgb( 255,255,250) // bordo

FUNCTION Scheda_Tecnica()

   LOCAL oDlg

   LOCAL oImageBig
   LOCAL oImage := Array( 8 )
   LOCAL aImage := { "", "", "", "", "", "", "", "" }
   LOCAL oBtnsel := Array( 3 )
   LOCAL nHeight := 580
   LOCAL cImgPath  := ".\images\"    // Folder
   LOCAL cDefault_Image := cImgPath + "noImages.png"
   LOCAL cDefault_ImageMini := cImgPath + "defamini.png"
   LOCAL cImmagine := ""
   LOCAL osay, cImgUrl, cFile, n
   LOCAL oCursorBtn := TCursor():New(, 'HAND' )
   LOCAL nRow := 220
   LOCAL nCol := 500
   LOCAL aLines := hb_ATokens( MemoRead( "images.txt" ), CRLF )// only  for demo  then memo field

   FOR n = 1 TO Len( aLines )
      aImage[ n ] := AllTrim( aLines[ n ] )
   NEXT

   // xbrowser aImage
   cImmagine := iif( Empty( aImage[ 1 ] ), cDefault_Image, aImage[ 1 ]  )
   cImgUrl := UrlImage( cImmagine )

   DEFINE DIALOG oDlg SIZE 820, nHeight PIXEL TRUEPIXEL ;
      COLOR CLR_BLACK, DLGCOLOR3 TITLE "One images with 8 small images"

   oDlg:lHelpIcon := .F.

   @ 30, 500 XIMAGE oImageBig ;
      FILENAME IF( Empty( cImmagine ), cDefault_Image, cImmagine  );// NOBORDER ;
      SIZE 265, 150 ;
      OF oDlg ;
      UPDATE

   oImageBig:bRClicked  := {|| NIL }
   oImageBig:ltransparent := .T.
   oImageBig:nUserControl := 0

   @ 185, 500 SAY oSay PROMPT cImgUrl SIZE 265, 24 PIXEL OF oDlg;
      COLOR nRgb( 245, 244, 234 ), nRgb( 218, 214, 179 ) ;
      CENTER

   @ 30, 770 BTNBMP oBtnSel[ 1 ] FLAT  SIZE 30, 24  OF oDlg PIXEL ;
      COLOR  nRgb( 238, 236, 219 ), nRgb( 238, 236, 219 ) ;
      BITMAP ".\bitmaps\carica.bmp" NOROUND;
      TOOLTIP "Load" ;
      ACTION  ( cFile := GetImage( oImageBig ), ;
      oImageBig:setsource( cFile ) )

   @ 60, 770 BTNBMP oBtnSel[ 2 ] FLAT SIZE 30, 24 OF oDlg PIXEL ;
      COLOR  nRgb( 238, 236, 219 ), nRgb( 238, 236, 219 )       ;
      RESOURCE ".\bitmaps\svuota.bmp" NOROUND                   ;
      TOOLTIP "Del" ;
      ACTION DelImmagine( oImage, oSay, oImageBig, aImage, cDefault_Image, cDefault_ImageMini )

   @ 90, 770 BTNBMP oBtnSel[ 3 ] FLAT SIZE 30, 24 OF oDlg PIXEL ;
      COLOR  nRgb( 238, 236, 219 ), nRgb( 238, 236, 219 )       ;
      RESOURCE ".\bitmaps\zoom.bmp" NOROUND                     ;
      TOOLTIP "zoom" ;
      ACTION Zoom_Image( oImageBig:usource )

   FOR n = 1 TO 3

      oBtnSel[ n ]:bClrGrad = {| lInvert | If( ! lInvert, ;
         { { 0.25, DLGCOLOR3, DLGCOLOR2 }, ;
         { 0.75, DLGCOLOR3, DLGCOLOR1 } }, ;
         { { 0.25, DLGCOLOR2, DLGCOLOR1 }, ;
         { 0.75, DLGCOLOR1, DLGCOLOR2 } } ) }

      oBtnSel[ n ]:nClrBorder := nRgb( 238, 236, 219 )
      oBtnSel[ n ]:oCursor :=   oCursorBtn

   NEXT

   // small Images
   FOR n = 1 TO 8

      Create_SmallImages( nRow, nCol, n, oImage, @aImage, cDefault_Image, cDefault_ImageMini, oDlg, oImageBig, oSay, oCursorBtn )

      nCol += 75

      IF n = 4
         nRow := 280
         nCol := 500
      ENDIF

      IF n = 8
         EXIT
      ENDIF

   NEXT

   ACTIVATE DIALOG oDlg CENTERED

RETURN NIL

STATIC FUNCTION TakeImages( oImageNum, oSay, oImageBig, aImage, cDefault_Image, cDefault_ImageMini, num )

   LOCAL cImgUrl
   LOCAL nPos
   LOCAL cFile := GetImage()

   // ? cFile

   xbrowser aImage

   // check if there is
   nPos := AScan( aImage, {| x | x =  LTrim( cFile ) } )

   IF nPos > 0

      IF msgYesNo( "Image found in archive, you want to replace it ?", ;
                   "Select an Option" )

         oImageBig:setsource( cFile )
         cImgUrl := UrlImage( cFile )

         oSay:settext( cImgUrl )

         aImage[ nPos ] := cFile

      ELSE

         oImageBig:setsource( cDefault_Image )
         oImageNum:setsource( cDefault_ImageMini )

         oSay:settext( "" )

      ENDIF

   ELSE

      aImage[ num ] := cFile
      oImageBig:setsource( cFile )
      cImgUrl := UrlImage( cFile )
      oSay:settext( cImgUrl )
      oImageNum:setsource( cFile )

   ENDIF

   oImageBig:refresh()
   oImageNum:refresh()

RETURN aImage

STATIC FUNCTION DelImmagine( oImage, oSay, oImageBig, aImage, cDefault_Image, ;
                             cDefault_ImageMini )

   LOCAL nPos
   LOCAL cFile := oImageBig:uSource

   // check if there is
   nPos := AScan( aImage, {| x | x =  cFile } )
   IF nPos > 0

      IF msgYesNo( "I must delete this image ?", "Select an option" )

         ADel( aImage, nPos )

         oImageBig:setsource( cDefault_Image )
         oImage[ nPos ]:setsource( cDefault_ImageMini )

      ENDIF

   ENDIF

RETURN NIL

STATIC FUNCTION ShowImages( oImageNum, oSay, oImageBig )

   LOCAL  cImmagine := ( oImageNum:uSource )
   LOCAL cImgUrl

   oImageBig:setsource( cImmagine )
   cImgUrl := UrlImage( cImmagine )

   oSay:settext( cImgUrl )

RETURN NIL

FUNCTION UrlImage( curlImg )

   LOCAL aTmp
   LOCAL nLevel := 1
   LOCAL x
   LOCAL cCad   := ""

   aTmp := hb_ATokens( curlImg, "\" )

   FOR x = Len( aTmp ) - nLevel + 1 TO Len( aTmp )

      cCad += AllTrim( aTmp[ x ] )

      IF x < Len( aTmp )

         cCad  += "\"

      ENDIF

   NEXT x

RETURN cCad

FUNCTION GetImage()

   LOCAL gcFile := cGetFile( "Bitmap (*.bmp)| *.bmp|" +         ;
                             "DIB   (*.dib)| *.dib|" +          ;
                             "PCX   (*.pcx)| *.pcx|"  +         ;
                             "JPEG  (*.jpg)| *.jpg|" +          ;
                             "GIF   (*.gif)| *.gif|"  +         ;
                             "TARGA (*.tga)| *.tga|" +          ;
                             "RLE   (*.rle)| *.rle|" +          ;
                             "All Files (*.*)| *.*"             ;
                           , "Please select a image file", 4 )

   IF .NOT. Empty( gcFile ) .AND. File( gcFile )

      // oImage:setsource( gcFile )

   ENDIF

RETURN gcFile

STATIC FUNCTION Create_SmallImages( nRow, nCol, n, oImage, aImage, cDefault_Image, cDefault_ImageMini, oDlg, oImageBig, oSay, oCursorBtn )

   @ nRow, nCol XIMAGE oImage[ n ] ;
      FILENAME IF( Empty( aImage[ n ] ), cDefault_ImageMini, aImage[ n ]  );// NOBORDER ;
      SIZE 50, 50 ;
      OF oDlg ;
      UPDATE

   oImage[ n ]:bRClicked  := {|| NIL  }
   oImage[ n ]:bLClicked  := {|| iif( Empty( oImage[ n ]:uSource ) .OR. oImage[ n ]:uSource == cDefault_ImageMini, ;
      TakeImages( oImage[ n ], oSay, oImageBig, @aImage, cDefault_Image, cDefault_ImageMini, n ), ;
      ShowImages( oImage[ n ], oSay, oImageBig ) ) }

   oImage[ n ]:ltransparent := .T.
   oImage[ n ]:nUserControl := 0

   oImage[ n ]:ocursor := oCursorBtn

RETURN NIL

FUNCTION Zoom_Image( cFile )

   LOCAL oDlgZoom, oImageZoom, oFont
   LOCAL oBtnClose
   LOCAL nBottom   := 24
   LOCAL nRight    := 90
   LOCAL nWidth    := Max( nRight * DLG_CHARPIX_W, 180 )
   LOCAL nHeight   := nBottom * DLG_CHARPIX_H

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 10

   DEFINE DIALOG oDlgZoom SIZE  nWidth, nHeight  ;
      PIXEL TRUEPIXEL FONT oFont TiTle "Zoom Image"

   @ 0, 0 XIMAGE oImageZoom ;
      FILENAME cFile;// NOBORDER ;
      SIZE oDlgZoom:nWidth - 20, oDlgZoom:nBottom - 60 ;
      OF oDlgZoom ;
      UPDATE

   oImageZoom:bRClicked  := {|| NIL }
   oImageZoom:ltransparent := .T.
   oImageZoom:nUserControl := 0

   oImageZoom:FitWidth()
   oImageZoom:FitHeight()

   @ 100, 10 BTNBMP oBtnClose PROMPT  "Close" of oDlgZoom ;
      SIZE 80, 22 FLAT NOROUND;
      ACTION  oDlgZoom:End()

   oDlgZoom:bResized := < ||
   LOCAL oRect := oDlgZoom:GetCliRect()
   oBtnClose:nTop  := oRect:nBottom - 50
   oBtnClose:nLeft := oRect:nRight  - 100

   RETURN NIL
   >

   ACTIVATE DIALOG oDlgZoom CENTERED;
      ON INIT Eval( oDlgZoom:bResized )

RETURN NIL

// FIN / END

Regards, saludos.

[Marc Venken]

Silvio,

You can consider a dialog with a xImage and a Xbrowse. I think it is less code with xbrowse options.