Bosan aku dengan laba-laba. Stress aku dengan coding. Pecahkan saja gelasnya. Piringnya jangan, itu buat ibu. Nglimur aku.... Ini wadahku source streesku... Hari ini... Besok.. dan... Besok.

Animasi Taskbar const {$J+} animatedTitle : string = ' Animated Application''s TaskBar Title '; {$J-} var cnt: Integer; begin Application.Title := animatedTitle; for cnt := 1 to (Length(animatedTitle) - 1) do animatedTitle[cnt] := Application.Title[cnt + 1]; animatedTitle[Length(animatedTitle)] := Application.Title[1]; end;

AT Command : 1. Dalam Form1, tambahkan komponen2 ini . 1 TComPort (Selanjutnya diberi nama CP) . 1 TEdit (Selanjutnya diberi nama ED) . 1 TButton (Selanjutnya diberi nama BT) . 1 TMemo (Selanjutnya diberi nama MM) 2. Untuk Property, cukup TComPort (CP) : .. .. BaudRate = br19200 (Siemens X35/45) .. .. Port=Com1 (sesuaikan dengan Port Kabel/IrDa) . Lainnya default : .. .. DataBits=dbEight .. .. Parity.Bits=prNone .. .. StopBits=sbOneStopBit . Umumnya Saya ubah : .. .. DiscardNull=True .. .. FlowControl.ControlDTR=dtrEnable 3. Untuk Event : .. .. BT.OnClick : Quote: -------------------------------------------------------------------------------- procedure TForm1.BTClick(Sender: TObject); var Str: String; begin Str := Edit.Text +#13#10; CP.WriteStr(Str); end; -------------------------------------------------------------------------------- .. .. CP.OnRxChar : Quote: -------------------------------------------------------------------------------- procedure TForm1.CPRxChar(Sender: TObject; Count: Integer); var Str: String; begin CP.ReadStr(Str, Count); MM.Text := MM.Text + Str; end; -------------------------------------------------------------------------------- Jangan lupa status Connected dari CP haru True Note Bila menggunakan kabel 5 in 1 atau non original, biasakan untuk menunggu inisiasi sekitar 4 detik sebelum mulai mencoba, untuk kabel ori, inisiasinya tergantung, berkisar 1-2 detik cukup silahkah ketik AT pada edit box (ED) dan tekan tombol (BT), bila tidak ada masalah, pada memo (MM) akan muncul tulisan OK Note umumnya ada 2 mode standar penulisan dalam ATC : .. .. 1. mengirimkan Text+#13#10, atau mengirimkan ATC ditambah CariageReturn dan LineFeed, Contoh seperti AT, AT+CGMR, etc .. .. 2 mengirimkan Text+#13#10 dilanjutkan mengirimkan Text+#23, atau mengirimkan ATC ditambah CariageReturn dan LineFeed, hasilnya berupa WaitingCommand, atau Command yang harus diisi dan diikuti dengan Escape, Contoh adalah AT+CMGS, atau mengirim SMS-PDU mode IMEI .. AT+CGSN Manfacture .. AT+CGMI Model .. AT+CGMM IMSI .. AT+CIMI Select PhoneBook SIM PhoneBook .. AT+CPBS="SM" ME (Mobile Equipment) PhoneBookAT+CPBS="ME" Selected PhoneBook Capacity .. AT+CPBR=? Read Record#1.. AT+CPBR=1 Nah trik berikutnya, 1. Gunakan array yang berisi ATC yang akan digunakan dalam program 2. Buat loop atas array, .. .. kirimkan tiap string array via ComPort.Write .. .. buat delay hingga penanda komunikasi (CommunicationFlag) muncul, seperti OK/ERROR .. .. Tuliskan hasil yang ada kedalam sebuah TStrings, Hapus baris2 yang mengandung OK / ERROR .. .. Kosongkan kembali FeedBuffer (Hasil yang bila menggunakan sample diatas, ditulis dalm TMemo) .. .. lanjutkan loop ke perintah berikutnya Read Record#1to 100 .. AT+CPBR=1,100

AVI to Delphi : In Notepad type or some other simple text editor type: MyAvi AVI "some.avi" or 100 AVI "some.avi" depending on how you want to reference the identifier. You will want to know whether it is referenced by a resource name or a resource ID when you write the code to play the AVI. Save the file with a .RC extension You will be using the Animate Component to play the file, therefore the same rules apply, like no sound can be with the AVI. Use Borland's Resource Compiler: BRCC32.EXE to convert the file to a .RES file. At the dos prompt type the following: brcc32 myfile.rc This is some code to play an animation using the Resource Name: Animate.ResHandle := 0; Animate.ResName := 'MyAvi'; Animate.Active := True; To stop an animation, call the Stop method. Place the following code to add your resource file into your executable. {$R MYFILE.RES} A sample file is listed below of how this would work correctly: AviRes.pas unit AviResU; interface uses Forms, ComCtrls, StdCtrls, Classes, Controls; type TForm1 = class(TForm) PlayBtn: TButton; Animate: TAnimate; StopBtn: TButton; procedure PlayBtnClick(Sender: TObject); procedure StopBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} {$R AVIRESRC.RES} procedure TForm1.PlayBtnClick(Sender: TObject); begin Animate.ResHandle := 0; Animate.ResName := 'TurboGuy'; Animate.Active := True; PlayBtn.Enabled := False; StopBtn.Enabled := True; end; procedure TForm1.StopBtnClick(Sender: TObject); begin Animate.Stop; PlayBtn.Enabled := True; StopBtn.Enabled := False; end; end.

