-
2
- #1
TariqMehmod
Programmer
Dear All,
Here is an attempt to send text messages,images,contents to whatsapp.
No need of any third party dll etc.
I have tested all method before uploading.
All methods work fine.
Before testing any method, you must have Whatsapp installed on your system
Link
Please enter whatsapp number on International format like 923000000000
Do not include +, 00 or dashes.
*--------------------------------------------------
Method:1- How to send simple message
*--------------------------------------------------
*--------------------------------------------------
Method:2- How to send an image file
*--------------------------------------------------
*--------------------------------------------------
Method:3- How to send Excel file as image
*--------------------------------------------------
Suppose I have this Excel File
C:\XLS\daily.xlsx
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/raw/upload/v1606821683/tips/daily_wihilk.xlsx[/url]
I shall convert this file into image without loosing format first then later send to whatsapp
You must have following 3 file in same folder
gpimage.FXP,gpimage.h,gpimage.prg
Download attachment that have all those 3 files
The following codes will generate a bmp file like this
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606821894/tips/9e97ccb8-f290-4ad1-9383-76281d5548ce_dx4qyv.bmp[/url]
*--------------------------------------------------
Method:4- How to send Bulk messages
*--------------------------------------------------
We shall create some data first
*--------------------------------------------------
Method:5- How to send contents of text file
*--------------------------------------------------
*--------------------------------------------------
Method:6- How to send Result Cards
*--------------------------------------------------
Suppose you are a principal of a school and want to send customized result card to parents.
Parents will receive this message on their whatsapp.
Same like this, while using an accounting system you can send Ledger to your customers also.
If you want to be more intelligent, don't want to use columns name and values in message then play like this
see result
*---------------------------------------------------
* Method:7- How to send unicode message from text file
*--------------------------------------------------
Some users asked me they want to send unicode message to whatsapp.
They have text file that contains data in their local language.
Suppose I have text file written our national lanugage URDU.
If I copy data from this file to VFP then data will be appear like this
?? ???? ??? ????? ???? ???? ??? ?? ???? ?????. ?? ?? ???? ????? ??
In this case I could not send this data to whats app with VFP codes
To make this data readable, I used my codes with this link
Here is complete routine
The result of above codes on whatsapp is as follows
You can read more about Unicode and Locale
*---------------------------------------------------
Method:8- How to send POS Invoice
*--------------------------------------------------
Today a user asked how to send POS Invoice/bill to customer on the spot.
It was good idea to get customers focus.
There are many issues to use custom page in VFP reports.
So there was need to send report on whatsapp with a small size to fit on Mobile Screen.
You must have following files in same folder before executing codes
(Files are in second attachment)
Suppose I want to send this invoice to customer.
To achieve this goal please give a try to following codes:
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606822489/tips/dd2f62ba-129f-478d-8135-f13411b499df_dor8bc.bmp[/url]
You can apply more formatting to excel file to make more better look.
*---------------------------------------------------
Method:9- How to send System Generated Reports (frx)
*--------------------------------------------------
You can use following formats with above codes
HTML,XML,TIF,EMF,JPG,GIF,PNG,BMP,DOC,XLS
Thanks Sir GriffMG and Mike Lewis for providing me support specially excel2image.
I shall welcome your feedback to make this integration more strong.
Thanks and best Regards
Here is an attempt to send text messages,images,contents to whatsapp.
No need of any third party dll etc.
I have tested all method before uploading.
All methods work fine.
Before testing any method, you must have Whatsapp installed on your system
Link
Please enter whatsapp number on International format like 923000000000
Do not include +, 00 or dashes.
*--------------------------------------------------
Method:1- How to send simple message
*--------------------------------------------------
Code:
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[923000000000]
ccMessage=[How are you sir?]
cmd='whatsapp://send?phone=&cPhone&text='+ccMessage
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ( "Whatsapp is not activated!" )
Endif
*--------------------------------------------------
Method:2- How to send an image file
*--------------------------------------------------
Code:
Do image_to_clip
** Declare Sleep
Declare Sleep In kernel32 Integer
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ("^{v}")
sleep(2000)
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ("Whatsapp is not activated!" )
Endif
Procedure image_to_clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001
Local xpict
m.xpict=Getpict()
If !Empty(m.xpict)
m.ext=Proper(Justext(m.xpict))
If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
Messagebox('Please select only images',0+16,'Whatsapp',3000)
Return
Endif
Else
Messagebox('Image not selected',0+64,'Whatsapp',3000)
Return
Endif
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
Endif
Endproc
*--------------------------------------------------
Method:3- How to send Excel file as image
*--------------------------------------------------
Suppose I have this Excel File
C:\XLS\daily.xlsx
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/raw/upload/v1606821683/tips/daily_wihilk.xlsx[/url]
I shall convert this file into image without loosing format first then later send to whatsapp
You must have following 3 file in same folder
gpimage.FXP,gpimage.h,gpimage.prg
Download attachment that have all those 3 files
The following codes will generate a bmp file like this
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606821894/tips/9e97ccb8-f290-4ad1-9383-76281d5548ce_dx4qyv.bmp[/url]
Code:
Do excel2image
Function excel2image
xflname="" && Get image file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin
lcXLS =[C:\xls\daily.xlsx]
If Empty(lcXLS)
Messagebox('Excel file not found',0+16,'System')
Return
Endif
Local oForm
oForm = Createobject("Form")
With oForm
.Height = 550
.Width = 360
.AutoCenter=.T.
.Caption=m.xflname
.MinButton=.F.
.MaxButton=.F.
.AlwaysOnTop=.T.
.Newobject("ExcelObject","oleExcelObject")
With .ExcelObject
.Left = 0
.Top = 0
.Width = .Parent.Width - 10
.Height = .Parent.Height - 10
.Visible = .T.
Endwith
.Newobject("Timer1","oTimer")
Endwith
oForm.Show(1)
Define Class oleExcelObject As OleControl
OleClass ="Excel.Sheet" && Server name
OLETypeAllowed = 0 && Linked
DocumentFile = lcXLS && This file should exist
Enddefine
Define Class oTimer As Timer
Interval=8000
Procedure Timer
This.Enabled = .F.
Do ScreenShot With This.Parent
This.Enabled = .T.
Enddefine
Procedure ScreenShot
Lparameters oForm
#INCLUDE gpImage.h
If Not "gpImage" $ Set("Procedure")
Set Procedure To gpImage Additive
Endif
GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
img.ImageWidth - (lnLeftBorder * 2), ;
img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release
Do image2Clip
Do send2whatsapp
Endfunc
Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict
m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'
Messagebox(m.xpict)
If !Empty(m.xpict)
m.ext=Proper(Justext(m.xpict))
If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
Messagebox('Please select only images')
Return
Endif
Else
Messagebox('Image not selected')
Return
Endif
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
Endif
Endfunc
Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.SendKeys ("^{v}")
Sleep(2000)
ox.SendKeys ( '{ENTER}' )
Else
Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc
*--------------------------------------------------
Method:4- How to send Bulk messages
*--------------------------------------------------
We shall create some data first
Code:
Create Cursor clients(mobile c(12))
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Insert Into clients Values('923000000000')
Go Top
Scan
Scatter Memv
cPhone=ALLTRIM(m.mobile)
cMessage=Alltrim('This is sales promotion message')
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 8 && 8 seconds internal in every message
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ( "Whatsapp is not activated!" )
Endif
Endscan
*--------------------------------------------------
Method:5- How to send contents of text file
*--------------------------------------------------
Code:
cFile=Getfile('txt')
_Cliptext=Filetostr(cFile)
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ("^{v}")
Sleep(2000)
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ( "Whatsapp is not activated!" )
Endif
*--------------------------------------------------
Method:6- How to send Result Cards
*--------------------------------------------------
Suppose you are a principal of a school and want to send customized result card to parents.
Code:
Create Cursor result(rollno N(3),student c(15),Chem N(3),phy N(3),bio N(3),;
eng N(3),math N(3),t_marks N(3),o_marks N(3),rem c(10),mobile c(13))
Insert Into result Values(1,'Ahmad Ali',78,25,33,85,50,500,271,'Pass','923000000000')
Insert Into result Values(1,'Zahid Mahmood',36,74,66,55,80,500,311,'Pass','92345000000')
Go Top
Scan
Scatter Memv
cPhone=Alltrim(m.mobile)
cMessage='*Result Card*';
+ '%0A'+'%0A';
+ m.student;
+ '%0A'+'%0A'+'Chem='+transform(m.Chem);
+ '%0A'+'Bio='+transform(m.bio);
+ '%0A'+'Phy='+transform(m.phy);
+ '%0A'+'Eng='+transform(m.eng);
+ '%0A'+'Math='+transform(m.math);
+ '%0A'+'%0A'+'Total='+transform(m.t_marks);
+ '%0A'+'Obtained='+Alltrim(Str(m.o_marks));
+ '%0A' +'%0A'+'Remarks='+'*'+Alltrim(m.rem)+'*';
+ '%0A' ;
+ Replicate('-',20);
+ '%0A'+'Principal:';
+ '%0A'+'Allied Public School'
Declare Sleep In kernel32 Integer
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cmd='whatsapp://send?phone=&cPhone&text=' + cMessage
=ShellExecute(0, 'open', cmd,'', '', 1)
Sleep(2000)
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ("Whatsapp is not activated!" )
Endif
Endscan
Parents will receive this message on their whatsapp.
Same like this, while using an accounting system you can send Ledger to your customers also.
If you want to be more intelligent, don't want to use columns name and values in message then play like this
Code:
FOR lnCnt = 1 TO FCOUNT()
*** Get the Field Name
lcField = FIELD( lnCnt )
*** Get the field Value
luFVal = &lcField
*** Now do whatever you want with it
? lcField, luFVal
NEXT
see result
*---------------------------------------------------
* Method:7- How to send unicode message from text file
*--------------------------------------------------
Some users asked me they want to send unicode message to whatsapp.
They have text file that contains data in their local language.
Suppose I have text file written our national lanugage URDU.
If I copy data from this file to VFP then data will be appear like this
?? ???? ??? ????? ???? ???? ??? ?? ???? ?????. ?? ?? ???? ????? ??
In this case I could not send this data to whats app with VFP codes
To make this data readable, I used my codes with this link
Here is complete routine
Code:
aa=Fullpath(Getfile('txt'))
tcUnicodeText=Strconv(Filetostr(aa), 5, 1256, 1)
*-------------------------------------------------
Do CopyUnicodeText2Clipboard With tcUnicodeText
Declare Sleep In kernel32 Integer
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[923226857062]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ("^{v}")
sleep(2000)
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ("Whatsapp is not activated!" )
Endif
&& Copy Unicode text into Clipboard
Function CopyUnicodeText2Clipboard(tcUnicodeText)
Local lnDataLen, lcDropFiles, llOk, i, lhMem, lnPtr, lcUnicodeText
#Define CF_UNICODETEXT 13
&& Global Memory Variables with Compile Time Constants
#Define GMEM_MOVABLE 0x0002
#Define GMEM_ZEROINIT 0x0040
#Define GMEM_SHARE 0x2000
&& Load required Windows API functions
=LoadApiDlls()
llOk = .T.
lcUnicodeText = tcUnicodeText + Chr(0)+Chr(0)
lnDataLen = Len(lcUnicodeText)
&& Copy Unicode text into the allocated memory
lhMem = GlobalAlloc(GMEM_MOVABLE+GMEM_ZEROINIT+GMEM_SHARE, lnDataLen)
lnPtr = GlobalLock(lhMem)
=CopyFromStr(lnPtr, @lcUnicodeText, lnDataLen)
=GlobalUnlock(lhMem)
&& Open clipboard and store Unicode text into it
llOk = (OpenClipboard(0) <> 0)
If llOk
=EmptyClipboard()
llOk = (SetClipboardData(CF_UNICODETEXT, lhMem) <> 0)
&& If call to SetClipboardData() is successful, the system will take ownership of the memory
&& otherwise we have to free it
If Not llOk
=GlobalFree(lhMem)
Endif
&& Close clipboard
=CloseClipboard()
Endif
Return llOk
Function LoadApiDlls
&& Clipboard Functions
Declare Long OpenClipboard In WIN32API Long HWnd
Declare Long CloseClipboard In WIN32API
Declare Long EmptyClipboard In WIN32API
Declare Long SetClipboardData In WIN32API Long uFormat, Long Hmem
&& Memory Management Functions
Declare Long GlobalAlloc In WIN32API Long wFlags, Long dwBytes
Declare Long GlobalFree In WIN32API Long Hmem
Declare Long GlobalLock In WIN32API Long Hmem
Declare Long GlobalUnlock In WIN32API Long Hmem
Declare Long RtlMoveMemory In WIN32API As CopyFromStr Long lpDest, String @lpSrc, Long iLen
RETURN
The result of above codes on whatsapp is as follows
You can read more about Unicode and Locale
*---------------------------------------------------
Method:8- How to send POS Invoice
*--------------------------------------------------
Today a user asked how to send POS Invoice/bill to customer on the spot.
It was good idea to get customers focus.
There are many issues to use custom page in VFP reports.
So there was need to send report on whatsapp with a small size to fit on Mobile Screen.
You must have following files in same folder before executing codes
(Files are in second attachment)
Suppose I want to send this invoice to customer.
To achieve this goal please give a try to following codes:
Code:
Create Cursor pos(items c(25),qty N(3),price N(3),Total N(4))
Insert Into pos Values('KAJU SADA 50G',1,150,150)
Insert Into pos Values('Kaju Roasted 50G',1,170,170)
Insert Into pos Values('AKHROT MAGAZ 50G',2,90,180)
Insert Into pos Values('Pista Namkeen 100G',1,250,250)
Insert Into pos Values('SANGARI NISRI 100G',1,30,30)
Insert Into pos Values('GANDAM DALYA 500G',1,50,50)
Insert Into pos Values('PODINA TIKI 50G',1,25,25)
Insert Into pos Values('CHAR MAGAZ 100G',1,65,65)
Insert Into pos Values('HARMONY LEMON 150G',1,65,65)
Insert Into pos Values('L C KA BEEG 100G',1,40, 40)
Insert Into pos Values('SERVING CUP BACHA',1,150,150)
#include excel.h
#Define xlA1 1
#Define xlR1C1 -4150
#Define xlLastCell 11
bError = .F.
On Error bError = .T.
loExcel = Createobj("excel.application")
If bError
Messagebox("Error")
Return
Endif
*MessageBox("Version: " + loExcel.Version) && version number
On Error
xflname="" && Get Excel file name
ahour=Padl(Alltrim(Str(Hour(Datetime()))),2,'0')
amin=Padl(Alltrim(Str(Minute(Datetime()))),2,'0')
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin
xflname=Alltrim("Tailor_")+Alltrim(Dtos(Date()))+"_"+ahour+amin
Select pos
Copy To 'C:\Xls\'+Alltrim(xflname)+Alltrim('.xls') Type Xl5
rec1=Reccount()
rec2=Reccount()+6
loExcel = Createobject("Excel.Application")
loworkbook = loExcel.workbooks.Open('C:\Xls\'+Alltrim(xflname))
losheet = loworkbook.sheets(1)
* insert 4 empty rows before data
With loExcel.activeworkbook.activesheet
.usedrange.RowHeight = 15
.Rows("1:4").Insert()
Endwith
&& First Line
losheet.Range("A1").Value=[Ehsas Mart]
With loExcel.Range("A1:D1")
.horizontalalignment = xlcenter
.verticalalignment = xlcenter
.wraptext = false
.Orientation = 0
.shrinktofit = false
.mergecells = true
.Font.Color = Rgb(128,64,64)
.Font.Name = 'Verdana'
.Font.bold = .T.
.Font.Size = 16
.RowHeight=22
Endwith
&& Second Line
losheet.Range("A2").Value=[Opp. Government Printing Press]
With loExcel.Range("A2:D2")
.horizontalalignment = xlcenter
.verticalalignment = xlcenter
.wraptext = false
.Orientation = 0
.shrinktofit = false
.mergecells = true
.Font.Color = Rgb(0,0,0)
.Font.Name = 'Verdana'
* .FONT.Bold = .T.
.Font.Size = 10
.RowHeight=15
Endwith
&& Third line
losheet.Range("A3").Value=[Bahawalpur, Ph.062-2504438]
With loExcel.Range("A3:D3")
.horizontalalignment = xlcenter
.verticalalignment = xlcenter
.wraptext = false
.Orientation = 0
.shrinktofit = false
.mergecells = true
.Font.Color = Rgb(0,0,0)
.Font.Name = 'Verdana'
* .Font.bold = .T.
.Font.Size = 10
.RowHeight=15
Endwith
&& Fourth line
losheet.Range("A4").Value=[21-Nov-2020 5:33pm Invoice No. 166]
With loExcel.Range("A4:D4")
.horizontalalignment = xlleft
.verticalalignment = xlcenter
.wraptext = false
.Orientation = 0
.shrinktofit = false
.mergecells = true
.Font.Color = Rgb(50,50,150)
.Font.Name = 'Verdana'
.Font.Size = 8
.Font.bold = .T.
.Font.Italic = 1
.RowHeight=15
Endwith
* Body Font name
rec5=5
With losheet.Range("A"+Alltrim(Str(rec5))+":"+"D"+Alltrim(Str(rec2)))
.Font.Name="Verdana"
Endwith
&& Foramt
rec4=4
losheet.Range("D"+Alltrim(Str(rec4))+":"+"D"+Alltrim(Str(rec2))).numberformat = "#[=0];###,###"
&& Headings
losheet.Range("A5").Value = "Name"
losheet.Range("B5").Value = "Qty"
losheet.Range("C5").Value = "Price"
losheet.Range("D5").Value = "Total"
losheet.Columns(1).AutoFit()
* Border of heading row
With loExcel.sheets(1).Range("A5:D5")
.BorderS(xlEdgeLeft).LineStyle = xlContinuous
.BorderS(xlEdgeTop).LineStyle = xlContinuous
.BorderS(xlEdgeBottom).LineStyle = xlContinuous
.BorderS(xlEdgeRight).LineStyle = xlContinuous
Endwith
* Heading Row
With loExcel.sheets(1).Range("A5:D5")
.Font.Name = 'Verdana'
.Font.bold = .T.
.RowHeight=20
.Font.Color = Rgb(10,25,245)
* .interior.Color = Rgb(10,235,245)
.interior.Color = 0x00FFFF
.horizontalalignment = -4108
.verticalalignment = -4108
Endwith
&& Summary Row
With losheet.Range("A"+Alltrim(Str(rec2))+":"+"D"+Alltrim(Str(rec2)))
.RowHeight = 20
.Font.Color = Rgb(0,0,255)
.interior.Color = Rgb(204,255,204)
.Font.Name = 'Verdana'
.Font.bold = .T.
.horizontalalignment = -4108
.verticalalignment = -4108
Endwith
rec3=rec2-1
&& Summary with Formula
losheet.Range("A"+Alltrim(Str(rec2))).Value = "TOTAL"
losheet.Range("b"+Alltrim(Str(rec2))).Formula = "=SUM(b2:b" + Alltrim(Str(rec3)) + ")"
losheet.Range("d"+Alltrim(Str(rec2))).Formula = "=SUM(d2:d" + Alltrim(Str(rec3)) + ")"
* column data autofit
For lni = 1 To Fcount("pos")
lccolumn = Chr(lni+96)+":"+Chr(lni+96)
loExcel.Columns(lccolumn).entirecolumn.AutoFit
Endfor
* Last Row/Column
lnLastRow = losheet.usedrange.Rows.Count
lnLastCol = losheet.usedrange.Columns.Count
thanks=lnLastRow+3
losheet.Range("A"+Alltrim(Str(thanks))).Value = "Thanks for visiting"
* Borders
loExcel.activewindow.displaygridlines = .F.
&& page margin
Local plportrait, pctitlerange, pllegal, pcprintarea, lnmargin
plportrait=.T.
pctitlerange="L"
With losheet.pagesetup
If plportrait = .T.
.Orientation = 1
Else
.Orientation = 2
Endif
If pllegal = .T.
.Papersize = 5
Else
.Papersize = 1
Endif
* .PaperSize = 5 && 5 for legal 1 for landscap
* .Orientation = 1 && 1 for portrati 2 for landscap
.topmargin = loExcel.inchestopoints(0.6)
.bottommargin = loExcel.inchestopoints(0.8)
.leftmargin = loExcel.inchestopoints(1)
.rightmargin = loExcel.inchestopoints(0.6)
.headermargin = loExcel.inchestopoints(0.1)
.footermargin = loExcel.inchestopoints(0.1)
.centerhorizontally = .T.
.Zoom = .F.
.fittopageswide = 1
.fittopagestall = .F.
If Type('pcTitleRange') <> 'L'
.printtitlerows = losheet.Range("A5:d5").address
Endif
If Type('pcPrintArea') <> 'L'
.printarea = pcprintarea
Endif
Endwith
&& Page Footer
losheet.pagesetup.rightfooter = "Page &P of &N"
*loExcel.Range("b6").Select
*loExcel.activewindow.freezepanes = .T. && freeze the panes
loExcel.Range("a1").Select
loExcel.activeworkbook.Save
loExcel.displayalerts = .F.
*loExcel.Visible = .T. && display Excel
*losheet.printpreview()
loExcel.Quit()
Release loExcel
Release All Like lo*
loExcel = .Null.
Do excel2image
Function excel2image
lcXLS ='C:\Xls\'+Alltrim(xflname)+'.xls'
If Empty(lcXLS)
Messagebox('Excel file not found',0+16,'System')
Return
Endif
Local oForm
oForm = Createobject("Form")
With oForm
.Height = 550
.Width = 360
.AutoCenter=.T.
.Caption=m.xflname
.MinButton=.F.
.MaxButton=.F.
.AlwaysOnTop=.T.
.Backcolor=RGB(255,255,255)
.Newobject("ExcelObject","oleExcelObject")
With .ExcelObject
.Left = 10
.Top = 10
.Width = .Parent.Width - 30
.Height = .Parent.Height - 30
.Visible = .T.
Endwith
.Newobject("Timer1","oTimer")
Endwith
oForm.Show(1)
Define Class oleExcelObject As OleControl
OleClass ="Excel.Sheet"
OLETypeAllowed = 0
DocumentFile = lcXLS
Enddefine
Define Class oTimer As Timer
Interval=3000
Procedure Timer
This.Enabled = .F.
Do ScreenShot With This.Parent
This.Enabled = .T.
Enddefine
Procedure ScreenShot
Lparameters oForm
#INCLUDE gpImage.h
If Not "gpImage" $ Set("Procedure")
Set Procedure To gpImage Additive
Endif
GDIP = Createobject("gpInit")
img = Createobject("gpImage")
img.Capture(oForm.HWnd)
Local lnTitleHeight, lnLeftBorder, lnTopBorder
lnTitleHeight = Sysmetric(9)
lnLeftBorder = Sysmetric(3)
lnTopBorder = Sysmetric(4)
img.Crop(lnLeftBorder, lnTitleHeight + lnTopBorder, ;
img.ImageWidth - (lnLeftBorder * 2), ;
img.ImageHeight - (lnTitleHeight + (lnTopBorder * 2)))
img.SaveasBMP('C:\Xls'+'\'+m.xflname)
img = Null
oForm.Release
Do image2Clip
Do send2whatsapp
Endfunc
Function image2Clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict
m.xpict='C:\XLS'+'\'+m.xflname+'.bmp'
If !Empty(m.xpict)
m.ext=Proper(Justext(m.xpict))
If !Inlist(m.ext,"Png","Jpg","Bmp","Gif","Tif")
Messagebox('Please select only images')
Return
Endif
Else
Messagebox('Image not selected')
Return
Endif
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
Endif
Endfunc
Function send2whatsapp
* Finally send this newly created image to whatsapp
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local lt, lhwnd
cPhone=[92300000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.SendKeys ("^{v}")
Sleep(2000)
ox.SendKeys ( '{ENTER}' )
Else
Messagebox ( "Whatsapp is not activated!" )
Endif
Endfunc
[URL unfurl="true"]https://res.cloudinary.com/engineering-com/image/upload/v1606822489/tips/dd2f62ba-129f-478d-8135-f13411b499df_dor8bc.bmp[/url]
You can apply more formatting to excel file to make more better look.
*---------------------------------------------------
Method:9- How to send System Generated Reports (frx)
*--------------------------------------------------
Code:
Clear
Set Safety Off
Public yout
Do select_frx
Do image_to_clip
Procedure select_frx
m.yrep=Getenv("TEMP")
Set Defa To (yrep)
xflname = DTOC(DATE(),1)+[_]+CHRTRAN(TIME(),[:],[])
m.yout=m.yrep+'\'+xflname
If !Directory(m.yout)
Md (m.yrep+'\'+xflname)
Endi
Local afile
*afile=Getfile('frx')
&& you can this following line for testing purpose
afile=(_Samples + "\Solution\Reports\Colors.frx")
If !Empty(m.afile)
m.ext=Lower(Justext(m.afile))
If m.ext<>[frx]
Messagebox('Please select only frx',0+16,'Whatsapp',3000)
Return
Endif
Else
Messagebox('Report not selected',0+64,'Whatsapp',3000)
Return
Endif
#Define OutputNothing -1
#Define OutputEMF 100
#Define OutputJPEG 102
#Define OutputGIF 103
#Define OutputPNG 104
#Define OutputBMP 105
#Define OutputTIFF 101
#Define OutputTIFFM 201
oListener =Newobject("ReportListener")
oListener.ListenerType=3
Report Form (afile) Preview Object oListener
myext=[.]+Alltrim('JPG')
ntype=OutputJPEG
m.yout=m.yout
For nPageno=1 To oListener.PageTotal
cOutputFile = m.yout+"\myreport"+Trans(nPageno)+myext
oListener.OutputPage(nPageno, cOutputFile,m.ntype)
Next
*!* If Not Inlist(ntype,OutputTIFFM,1000,1001)
*!* Run/N "explorer" &yout
*!* Endi
reporlistener=Null
Release ReportListener
Endproc
Procedure image_to_clip
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
Declare Sleep In kernel32 Integer
Declare Integer FindWindow In WIN32API String , String
Declare Integer SetForegroundWindow In WIN32API Integer
Declare Integer ShowWindow In WIN32API Integer , Integer
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001
fso=Createobject("scripting.filesystemobject")
fld=fso.getfolder(yout)
For Each fil In fld.Files
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.yout+"\"+(fil.Name)
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.yout+"\"+(fil.Name)+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0)
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
Endif
Local lt, lhwnd
cPhone=[923000000000]
cmd='whatsapp://send?phone=&cPhone'
=ShellExecute(0, 'open', cmd,'', '', 1)
Wait "" Timeout 3
lt = "Whatsapp"
lhwnd = FindWindow (0, lt)
If lhwnd!= 0
SetForegroundWindow (lhwnd)
ShowWindow (lhwnd, 1)
ox = Createobject ( "Wscript.Shell" )
ox.sendKeys ("^{v}")
Sleep(2000)
ox.sendKeys ( '{ENTER}' )
Else
Messagebox ("Whatsapp is not activated!" )
Endif
Next
Endproc
You can use following formats with above codes
HTML,XML,TIF,EMF,JPG,GIF,PNG,BMP,DOC,XLS
Thanks Sir GriffMG and Mike Lewis for providing me support specially excel2image.
I shall welcome your feedback to make this integration more strong.
Thanks and best Regards