StringGrid 'de renklendirme işlemi
bu kodu genelde cari hareketlerinde kullanı yorum ama ba ş ka men ü lerde
de kullana bilirsizin
iyi ç al ış malar delphici arkada ş lara
fuatkilinc41@ hotmail . com
procedure TCariHareketForm . StringGrid1DrawCell ( Sender : TObject ; ACol ,
ARow : Integer ; Rect : TRect ; State : TGridDrawState );
StringGrid1 . Canvas . Brush . BeforeDestruction ;
If StringGrid1 . Cells [ 7 , ARow ] = 'A' Then
StringGrid1 . Canvas . Brush . Color := clmoneygreen ;
StringGrid1 . Canvas . Font . Color := clBlack ;
If StringGrid1 . Cells [ 7 , ARow ] = 'B' Then
StringGrid1 . Canvas . Brush . Color := claqua ;
StringGrid1 . Canvas . Font . Color := clBlack ;
If StringGrid1 . Cells [ 7 , ARow ] = '' Then
StringGrid1 . Canvas . Brush . Color := clsilver ;
end ;
Delphi - .....................................
StringGrid 'de renklendirme işlemi
bu kodu genelde cari hareketlerinde kullanı yorum ama ba ş ka men ü lerde
de kullana bilirsizin
iyi ç al ış malar delphici arkada ş lara
fuatkilinc41@ hotmail . com
procedure TCariHareketForm . StringGrid1DrawCell ( Sender : TObject ; ACol ,
ARow : Integer ; Rect : TRect ; State : TGridDrawState );
StringGrid1 . Canvas . Brush . BeforeDestruction ;
If StringGrid1 . Cells [ 7 , ARow ] = 'A' Then
StringGrid1 . Canvas . Brush . Color := clmoneygreen ;
StringGrid1 . Canvas . Font . Color := clBlack ;
If StringGrid1 . Cells [ 7 , ARow ] = 'B' Then
StringGrid1 . Canvas . Brush . Color := claqua ;
StringGrid1 . Canvas . Font . Color := clBlack ;
If StringGrid1 . Cells [ 7 , ARow ] = '' Then
StringGrid1 . Canvas . Brush . Color := clsilver ;
end ;
Delphi - .....................................
İnternet Bileşenleriyle Chat Programı
İ nternet bile ş enleri TSERVERSOCKET VE TCL İ ENTSOCKET
bu bile ş enler internet tab ı nda yer almaktad ı r
Ama direk kurulu olarak gelmez kurmak i ç in component intsall packages t ı klay ı n gelen menude add diyin bin dosyas ı na gelin ve dclsockets70 . bpl paketini secin bukadar
Bile ş enler internet tab ı na yerle ş mi ş olacakt ı r
Bu bile ş enleri daha iyi anlaman ı z i ç in bir ö rnek yapt ı m hem server hem client daha do ğ rusu ç ok ö n ç e yapm ış t ı m ama size ö rnek olsun
Not : program ı ç al ış t ı rd ı ktan sonra bir port kaydetmiyi untmay ı n size ba ğ lanmak istiyen portu bilmeli art ı k geli ş tirmek size kalm ış internet ü zerinden denedim ç al ışı yor
Kod :
procedure TForm1 . Image4Click ( Sender : TObject );
begin
form2 . Show ;
end ;
procedure TForm1 . YARDIM1Click ( Sender : TObject );
begin
form3 . show ;
end ;
procedure TForm1 . Image6Click ( Sender : TObject );
begin
if fontdialog1 . Execute then
mesaj . Font := fontdialog1 . Font ;
memo1 . Font := fontdialog1 . Font ;
end ;
procedure TForm1 . KAPAT1Click ( Sender : TObject );
begin
form1 . Close ;
end ;
procedure TForm1 . BitBtn1Click ( Sender : TObject );
var
Address : string ;
begin
if not ClientSocket1 . Active then
begin
ClientSocket1 . Host := '' ;
ClientSocket1 . Address := '' ;
Address := edit1 . Text ;
if inet_addr ( PChar ( Address )) = INADDR_NONE then
ClientSocket1 . Host := Address
else
ClientSocket1 . Address := Address ;
ClientSocket1 . Port := spiPort . Value ;
end ;
ClientSocket1 . Active := not ClientSocket1 . Active ;
end ;
procedure TForm1 . BitBtn2Click ( Sender : TObject );
begin
if clientsocket1 . Active then
clientsocket1 . Socket . SendText ( 'kulanıcı1::' + mesaj . Text );
memo1 . Lines . Add ( mesaj . Text );
mesaj . Clear ;
end ;
procedure TForm1 . ClientSocket1Disconnect ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlantı koptu' ;
end ;
procedure TForm1 . ClientSocket1Connect ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlantı saglandı' ;
end ;
procedure TForm1 . ClientSocket1Connecting ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlanıyor' ;
end ;
procedure TForm1 . ClientSocket1Error ( Sender : TObject ;
Socket : TCustomWinSocket ; ErrorEvent : TErrorEvent ;
var ErrorCode : Integer );
begin
memo1 . Lines . Text := 'bir hata oluştu' ;
end ;
procedure TForm1 . ServerSocket1ClientRead ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Add ( socket . ReceiveText );
end ;
procedure TForm1 . FormClose ( Sender : TObject ; var Action : TCloseAction );
begin
serversocket1 . Active := false ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
button2 . Show ;
button1 . Enabled := false ;
if ServerSocket1 . Active then
begin
ServerSocket1 . Close ;
memo1 . Lines . Text := 'baglantı koptu' ;
Exit ;
end ;
ServerSocket1 . Port := spinedit2 . Value ;
ServerSocket1 . Open ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
button2 . Hide ;
timer1 . Interval := 100 ;
timer1 . Enabled := true ;
end ;
procedure TForm1 . Timer1Timer ( Sender : TObject );
var
x : integer ;
begin
x := form1 . Height ;
form1 . Height := x + 13 ;
if x > 550 then
timer1 . Enabled := false ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
button1 . Enabled := true ;
button2 . Hide ;
serversocket1 . Active := false ;
end ;
procedure TForm1 . mesajKeyPress ( Sender : TObject ; var Key : Char );
begin
if Key = #13 then
bitbtn2Click ( Sender );
end ;
procedure TForm1 . ServerSocket1Accept ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Add ( socket . RemoteAddress + 'bağlandı' );
end ;
end .
Delphi - .....................................
İnternet Bileşenleriyle Chat Programı
İ nternet bile ş enleri TSERVERSOCKET VE TCL İ ENTSOCKET
bu bile ş enler internet tab ı nda yer almaktad ı r
Ama direk kurulu olarak gelmez kurmak i ç in component intsall packages t ı klay ı n gelen menude add diyin bin dosyas ı na gelin ve dclsockets70 . bpl paketini secin bukadar
Bile ş enler internet tab ı na yerle ş mi ş olacakt ı r
Bu bile ş enleri daha iyi anlaman ı z i ç in bir ö rnek yapt ı m hem server hem client daha do ğ rusu ç ok ö n ç e yapm ış t ı m ama size ö rnek olsun
Not : program ı ç al ış t ı rd ı ktan sonra bir port kaydetmiyi untmay ı n size ba ğ lanmak istiyen portu bilmeli art ı k geli ş tirmek size kalm ış internet ü zerinden denedim ç al ışı yor
Kod :
procedure TForm1 . Image4Click ( Sender : TObject );
begin
form2 . Show ;
end ;
procedure TForm1 . YARDIM1Click ( Sender : TObject );
begin
form3 . show ;
end ;
procedure TForm1 . Image6Click ( Sender : TObject );
begin
if fontdialog1 . Execute then
mesaj . Font := fontdialog1 . Font ;
memo1 . Font := fontdialog1 . Font ;
end ;
procedure TForm1 . KAPAT1Click ( Sender : TObject );
begin
form1 . Close ;
end ;
procedure TForm1 . BitBtn1Click ( Sender : TObject );
var
Address : string ;
begin
if not ClientSocket1 . Active then
begin
ClientSocket1 . Host := '' ;
ClientSocket1 . Address := '' ;
Address := edit1 . Text ;
if inet_addr ( PChar ( Address )) = INADDR_NONE then
ClientSocket1 . Host := Address
else
ClientSocket1 . Address := Address ;
ClientSocket1 . Port := spiPort . Value ;
end ;
ClientSocket1 . Active := not ClientSocket1 . Active ;
end ;
procedure TForm1 . BitBtn2Click ( Sender : TObject );
begin
if clientsocket1 . Active then
clientsocket1 . Socket . SendText ( 'kulanıcı1::' + mesaj . Text );
memo1 . Lines . Add ( mesaj . Text );
mesaj . Clear ;
end ;
procedure TForm1 . ClientSocket1Disconnect ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlantı koptu' ;
end ;
procedure TForm1 . ClientSocket1Connect ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlantı saglandı' ;
end ;
procedure TForm1 . ClientSocket1Connecting ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Text := 'bağlanıyor' ;
end ;
procedure TForm1 . ClientSocket1Error ( Sender : TObject ;
Socket : TCustomWinSocket ; ErrorEvent : TErrorEvent ;
var ErrorCode : Integer );
begin
memo1 . Lines . Text := 'bir hata oluştu' ;
end ;
procedure TForm1 . ServerSocket1ClientRead ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Add ( socket . ReceiveText );
end ;
procedure TForm1 . FormClose ( Sender : TObject ; var Action : TCloseAction );
begin
serversocket1 . Active := false ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
button2 . Show ;
button1 . Enabled := false ;
if ServerSocket1 . Active then
begin
ServerSocket1 . Close ;
memo1 . Lines . Text := 'baglantı koptu' ;
Exit ;
end ;
ServerSocket1 . Port := spinedit2 . Value ;
ServerSocket1 . Open ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
button2 . Hide ;
timer1 . Interval := 100 ;
timer1 . Enabled := true ;
end ;
procedure TForm1 . Timer1Timer ( Sender : TObject );
var
x : integer ;
begin
x := form1 . Height ;
form1 . Height := x + 13 ;
if x > 550 then
timer1 . Enabled := false ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
button1 . Enabled := true ;
button2 . Hide ;
serversocket1 . Active := false ;
end ;
procedure TForm1 . mesajKeyPress ( Sender : TObject ; var Key : Char );
begin
if Key = #13 then
bitbtn2Click ( Sender );
end ;
procedure TForm1 . ServerSocket1Accept ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
memo1 . Lines . Add ( socket . RemoteAddress + 'bağlandı' );
end ;
end .
Delphi - .....................................
Indy İle Dosya Gönderme
DOSYA GÖ NDERME
İ ndy tcp bile ş enlerini kullanarak chat program ı yapm ış t ı k birde bu uygulamaya dosya g ö nderme foksiyonu ekliyelim
CLİ ENT
BEN tasar ı m ı bu ş ekilde yapt ı m dosyan ı n g ö nerim durumunu izlemek i ç in bir tane pogressbar at ı n kod aynen şö yle
Kod :
procedure TForm1 . FormCreate ( Sender : TObject );
begin
bitbtn3 . Enabled := false ;
bitbtn2 . Enabled := false ;
animate1 . hide ;
end ;
procedure TForm1 . BitBtn1Click ( Sender : TObject );
var
port : integer ;
begin
port := strtoint ( edit2 . Text );
client1 . Port := port ; //unutulmaması gereken serverdeki portla aynı olması gerekir
client1 . Host :=( edit1 . Text );
client1 . Connect ;
if client1 . Connected = true then
begin
bitbtn1 . Enabled := false ;
bitbtn2 . Enabled := true ;
bitbtn3 . Enabled := true ;
bar1 . Panels [ 0 ]. Text := 'baglantı sağlandı' ;
end ;
end ;
procedure TForm1 . Client1Disconnected ( Sender : TObject );
begin
bar1 . Panels [ 0 ]. Text := 'bağlantı koptu ' ;
bitbtn3 . Enabled := false ;
bitbtn1 . Enabled := true ;
bitbtn2 . Enabled := false ;
end ;
procedure TForm1 . BitBtn2Click ( Sender : TObject );
begin
client1 . Disconnect ;
end ;
procedure TForm1 . BitBtn3Click ( Sender : TObject );
var
boyut : single ;
dosya : tfilestream ;
dyol : ansistring ;
begin
if opendialog1 . Execute then
begin
dyol := opendialog1 . FileName ;
label5 . Caption := dyol ;
end ;
dosya := tfilestream . Create ( dyol , fmopenread );
boyut := dosya . Size ;
label6 . Caption := floattostr ( boyut );
client1 . WriteStream ( dosya );
end ;
// işlem durumunu görmek için
procedure TForm1 . Client1WorkBegin ( Sender : TObject ; AWorkMode : TWorkMode ;
const AWorkCountMax : Integer );
begin
bar1 . Panels [ 0 ]. Text := 'dosya gönderiliyor ' ;
progressbar1 . Visible := true ;
progressbar1 . Position := 0 ;
progressbar1 . Max := AWorkCountMax ;
animate1 . Active := true ;
animate1 . Show ;
if AWorkCountMax > 0 then
label7 . Caption := inttostr ( AWorkCountMax );
application . ProcessMessages ;
end ;
procedure TForm1 . Client1WorkEnd ( Sender : TObject ; AWorkMode : TWorkMode );
begin
bar1 . Panels [ 0 ]. Text := 'dosya gönderildi ' ;
animate1 . Active := false ;
animate1 . Hide ;
progressbar1 . Visible := false ;
application . ProcessMessages ;
end ;
procedure TForm1 . Client1Work ( Sender : TObject ; AWorkMode : TWorkMode ;
const AWorkCount : Integer );
begin
if progressbar1 . Max > 0 then
begin
label7 . Caption := 'durum:' + inttostr ( AWorkCount )+ '/' + inttostr ( progressbar1 . Max )+ 'byte' ;
progressbar1 . Position :=( AWorkCount );
end
else
label7 . Caption := inttostr ( AWorkCount )+ 'byte' ;
application . ProcessMessages ;
end ;
end .
SERVER KISMI
Kod :
procedure TForm1 . FormCreate ( Sender : TObject );
begin
server1 . DefaultPort := 1111 ; //dinlemeye aldımız port
server1 . Active := true ;
end ;
procedure TForm1 . Server1Connect ( AThread : TIdPeerThread );
begin
statusbar1 . Panels [ 0 ]. Text :=( athread . Connection . Socket . Binding . PeerIP + 'numaralı kişi baglandı ' );
statusbar1 . Panels [ 1 ]. Text := 'bilgisayrın adı ' + athread . Connection . Socket . Name ;
end ;
procedure TForm1 . Server1Execute ( AThread : TIdPeerThread );
var
kod : string ;
dosya : tfilestream ;
dyol : ansistring ;
boyut : single ;
begin
kod := athread . Connection . ReadLn ;
if ( kod = 'dosya' ) then
begin
if ( save . Execute ) then
begin
dyol := save . FileName ;
end ;
dosya := tfilestream . Create ( dyol , fmcreate );
boyut := dosya . Size ;
statusbar1 . Panels [ 0 ]. Text := ':' + floattostr ( boyut )+ 'boyutunda dosya alınıyor' ;
athread . Connection . ReadStream ( dosya );
statusbar1 . Panels [ 0 ]. Text := 'dosya gönderimi tamam' ;
end ;
end ;
end .
Delphi - .....................................
Indy İle Dosya Gönderme
DOSYA GÖ NDERME
İ ndy tcp bile ş enlerini kullanarak chat program ı yapm ış t ı k birde bu uygulamaya dosya g ö nderme foksiyonu ekliyelim
CLİ ENT
BEN tasar ı m ı bu ş ekilde yapt ı m dosyan ı n g ö nerim durumunu izlemek i ç in bir tane pogressbar at ı n kod aynen şö yle
Kod :
procedure TForm1 . FormCreate ( Sender : TObject );
begin
bitbtn3 . Enabled := false ;
bitbtn2 . Enabled := false ;
animate1 . hide ;
end ;
procedure TForm1 . BitBtn1Click ( Sender : TObject );
var
port : integer ;
begin
port := strtoint ( edit2 . Text );
client1 . Port := port ; //unutulmaması gereken serverdeki portla aynı olması gerekir
client1 . Host :=( edit1 . Text );
client1 . Connect ;
if client1 . Connected = true then
begin
bitbtn1 . Enabled := false ;
bitbtn2 . Enabled := true ;
bitbtn3 . Enabled := true ;
bar1 . Panels [ 0 ]. Text := 'baglantı sağlandı' ;
end ;
end ;
procedure TForm1 . Client1Disconnected ( Sender : TObject );
begin
bar1 . Panels [ 0 ]. Text := 'bağlantı koptu ' ;
bitbtn3 . Enabled := false ;
bitbtn1 . Enabled := true ;
bitbtn2 . Enabled := false ;
end ;
procedure TForm1 . BitBtn2Click ( Sender : TObject );
begin
client1 . Disconnect ;
end ;
procedure TForm1 . BitBtn3Click ( Sender : TObject );
var
boyut : single ;
dosya : tfilestream ;
dyol : ansistring ;
begin
if opendialog1 . Execute then
begin
dyol := opendialog1 . FileName ;
label5 . Caption := dyol ;
end ;
dosya := tfilestream . Create ( dyol , fmopenread );
boyut := dosya . Size ;
label6 . Caption := floattostr ( boyut );
client1 . WriteStream ( dosya );
end ;
// işlem durumunu görmek için
procedure TForm1 . Client1WorkBegin ( Sender : TObject ; AWorkMode : TWorkMode ;
const AWorkCountMax : Integer );
begin
bar1 . Panels [ 0 ]. Text := 'dosya gönderiliyor ' ;
progressbar1 . Visible := true ;
progressbar1 . Position := 0 ;
progressbar1 . Max := AWorkCountMax ;
animate1 . Active := true ;
animate1 . Show ;
if AWorkCountMax > 0 then
label7 . Caption := inttostr ( AWorkCountMax );
application . ProcessMessages ;
end ;
procedure TForm1 . Client1WorkEnd ( Sender : TObject ; AWorkMode : TWorkMode );
begin
bar1 . Panels [ 0 ]. Text := 'dosya gönderildi ' ;
animate1 . Active := false ;
animate1 . Hide ;
progressbar1 . Visible := false ;
application . ProcessMessages ;
end ;
procedure TForm1 . Client1Work ( Sender : TObject ; AWorkMode : TWorkMode ;
const AWorkCount : Integer );
begin
if progressbar1 . Max > 0 then
begin
label7 . Caption := 'durum:' + inttostr ( AWorkCount )+ '/' + inttostr ( progressbar1 . Max )+ 'byte' ;
progressbar1 . Position :=( AWorkCount );
end
else
label7 . Caption := inttostr ( AWorkCount )+ 'byte' ;
application . ProcessMessages ;
end ;
end .
SERVER KISMI
Kod :
procedure TForm1 . FormCreate ( Sender : TObject );
begin
server1 . DefaultPort := 1111 ; //dinlemeye aldımız port
server1 . Active := true ;
end ;
procedure TForm1 . Server1Connect ( AThread : TIdPeerThread );
begin
statusbar1 . Panels [ 0 ]. Text :=( athread . Connection . Socket . Binding . PeerIP + 'numaralı kişi baglandı ' );
statusbar1 . Panels [ 1 ]. Text := 'bilgisayrın adı ' + athread . Connection . Socket . Name ;
end ;
procedure TForm1 . Server1Execute ( AThread : TIdPeerThread );
var
kod : string ;
dosya : tfilestream ;
dyol : ansistring ;
boyut : single ;
begin
kod := athread . Connection . ReadLn ;
if ( kod = 'dosya' ) then
begin
if ( save . Execute ) then
begin
dyol := save . FileName ;
end ;
dosya := tfilestream . Create ( dyol , fmcreate );
boyut := dosya . Size ;
statusbar1 . Panels [ 0 ]. Text := ':' + floattostr ( boyut )+ 'boyutunda dosya alınıyor' ;
athread . Connection . ReadStream ( dosya );
statusbar1 . Panels [ 0 ]. Text := 'dosya gönderimi tamam' ;
end ;
end ;
end .
Delphi - .....................................
Tabloyu Word Ve Excel'e Gönderme
Ö ncelikle http : //sourceforge.net/projects/tpofficepartner/ adresinden Office Partner
Componentini indirip Kurun . Kullan ı m ı Ü cretsiz Bir Component . Kurduuktan Sonra
Component Palette OfficePartner sekmesiyle yerini alacakt ı r . Bu bile ş enleri
kullanartak kolayl ı kla Word ve Excel 'e veri aktarabiliriz.
Tabloyu Word 'e Gönderme
Bildi ğ iniz Ş ekilde Veritaban ı Ba ğ lant ı n ı z ı Yap ı n . Component Palette OfficePartner
sekmesinde bir Opword birde OpDataSetModel Bile ş eni Varsay ı lan adlar ı yla b ı rak ı yorum .
Tablomu Worde aktaracak bile ş enimin ad ı ibquery1 . sizinki table1 , query1 , adoquery1
vb . olabilir .
Opword ve OpdatasetModel bile ş enlerinin ö zellikleriyle oynaman ı za gerek yok Her ş eyi
Kodla Halledece ğ iz . Ö ncelikle A ş a ğı daki De ğ i ş keni Tan ı mlay ı n .
Kod :
var
Form1 : TForm1 ;
MergeDoc : TOpWordDocument ; //Değişkenimiz. Daha Sonra Uygulamamız Kapatıldığında
Wordle Ba ğ lant ı m ı z ı Kesildi ğ ini Garantilemek i ç in Formun OnClose Olay ı na A ş a ğı daki
Kodu Yaz ı n
Kod :
if Assigned ( MergeDoc ) then //Word Daha Önce Açılmışsa
MergeDoc . Free ; //Word'ü Kapat
if OpWord1 . Connected = true then //Word'e Bağlıysa
OpWord1 . Connected := false ; //Bağlantıyı Kes
A ş a ğı daki Kodda Verileri Word 'e gödermemizi sağlıyor. Ben Buttonun OnClick Olayına
Yazd ı m .
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
begin
//Worde Aktaracağımız Tabloyu OpDataSetModel Bileşeninin
//Dataset özelliğine Aktarıyoruz
OpDataSetModel1 . Dataset := IBQuery1 ;
if Assigned ( MergeDoc ) then //Word Daha Önce Açılmışsa
MergeDoc . Free ; //Word'ü Kapat
if OpWord1 . Connected = true then //Word'e Bağlıysa
OpWord1 . Connected := false ; //Bağlantıyı Kes
ibquery1 . Active := true ; //Tabloyu Aç
OpWord1 . Connected := True ; //Word'e Bağlan
OpWord1 . DisplayScrollBars := true ; //Word'de Kaydırma Çubukları Görünsün
OpWord1 . Visible := False ; //Word'ü Gizle
MergeDoc := OpWord1 . NewDocument ; //Yeni Word Belgesi Aç
OpWord1 . Visible := True ; //Word'ü Göster
Opword1 . WindowState := wdwsMaximized ; //Word'ü Tam Ekran Olarak Göster
//Tabloyu Word'e Aktar
with OpWord1 . Documents [ 0 ]. Tables . Add do
begin
OfficeModel := OpDatasetModel1 ;
PopulateDocTable ;
end ;
ibquery1 . Active := false ; //Tabloyu Aç
end ;
Tabloyu Excel 'e Gönderme
Bildi ğ iniz Ş ekilde Veritaban ı Ba ğ lant ı n ı z ı Yap ı n . Component Palette OfficePartner
sekmesinde bir OpExcel birde OpDataSetModel Bile ş eni Varsay ı lan adlar ı yla b ı rak ı yorum .
Tablomu Excel 'e aktaracak bileşenimin adı ibquery1. sizinki table1,query1,adoquery1
vb . olabilir .
OpExcel ve OpdatasetModel bile ş enlerinin ö zellikleriyle oynaman ı za gerek yok Her ş eyi
Kodla Halledeceğ iz . Ö ncelikle A ş a ğı daki De ğ i ş keni Tan ı mlay ı n .
Kod :
var
Form1 : TForm1 ;
NewBook : TopExcelWorkBook ; A ş a ğı daki Kodu OpExcel Bile ş eninin BeforeWorkBookClose
Olay ı nada yaz ı n .
Kod :
if Assigned ( NewBook :) then //Excel Daha Önce Açılmışsa
NewBook :. Free ; ///Excel'i Kapat
if OpExcel1 . Connected = true then //Excel 'e Bağlıysa
OpExcel1 . Connected := false ; //Bağlantıyı Kes
Daha Sonra Uygulamam ı z Kapat ı ld ığı nda Excelle Ba ğ lant ı m ı z ı Kesildi ğ ini Garantilemek
iç in Formun OnClose Olay ı na A ş a ğı daki Kodu Yaz ı n .
Kod :
if OpExcel1 . Connected = true then //Excel 'e Bağlıysa
OpExcel1 . Connected := false ; //Bağlantıyı Kes
A ş a ğı daki Kodda Verileri Excel 'e gödermemizi sağlıyor. Ben Buttonun OnClick Olayına
Yazd ı m .
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
var
Rng : TOpExcelRange ;
begin
OpExcel1 . Connected := True ; //Excel'e Bağlan
OpExcel1 . Visible := True ; //Excel'i Göster
OpExcel1 . WindowState := xlwsMaximized ; //Excel'i Tam Ekran Olarak Göster
IBQuery1 . Active := true ; //Tabloyu Aç
NewBook := OpExcel1 . Workbooks . Add ; //Yeni Excel Belgesi Aç ü
//Ayarları Yap
Rng := OpExcel1 . Workbooks [ 0 ]. Worksheets [ 0 ]. Ranges . Add ;
Rng . Name := 'www.delphidunyasi.com' ; //Keyfinize Göre Bir isim Verin
Rng . Address := 'A1' ;
Rng . OfficeModel := OpDataSetModel1 ; //Kaynak OpDataSetModel Bileşeni
//Excele Aktaracağımız Tabloyu OpDataSetModel Bileşeninin
//Dataset özelliğine Aktarıyoruz
OpDataSetModel1 . Dataset := IBQuery1 ;
OpExcel1 . RangeByName [ 'www.delphidunyasi.com' ]. Populate ; //Tabloyu Aktar
OpExcel1 . Workbooks [ 0 ]. Worksheets [ 0 ]. Activate ; //Exceli Aktif Pencere yap
Rng . AsRange . Columns . AutoFit ; //Kolon Genişlikleri Otomatik
IBQuery1 . Active := false ; //Tabloyu Kapat
end ;
Not : Alan Adlar ı n ı Field Editorden DisplayFormat Ö zelli ğ i ile istedi ğ iniz gibi
de ğ i ş tirebilirsiniz . ö rne ğ in alan ad ı DOGUM_TARIHI ise alan ı n DisPlayFormat
ö zelli ğ ine Do ğ um Tarihi Yazarsan ı z alan ad ı DisPlayFormat ö zelli ğ inde oldu ğ u gibi
gö r ü n ü r
Delphi - .....................................
Tabloyu Word Ve Excel'e Gönderme
Ö ncelikle http : //sourceforge.net/projects/tpofficepartner/ adresinden Office Partner
Componentini indirip Kurun . Kullan ı m ı Ü cretsiz Bir Component . Kurduuktan Sonra
Component Palette OfficePartner sekmesiyle yerini alacakt ı r . Bu bile ş enleri
kullanartak kolayl ı kla Word ve Excel 'e veri aktarabiliriz.
Tabloyu Word 'e Gönderme
Bildi ğ iniz Ş ekilde Veritaban ı Ba ğ lant ı n ı z ı Yap ı n . Component Palette OfficePartner
sekmesinde bir Opword birde OpDataSetModel Bile ş eni Varsay ı lan adlar ı yla b ı rak ı yorum .
Tablomu Worde aktaracak bile ş enimin ad ı ibquery1 . sizinki table1 , query1 , adoquery1
vb . olabilir .
Opword ve OpdatasetModel bile ş enlerinin ö zellikleriyle oynaman ı za gerek yok Her ş eyi
Kodla Halledece ğ iz . Ö ncelikle A ş a ğı daki De ğ i ş keni Tan ı mlay ı n .
Kod :
var
Form1 : TForm1 ;
MergeDoc : TOpWordDocument ; //Değişkenimiz. Daha Sonra Uygulamamız Kapatıldığında
Wordle Ba ğ lant ı m ı z ı Kesildi ğ ini Garantilemek i ç in Formun OnClose Olay ı na A ş a ğı daki
Kodu Yaz ı n
Kod :
if Assigned ( MergeDoc ) then //Word Daha Önce Açılmışsa
MergeDoc . Free ; //Word'ü Kapat
if OpWord1 . Connected = true then //Word'e Bağlıysa
OpWord1 . Connected := false ; //Bağlantıyı Kes
A ş a ğı daki Kodda Verileri Word 'e gödermemizi sağlıyor. Ben Buttonun OnClick Olayına
Yazd ı m .
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
begin
//Worde Aktaracağımız Tabloyu OpDataSetModel Bileşeninin
//Dataset özelliğine Aktarıyoruz
OpDataSetModel1 . Dataset := IBQuery1 ;
if Assigned ( MergeDoc ) then //Word Daha Önce Açılmışsa
MergeDoc . Free ; //Word'ü Kapat
if OpWord1 . Connected = true then //Word'e Bağlıysa
OpWord1 . Connected := false ; //Bağlantıyı Kes
ibquery1 . Active := true ; //Tabloyu Aç
OpWord1 . Connected := True ; //Word'e Bağlan
OpWord1 . DisplayScrollBars := true ; //Word'de Kaydırma Çubukları Görünsün
OpWord1 . Visible := False ; //Word'ü Gizle
MergeDoc := OpWord1 . NewDocument ; //Yeni Word Belgesi Aç
OpWord1 . Visible := True ; //Word'ü Göster
Opword1 . WindowState := wdwsMaximized ; //Word'ü Tam Ekran Olarak Göster
//Tabloyu Word'e Aktar
with OpWord1 . Documents [ 0 ]. Tables . Add do
begin
OfficeModel := OpDatasetModel1 ;
PopulateDocTable ;
end ;
ibquery1 . Active := false ; //Tabloyu Aç
end ;
Tabloyu Excel 'e Gönderme
Bildi ğ iniz Ş ekilde Veritaban ı Ba ğ lant ı n ı z ı Yap ı n . Component Palette OfficePartner
sekmesinde bir OpExcel birde OpDataSetModel Bile ş eni Varsay ı lan adlar ı yla b ı rak ı yorum .
Tablomu Excel 'e aktaracak bileşenimin adı ibquery1. sizinki table1,query1,adoquery1
vb . olabilir .
OpExcel ve OpdatasetModel bile ş enlerinin ö zellikleriyle oynaman ı za gerek yok Her ş eyi
Kodla Halledeceğ iz . Ö ncelikle A ş a ğı daki De ğ i ş keni Tan ı mlay ı n .
Kod :
var
Form1 : TForm1 ;
NewBook : TopExcelWorkBook ; A ş a ğı daki Kodu OpExcel Bile ş eninin BeforeWorkBookClose
Olay ı nada yaz ı n .
Kod :
if Assigned ( NewBook :) then //Excel Daha Önce Açılmışsa
NewBook :. Free ; ///Excel'i Kapat
if OpExcel1 . Connected = true then //Excel 'e Bağlıysa
OpExcel1 . Connected := false ; //Bağlantıyı Kes
Daha Sonra Uygulamam ı z Kapat ı ld ığı nda Excelle Ba ğ lant ı m ı z ı Kesildi ğ ini Garantilemek
iç in Formun OnClose Olay ı na A ş a ğı daki Kodu Yaz ı n .
Kod :
if OpExcel1 . Connected = true then //Excel 'e Bağlıysa
OpExcel1 . Connected := false ; //Bağlantıyı Kes
A ş a ğı daki Kodda Verileri Excel 'e gödermemizi sağlıyor. Ben Buttonun OnClick Olayına
Yazd ı m .
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
var
Rng : TOpExcelRange ;
begin
OpExcel1 . Connected := True ; //Excel'e Bağlan
OpExcel1 . Visible := True ; //Excel'i Göster
OpExcel1 . WindowState := xlwsMaximized ; //Excel'i Tam Ekran Olarak Göster
IBQuery1 . Active := true ; //Tabloyu Aç
NewBook := OpExcel1 . Workbooks . Add ; //Yeni Excel Belgesi Aç ü
//Ayarları Yap
Rng := OpExcel1 . Workbooks [ 0 ]. Worksheets [ 0 ]. Ranges . Add ;
Rng . Name := 'www.delphidunyasi.com' ; //Keyfinize Göre Bir isim Verin
Rng . Address := 'A1' ;
Rng . OfficeModel := OpDataSetModel1 ; //Kaynak OpDataSetModel Bileşeni
//Excele Aktaracağımız Tabloyu OpDataSetModel Bileşeninin
//Dataset özelliğine Aktarıyoruz
OpDataSetModel1 . Dataset := IBQuery1 ;
OpExcel1 . RangeByName [ 'www.delphidunyasi.com' ]. Populate ; //Tabloyu Aktar
OpExcel1 . Workbooks [ 0 ]. Worksheets [ 0 ]. Activate ; //Exceli Aktif Pencere yap
Rng . AsRange . Columns . AutoFit ; //Kolon Genişlikleri Otomatik
IBQuery1 . Active := false ; //Tabloyu Kapat
end ;
Not : Alan Adlar ı n ı Field Editorden DisplayFormat Ö zelli ğ i ile istedi ğ iniz gibi
de ğ i ş tirebilirsiniz . ö rne ğ in alan ad ı DOGUM_TARIHI ise alan ı n DisPlayFormat
ö zelli ğ ine Do ğ um Tarihi Yazarsan ı z alan ad ı DisPlayFormat ö zelli ğ inde oldu ğ u gibi
gö r ü n ü r
Delphi - .....................................
Sitedeki Buttona Delphiden Tıklatmak
Arkadaş lar yap ı ş u ş ekilde ;
Kod :
procedure TForm1 . WebBrowser1DocumentComplete ( Sender : TObject ;
const pDisp : IDispatch ; var URL : OleVariant );
var iDoc : IHtmlDocument2 ;
i : integer ;
ov : OleVariant ;
iDisp : IDispatch ;
iColl : IHTMLElementCollection ;
iInputElement : IHTMLInputElement ;
iTextElement : IHTMLTextAreaElement ;
formelement : IHtmlFormElement ;
begin
ov := 'INPUT' ;
IDisp := iDoc . all . tags ( ov );
if assigned ( IDisp ) then begin
IDisp . QueryInterface ( IHTMLElementCollection , iColl );
if assigned ( iColl ) then begin
for i := 1 to iColl . Get_length do begin
iDisp := iColl . item ( pred ( i ), 0 );
iDisp . QueryInterface ( IHTMLInputElement , iInputElement );
if assigned ( iInputElement ) then
f iInputElement . Get_type_ = 'submit'
then iInputElement . Get_form . submit ;
Burda sonda yazm ış oldu ğ um ifade tipi submit olan bir buton bularak clickleme i ş lemini ger ç ekle ş tiriyor arkada ş lar .
Ayn ı ş ekilde e ğ er herhangi bir bo ş luk doldurucaksan ı z bu ifade yerine şö yle bir ifade kullan ı caks ı n ı z ;
Kod :
if iInputElement . Get_name = 'subject'
then iInputElement . Set_value ( 'Selam' ); Buda anla şı laca ğı gibi ad ı subject olan bo ş lu ğ a " Selam " stringini atamak i ç indir .
Son olarakta i ş inize yarayabilice ğ ini d üşü nd üğü m text alanlar ı n ı doldurmak i ç in
kullanabilce ğ iniz bir kod daha ekliyorum .
Yukarda vermi ş oldu ğ um ifade de
Kod :
ov := 'TEXTAREA' ;
IDisp := iDoc . all . tags ( ov );
if assigned ( IDisp ) then
begin
IDisp . QueryInterface ( IHTMLElementCollection , iColl );
if assigned ( iColl ) then
begin
for i := 1 to iColl . Get_length do begin
iDisp := iColl . item ( pred ( i ), 0 );
iDisp . QueryInterface ( IHTMLTextAreaElement , iTextElement );
if assigned ( iTextElement ) then
begin
iTextElement . Set_value ( 'Delphi Güzel Bir Programlama Dilidir.' );
iInputElement . Get_form . submit ;
gibi bir de ğ i ş iklik yaparsan ı z textarea denilen b ö l ü mleride doldurma ş ans ı n ı z
olucakt ı r . B ö yle bir uygulama nerde i ş inize yar ı yabilir sorusunun cevab ı na gelince
ise e ğ er sizde benim gibi formlar ı doldurmaktan s ı k ı ld ı iseniz kendinize b ö yle bir
program yazarak bu ç ileden kurtulma yolunu se ç ebilirsiniz .
Hepinize bol kodlu ve mutlu g ü nler dilerim .
Delphi - .....................................
Sitedeki Buttona Delphiden Tıklatmak
Arkadaş lar yap ı ş u ş ekilde ;
Kod :
procedure TForm1 . WebBrowser1DocumentComplete ( Sender : TObject ;
const pDisp : IDispatch ; var URL : OleVariant );
var iDoc : IHtmlDocument2 ;
i : integer ;
ov : OleVariant ;
iDisp : IDispatch ;
iColl : IHTMLElementCollection ;
iInputElement : IHTMLInputElement ;
iTextElement : IHTMLTextAreaElement ;
formelement : IHtmlFormElement ;
begin
ov := 'INPUT' ;
IDisp := iDoc . all . tags ( ov );
if assigned ( IDisp ) then begin
IDisp . QueryInterface ( IHTMLElementCollection , iColl );
if assigned ( iColl ) then begin
for i := 1 to iColl . Get_length do begin
iDisp := iColl . item ( pred ( i ), 0 );
iDisp . QueryInterface ( IHTMLInputElement , iInputElement );
if assigned ( iInputElement ) then
f iInputElement . Get_type_ = 'submit'
then iInputElement . Get_form . submit ;
Burda sonda yazm ış oldu ğ um ifade tipi submit olan bir buton bularak clickleme i ş lemini ger ç ekle ş tiriyor arkada ş lar .
Ayn ı ş ekilde e ğ er herhangi bir bo ş luk doldurucaksan ı z bu ifade yerine şö yle bir ifade kullan ı caks ı n ı z ;
Kod :
if iInputElement . Get_name = 'subject'
then iInputElement . Set_value ( 'Selam' ); Buda anla şı laca ğı gibi ad ı subject olan bo ş lu ğ a " Selam " stringini atamak i ç indir .
Son olarakta i ş inize yarayabilice ğ ini d üşü nd üğü m text alanlar ı n ı doldurmak i ç in
kullanabilce ğ iniz bir kod daha ekliyorum .
Yukarda vermi ş oldu ğ um ifade de
Kod :
ov := 'TEXTAREA' ;
IDisp := iDoc . all . tags ( ov );
if assigned ( IDisp ) then
begin
IDisp . QueryInterface ( IHTMLElementCollection , iColl );
if assigned ( iColl ) then
begin
for i := 1 to iColl . Get_length do begin
iDisp := iColl . item ( pred ( i ), 0 );
iDisp . QueryInterface ( IHTMLTextAreaElement , iTextElement );
if assigned ( iTextElement ) then
begin
iTextElement . Set_value ( 'Delphi Güzel Bir Programlama Dilidir.' );
iInputElement . Get_form . submit ;
gibi bir de ğ i ş iklik yaparsan ı z textarea denilen b ö l ü mleride doldurma ş ans ı n ı z
olucakt ı r . B ö yle bir uygulama nerde i ş inize yar ı yabilir sorusunun cevab ı na gelince
ise e ğ er sizde benim gibi formlar ı doldurmaktan s ı k ı ld ı iseniz kendinize b ö yle bir
program yazarak bu ç ileden kurtulma yolunu se ç ebilirsiniz .
Hepinize bol kodlu ve mutlu g ü nler dilerim .
Delphi - .....................................