Background From MySQL : var Bcg: TBitmap; BF: TBlobField; Buf: TStream; begin // fetch data pake query XQuery.SQL.Text:= 'SELECT IMG_FIELD FROM TABLE_NAME WHERE PK_KEY = 101'; XQuery.Open; // assign Blob field to BF BF:= XQuery.FindField('IMG_FIELD'); // create memory stream Buf:= TMemoryStream.Create; try // assign blob field data to stream BF.SaveToStream(Buf); // reset stream pointer Buf.Seek(0, soFromBeginning); // nah... sekarang tinggal assign Buf stream ke bitmap Bcg.LoadFromStream(Buf); finally Buf.Free; end; end;

Bel Hari Pelajaran : unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls, DB, ADODB, Buttons, DBCtrls, Mask, Grids, DBGrids,MMsystem; type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Timer1: TTimer; ADOConnection1: TADOConnection; ADOTable1: TADOTable; BitBtn1: TBitBtn; DataSource1: TDataSource; DBGrid1: TDBGrid; DBEdit1: TDBEdit; DBComboBox1: TDBComboBox; DBComboBox2: TDBComboBox; Label8: TLabel; Label9: TLabel; Label10: TLabel; DBNavigator1: TDBNavigator; ADOQuery1: TADOQuery; DataSource2: TDataSource; Edit1: TEdit; DBGrid2: TDBGrid; Label11: TLabel; DBEdit2: TDBEdit; DBEdit3: TDBEdit; Button1: TButton; procedure Timer1Timer(Sender: TObject); procedure DBEdit1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public path:string; { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); var i: word; begin label5.Caption:=timetostr(time); if label5.caption=dbedit2.Text then begin if dbedit3.Text ='9' then sndPlaySound('bel2.wav', SND_ASYNC or SND_FILENAME) else begin for i:=1 to strtoint(dbedit3.Text) do begin sndPlaySound('bel1.wav', SND_ASYNC and snd_loop); end; sndPlaySound('',snd_async); end; adoquery1.Next ; end; end; procedure TForm1.DBEdit1Change(Sender: TObject); begin if dbedit1.IsMasked = not true then dbedit1.Field.EditMask :='99:99:99'; end; procedure TForm1.FormCreate(Sender: TObject); var ADate: TDateTime; days: array of string; begin path:=ExtractFilePath (Application.ExeName); adoconnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+path+'\Database\bel.mdb;Persist Security Info=False'; adoconnection1.Connected :=true; adotable1.Active :=true; { form1.Caption :=ExtractFilePath (Application.ExeName); } form1.Height :=600; form1.Width :=800; pagecontrol1.ActivePage :=tabsheet1; days[1] := 'Minggu'; days[2] := 'Senin'; days[3] := 'Selasa'; days[4] := 'Rabu'; days[5] := 'Kamis'; days[6] := 'Jumat'; days[7] := 'Sabtu'; ADate := date; label6.Caption:=datetostr(date); label7.Caption:=days[DayOfWeek(ADate)]; edit1.Text :=label7.Caption; adoQuery1.Parameters.ParamByName('hari_apa').Value := Edit1.Text; adoquery1.Active :=true; { adoquery1.SetFields(jam_ke) adoquery1.go Table1.SetKey; Table1.Fields[0].AsString := 'Sm'; Table1.GotoNearest;} { adoquery1.First ;} end; procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin if dbedit3.Text ='9' then sndPlaySound('bel2.wav', SND_ASYNC or SND_FILENAME) else begin for i:=1 to strtoint(dbedit3.Text) do begin sndPlaySound('bel1.wav', SND_ASYNC and snd_loop); end; sndPlaySound('',snd_async); end; end; end. {function ExitWindowsEx (uFlags : word ; dwReserved : DWORD): BOOL; ExitWindowsEx (EWX_SHUTDOWN, 0); }

Cek Printer : Function PrinterStatus(LPTPort: Word): Byte; var Status: byte; CheckLPT: word; begin Status := 0; if (LPTPort >= 1) and (LPTPort <= 3) then begin CheckLPT := LPTPort - 1; asm mov dx, CheckLPT; mov al, 0; mov ah, 2; int 17h; mov &Status, ah; end; end; Result := Status; end;

Rekan eksant, masukkan di artikel saja, lebih nyaman lohh.. http://pascal-id.org/dpr/Submit_News.pas

