Ads

Ads

Translate

Saturday, 9 March 2013

[Video - Tutorial] Absolute Database in Delphi XE3

Absolute Database is a Delphi database engine which lets you forget the Borland Database Engine (BDE). This BDE replacement is the compact, high-speed, robust and easy-to-use database engine:

Key Features: No BDE; no DLLs Single-file database SQL'92 (DDL & DML) support Compatible with standard and third-party database controls Single-user and multi-user mode (file-server) Works great on all versions of Windows - from 98 to Vista, doesn't require any updates or service packs Ultra-fast in-memory tables Unmatched ease-of-use Strong encryption BLOB compression Free for personal use Full source code available Royalty-free distribution

Thursday, 7 March 2013

New Delphi Twain component

This Delphi Twain modified by Kluug.net is the unicode - enabled successor of Delphi Twain library by Gustavo Gaud which hasn't been updated since 2004.

The library allows you to easily access scanning functions from Delphi 6, 7, 2007, 2009, 2010, XE, XE2, XE3 and also from Lazarus.


Library design

  • Full html help for the component classes. The library is able to fully access Twain capabilities.
  • Acquiring images is easy as a few line codes
  • Direct access to various twain features
  • Showcases making it easy to learn

Installation

I included packages for Delphi XE2, but there is no need to install them. You can easily use Delphi Twain from the source code. Just add the source code directory to your library path.
An experienced user will definitely be able to create packages for other Delphi versions.

License

He couldn't find any license information of the original DelphiTwain library, so I decided to license my modified library (starting from version 1.1) under:
MPL / GPL / LGPL.
The library is initially created by © Gustavo Daud and modified by Nemeth Peter and vcldeveloper.

Original versions


 Please be sure you check the license information before downloading any of the files below.

Libraries with full source code


http://www.kluug.net/delphitwain.php

Saturday, 16 February 2013

FreePascal/Lazarus Ebook

Ebook Lazarus / Freepascal berbahasa Inggris untuk newbie.


Introduction
Buku ini ditulis untuk programmers yang ingin mempelajari Object Pascal Language. Buku ini cocok untuk para programmer and non-programmers.
It illustrates programming techniques as general in addition to Object Pascal Language.
License:
License of this book is Creative Commons.

Chapters:
  1. Language Basics
  2. Structured Programming
  3. GUI
  4. Object Oriented Programing

Download PDF
Download Book Examples
License: Creative commons

Monday, 11 February 2013

Delphi SMSgateway Sourcecode

FilenameSize
03509288smsdemo_delphi.rar203 KB
04563522Delphicuankoutouxinshilidaohang.rar9.6 MB
09627989SendSMS.rar251 KB
14019764sms.rar253 KB
168339SpcommSMS.rar284 KB
26904256mobile_Bomb.rar218 KB
43728622004062215563318875.rar12 KB
464280��ͨ����ƽ̨Ô´����.rar16 KB
49635882agamem_sms.rar224 KB
52167887dll.rar245 KB
650540sms_COM_test_LUDEHAI.rar11 KB
661587174wavecom_soft.rar293 KB
74237987Delphi.rar505 KB
773699205itlongxin_SendSMS.rar553 KB
863770805FHSMS.rar375 KB
984982806GSM.zip56 KB
987078302SMS_SDK2.0.rar1.3 MB
CRACK - Delphi-SMS-Modem.rar531 KB
sms DELPHI VCL.rar239 KB
19 files (15.1 MB)

DOWNLOAD
Sourcecode delphi sms gateway

Buku Mudah SMS Gateway Dengan Delphi 7

Bagi anda praktisi, mahasiswa, pelajar ,  maupun kalangan awam yang ingin belajar cara pembuatan aplikasi SMS gateway dengan delphi, anda dapat mempelajari
 Buku Membuat SMS Gateway dengan Delphi 7 sebagai referensinya



Secara teknis Buku ini di rancang sedemikian rupa supaya pembaca lebih mudah untuk memahami materi (semoga aja demikian ya …he he he), dan dilengkapi dengan flowchart dan contoh program supaya pembaca lebih terasah kemampuan programmingnya.

Contact Person 085787677544 Fajar Priyadi

