Collapsed Container in VFP

http://expertsoftwarecompany.wordpress.com/2012/12/22/collapsed-containter-in-vfp/

De cat timp este pornit calculatorul

Declare Integer StrFromTimeInterval In Shlwapi;
String @ pszOut, Integer cchMax, Integer dwTimeMS, Integer digits

Declare Integer GetTickCount In kernel32
nIni = GetTickCount()

cSalida = Space(50)

=StrFromTimeInterval (@cSalida, Len(cSalida), nIni, 10)
Wait Window cSalida

Converirea dimensiune fisier in valoarea corespunzatoare

Function _ApiFileSize(tnBytes As Number)
Text To Exemple NoShow TextMerge
   = _ApiFileSize(532)
   = _ApiFileSize(1340)
   = _ApiFileSize(23506)
   = _ApiFileSize(2400016)
   = _ApiFileSize(2400000000)
   = _ApiFileSize(4294967295)
EndText
Declare STRING StrFormatByteSize IN Shlwapi INTEGER dw, STRING @ pszBuf, INTEGER cchBuf
    pszBuf = SPACE(50)
    Return Transform(tnBytes) +  " -> " +  StrFormatByteSize (m.tnBytes, @pszBuf, Len(pszBuf))
EndFunc

Numarul de randuri visibile intr-un grid

With This.Grid1
   nCeldas = Int(.Height - .HeaderHeight)/.RowHeight
   Wait Windows Transform(nCeldas)EndWith

Afisare imagini variate intr-o lista

Public oform1
oform1=NewObject("form1")
oform1.Show
Return
Define Class form1 As Form
Top = 65
Left = 192
DoCreate = .T.
Caption = "Imagenes en ListBox"
Name = "Form1"
Add Object list1 As ListBox With ;
Height = 181, ;
Left = 36, ;
Top = 24, ;
Width = 300, ;
Name = "List1"

Procedure list1.Init
Set Path To Home(4) + "ICONS\MISC"
With This
.AddItem("Usuario 1",1,1)
.Picture(1) = "FACE01.ICO"
.AddItem("Usuario 2",2,1)
.Picture(2) = "FACE02.ICO"

.AddItem("Usuario 3",3,1)
.Picture(3) = "FACE02.ICO"

.AddItem("Usuario 2",4,1)
.Picture(4) = "FACE03.ICO"
EndWith

EndProc
EndDefine

Copiere rapida a unui tabel in Excel

Function FastExcelCopy (tcTable As String, tcXlsFile As String, tlOpen) As VOID HelpString 'Copieaza o tabela in Excel'
If Not Used(TcTable)
MessageBox("Eroare: Tabela nu este deschisa !", 16, "Eroare")
Return
EndIf
Local lnWorkArea
lnWorkArea = Select()

Select (tcTable)
Local lcTmpFile
lcTmpFile = GetEnv("TEMP")+"" + Sys(2015) + ".Tmp"
Copy To (lcTmpFile) Delimited With Tab
_Cliptext = FileToStr(lcTmpFile)

oExcel= Createobject("Excel.Application")
With oExcel
.DisplayAlerts = .F.
.Workbooks.Add()
    .Range("A1").PasteSpecial
EndWith
If PCount()>1
oExcel.Workbooks(1).SaveAs(tcXlsFile)
EndIf
If Not tlOpen
oExcel.Quit
oExcel= .Null.
Release oExcel
EndIf
Select (lnWorkArea)
EndFunc

Excel Graph

#Define Tab Chr(9)
#Define CRLF Chr(13)+Chr(10)

Public oGraph
_Cliptext = "" ;
+ Tab + "Depto X" + Tab + "Depto Y" + CRLF + ;
"Arroz" + Tab + "248" + Tab + "297" + CRLF+;
"Maíz" + Tab + "339" + Tab + "440" + CRLF+;
"Cereal" + Tab + "500" + Tab + "489" + CRLF+;
"Papas" + Tab + "125" + Tab + "235" + CRLF+;
"Otros" + Tab + "631" + Tab + "455" + CRLF

oGraph = GetObject("","Excel.Chart")

With oGraph.Application
.Visible= .T.
.WorkSheets(1).Cells().Clear
.WorkSheets(1).Cells(1,1).PasteSpecial
.Charts[1].AutoFormat(-4100,1)
EndWith

Eliminare spatii suplimentare dintr-un sir

Function RemoveExtraSpace(tcSir)
lnCountR = Ceiling( SQrt( Occurs(Space(1), tcSir) ) )
Return Evaluate ;
(;
Replicate([StrTran(], lnCountR) + [tcSir] + Replicate([, Space(2), Space(1))], lnCountR) ;
)
EndFunc

Arhivare cu WinZip

oZip = CreateObject("WScript.Shell")
oZip.Run("Winzip -a -r -p -ex c:\archiva.zip c:\Director_de_Arhivat\*.*", 0,.T.)

Release oZip
oZip = Null

Convertire ADO in Cursor cu ajutorul XML-ului