Chatting : CHATING - CLIENT unit UClient; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, jpeg, StdCtrls, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdTCPServer, IdException; type TFClient = class(TForm) Image1: TImage; IdServer: TIdTCPServer; IdClient: TIdTCPClient; EdPesan: TEdit; Label1: TLabel; BKirim: TPanel; ListPesan: TMemo; procedure FormCreate(Sender: TObject); procedure IdServerExecute(AThread: TIdPeerThread); procedure BKirimMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure BKirimMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure BKirimClick(Sender: TObject); procedure EdPesanKeyPress(Sender: TObject; var Key: Char); private { Private declarations } public { Public declarations } end; var FClient: TFClient; implementation {$R .dfm} procedure TFClient.FormCreate(Sender: TObject); begin Image1.Picture.LoadFromFile(GetCurrentDir + '\XP.JPG'); end; procedure TFClient.IdServerExecute(AThread: TIdPeerThread); var s : string; begin with AThread.Connection do begin s := ReadLn; ListPesan.Lines.Append('[' + FormatDateTime('hh : mm : ss', Time) + ']' + s); end; end; procedure TFClient.BKirimMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin BKirim.BevelInner := bvLowered; BKirim.BevelOuter := bvLowered; end; procedure TFClient.BKirimMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin BKirim.BevelInner := bvNone; BKirim.BevelOuter := bvRaised; end; procedure TFClient.BKirimClick(Sender: TObject); begin if Trim(EdPesan.Text) = '' then begin MessageDlg('Ketik dulu pesannya, fuck boy !!!', mtWarning, [MBOK], 0); EdPesan.SetFocus; end else begin try IdClient.Host := '127.0.0.1'; IdClient.Port := 1500; IdClient.Connect; IdClient.WriteLn('<nDu711> ' + EdPesan.Text); IdClient.Disconnect; ListPesan.Lines.Append('[' + FormatDateTime('hh : mm : ss', Time) + ']' + ' <nDu711> ' + EdPesan.Text); EdPesan.Text := ''; EdPesan.SetFocus; MessageDlg('Pesan berhasil dikirim !', mtInformation, [MBOK], 0); except on EIdConnClosedGracefully do begin MessageDlg('Koneksi ke tox2wow terputus !', mtWarning, [MBOK], 0); IdClient.Disconnect; Label1.Caption := ''; EdPesan.Text := ''; end; on EIdAlreadyConnected do begin MessageDlg('Anda sudah terkoneksi !', mtWarning, [MBOK], 0); IdClient.Disconnect; EdPesan.Text := ''; end; on EIdSocketError do begin MessageDlg('Aplikasi di tox2wow tidak dijalankan !', mtWarning, [MBOK], 0); IdClient.Disconnect; Label1.Caption := ''; EdPesan.Text := ''; end; end; end; end; procedure TFClient.EdPesanKeyPress(Sender: TObject; var Key: Char); begin if key =#13then BKirim.OnClick(self); end; end. CHATING - SERVER unit UServer; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, jpeg, StdCtrls, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdTCPServer, IdException; type TForm1 = class(TForm) Image1: TImage; IdServer: TIdTCPServer; IdClient: TIdTCPClient; EdPesan: TEdit; Label1: TLabel; BKirim: TPanel; ListPesan: TMemo; Label2: TLabel; CbJenis: TComboBox; procedure FormCreate(Sender: TObject); procedure IdServerExecute(AThread: TIdPeerThread); procedure BKirimMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure BKirimMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure BKirimClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R .dfm} procedure TForm1.FormCreate(Sender: TObject); begin Image1.Picture.LoadFromFile(GetCurrentDir + '\XP.JPG'); end; procedure TForm1.IdServerExecute(AThread: TIdPeerThread); var s : string; begin with AThread.Connection do begin s := ReadLn; ListPesan.Lines.Append('[' + FormatDateTime('hh : mm : ss', Time) + ']' + s); end; end; procedure TForm1.BKirimMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin BKirim.BevelInner := bvLowered; BKirim.BevelOuter := bvLowered; end; procedure TForm1.BKirimMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin BKirim.BevelInner := bvNone; BKirim.BevelOuter := bvRaised; end; procedure TForm1.BKirimClick(Sender: TObject); begin try IdClient.Host := '127.0.0.1'; IdClient.Port := 1500; IdClient.Connect; IdClient.WriteLn('<tox2wow> ' + EdPesan.Text); IdClient.Disconnect; ListPesan.Lines.Append('[' + FormatDateTime('hh : mm : ss', Time) + ']' + ' <tox2wow> ' + EdPesan.Text); EdPesan.Text := ''; EdPesan.SetFocus; except on EIdConnClosedGracefully do begin ShowMessage('Koneksi ke nDu711 terputus !'); IdClient.Disconnect; Label1.Caption := ''; end; on EIdAlreadyConnected do begin ShowMessage('Anda sudah terkoneksi !'); IdClient.Disconnect; end; on EIdSocketError do begin ShowMessage('Koneksi ke nDu711 gagal !'); IdClient.Disconnect; Label1.Caption := ''; end; end; end; end.

Pindah ach... OnArtikel. Kamsya kang Luri