Demikian flash info dari saya, semoga buku ini bermanfaat bagi masyarakat Indonesia dan menambah wawasan dunia IT kepada pelajar dan mahasiswa yang haus akan ilmu dan pengetahuan praktis. Oya, buku ini dilengkapi CD, jadi semua contoh program dan file dependency (installer, komponen Delphi, library, unit tambahan) ada di sini.

Friday, 25 January 2013

~'Modem Wavecom M1306B P2303 USB GSM"




Kondisi Barang : New
Harga : Rp. 275.000
Lokasi Seller : Daerah Istimewa Yogyakarta


Modem Wavecom M1306B P2303 USB GSM MURAH adalah modem untuk kebutuhan server pulsa dan sms gateway.
Modem ini menggunakan chipset P2303, modem type chipset ini kami rekomendasikan untuk penggunaan SMSdan Dial kerena sangat ampuh dan bandel. Daya tahan penggunaan modem selama 24jam bisa dibilang Jempolan.
  Kami menyediakan modem GSM Wavecom dengan RS232 dan USB port yang lebih stabil dibandingkan handphone biasa.

Berikut ini adalah kelebihan Modem Wavecom M1306B P2303 USB GSMdaripada hp/modem lain untuk SMS Gateway:


  1. Mendukung AT command dan SMS Gateway dengan Gammu.
  2. Gunakan connection = at115200 pada konfigurasi GAMMURC maupun SMSDRC nya.
  3. Secara umum dapat digunakan bersama software SMS Gateway (Now SMS dll) dan juga untuk software pulsa lainnya.
  4. Dapat digunakan untuk mengirim atau menerima long SMS (SMS dengan panjang karakter lebih dari 160 buah).
  5. Modem Wavecom M1306B P2303 USB GSMMelakukan transaksi jauh lebih cepat daripada hp biasa (2x – 5x lebih cepat).
  6. Sanggup menangani volume transaksi yang besar
  7. Sanggup menangani transaksi bertubi-tubi dalam waktu yang singkat
  8. Lebih awet dan perawatannya lebih mudah
  9. Lebih stabil dalam kinerjanya
  10. Mampu dijalankan terus menerus (24 jam nonstop)
  11. Lebih tahan panas
  12. Mendukung semua sistem operasi Windows (XP, Vista, 7) dan Linux


Spesifikasi Modem M1306B P2303 :

  1. Modem Wavecom M1306B P2303 USB GSM Aluminum casing
  2. Modem Wavecom M1306B P2303 USB GSMWireless access to internet
  3. Based on Wavecom module P2303
  4. Dual-band 900/1800MHZ
  5. 3V SIM card slot
  6. Standard USB interface
  7. Double tone multi-frequency function (DTMF)
  8. Send and receive voice, data, fax, e-mail, SMS,MMS
  9. Maximum transmitting speed 115KB/s
  10. Support AT command to make remote control (GSM07.07 and 07.05)
  11. GPRS Class 10
  12. Antenna with high sensitivity
  13. Always on-line
  14. Conform with ETSI GSM Phase2+ standard
  15. Output Power
  16. Class 4(2W @ 900MHz)
  17. Class 1(1W @ 1800MHz)
  18. Input voltage 5V-24V DC
  19. Input current 1-2A
  20. Working temperature -20 °C -+55 °C
  21. Storage temperature:-25 °C -+70 °C
  22. Size 98*54*25mm
  23. WeighT.130g

Minat langsung PM atau Hubungi : 085787677544 Fajar Priyadi

Sunday, 20 January 2013

DVD Tutorial Delphi Toolkit 2, Referensi Lengkap Programmer Delphi

Delphi adalah salah satu bahasa pemrograman yang cukup populer di Indonesia, karena bahasa dan sintaks yang digunakan relatif mudah dan juga referensi yang tersedia juga cukup banyak. Kali ini saya akan menghadirkan salah satu referensi tutorial lengkap bagi programmer Delphi yang berbentuk DVD.

Delphi Toolkit Versi 2 kini hadir dengan konten yang lebih baik dan lengkap yang terdiri dari 2 keping DVD dengan total sekitar 8.45 GB (9.078.937.048 bytes, setara dengan 12 keping CD).