cCadCon = "Provider=VFPOLEDB;Data Source=" +_Samples +"data estdata.dbc"

oCon = Createobject("AdoDb.Connection")oCon.ConnectionString = cCadCon
oCon.Open

oRS = oCon.Execute("Select * From Customer")

xDOM = Newobject("MSXML.DOMDocument")

oRS.Save(xDOM, 1)
oRS.CloseoCon.Close

XmlToCursor(xDOM.XML, "MyCursor", 1028)Select MyCursorBrowse

Dezactivare firewall

Run netsh firewall Set opmode Disable

Arata Desktopul Windowsului din VFP

oShellApp = CreateObject("Shell.Application")
oShellApp.ToggleDesktop

Activare dezactivare tasta PrintScreen

#Define VK_PRINTSCREEN 0x2c
Declare Integer RegisterHotKey In user32 ;
Integer HWnd ;
, Integer Id ;
, Integer fsModifiers ;
, Integer vk
* Dezactivare
RegisterHotKey(_Screen.HWnd, 0, 0, VK_PRINTSCREEN)
* Activare
Declare Integer UnregisterHotKey In user32 Integer HWnd, Integer Id
UnregisterHotKey(_Screen.HWnd, 0)

Aflarea spatiului ocupat de o tabela DBF

*Select lcAlias
Wait Window Header() + Recsize() * Reccount() + 1

Obtinere inregistrari care nu se regasesc in alt tabel

Select * From Tabla1 ;    WHERE Not Exists ;
   (Select * From Tabla2 ;
   WHERE Tabla1.Id = Tabla2.Id)

sau

Select * From Tabla1 ;    Where Id Not In (Select Id From Tabla2)

Obtinere zecumale dintr-un numar

Function GetDecimals(tnDecimal  As Decimal) As Decimal
    Return tnDecimal - Int(tnDecimal)
EndFunc

Afisare CheckBox in Raport

Iif(CampLogic, Chr(0xFD), Chr(0xA8))

Public oForm
oForm=CreateObject("form1")
oForm.Show
Define Class form1 As Form
Top = 0
Left = 0
Height = 520
Width = 790
DoCreate = .T.
Name = "Form1"

Add Object Graf As OleControl With ;
Top = 10, ;
Left = 5, ;
Height = 500, ;
Width = 780, ;
Name = "Graf", ;
OleClass = "MSChart20Lib.MsChart"

Procedure Init
Text to _cliptext noshow
X1 X2 X3 X4
25 35 15 25
EndText
This.Graf.Editpaste
#Define VtChChartType2dPie 14
This.Graf.ChartType = VtChChartType2dPie
This.Graf.ShowLegend = .T.
This.Graf.TitleText = "Titul Graficului"
EndProc
EndDefine

Utilizare ADOX pentru a adauga un tabel DBF la o baza de date MsAcces

Cat = CreateObject("ADOX.Catalog")
oTab = CreateObject("ADOX.Table")
cPathDB = "Provider=Microsoft.Jet.OLEDB.4.0;"+ "Data Source=C:\BaseDatos.mdb;"
* Deschidere catalog
oCat.ActiveConnection = cPath
* Creare tabel nou
With oTab
.Name =
"Linked Table dBASE"
.ParentCatalog = oCat
EndWith

* Setarea proprietatilor pentru a crea legatura cu tabela dBASE
With oTab
.Properties("Jet OLEDB:Link Datasource") = "C:\"
.Properties("Jet OLEDB:Remote Table Name") ="vacunas#dbf"
.Properties("Jet OLEDB:Create Link") = .T.
.Properties("Jet OLEDB:Link Provider String") = "dBASE 5.0;"
EndWith


* adaugare tabel la colectia Tabele
oCat.Tables.Append(oTbl)
oCat = Null
=MessageBox("Legatura tabelului a reusit.")

Refresh form cu API

#Define RDW_INVALIDATE 0x0001
#Define RDW_INTERNALPAINT 0x0002
#Define RDW_ERASE 0x0004
#Define RDW_VALIDATE 0x0008
#Define RDW_NOINTERNALPAINT 0x0010
#Define RDW_NOERASE 0x0020
#Define RDW_NOCHILDREN 0x0040
#Define RDW_ALLCHILDREN 0x0080
#Define RDW_UPDATENOW 0x0100
#Define RDW_ERASENOW 0x0200
#Define RDW_FRAME 0x0400
#Define RDW_NOFRAME 0x0800

*Wait Window Bitor(RDW_NOFRAME ,Bitor(RDW_FRAME ,Bitor(RDW_ERASENOW,RDW_ALLCHILDREN )))

Declare Integer RedrawWindow In WIN32API As ApiRedrawWindow ;
Integer HWnd, ;
Integer nUpdateRect, ;
Integer nUpdateRegion, ;
Integer nFlags

ApiRedrawWindow(ThisForm.HWnd, 0, 0, RDW_INTERNALPAINT + RDW_ALLCHILDREN + RDW_UPDATENOW)

Clear Dlls 'ApiRedrawWindow'