emotta

gera um nome de arquivo temporario, mas a extensao deve ser a mesma da figura original gravada. Edite o tópico e coloque como RESOLVIDO para que este nao seja mais respondido. abraço,

nao consegue porque nao dá. Vc deve gerar um arquivo e exibir a partir do arquivo.

Para visualizar a imagem depois: cLogo := Hex2Str(AllTrim(EMPRESA->LOGOMARCA)) nH := fCreate("imagem_temp.jpg") fWrite(nH,cLogo) fClose(nH) // pronto, imagem criada.

que preguiça hein meu amigo... segue o código: T_LOGO_EMP := MemoRead("IMAGEM.JPG") T_LOGO_EMP := Str2Hex(T_LOGO_EMP) ///=============================================================================/// Grava o Cadastro de EMPRESA///=============================================================================FUNCTION GRAVA_EMPRESA() DBSELECTAREA( "EMPRESA" ) IF T_OPERACAO_EMPRESA == "I" EMPRESA->(SqlFilter( "" )) DBSELECTAREA( "EMPRESA" ) EMPRESA->( OrdSetFocus( 01 ) ) DBGOBOTTOM() T_CODIGO := EMPRESA->CODIGO + 1 APPEND BLANK ENDIF IF T_CODIGO != 0 RLOCK() REPLACE EMPRESA->CODIGO WITH T_CODIGO REPLACE EMPRESA->NOMEMP WITH T_NOME REPLACE EMPRESA->ENDEMP WITH T_ENDERECO REPLACE EMPRESA->NUMERO WITH T_NUMERO REPLACE EMPRESA->BAIEMP WITH T_BAIRRO REPLACE EMPRESA->CEPEMP WITH T_CEP REPLACE EMPRESA->CIDEMP WITH T_CIDADE REPLACE EMPRESA->ESTEMP WITH T_ESTADO REPLACE EMPRESA->FONEMP WITH T_TEFONE REPLACE EMPRESA->FAXEMP WITH T_FAX REPLACE EMPRESA->CGCEMP WITH T_CNPJ REPLACE EMPRESA->INSEMP WITH T_INSCRICAO REPLACE EMPRESA->OBS_01 WITH T_OBSERVACAO REPLACE EMPRESA->SEM_SALDO WITH T_VDE_SEM_SALDO REPLACE EMPRESA->JURO_MES WITH T_JUROS REPLACE EMPRESA->E_MAIL WITH T_EMAIL_ REPLACE EMPRESA->FANTASIA WITH T_FANTASIA REPLACE EMPRESA->ATIVIDADE WITH VAL(SUBSTR(T_ATIVIDADE,01,02)) REPLACE EMPRESA->OBS_OS WITH T_EMP_OBS_OS REPLACE EMPRESA->CONTATO WITH T_RESPONSAVEL REPLACE EMPRESA->SER_ECF WITH T_NUM_SERECF REPLACE EMPRESA->PZ_GARANT WITH T_GRANTIA_OS REPLACE EMPRESA->PG_COM WITH SUBSTR(T_PAG_COMISSAO,01,01) REPLACE EMPRESA->SEM_SALDO WITH SUBSTR(T_VDE_SEM_SALDO,01,01)Sei que está errado, mas teria como Exemplificar no meu código... REPLACE EMPRESA->LOGOMARCA WITH T_LOGO_EMP UNLOCK COMMIT ELSE MsgStop( "Não é Possível Gravar com Código Zerado ! " + chr(13) +; " ","...:: Erro ::...") ENDIF T_OPERACAO_EMPRESA := "A"RETURN .T.

Qual o tipo do campo que voce está gravando? Poste seu codigo novamente. Editado por - emotta on 13/07/2008 23:02:12

a versao do seu (x)harbour deve estar desatualizada. Use as do fivewin mesmo: cStrHex := Str2Hex(cStr) e Hex2Str(cStrHex) qualquer duvida veja no samples do fivewin o exemplo de uso no fonte testhex2.prg