Beberapa perbaikan, update atau tambahan dari versi sebelumnya antara lain:

  1. Pengelompokan kategori komponen yang lebih baik dan detail
  2. Adanya informasi lebih detail (baik dalam bentuk TXT, RTF, DOC, PDF, HTML atau CHM) di sebagian besar komponen [pilihan] untuk memudahkan mengetahui sekilas fungsi dan fitur komponen tersebut.
  3. Update besar-besaran berbagai komponen delphi, seiring dengan adanya Delphi versi baru (XE dan XE3)
  4. Update konten pendukung bagi progammer, seperti Delphi Tools, Programmer Tools dan Database
  5. Tambahan ratusan komponen baru, sehingga ukuran komponen sendiri hampir 3.5 GB (lebih dari 2x dari versei sebelumnya)
  6. Tambahan berbagai koleksi video tutorial terbaru, termasuk untuk Delphi XE2 & Firemonkey. Sehingga kini untuk video tutorial saja dikompilasi dalam 1 DVD khusus
  7. Bonus koleksi icon gratis (berisi ribuan icon dan gambar), mengingat membuat program biasanya akan memerlukan icon

Delphi Toolkit 2 terdiri dari 2 keping DVD, satu DVD berisi komponen delphi dan tools pelengkap bagi programmer dan DVD 2 khusus berisi video tutorial. Berikut daftar singkat ini untuk masing-masing DVD tersebut.

Konten DVD-1 (Components)

  1. Ribuan komponen Delphi gratis, mencakup berbagai kategori seperti COM Port, Compression, Grafik (2D/3D), Akses Database, Expert, Hardware, KOL (Key Object Libraray), Internet/Networking, Office/Reporting, Science, Security, Animasi dan lainnya. Total sekitar 3.5 GB
  2. Berbagai contoh aplikasi dan proyek dengan source kodenya
  3. Delphi Tools yang berisi berbagai tool untuk Analis kode, Debugging, Pembuatan Help, Profiler, Logging, Tweaking dan sebagainya
  4. Free Icons, berisi ribuan (puluhan ribu) icon gratis
  5. Database, berisi 3 database (RDBMS) pilihan terbaru untuk mengembangkan aplikasi berbasis database (Firebird, MySQL dan SQlite) termasuk program administrator database.
  6. Programmer Tools, tambahan program untuk programmer, seperti pembuatan Installer, Help dan Editor
  7. Referensi, Tips & Trik serta Tutorial dalam bentuk CHM (termasuk arsip website) sehingga mudah digunakan. Sebagian tutorial saat ini mungkin websitenya sudah tidak ada lagi

Konten DVD-2 (Video Tutorials)

  1. 3 Virtual Delphi Users Group Tutorial (~370 MB). 3 tutorial pilihan dengan total durasi sekitar 4 jam
  2. 6 series two-minutes tutorials, tutorial singkat masing-masing sekitar 2 menit (~ 66 MB)
  3. 9 Delphi training series (total ~576 MB), tutorial lengkap pembuatan program mulai dari nol (aplikasi MP3 player) dari 3dbuzz.com, menggunakan Turbo delphi (bisa diterapkan menggunakan delphi versi lainnya juga)
  4. 27 Delphi XE XE2 Firemonkey (~ 649 MB), berbagai tutorial dan tips dari master Delphi (baik untuk Windows, Mac OS, dan iOS) dengan Delphi XE2 & Firemonkey. Sebagian tersedia dalam HD Video (720p)
  5. 30 Turbo Delphi Tutorials (~700 MB). 30 Video tutorial oleh Nick Hodges menjelaskan mulai dari antarmuka, bahasa dalam delphi sampai mendeteksi kesalahan pemrograman (debugging).
  6. 45 Ridlersoft video tutorial (~220 MB). Tutorial delphi mulai dari dasar (pengenalan), sampai pembuatan program sederhana (Test Editor). Juga pengenalan tentang pemrograman grafik di TCanvas.
  7. 75 Tutorials LearnDelphi.tv (dulu codegearguru.com ~ 1125 MB / 1.1 GB). Tutorial video oleh Alister Christie, 75 video ini menjelaskan berbagai hal, mulai dari pengenalan antarmuka, tips trik, database, SQL, Class dan berbagai tips menarik baik bagi anda yang sudah mahir pun.
  8. Others Video ( ~660 MB), berbagai koleksi video tutorial lainnya


Semua Video tutorial tersebut dibuat oleh master-master delphi (bahasa/audio yang digunakan menggunakan bahasa Inggris). Meskipun begitu hal itu bukan menjadi penghalang bagi yang masih terbatas kemampuan bahasanya, karena kita hanya cukup melihat presentasi dalam video tersebut. Sebagian besar Video tutorial baru tampil dengan kualitas High Definition (HD) Video (720p, diatas kualitas DVD), sehingga tutorial akan semakin jelas, terutama dalam Full Screen.






Untuk daftar lengkap apa saja isi kedua DVD yang ada dalam Delphi Toolkit 2 ini, silahkan melihat langsung dengan mendownload untuk dalam bentuk zip untuk dilihat di komputer secara offline berikut: Konten DVD-1.zip, Konten DVD-2.zip.

Harga dan Pemesanan

 

Harga DVD Tutorial Delphi Toolkit 2 ini Rp. 100.000, ditambah biaya kirim untuk wilayah jawa Rp 10.000 dan luar jawa Rp 15.000 dengan jasa pengiriman Pos Indonesia. Jika ingin menggunakan jasa pengiriman lainnya, silahkan jika berminat hubungi saya di 081290906693  Fajar Priyadi

Tuesday, 8 January 2013

New Motion detector component for Delphi 7 and XE

TMotionDetector
Motion detector component for Delphi 7 and XE



The motion detector is used to detect motion and lightness from webcam, video frames and more...
By feeding frames into the component, it defines the value and lightness parameters than can be read.
Optional 8-Bit mask of motion can be enabled, and drawn on the image if desired.
It has tolerance and minimum pixel difference tolerance that can be adjusted to exclude background noise and so on.






HISTORY

2012, July: Version 1.1 available at webpage
2012, April: Thanks to Soitjes for sending me his Delphi XE version of the project.
2012, February: Version 1.0 available at webpage

WHAT'S NEW
* Changes of data types for Delphi version compatibility, pAnsiChar etc.
* Lightness "div 3" not inside the loop, now done finally
* Using pRgb directly, might be a little faster

http://www.mbsnet.dk/_media/hlrqmd6oemc2wgfk.zip Download Motiondetect v1.1.zip, 215.36 Kb.

website pengembang : http://www.mortenbs.com

Properties

Property Description
tolerance:cardinal   Tolerance (Number of pixels)  
minimumDifference:byte   Minimum pixel-difference tolerance  
useDetectLight:boolean   Enable lightness detection (slower)  
motionMask:tShowMask   Show motion mask (None, Full Mask, Motion Only, Last Motion Only)  
onMotion:tSimpleEvent   Event when motion above tolerance is beginning  
value:cardinal   Current number of pixels above the tolerance  
lightness:cardinal   Current lightness amount  
hasMotion:boolean   Is true when motion and three seconds after  
maxDiff:byte   Maximum difference that can be read as info  

Routines
Routine Description
reset   Reset motion info parameters  
setSize()   Set width and height simultaneously  
feedFrame():boolean   Feed frame into the motion detector  
getImage():boolean   Get current image with overlays  
sq:cardinal   Square size (width*height)  

Motiondetect Src.pas (TMotionDetector)

unit motiondetect;

//For Delphi 7 and XE, 24-Bit TBitmap

//HISTORY
//2012, July:     Version 1.1 available at webpage: http://www.mortenbs.com/it/delphi/motiondetector/
//2012, April:    Thanks to Soitjes sending me his Delphi XE version of the project.
//2012, February: Version 1.0 available at webpage: http://www.mortenbs.com/it/delphi/motiondetector/

//WHAT'S NEW
// * Changes of data types for Delphi version compatibility, pAnsiChar etc.
// * Lightness "div 3" not inside the loop, now done finally
// * Using pRgb directly, might be a little faster

interface

uses
 sysUtils,classes,graphics;

type
 pRgb=^tRgb;
 tRgb=record b,g,r:byte end;//24-Bit RGB

const
 NULL = #0;
 NONE = $00;

type
 tSimpleEvent=procedure of object;//Simple event without any arguments
 tShowMask=(smNone,smFullMask,smMotionOnly,smLastMotionOnly);