tente converter para hexadecimal e gravar normalmente em um campo. Eu faço uso com templates de digitais de biometria. Exemplo: cImagem := Memoread("imagem.jpg") cImgGrv := StrToHex(cImagem) // aqui vc pode colocar o comando para gravar, usando replace mesmo em um campo MEMO Para restaurar: cImagem := HexToStr(TABELA->CAMPO) Abraço, Eduardo Motta (as funcoes HexToStr() e StrToHex() são do (x)Harbour)

nao consegui baixar.

Rochinha, vou baixar sua biblioteca e tentar fazer uma RDD dela usando a USRRDD. Qualquer novidade lhe aviso. Eduardo Motta

O problema é que se compilar o exemplo pelo xBuild setando a opcao MULTITHREAD ele da GPF. Alguem sabe o motivo?

faça assim: Function FileMov(cArqOri,cArqDest) Return fRename(cArqOri,cArqDest) MAS CUIDADO, PORQUE filemove é nativa do xharbour, veja o HELP do xHarbour comercial: FileMove() Moves a file to another directory. Syntax FileMove( , ) --> nErrorCode Arguments This is a character string holding the name of the file to move. It must include path and file extension. The path can be omitted from when the file resides in the current directory. This is a character string with the new file name including file extension. Drive and/or path are optional. Return The function returns zero on success or a numeric error code on failure. Description The function moves to a file specified with . The target file must be on the same drive as the source file. EM TODO CASO, VOCE PODE CRIAR UMA, COMO ABAIXO:

nao está.

Uso o xHarbour comercial. Ao compilar pelo xBuild da erro. Verifiquei e esta faltando o seguinte arquivo: grfingerhb.h Alguem pode me enviar? Obrigado Eduardo Motta emotta@gmail.com.br eduardo@emotta.com.br gabriel@emotta.com.br