//-----------------------------|----------------|----------------------|----------------------------
 tMotionDetector=class(TComponent)//24-Bit bitmap motion detector
  procedure reset;                              //Reset motion stats
  procedure setSize(w,h:word);                  //Set width and height simultaneously
  function feedFrame(aBmp:tBitmap):boolean;     //Feed frame into the motion detector
  function getImage(aBmp:tBitmap;aRePaint:boolean=true):boolean;//Get current image with addons
  function sq:cardinal;                         //Square size of current width and height
  procedure setTolerance(n:cardinal);
  procedure setMinDiff(b:byte);
 private
  pLastFrame                   :pByte;          //Last frame data to compare (24-Bit)
  pMotionMask                  :pByte;          //Optional motion mask overlay (8-Bit)
  fWidth,fHeight               :word;           //Size
  fTolerance                   :cardinal;       //Tolerance of different pixels
  fMinDiff                     :byte;           //Minimum pixel difference
  fMotionMask                  :tShowMask;      //Motion mask overlay
  fUseDetectLight              :boolean;        //Enable using lightness count
  fOnMotion                    :tSimpleEvent;   //..
  motionTick                   :int64;
  procedure notifyMotion;
 public
  //output stats:
  hasMotion                    :boolean;        //Is there motion currently
  maxDiff                      :byte;           //Current max difference of any pixel
  value,lightness              :cardinal;       //Current motion and lightness amount
  constructor create(aOwner:tComponent);override;
  destructor destroy;override;
  property tolerance           :cardinal        read fTolerance        write setTolerance;
  property minimumDifference   :byte            read fMinDiff          write setMinDiff;
  property useDetectLight      :boolean         read fUseDetectLight   write fUseDetectLight;
  property motionMask          :tShowMask       read fMotionMask       write fMotionMask;
  property onMotion            :tSimpleEvent    read fOnMotion         write fOnMotion;
 end;
//-----------------------------|----------------|----------------------|----------------------------

function tick64:int64;stdcall//Get tick count (64-Bit)
//--
procedure Register;

implementation

procedure pFill(p:pAnsiChar;sz:cardinal;ch:ansiChar=NULL);
begin
 while sz<>NONE do begin p^:=ch;inc(p);dec(sz) end;
end;

function pReAlloc(var p;aSize:cardinal;aZeroMem:boolean=true):boolean;
begin
 try reAllocMem(pointer(p),aSize);result:=true except result:=false end;
 if result and aZeroMem then pFill(pointer(p),aSize,NULL)
end;

//--------------------------------------------------------------------------------------------------
//tMotionDetector:

constructor tMotionDetector.create(aOwner:tComponent);
begin inherited create(aOwner);
 pLastFrame:=nil;pMotionMask:=nil;
 fWidth:=NONE;fHeight:=NONE;
 fTolerance:=1000;fMinDiff:=35;
 fMotionMask:=smMotionOnly;
 fUseDetectLight:=true;
 reset;
end;

destructor tMotionDetector.destroy;
begin
 if pMotionMask<>nil then begin freeMem(pMotionMask);pMotionMask:=nil end;
 if pLastFrame<>nil then begin freeMem(pLastFrame);pLastFrame:=nil end;
 inherited destroy
end;

procedure tMotionDetector.reset;
begin hasMotion:=false;
 value:=NONE;lightness:=NONE;maxDiff:=NONE;
end;

procedure tMotionDetector.setSize(w,h:word);//Set width and height simultaneously
begin
 if (w=fWidth) and (h=fHeight) then exit;
 fWidth:=w;fHeight:=h;reset;
 if not pReAlloc(pMotionMask,sq) then exit;   //"safe" reallocate and fill blank (clear)
 if not pReAlloc(pLastFrame,sq*3then exit;  //"safe" reallocate and fill blank (clear)
end;

function tMotionDetector.feedFrame(aBmp:tBitmap):boolean;//Feed frame into the motion detector
var
 p              :pRgb;
 eP,sP,pSrc     :pAnsiChar;
 mP,lP          :pByte;
 psl,v,l,z      :cardinal;
 k,n,aMaxDiff   :byte;
 y              :word;
begin
 result:=false;if aBmp.pixelFormat<>pf24bit then exit;
 if (aBmp.height<>fHeight) or (aBmp.width<>fWidth) then setSize(aBmp.width,aBmp.height); //set size if different
 if (fHeight<2or (fWidth<2then exit;                     //exit if empty picture
 pSrc:=aBmp.scanLine[NONE];sP:=pSrc;                         //first pixel (source)
 psl:=aBmp.scanLine[1]-pSrc;                                 //bytes per scan line
 if fMotionMask<>smNone then mP:=pMotionMask else mP:=nil;   //motion mask (if enabled)
 lP:=pLastFrame;aMaxDiff:=NONE;v:=NONE;l:=NONE;z:=fWidth*3;  //reset
 for y:=NONE to fHeight-1 do begin
  p:=pRgb(sP);eP:=sP+z;                                      //start + end pointer of current line (y)
  while p<eP do begin                                        //fast loop pixels
   k:=abs(lP^-p^.b);lP^:=p^.b;inc(lP);                       //detect motion and write to last frame, BGR
   n:=abs(lP^-p^.g);lP^:=p^.g;inc(lP);if n>k then k:=n;
   n:=abs(lP^-p^.r);lP^:=p^.r;inc(lP);if n>k then k:=n;
   if k>aMaxDiff then aMaxDiff:=k;                           //detect maximum difference
   if k>=fMinDiff then inc(v);                               //value by tolerance
   if fUseDetectLight then inc(l,p^.r+p^.g+p^.b);            //detect lightness
   inc(p);
   if mP<>nil then begin                                     //8-Bit mask of pixel difference
    if fMotionMask<>smLastMotionOnly then mP^:=k else
    if (mP^>fMinDiff) or (mP^=NONEthen mP^:=k else mP^:=NONE;
    inc(mP);
   end;
  end;inc(sP,psl)                                            //next source line
 end;
 value:=v;

 if v>tolerance then begin
  if not hasMotion then notifyMotion
 end else
 if hasMotion and (tick64-motionTick>=3000then hasMotion:=false;

 if fUseDetectLight then lightness:=l div 3;
 maxDiff:=aMaxDiff;result:=true;
end;

function tMotionDetector.getImage(aBmp:tBitmap;aRePaint:boolean=true):boolean;//Get current image with addons
var
 dP          :pRgb;
 eP,pDst     :pAnsiChar;
 lP,mP       :pByte;
 z,psl       :cardinal;
 i           :smallInt;
 y           :word;
begin
  result:=false;
  aBmp.height:=fHeight;
  aBmp.width:=fWidth;
  aBmp.pixelFormat:=pf24bit;
  if (fHeight<2or (fWidth<2or (pLastFrame=nilthen  exit;//exit if empty picture
  pDst:=aBmp.scanLine[NONE];//first pixel (dest)
  psl:=aBmp.scanLine[1]-pAnsiChar(pDst);//bytes per scan line

  lP:=pLastFrame;z:=fWidth*3;
  if fMotionMask<>smNone then mP:=pMotionMask else mP:=nil;
  for y:=NONE to fHeight-1 do begin
   dP:=pRgb(pDst+y*psl);eP:=pAnsiChar(dP)+z;
   while dP<eP do begin

    if aRePaint then begin
     dP^.b:=lP^;inc(lP);
     dP^.g:=lP^;inc(lP);
     dP^.r:=lP^;inc(lP)
    end;//repaint frame

    if mP<>nil then begin
     case fMotionMask of
      smMotionOnly,smLastMotionOnly:if mP^>fMinDiff then begin dP^.g:=NONE;dP^.b:=NONE;i:=dP^.r+mP^;if i>$FF then i:=$FF;dP^.r:=i end;
      smFullMask:if mP^>fMinDiff then begin dP^.g:=NONE;dP^.b:=NONE;i:=dP^.r+mP^;if i>$FF then i:=$FF;dP^.r:=i end;
     else
      dP^.r:=NONE;
      dP^.b:=NONE;
      i:=dP^.g+mP^;if i>$FF then i:=$FF;
      dP^.g:=i
     end;
     inc(mP);
    end;inc(dP);
  end;
 end;

 //some text overlay...
 with aBmp.canvas do begin
  brush.color:=clBlack;font.style:=[fsBold];
  if hasMotion then font.color:=clRed else font.color:=clLime;
  textOut(5,5,'Motion: '+intToStr(value)+' of '+intToStr(sq));
  font.color:=clWhite;
  textOut(5,20,'Lightness: '+intToStr(lightness div sq)+' of '+intToStr(255));
  textOut(5,35,'Max difference: '+intToStr(maxDiff));
 end;

 result:=true
end;

function tMotionDetector.sq:cardinal;begin result:=fWidth*fHeight end;
procedure tMotionDetector.setTolerance(n:cardinal);begin if n<10 then n:=10;fTolerance:=n end;
procedure tMotionDetector.setMinDiff(b:byte);begin if b<1 then b:=1;fMinDiff:=b end;

procedure tMotionDetector.notifyMotion;
begin hasMotion:=true;motionTick:=tick64;
 if assigned(fOnMotion) then fOnMotion;
 //windows.beep(1000,100)
end;

//..

function tick64:int64;external'winmm.dll' name'timeGetTime';

procedure Register;
begin
 registerComponents('Standard', [tMotionDetector]);
end;

end.


Motiondetect Demo.pas (TMotionDetector)
unit Unit1;

interface

uses
  windows,sysUtils,classes,controls,graphics,forms,comObj, ExtCtrls, activeX,
  directShow9, motiondetect;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    pGraph       :iGraphBuilder;
    pBuilder     :iCaptureGraphBuilder2;
    pDevEnum     :iCreateDevEnum;
    pClassEnum   :iEnumMoniker;
    pMoniker     :iMoniker;
    pSrc         :iBaseFilter;
    cFetched     :pLongInt;
    videoWindow  :iVideoWindow;
    mediaControl :iMediaControl;
  public
    motion :tMotionDetector;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
begin
 motion:=tMotionDetector.create(nil);
 image1.picture.bitmap:=tBitmap.create;
 with image1.picture.bitmap do begin
  pixelFormat:=pf24bit;
  width:=image1.width;
  height:=image1.height
 end;
 //--
 pGraph:=createComObject(CLSID_FilterGraph) as iGraphBuilder;
 pBuilder:=createComObject(CLSID_CaptureGraphBuilder2) as iCaptureGraphBuilder2;
 pBuilder.SetFiltergraph(pGraph);
 pDevEnum:=createComObject(CLSID_SystemDeviceEnum) as iCreateDevEnum;
 pDevEnum.createClassEnumerator(CLSID_VideoInputDeviceCategory,pClassEnum,0);
 if pClassEnum.next(1,pMoniker,cFetched)=S_OK then
 pMoniker.bindToObject(nil,nil,IID_IBaseFilter,pSrc);
 pGraph.addFilter(pSrc,'Video Capture');
 pGraph.queryInterface(IID_IMediaControl,mediaControl);
 pGraph.queryInterface(IID_IVideoWindow,videoWindow);
 pBuilder.renderStream(@PIN_CATEGORY_PREVIEW,@MEDIATYPE_VIDEO,pSrc,nil,nil);
 videoWindow.put_windowStyle(WS_CHILD or WS_CLIPSIBLINGS);
 videoWindow.setWindowPosition(0,0,panel1.width,panel1.height);
 videoWindow.put_owner(panel1.handle);
 mediaControl.run;
 timer1.interval:=250;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var aBmp:tBitmap;dc:hdc;
begin
 aBmp:=tBitmap.create;dc:=getDc(panel1.handle);
 with aBmp do begin pixelFormat:=pf24bit;width:=image1.width;height:=image1.height end;
 bitblt(aBmp.canvas.handle,NONE,NONE,width,height,dc,NONE,NONE,SRCCOPY);
 motion.feedFrame(aBmp);
 motion.getImage(aBmp);
 image1.picture.bitmap.canvas.draw(NONE,NONE,aBmp);
 aBmp.free;
end;

end.

Best Post This Year

Install Fortesreport community Delphi 7 dan RX Berlin

Download  Pertama2 kita harus punya file installernya terlebih dahulu, download  https://github.com/fortesinformatica/fortesrepo...

Total Pageviews

© 2014 Fajar Priyadi. WP themonic converted by Bloggertheme9. Published By Gooyaabi Templates | Powered By Blogger
TOP