EU USO ESTE FONTE NA COMERCIAL E FUNCIONANDO BEM. #include "Fivewin.ch" #include "image.ch" Static cWebCamDriver := "Microsoft WDM Image Capture" Static _oWebcam_ := nil Static hDllW ************************************************************************ * ************************************************************************ Function fFotografia(x) Local oWnd, oMenu, oImg Local oWC,oBtn Local cPath := ALLTRIM(CURDRIVE())+":\"+CURDIR()+'\Tempo\' DEFAULT x := "NADA" IF x=="NADA" .OR. x!="GsT" RETURN '' ENDIF hDLLW := LoadLibrary("avicap32.dll") oWC:=tWebCamPhoto():New() IF oWC = NIL FreeLibrary( hDLLW ) RETURN '' ENDIF /* MENU oMenu MENUITEM "Cámara" MENU MENUITEM "Conectar" ACTION oWC:Connect() MENUITEM "Desconectar" ACTION oWC:Disconnect() SEPARATOR MENUITEM "Fuente" ACTION oWC:Source() MENUITEM "Formato" ACTION oWC:Format() ENDMENU MENUITEM "Capturar" MENU MENUITEM "Clipboard" ACTION oWC:Clipboard(oImg) SEPARATOR MENUITEM "BMP" ACTION oWC:Save(oImg,'webcam32.bmp') MENUITEM "JPG" ACTION oWC:Save(oImg,'webcam32.jpg',80) ENDMENU MENUITEM "Salir" ACTION (oWC:End(), oWnd:End()) ENDMENU */ DEFINE WINDOW oWnd FROM 0,0 TO 30,80 MENU oMenu TITLE "CAPTURA DE FOTOGRAFIA" @ 60,400 IMAGE oImg OF oWnd SIZE 160,120 PIXEL ADJUST oImg:nProgress:=0 @ 01,12 BUTTON oBtn PROMPT "Tomar foto" OF oWnd SIZE 70,35 ; ACTION ( oWC:Save(oImg,'tmp.jpg',80),oWnd:End(),(IF(FILE(cPath+"caced.gst"),FERASE(cPath+"caced.gst"),.t.)), ; FILEMOVE("tmp.jpg",cPath+"caced.gst") ) ACTIVATE WINDOW oWnd MAXIMIZED ON INIT; ( oWnd:Center(),oWC:CreateWnd(oWnd,60,20,320,240),oWC:Connect() ) * ( oWnd:Center(),oWC:CreateWnd(oWnd,60,10,320,240),oWC:Connect(),MSGALERT((oWnd:nHeight-3)) ) FreeLibrary( hDLLW ) return cPath+"caced.gst" /********************************************************** * * * Clase tWebCamPhoto (Sólo para FWH) * Objetivo: Capturar fotos con una Webcam * * César E. Lozada, cesarlozada@hotmail.com * Los Teques, Venezuela - 22/06/2003 * * ***********************************************************/ #define WM_CAP_START WM_USER #define WM_CAP_DRIVER_CONNECT WM_CAP_START + 10 #define WM_CAP_DRIVER_DISCONNECT WM_CAP_START + 11 #define WM_CAP_SET_PREVIEW WM_CAP_START + 50 #define WM_CAP_SET_PREVIEWRATE WM_CAP_START + 52 #define WM_CAP_SET_SCALE WM_CAP_START + 53 #define WM_CAP_EDIT_COPY WM_CAP_START + 30 #define WM_CAP_FILE_SAVEDIB WM_CAP_START + 25 #define WM_CAP_DLG_VIDEOFORMAT WM_CAP_START + 41 #define WM_CAP_DLG_VIDEOSOURCE WM_CAP_START + 42 #define WM_CAP_GET_STATUS WM_CAP_START + 54 ********************************************************* * EXIT Procedure WebcamDisconnect() * Asegura la desconexión de la cámara. ********************************************************* EXIT Procedure WebcamDisconnect() if _oWebcam_<>nil _oWebcam_:Disconnect() _owebcam_:=nil endif return **************************************************************************** CREATE CLASS tWebCamPhoto DATA nFrameRate INIT 66 //Velocidad de actualización de la WebCam DATA nJpgQuality INIT 75 //Calidad de los JPG DATA hWnd //Handle de la centana de la imagen DATA aDrivers //Drivers de captura disponibles DATA nDriver //número del driver instalado + 1 DATA lConnected INIT .F. //¿Está conectada> METHOD New(cDriver,lSelect) CONSTRUCTOR // Construye el objeto. cDriver es el nombre // del driver a usar, recomendado guardar en ini. // Si lSelect=.T. muestra la lista para escogerlo METHOD CreateWnd(oWnd,nLeft,nTop,nWidth,nHeight,nStyle,cTitle) // Crea la ventana para la cámara en oWnd. METHOD Connect // Conecta la cámara METHOD Disconnect // Desconecta la cámara METHOD Clipboard(oImg) //Captura la imagen en clipboard. Opcionalmente //actualiza a oImg con la imagen capturada METHOD Save(oImg,cFile,nQuality) //Captura la imagen y guarda en archivo (BMP/JPG). //Opcionalmente actualiza a oImg con la imagen capturada METHOD Source() //Configura la fuente de la webcam METHOD Format() //Configura el formato de la imagen METHOD GetStatus() //Status de la imagen METHOD Resize() //Redimensiona la ventana de la imagen METHOD End() INLINE ::Disconnect() // Finaliza el objeto ENDCLASS *=========================================================================== METHOD New(cDriver,lSelect) DEFAULT cDriver:=cWebCamDriver DEFAULT lSelect:=.F. ::aDrivers:=WebCamList() ::nDriver:=aScan(::aDrivers,{|u| Upper(StrTran(cDriver,' '))==Upper(StrTran(u,' '))}) IF ::nDriver=0 .or. lSelect ::nDriver:=WebCamSelect(::nDriver,::aDrivers) ENDIF _oWebCam_:=Self return Self *=========================================================================== METHOD CreateWnd(oWnd,nTop,nLeft,nWidth,nHeight,nStyle,cTitle) DEFAULT nTop:=0, nLeft:=0, nWidth:=160, nHeight:=120 DEFAULT nStyle:=nOr(WS_VISIBLE,WS_CHILD,WS_BORDER) IF ::nDriver>0 ::hWnd:=wCamCreaWnd(::aDrivers[::nDriver], nStyle,; nLeft, nTop, nWidth, nHeight, oWnd:hWnd, 0) ENDIF return ::hWnd *=========================================================================== METHOD Connect() if ::hWnd<>nil if SendMessage(::hWnd, WM_CAP_DRIVER_CONNECT, ::nDriver-1, 0)=1 cWebCamDriver:=::aDrivers[::nDriver] SendMessage(::hWnd, WM_CAP_SET_SCALE, 1, 0) SendMessage(::hWnd, WM_CAP_SET_PREVIEWRATE, ::nFrameRate, 0) SendMessage(::hWnd, WM_CAP_SET_PREVIEW, 1, 0) ::lConnected:=.T. ::Resize() else ::lConnected:=.F. ::hWnd:=nil endif endif return ::lConnected *=========================================================================== METHOD Disconnect IF ::hWnd<>Nil .and. ::lConnected if SendMessage(::hWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)=1 ::lConnected:=.F. _oWebCam_:=nil endif ENDIF return nil *=========================================================================== METHOD Clipboard(oImg) Local lSucc:=.F. if ::hWnd<>nil lSucc:=(SendMessage(::hWnd, WM_CAP_EDIT_COPY, 0, 0)=1) IF lSucc .and. oImg<>nil oImg:LoadFromClipboard() oImg:Refresh() ENDIF endif return lSucc *=========================================================================== METHOD Save(oImg,cFile,nQuality) Local lSucc:=.F. Local cFileExt:=Upper(cFileExt(cFile)) Local cFileName:=cFileNoExt(cFile) Local cExec:='BMPtoJPG.EXE' if ::hWnd<>nil CursorWait() IF (cFileExt=="JPG" .or. cFileExt=="JPEG") IF ::Clipboard() DEFAULT nQuality:=::nJpgQuality ::nJpgQuality:=Max(Min(Int(nQuality),100),10) WaitRun(cExec+' -q'+LTrim(Str(::nJpgQuality,3,0))+' -c'+cFileName+' -o -s',0) ENDIF ELSEIF cFileExt=='BMP' SendMessage(::hWnd, WM_CAP_FILE_SAVEDIB, 0, cFile) ENDIF CursorArrow() SysRefresh() IF !(lSucc:=File(cFile)) MsgAlert(' No pudo crearse '+cFile) ELSEIF oImg<>nil oImg:LoadImage(nil,cFile) oImg:Refresh() ENDIF endif return lSucc *=========================================================================== METHOD Source() if ::hWnd<>nil .and. ::lConnected SendMessage(::hWnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0) endif return nil *=========================================================================== METHOD Format() if ::hWnd<>nil .and. ::lConnected SendMessage(::hWnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0) ::Resize() endif return nil *=========================================================================== #include "Struct.ch" METHOD GetStatus() Local oPoint, oStatus, cBuffer STRUCT oPoint MEMBER X AS LONG MEMBER Y AS LONG ENDSTRUCT STRUCT oStatus MEMBER nWidth AS LONG // Width of the image MEMBER nHeight AS LONG // Height of the image MEMBER lLive AS LONG // Now Previewing video? MEMBER lOverlay AS LONG // Now Overlaying video? MEMBER lScale AS LONG // Scale image to client? MEMBER oXYScroll AS STRING LEN 8 //AS POINTAPI // Scroll position MEMBER lDefPalette AS LONG // Using default driver palette? MEMBER lAudHardware AS LONG // Audio hardware present? MEMBER lCapFile AS LONG // Does capture file exist? MEMBER nCurVidFrm AS LONG // # of video frames cap'td MEMBER nCurVidDropped AS LONG // # of video frames dropped MEMBER nCurWavSamples AS LONG // # of wave samples cap'td MEMBER nCurTimeEl AS LONG // Elapsed capture duration MEMBER hPalCur AS LONG // Current palette in use MEMBER lCapturing AS LONG // Capture in progress? MEMBER nReturn AS LONG // Error value after any operation MEMBER nVidAlloc AS LONG // Actual number of video buffers MEMBER wAudAlloc AS LONG // Actual number of audio buffers ENDSTRUCT oPoint:x:=0; oPoint:y:=0 oStatus:oXYScroll:=oPoint:cBuffer cBuffer:= oStatus:cBuffer SendMessage(::hWnd, WM_CAP_GET_STATUS, Len(cBuffer), @cBuffer) oStatus:cBuffer:= cBuffer return oStatus *=========================================================================== #define HWND_BOTTOM 1 #define SWP_NOMOVE 2 #define SWP_NOSIZE 1 #define SWP_NOZORDER 4 METHOD Resize() Local oStatus if ::hWnd<>nil .and. ::lConnected SysRefresh() oStatus := ::GetStatus() SetWindowPos(::hWnd,HWND_BOTTOM,0,0,oStatus:nWidth,oStatus:nHeight,; nOr(SWP_NOMOVE,SWP_NOZORDER ) ) SysRefresh() endif return nil **************************************************************************** Function WebcamList() Local aDrivers:={}, nDriver:=0 Local cName, cVersion, nLen:=255 DO WHILE .T. cName:=space(nLen); cVersion:=space(nLen) IF !wCamGetDrvDesc(nDriver, @cName, nLen, @cVersion, nLen) EXIT ENDIF if chr(0)$cName cName:=Left(cName,At(chr(0),cName)-1) endif if chr(0)$cVersion cVersion:=Left(cVersion,At(chr(0),cVersion)-1) endif aAdd(aDrivers,cName) nDriver++ ENDDO return aDrivers **************************************************************************** Function WebcamSelect(nDriver,aDrivers) Local oDlg, oCbx Local cDriver Local lSelect:=.F. DEFAULT nDriver:=0, aDrivers:=WebcamList() IF Empty(aDrivers) MsgAlert('No Webcams') return 0 ELSE cDriver:=aDrivers[Max(1,nDriver)] IF LEN(aDrivers)>1 DEFINE DIALOG oDlg FROM 0,0 to 6,40 TITLE "Select webcam" @ 0,0 COMBOBOX oCbx VAR cDriver OF oDlg ITEMS aDrivers; SIZE 160,50 PIXEL @ 1.5, 4 BUTTON "Select" OF oDlg SIZE 40,12; ACTION (nDriver:=oCbx:nAt ,oDlg:End()) @ 1.5,16 BUTTON "Cancel" OF oDlg SIZE 40,12; ACTION oDlg:End() ACTIVATE DIALOG oDlg CENTERED ELSE nDriver := 1 ENDIF ENDIF return nDriver **************************************************************************** Function WebCamVersion(nDriver) Local cName, cVersion, nLen:=255 DEFAULT nDriver:=0 IF nDriver>0 cName:=space(nLen); cVersion:=space(nLen) IF wCamGetDrvDesc(nDriver-1, @cName, nLen, @cVersion, nLen) if chr(0)$cVersion cVersion:=Left(cVersion,At(chr(0),cVersion)-1) endif ELSE cVersion:=nil ENDIF ENDIF return cVersion /* **************************************************************************** *DLL32 STATIC FUNCTION wCamGetDrvDesc; DLL32 FUNCTION wCamGetDrvDesc; (nDriver AS _INT,; cName AS STRING,; nName AS LONG,; cVersion AS STRING,; nVersion AS LONG) AS BOOL PASCAL; FROM "capGetDriverDescriptionA" LIB hDllW * FROM "capGetDriverDescriptionA" LIB "avicap32.dll" ************************************************************************ *DLL32 STATIC FUNCTION wCamCreaWnd; DLL32 FUNCTION wCamCreaWnd; (cTitle AS STRING,; nStyle AS LONG,; x AS LONG, y AS LONG, nWidth AS LONG, nHeight AS LONG,; hWndParent AS LONG, nID AS LONG) AS LONG PASCAL; FROM "capCreateCaptureWindowA" LIB hDllW * FROM "capCreateCaptureWindowA" LIB "avicap32.dll" ************************************************************************ */ function wCamGetDrvDesc(nDriver ,cName,nName,cVersion,nVersion ) local uResult local cFarProc if Abs(hDLLW ) > 32 cFarProc = GetProcAddress(hDLLW,If(Empty("capGetDriverDescriptionA" ) == .t.,"wCamGetDrvDesc","capGetDriverDescriptionA" ),.T.,5,7 ,8,7,8,7 ) uResult = CallDLL(cFarProc,nDriver ,cName,nName,cVersion,nVersion ) else MsgAlert("Error code: " + LTrim(Str(hDLLW ) ) + " loading " + If(ValType(hDllW ) == "C",hDllW,Str(hDllW ) ) ) endif return uResult function wCamCreaWnd(cTitle ,nStyle,x,y,nWidth,nHeight,hWndParent,nID ) local uResult local cFarProc if Abs(hDLLW ) > 32 cFarProc = GetProcAddress(hDLLW,If(Empty("capCreateCaptureWindowA" ) == .t.,"wCamCreaWnd","capCreateCaptureWindowA" ),.T.,7,8 ,7,7,7,7,7,7,7 ) uResult = CallDLL(cFarProc,cTitle ,nStyle,x,y,nWidth,nHeight,hWndParent,nID ) else MsgAlert("Error code: " + LTrim(Str(hDLLW ) ) + " loading " + If(ValType(hDllW ) == "C",hDllW,Str(hDllW ) ) ) end return uResult

perdoado

Fivewin foi realmente a salvacao para clipeiro, mas só uma correção para uma das mensagens acima, Fivewin nao é linguagem e sim biblioteca. Quem está substituindo o clipper é xharbour/harbour/flagship, etc. abraços e avante fw

Em xHarbour, em vez de utilizar uma posicao de array para controlar os microterminais use Thread.

Pode usar a Folha da Syspel (www.syspel.com.br) e o nosso software para ponto (www.emotta.com.br) Tanto um como outro é em fivewin/xharbour e nada como ajudar a comunidade. se resolver fale comigo. abraços, Eduardo Motta eduardo@emotta.com.br Editado por - emotta on 23/04/2008 17:36:58

Valeu pessoal.

Como fazer para o LISTBOX ficar com as cores alternadas? Gostaria de usar a classe padrao do FWH. Obrigado, Eduardo Motta Editado por - emotta on 22/04/2008 15:15:03

Como fazer para o LISTBOX ficar com as cores alternadas? Gostaria de usar a classe padrao do FWH. Obrigado, Eduardo Motta Editado por - emotta on 22/04/2008 15:15:03

Eu resolvo assim: Select ItemPedido Set orde TO 1 // GO TOP ItemPedido->(ORDSCOPE(0,Str(nCaixa,2)+"0")) ItemPedido->(ORDSCOPE(1,Str(nCaixa,2)+"0")) GO TOP aRegDel := {} DO WHILE !EOF() SELECT ItemPedido aadd(aRegDel,ItemPedido->(Recno())) SKIP ENDDO For nI := 1 to Len(aRegDel) ItemPedido->(DbGoto(aRegDel[nI])) IF BloqReg(10) ItemPedido->caixa := 0 DBUNLOCK() ENDIF Next Editado por - emotta on 14/04/2008 23:29:06

Tente renomear o DBF, usando uma extensao com outro nome só pra despistar. Na hora de abrir a tabela no sistema coloque o nome completo, inclusive a extensao. Ex: clientes.dbf para clientes.dat No use informe: Use clientes.dat shared new Pra ele abrir no excel terá que renomear o arquivo ou fazer uma copia, e com isso não vai dar problema na sua tabela de dados. Abraço,

Esta dando errado porque deve ter uma variavel de memoria com o mesmo nome do campo, e ele da prioridade para a variavel de memoria. Faça assim: Function SomarItem(aGet) Local cAlias := Alias() //--------------------------------------------------- LOCAL i, nGets , vCampo , nvlrCampo nGets = fCount() for i := 17 to nGets vCampo=AllTrim(field(i)) // mudei aqui 1 nvlrcampo:= &(cAlias+"->"+vCampo) // mudei aqui 2 next

o exemplo acima funciona em clipper e em harbour/xharbour com ou sem fivewin.