Edit ve Benzeri Elemanların Üzerinde Değişiklik Olduğu Zaman Fark Eden Program Parçası
Uzun Yolu
void __fastcall TForm3::Edit3Change(TObject *Sender)
{
int a,b=32;
if (DBEdit3->ReadOnly==false )
{
a=StrToInt(DBEdit3->Text.Length());
b=a-1;
if (a>b)
{
ToolButton2->Enabled=true ;
ToolButton1->Enabled=false ;
ToolButton4->Enabled=false ;
ToolButton3->Enabled=false ;
ToolButton8->Enabled=false ;
}
}
}
Kısa Yolu
void __fastcall TForm3::Edit3Change(TObject *Sender)
{
if (Edit1->Modified) ShowMessage ("Değişiklik Yapıldı.");
}
C++ Builder - .....................................
Sevgili Programcılar ve Eğitimciler
... (*
Merhaba, ben Tarık Bağrıyanık, Tuzla
Gelecek yıl MEGEP isminde (www.megep.meb.gov.tr) uygulanmaya başlayacak olan
gelişim içinde, Bilişim bölümünün müfredatını hazırlama görevini aldık.
6 ay gibi kısa bir sürede kitap ve ders oluşumlarını bitirmemiz gerekli.
2006-2007'de, olsa da olmasa da uygulama başlayacak...
MEGEP(MESLEKİ EĞİTİM VE ÖĞRETİM SİSTEMİNİN GÜÇLENDİRİLMESİ PROJESİ );
sertifikasyon ve diploma sistemine dayalı modüler eğitim sistemidir.
Tüm meslek dallarının içeriği (modülleri) bir havuza toplanacak, yılın başında
zümre öğretmenleri hangi dersleri/dalları okulda vereceğine karar verecek.
Öğrencinin uygulama ve araştırma yaparak öğrenmesi asıl amaç, yani öğretmene değil
öğrenciye dayalı eğitim.
Yıl sonunda da "Ulusal Yeterlik Sınavı" adında bir sınav olacak. Tüm okullar eşit
olarak sınava girecek. Öğretmen ve öğrencinin kalitesi artırılmaya çalışıyor.
Lisenin meslek liselerine oranı şimdilik %70 iken, bir süre sonra %10 gibi olacak.
Herkese bir veya daha fazla meslek kazandırılıyor. Piyasadaki insanlar, treni kaçırdım
diye üzülmemeli. Çünkü bu eğitim yaygın eğitim (TV, radyo, net, kitap, okul) ortamlarına
halinde hazır olacak. Kitaplar(CD'li, uygulamalı) bedava olarak dağıtılıyor.
Yaş ne olursa olsun sertifika kazanmak için meslek liselerine başvurulabilecek.
Yaşam boyu eğitim... Yerel ihtiyaçlar gözönünde bulundurulacak. Yani her yerde
"Gemicilik" bölümü açılamayacak.
Şu anda 17 bölüm hazır. 33 adet daha bölüm hazırlanıyor. Tabi ders, CD hazırlandı
bitti 30 yıl bunlar okutulacak DEĞİL... devamlı ihtiyaçlar analiz edilip, modüller
güncellenecek. Mesela MSAccess'in artık bir geçerliği kalmamış, yerine başka
bir sistem gelmişse, ona yönelecek!
Avrupa Birliğine uyum için çalışmalar hızla devam ediyor.
Profesyonel olmayan bakış açımız ile şöyle bir plan yapıyoruz:
Genel olarak bilişim 4 dal gibi gözüküyor:
1-Yazılım (MCSD, MCAD, MCDBA)
2-Web tasarım (Macromedia, ASP.NET)
3-Ağ sistemleri (Cisco - CCNA)
4-Teknik destek elemanı (Cisco)
Bilişim mesleği - YAZILIM dalı:
9. sınıf: genel ortak dersler (liseler ile aynı)
10. sınıf: bilgisayar teknik servis, yazılım destek, algoritma
11. sınıf: veritabanı (MSAccess) ve VB.NET ile programlama
12. sınıf: SQL sunucu (MSSQL) ve staj/proje
Sektör (yani siz
-Sizce meslek liseleri seviyesinde biz öğrencilere hangi dersleri vermemiz doğru olur?
-Üniversiteye gelmeden önce veya hayata atılamadan önce lisede neler görmelidir?
-üstte eksiklerimiz/fazlalarımız nelerdir?
-İçerik olarak neler tavsiye ediyorsunuz?
Kolay gelsin. Cevaplarınızı buraya değil de mail olarak bana yollar mısınız?
Diğer insanları rahatsız (sinir) etmeyelim.
(ne TDİ, ne de kod örneği olmayan bu yazı için özür dilerim, ama tüm
Türkiye'yi ilgilendiriyor, sizin de fikrinizi almam gerekli...)
Sitem: www.yunus.projesi.com
Mail : tbagriyanik@mynet.com (tbagriyanik@hotmail.com messenger için)
Delphi - .....................................
Sevgili Programcılar ve Eğitimciler
... (*
Merhaba, ben Tarık Bağrıyanık, Tuzla
Gelecek yıl MEGEP isminde (www.megep.meb.gov.tr) uygulanmaya başlayacak olan
gelişim içinde, Bilişim bölümünün müfredatını hazırlama görevini aldık.
6 ay gibi kısa bir sürede kitap ve ders oluşumlarını bitirmemiz gerekli.
2006-2007'de, olsa da olmasa da uygulama başlayacak...
MEGEP(MESLEKİ EĞİTİM VE ÖĞRETİM SİSTEMİNİN GÜÇLENDİRİLMESİ PROJESİ );
sertifikasyon ve diploma sistemine dayalı modüler eğitim sistemidir.
Tüm meslek dallarının içeriği (modülleri) bir havuza toplanacak, yılın başında
zümre öğretmenleri hangi dersleri/dalları okulda vereceğine karar verecek.
Öğrencinin uygulama ve araştırma yaparak öğrenmesi asıl amaç, yani öğretmene değil
öğrenciye dayalı eğitim.
Yıl sonunda da "Ulusal Yeterlik Sınavı" adında bir sınav olacak. Tüm okullar eşit
olarak sınava girecek. Öğretmen ve öğrencinin kalitesi artırılmaya çalışıyor.
Lisenin meslek liselerine oranı şimdilik %70 iken, bir süre sonra %10 gibi olacak.
Herkese bir veya daha fazla meslek kazandırılıyor. Piyasadaki insanlar, treni kaçırdım
diye üzülmemeli. Çünkü bu eğitim yaygın eğitim (TV, radyo, net, kitap, okul) ortamlarına
halinde hazır olacak. Kitaplar(CD'li, uygulamalı) bedava olarak dağıtılıyor.
Yaş ne olursa olsun sertifika kazanmak için meslek liselerine başvurulabilecek.
Yaşam boyu eğitim... Yerel ihtiyaçlar gözönünde bulundurulacak. Yani her yerde
"Gemicilik" bölümü açılamayacak.
Şu anda 17 bölüm hazır. 33 adet daha bölüm hazırlanıyor. Tabi ders, CD hazırlandı
bitti 30 yıl bunlar okutulacak DEĞİL... devamlı ihtiyaçlar analiz edilip, modüller
güncellenecek. Mesela MSAccess'in artık bir geçerliği kalmamış, yerine başka
bir sistem gelmişse, ona yönelecek!
Avrupa Birliğine uyum için çalışmalar hızla devam ediyor.
Profesyonel olmayan bakış açımız ile şöyle bir plan yapıyoruz:
Genel olarak bilişim 4 dal gibi gözüküyor:
1-Yazılım (MCSD, MCAD, MCDBA)
2-Web tasarım (Macromedia, ASP.NET)
3-Ağ sistemleri (Cisco - CCNA)
4-Teknik destek elemanı (Cisco)
Bilişim mesleği - YAZILIM dalı:
9. sınıf: genel ortak dersler (liseler ile aynı)
10. sınıf: bilgisayar teknik servis, yazılım destek, algoritma
11. sınıf: veritabanı (MSAccess) ve VB.NET ile programlama
12. sınıf: SQL sunucu (MSSQL) ve staj/proje
Sektör (yani siz
-Sizce meslek liseleri seviyesinde biz öğrencilere hangi dersleri vermemiz doğru olur?
-Üniversiteye gelmeden önce veya hayata atılamadan önce lisede neler görmelidir?
-üstte eksiklerimiz/fazlalarımız nelerdir?
-İçerik olarak neler tavsiye ediyorsunuz?
Kolay gelsin. Cevaplarınızı buraya değil de mail olarak bana yollar mısınız?
Diğer insanları rahatsız (sinir) etmeyelim.
(ne TDİ, ne de kod örneği olmayan bu yazı için özür dilerim, ama tüm
Türkiye'yi ilgilendiriyor, sizin de fikrinizi almam gerekli...)
Sitem: www.yunus.projesi.com
Mail : tbagriyanik@mynet.com (tbagriyanik@hotmail.com messenger için)
Delphi - .....................................
fast report kullanarak database e blob alana yazıp okutturmak
//Bu yazmak
function TForm1 . frxDesigner1SaveReport ( Report : TfrxReport ;
SaveAs : Boolean ): Boolean ;
var template : TStream ;
begin
template := TMemoryStream . Create ;
template . Position := 0 ;
frxReport1 . SaveToStream ( template );
Reports . Edit ;
try
Reports . DisableControls ;
( Reports . FieldByName ( 'Report' ) as TBlobField ). LoadFromStream ( template );
Reports . Post ;
finally
Reports . EnableControls ;
end ;
end ;
//Buda okutturmak
procedure TForm1 . btnPrintClick ( Sender : TObject );
var template : TStream ;
begin
template := Reports . CreateBlobStream ( Reports . FieldByName ( 'Report' ), bmRead );
template . Position := 0 ;
try
frxReport1 . LoadFromStream ( template );
frxReport1 . ShowReport ;
finally
template . Free ;
end ;
end ;
(*
-----------------------------------------------------------------------
Şükrü Kansız
GEBİTEK A.Ş. (Gelişmiş Bilişim Teknolojileri Tic. A.Ş.)
Bilgisayar Programcısı - Proje Koordinatörü
sukru@gebitek.com / www.gebitek.com
Tel: +90(212) 225 84 77 Fax: +90(212) 225 84 76
-----------------------------------------------------------------------
*)
Delphi - .....................................
fast report kullanarak database e blob alana yazıp okutturmak
//Bu yazmak
function TForm1 . frxDesigner1SaveReport ( Report : TfrxReport ;
SaveAs : Boolean ): Boolean ;
var template : TStream ;
begin
template := TMemoryStream . Create ;
template . Position := 0 ;
frxReport1 . SaveToStream ( template );
Reports . Edit ;
try
Reports . DisableControls ;
( Reports . FieldByName ( 'Report' ) as TBlobField ). LoadFromStream ( template );
Reports . Post ;
finally
Reports . EnableControls ;
end ;
end ;
//Buda okutturmak
procedure TForm1 . btnPrintClick ( Sender : TObject );
var template : TStream ;
begin
template := Reports . CreateBlobStream ( Reports . FieldByName ( 'Report' ), bmRead );
template . Position := 0 ;
try
frxReport1 . LoadFromStream ( template );
frxReport1 . ShowReport ;
finally
template . Free ;
end ;
end ;
(*
-----------------------------------------------------------------------
Şükrü Kansız
GEBİTEK A.Ş. (Gelişmiş Bilişim Teknolojileri Tic. A.Ş.)
Bilgisayar Programcısı - Proje Koordinatörü
sukru@gebitek.com / www.gebitek.com
Tel: +90(212) 225 84 77 Fax: +90(212) 225 84 76
-----------------------------------------------------------------------
*)
Delphi - .....................................
SQL Sorgu Örnekleri FROM_UNIXTIME
(* MySQL *)
SELECT FROM_UNIXTIME ( tarih_col , '' % d .% m .% Y '' ) AS tarih_col_tmp FROM ....
(* Çıktı *)
tarih_col = '01.01.1979 '
(* Örnekler *)
mysql > SELECT DATE_ADD ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1998-02-02 '
mysql > SELECT ADDDATE ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1998-02-02 '
mysql > SELECT ADDDATE ( '1998-01-02 ' , 31 );
-> '1998-02-02 '
mysql > SELECT CONVERT_TZ ( '2004-01-01 12:00: 00' , 'GMT' , 'MET' );
-> '2004-01-01 13:00: 00'
mysql > SELECT CONVERT_TZ ( '2004-01-01 12:00: 00' , '+00:00' , '-07:00' );
-> '2004-01-01 05:00: 00'
mysql > SELECT '1997-12-31 23:59: 59' + INTERVAL 1 SECOND ;
-> '1998-01-01 00:00: 00'
mysql > SELECT INTERVAL 1 DAY + '1997-12-31 ' ;
-> '1998-01-01 '
mysql > SELECT '1998-01-01 ' - INTERVAL 1 SECOND ;
-> '1997-12-31 23:59: 59'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL 1 SECOND );
-> '1998-01-01 00:00: 00'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL 1 DAY );
-> '1998-01-01 23:59: 59'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL '1:1' MINUTE_SECOND );
-> '1998-01-01 00:01: 00'
mysql > SELECT DATE_SUB ( '1998-01-01 00:00: 00' ,
-> INTERVAL '1 1:1:1' DAY_SECOND );
-> '1997-12-30 22:58: 59'
mysql > SELECT DATE_ADD ( '1998-01-01 00:00: 00' ,
-> INTERVAL '-1 10' DAY_HOUR );
-> '1997-12-30 14:00: 00'
mysql > SELECT DATE_SUB ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1997-12-02 '
mysql > SELECT DATE_ADD ( '1992-12-31 23:59: 59.000002' ,
-> INTERVAL '1.999999' SECOND_MICROSECOND );
-> '1993-01-01 00:00: 01.000001'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' , '%W %M %Y' );
-> 'Saturday October 1997'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' , '%H:%i:%s' );
-> '22:23:00'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' ,
'%D %y %a %d %m %b %j' );
-> '4th 97 Sat 04 10 Oct 27 7'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' ,
'%H %k %I %r %T %S %w' );
-> '22 22 10 10:23: 00 PM 22:23: 00 00 6'
mysql > SELECT DATE_FORMAT ( '1999-01-01 ' , '%X %V' );
-> '1998 52'
mysql > SELECT TIMESTAMPDIFF ( MONTH , '2003-02-01 ' , '2003-05-01 ' );
-> 3
mysql > SELECT TIMESTAMPDIFF ( YEAR , '2002-05-01 ' , '2001-01-01 ' );
-> -1
mysql > SELECT WEEK ( '1998-02-20 ' );
-> 7
mysql > SELECT WEEK ( '1998-02-20 ' , 0 );
-> 7
mysql > SELECT WEEK ( '1998-02-20 ' , 1 );
-> 8
mysql > SELECT WEEK ( '1998-12-31 ' , 1 );
-> 53
mysql > UPDATE tbl_name
SET blob_column = LOAD_FILE ( '/tmp/picture' )
WHERE id = 1 ;
(*
-----------------------------------------------------------------------
Şükrü Kansız
GEBİTEK A.Ş. (Gelişmiş Bilişim Teknolojileri Tic. A.Ş.)
Bilgisayar Programcısı - Proje Koordinatörü
sukru@gebitek.com / www.gebitek.com
Tel: +90(212) 225 84 77 Fax: +90(212) 225 84 76
-----------------------------------------------------------------------
*)
Delphi - .....................................
SQL Sorgu Örnekleri FROM_UNIXTIME
(* MySQL *)
SELECT FROM_UNIXTIME ( tarih_col , '' % d .% m .% Y '' ) AS tarih_col_tmp FROM ....
(* Çıktı *)
tarih_col = '01.01.1979 '
(* Örnekler *)
mysql > SELECT DATE_ADD ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1998-02-02 '
mysql > SELECT ADDDATE ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1998-02-02 '
mysql > SELECT ADDDATE ( '1998-01-02 ' , 31 );
-> '1998-02-02 '
mysql > SELECT CONVERT_TZ ( '2004-01-01 12:00: 00' , 'GMT' , 'MET' );
-> '2004-01-01 13:00: 00'
mysql > SELECT CONVERT_TZ ( '2004-01-01 12:00: 00' , '+00:00' , '-07:00' );
-> '2004-01-01 05:00: 00'
mysql > SELECT '1997-12-31 23:59: 59' + INTERVAL 1 SECOND ;
-> '1998-01-01 00:00: 00'
mysql > SELECT INTERVAL 1 DAY + '1997-12-31 ' ;
-> '1998-01-01 '
mysql > SELECT '1998-01-01 ' - INTERVAL 1 SECOND ;
-> '1997-12-31 23:59: 59'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL 1 SECOND );
-> '1998-01-01 00:00: 00'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL 1 DAY );
-> '1998-01-01 23:59: 59'
mysql > SELECT DATE_ADD ( '1997-12-31 23:59: 59' ,
-> INTERVAL '1:1' MINUTE_SECOND );
-> '1998-01-01 00:01: 00'
mysql > SELECT DATE_SUB ( '1998-01-01 00:00: 00' ,
-> INTERVAL '1 1:1:1' DAY_SECOND );
-> '1997-12-30 22:58: 59'
mysql > SELECT DATE_ADD ( '1998-01-01 00:00: 00' ,
-> INTERVAL '-1 10' DAY_HOUR );
-> '1997-12-30 14:00: 00'
mysql > SELECT DATE_SUB ( '1998-01-02 ' , INTERVAL 31 DAY );
-> '1997-12-02 '
mysql > SELECT DATE_ADD ( '1992-12-31 23:59: 59.000002' ,
-> INTERVAL '1.999999' SECOND_MICROSECOND );
-> '1993-01-01 00:00: 01.000001'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' , '%W %M %Y' );
-> 'Saturday October 1997'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' , '%H:%i:%s' );
-> '22:23:00'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' ,
'%D %y %a %d %m %b %j' );
-> '4th 97 Sat 04 10 Oct 27 7'
mysql > SELECT DATE_FORMAT ( '1997-10-04 22:23: 00' ,
'%H %k %I %r %T %S %w' );
-> '22 22 10 10:23: 00 PM 22:23: 00 00 6'
mysql > SELECT DATE_FORMAT ( '1999-01-01 ' , '%X %V' );
-> '1998 52'
mysql > SELECT TIMESTAMPDIFF ( MONTH , '2003-02-01 ' , '2003-05-01 ' );
-> 3
mysql > SELECT TIMESTAMPDIFF ( YEAR , '2002-05-01 ' , '2001-01-01 ' );
-> -1
mysql > SELECT WEEK ( '1998-02-20 ' );
-> 7
mysql > SELECT WEEK ( '1998-02-20 ' , 0 );
-> 7
mysql > SELECT WEEK ( '1998-02-20 ' , 1 );
-> 8
mysql > SELECT WEEK ( '1998-12-31 ' , 1 );
-> 53
mysql > UPDATE tbl_name
SET blob_column = LOAD_FILE ( '/tmp/picture' )
WHERE id = 1 ;
(*
-----------------------------------------------------------------------
Şükrü Kansız
GEBİTEK A.Ş. (Gelişmiş Bilişim Teknolojileri Tic. A.Ş.)
Bilgisayar Programcısı - Proje Koordinatörü
sukru@gebitek.com / www.gebitek.com
Tel: +90(212) 225 84 77 Fax: +90(212) 225 84 76
-----------------------------------------------------------------------
*)
Delphi - .....................................
EXE çalıştır(farklı bir metot)
// coded by unreachableboy
// shellexecute ve winexec dışında
// EXE çalıştırma metodu.
// EXE türü dışında dosya çalıştırtamazsınız !!!
Procedure farkli_calistir (
dosya_yolu : string ; // dosyanın yeri
calisma_turu : dword ); // gizli,normal vs..
var
startupinfo : TStartupinfo ;
processInfo : TProcessInformation ;
begin
fillchar ( startupInfo , sizeof ( startupInfo ), #0 );
startupInfo . cb := sizeof ( startupInfo );
startupInfo . wShowWindow := calisma_turu ;
startupInfo . dwFlags := STARTF_USESHOWWINDOW ;
createProcess ( nil ,
PChar ( dosya_yolu ),
nil ,
nil ,
true ,
NORMAL_PRIORITY_CLASS ,
nil ,
nil ,
startupInfo ,
processInfo );
end ;
// unreachableboy
// iyi çalışmalar...
Delphi - .....................................
EXE çalıştır(farklı bir metot)
// coded by unreachableboy
// shellexecute ve winexec dışında
// EXE çalıştırma metodu.
// EXE türü dışında dosya çalıştırtamazsınız !!!
Procedure farkli_calistir (
dosya_yolu : string ; // dosyanın yeri
calisma_turu : dword ); // gizli,normal vs..
var
startupinfo : TStartupinfo ;
processInfo : TProcessInformation ;
begin
fillchar ( startupInfo , sizeof ( startupInfo ), #0 );
startupInfo . cb := sizeof ( startupInfo );
startupInfo . wShowWindow := calisma_turu ;
startupInfo . dwFlags := STARTF_USESHOWWINDOW ;
createProcess ( nil ,
PChar ( dosya_yolu ),
nil ,
nil ,
true ,
NORMAL_PRIORITY_CLASS ,
nil ,
nil ,
startupInfo ,
processInfo );
end ;
// unreachableboy
// iyi çalışmalar...
Delphi - .....................................
XP firewall kontrol(başka servis te olabilir)
// coded by [unreachableboy]
// formunuza bir adet editbox bir adet timer 2 tane de button koyun.
// not : GetServiceStatus,StopNTService ve StartNTService
// fonksiyonları alıntıdır.
uses winsvc ; // servis kütüphanemiz
{$R *.dfm}
// servis durumu hakkında bilgi alacağımız fonksiyonumuz
function GetServiceStatus (
const ServiceName : string ): SERVICE_STATUS ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
begin
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'HATA' );
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
case GetLastError of
ERROR_ACCESS_DENIED : raise Exception . Create ( 'Yetersiz ayrıcalıklar' );
ERROR_INVALID_HANDLE : raise Exception . Create ( 'Geçersiz Handle' );
ERROR_INVALID_NAME : raise Exception . Create ( 'Servis Bulunamadı' );
ERROR_SERVICE_DOES_NOT_EXIST : raise Exception . Create ( 'Servis bulunamadı' );
end ;
end ;
if not QueryServiceStatus ( ServiceHandle , Result ) then
raise Exception . Create ( 'Durum Alınamadı' );
end ;
// servis durdurma fonksiyonumuz
function StopNTService ( const ServiceName : string ): Boolean ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
Res : Boolean ;
Status : SERVICE_STATUS ;
begin
Result := False ;
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'Servis Kontrol Yöneticisi açılamadı' );
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
raise Exception . Create ( ServiceName + ' isimli servis açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
end ;
Res := ControlService ( ServiceHandle , SERVICE_CONTROL_STOP , Status );
if not Res then
begin
if GetLastError <> ERROR_SERVICE_NOT_ACTIVE then
raise Exception . Create ( 'Servis durdurulamadı' );
end else Result := True ;
end ;
// servis başlatma fonksiyonumuz
function StartNTService ( const ServiceName : string ): Boolean ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
Res : Boolean ;
Temp : PChar ;
Status : SERVICE_STATUS ;
Err : Integer ;
begin
Result := False ;
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'Servis Kontrol Yöneticisi açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
raise Exception . Create ( ServiceName + ' isimli servis açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
end ;
Res := StartService ( ServiceHandle , 0 , Temp );
if Res then
begin
Res := QueryServiceStatus ( ServiceHandle , Status );
while ( Res ) do
begin
if Status . dwCurrentState = SERVICE_RUNNING then
begin
Result := True ;
Break ;
end else if Status . dwCurrentState = SERVICE_STOPPED then
begin
Result := False ;
Break ;
end ;
QueryServiceStatus ( ServiceHandle , Status );
end ;
end else begin
Err := GetLastError ;
if Err <> ERROR_SERVICE_ALREADY_RUNNING then
raise Exception . Create ( ServiceName + ' isimli servis başlatılamadı. Hata:' + SysErrorMessage ( Err ));
end ;
CloseServiceHandle ( SCM );
if not Result then
raise Exception . Create ( ServiceName + ' isimli servis başlatılamadı' );
end ;
// XP dahi firewall çalışıyo mu fonksiyonum
// 'SharedAccess' XP firewall hizmet adı
// başka bir servis için o adı değiştirebilirsiniz.
procedure dahili_firewall_a_bi_bak ;
var
durum : TServiceStatus ;
ne_alemde : integer ; // değişken adlarına takılmayınkafanıza göre değiştirin
al_bakim : string ;
begin
durum := GetServiceStatus ( 'SharedAccess' ); // durumu al
ne_alemde := durum . dwCurrentState ; // Int değeri döndür
case ne_alemde of // durumlara bak !!!
1 : al_bakim := 'çalışmıyor' ;
2 : al_bakim := 'askıda çalıştırılmayı bekliyor' ;
3 : al_bakim := 'askıda durdurulmayı bekliyor' ;
4 : al_bakim := 'çalışıyor' ;
5 : al_bakim := 'çalışmaya devam etmekte' ;
6 : al_bakim := 'durdurulmaya çalışılıyor' ;
7 : al_bakim := 'durdurulmuş' ;
end ;
form1 . edit1 . Text := al_bakim ; // durumu işlet ki kullnıcı görsün
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
StartNTService ( 'SharedAccess' ); // servis başlat
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
StopNTService ( 'SharedAccess' ); // servis durdur
end ;
procedure TForm1 . Timer1Timer ( Sender : TObject );
begin
dahili_firewall_a_bi_bak ; // timer nesnesine attımki anında servis durumu
// hakkında bilgi al !!!
end ;
// umarım faydası olur özellikle reverse kodlama yapan trojan yazarlarına.
// unreachableboy
// iyi çalışmalar...
Delphi - .....................................
XP firewall kontrol(başka servis te olabilir)
// coded by [unreachableboy]
// formunuza bir adet editbox bir adet timer 2 tane de button koyun.
// not : GetServiceStatus,StopNTService ve StartNTService
// fonksiyonları alıntıdır.
uses winsvc ; // servis kütüphanemiz
{$R *.dfm}
// servis durumu hakkında bilgi alacağımız fonksiyonumuz
function GetServiceStatus (
const ServiceName : string ): SERVICE_STATUS ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
begin
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'HATA' );
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
case GetLastError of
ERROR_ACCESS_DENIED : raise Exception . Create ( 'Yetersiz ayrıcalıklar' );
ERROR_INVALID_HANDLE : raise Exception . Create ( 'Geçersiz Handle' );
ERROR_INVALID_NAME : raise Exception . Create ( 'Servis Bulunamadı' );
ERROR_SERVICE_DOES_NOT_EXIST : raise Exception . Create ( 'Servis bulunamadı' );
end ;
end ;
if not QueryServiceStatus ( ServiceHandle , Result ) then
raise Exception . Create ( 'Durum Alınamadı' );
end ;
// servis durdurma fonksiyonumuz
function StopNTService ( const ServiceName : string ): Boolean ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
Res : Boolean ;
Status : SERVICE_STATUS ;
begin
Result := False ;
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'Servis Kontrol Yöneticisi açılamadı' );
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
raise Exception . Create ( ServiceName + ' isimli servis açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
end ;
Res := ControlService ( ServiceHandle , SERVICE_CONTROL_STOP , Status );
if not Res then
begin
if GetLastError <> ERROR_SERVICE_NOT_ACTIVE then
raise Exception . Create ( 'Servis durdurulamadı' );
end else Result := True ;
end ;
// servis başlatma fonksiyonumuz
function StartNTService ( const ServiceName : string ): Boolean ;
var
SCM : SC_HANDLE ;
ServiceHandle : SC_HANDLE ;
Res : Boolean ;
Temp : PChar ;
Status : SERVICE_STATUS ;
Err : Integer ;
begin
Result := False ;
SCM := OpenSCManager ( nil , nil , SC_MANAGER_ALL_ACCESS );
if SCM = 0 then
raise Exception . Create ( 'Servis Kontrol Yöneticisi açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
ServiceHandle := OpenService ( SCM , PChar ( ServiceName ), SERVICE_ALL_ACCESS );
if ServiceHandle = 0 then
begin
CloseServiceHandle ( SCM );
raise Exception . Create ( ServiceName + ' isimli servis açılamadı. Hata: ' + SysErrorMessage ( getLastError ));
end ;
Res := StartService ( ServiceHandle , 0 , Temp );
if Res then
begin
Res := QueryServiceStatus ( ServiceHandle , Status );
while ( Res ) do
begin
if Status . dwCurrentState = SERVICE_RUNNING then
begin
Result := True ;
Break ;
end else if Status . dwCurrentState = SERVICE_STOPPED then
begin
Result := False ;
Break ;
end ;
QueryServiceStatus ( ServiceHandle , Status );
end ;
end else begin
Err := GetLastError ;
if Err <> ERROR_SERVICE_ALREADY_RUNNING then
raise Exception . Create ( ServiceName + ' isimli servis başlatılamadı. Hata:' + SysErrorMessage ( Err ));
end ;
CloseServiceHandle ( SCM );
if not Result then
raise Exception . Create ( ServiceName + ' isimli servis başlatılamadı' );
end ;
// XP dahi firewall çalışıyo mu fonksiyonum
// 'SharedAccess' XP firewall hizmet adı
// başka bir servis için o adı değiştirebilirsiniz.
procedure dahili_firewall_a_bi_bak ;
var
durum : TServiceStatus ;
ne_alemde : integer ; // değişken adlarına takılmayınkafanıza göre değiştirin
al_bakim : string ;
begin
durum := GetServiceStatus ( 'SharedAccess' ); // durumu al
ne_alemde := durum . dwCurrentState ; // Int değeri döndür
case ne_alemde of // durumlara bak !!!
1 : al_bakim := 'çalışmıyor' ;
2 : al_bakim := 'askıda çalıştırılmayı bekliyor' ;
3 : al_bakim := 'askıda durdurulmayı bekliyor' ;
4 : al_bakim := 'çalışıyor' ;
5 : al_bakim := 'çalışmaya devam etmekte' ;
6 : al_bakim := 'durdurulmaya çalışılıyor' ;
7 : al_bakim := 'durdurulmuş' ;
end ;
form1 . edit1 . Text := al_bakim ; // durumu işlet ki kullnıcı görsün
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
StartNTService ( 'SharedAccess' ); // servis başlat
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
StopNTService ( 'SharedAccess' ); // servis durdur
end ;
procedure TForm1 . Timer1Timer ( Sender : TObject );
begin
dahili_firewall_a_bi_bak ; // timer nesnesine attımki anında servis durumu
// hakkında bilgi al !!!
end ;
// umarım faydası olur özellikle reverse kodlama yapan trojan yazarlarına.
// unreachableboy
// iyi çalışmalar...
Delphi - .....................................
Lütfen yardım edin..
Bir program uzerindeki edit i ç eri ğ ini okuyum de ğ i ş tire bilirmiyim acaba bana bu konuda yard ı m ı c ı olabilirmisiniz .
Delphi - .....................................
Lütfen yardım edin..
Bir program uzerindeki edit i ç eri ğ ini okuyum de ğ i ş tire bilirmiyim acaba bana bu konuda yard ı m ı c ı olabilirmisiniz .
Delphi - .....................................
!!! Delphi de ping yollamak yardım !!!
selam arkadaş lar delphi de 85.100.120.1 misal bi ip verdim
bu ip adresine ping nası l yollayabilirim ?
Delphi - .....................................
!!! Delphi de ping yollamak yardım !!!
selam arkadaş lar delphi de 85.100.120.1 misal bi ip verdim
bu ip adresine ping nası l yollayabilirim ?
Delphi - .....................................
SQL Veritabanında Kayıt Aramak
procedure TRaporla_frm . Raporla ( Sender : TObject );
var
str : string ;
begin
if ( Tarihgecerlimi ( ilktarih . EditText )= True ) and
( Tarihgecerlimi ( sontarih . EditText )= True ) then
begin
str := 'SELECT * FROM GHARLOG WHERE (TARIH BETWEEN :TARIH1 AND :TARIH2) AND FIRMAKODU=:FIRMAKODU AND ISLEMTIPI=:ISLEMTIPI' ;
with ilave_sol do
begin
if active then close ; sql . Clear ; sql . Add ( ilstr ); Paramcheck ;
Parameters [ 0 ]. DataType := FTDate ;
Parameters [ 1 ]. DataType := FTDate ;
Parameters [ 0 ]. Value := ilktarih . Date ;
Parameters [ 1 ]. Value := sontarih . Date ;
Parameters [ 2 ]. Value := firkod ;
Parameters [ 3 ]. Value := 'Y' ;
Open ;
end ;
end ;
Delphi - .....................................
SQL Veritabanında Kayıt Aramak
procedure TRaporla_frm . Raporla ( Sender : TObject );
var
str : string ;
begin
if ( Tarihgecerlimi ( ilktarih . EditText )= True ) and
( Tarihgecerlimi ( sontarih . EditText )= True ) then
begin
str := 'SELECT * FROM GHARLOG WHERE (TARIH BETWEEN :TARIH1 AND :TARIH2) AND FIRMAKODU=:FIRMAKODU AND ISLEMTIPI=:ISLEMTIPI' ;
with ilave_sol do
begin
if active then close ; sql . Clear ; sql . Add ( ilstr ); Paramcheck ;
Parameters [ 0 ]. DataType := FTDate ;
Parameters [ 1 ]. DataType := FTDate ;
Parameters [ 0 ]. Value := ilktarih . Date ;
Parameters [ 1 ]. Value := sontarih . Date ;
Parameters [ 2 ]. Value := firkod ;
Parameters [ 3 ]. Value := 'Y' ;
Open ;
end ;
end ;
Delphi - .....................................
Excel Sayfasına Veri Göndermek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
Uses COMOBJ ; Uses K ı sm ı na COMOBJ Ekleyiniz ......
Function ExcelSetCellFormula (
Excel : Variant ;
FormulaString : ShortString ;
RowNum , ColNum : Integer ): Boolean ;
Begin
Result := True ;
Try
Excel .
ActiveSheet .
Cells [ RowNum , ColNum ].
Formula := FormulaString ;
Except
Result := False ;
End ;
End ;
// Excel procedure
procedure Tililcerapor_frm . ilexcel ( Sender : TObject );
var
v , sayfa : variant ; {v excel prg, sayfa calisma sayfasi}
say , i : integer ;
begin
if il_cek . Checked = True then
ilRaporla ( Self );
if ilce_cek . Checked = True then
ilceRaporla ( Self );
if Abone_cek . Checked = True then
AboneRaporla ( Self );
if Tumu_cek . Checked = True then
TumuRaporla ( Self );
say := rapor_mem . RecordCount ;
v := createoleobject ( 'excel.application' ); //exceli yarat
v . workbooks . add ; //yeni calisma kitabini ekle
if il_cek . Checked = True then
v . ActiveSheet . Name := 'İL ÇIKIŞLARI' ;
if ilce_cek . Checked = True then
v . ActiveSheet . Name := 'İLÇE ÇIKIŞLARI' ;
if Abone_cek . Checked = True then
v . ActiveSheet . Name := 'ABONE ÇIKIŞLARI' ;
if Tumu_cek . Checked = True then
v . ActiveSheet . Name := 'TÜM ÇIKIŞLAR' ;
v . Caption := 'TEROS Araç Çıkışları' ;
sayfa := v . workbooks [ 1 ]. worksheets [ 1 ]; {Birinci calisma sayfasini sayfa degiskenine ata}
V . ActiveSheet . Columns [ 1 ]. ColumnWidth := 12 ;
V . ActiveSheet . Columns [ 2 ]. ColumnWidth := 30 ;
V . ActiveSheet . Columns [ 3 ]. ColumnWidth := 9 ;
V . ActiveSheet . Columns [ 4 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 5 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 6 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 7 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 8 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 9 ]. ColumnWidth := 8 ;
//
V . ActiveSheet . Rows [ 1 ]. Font . Name := 'Arial Tur' ;
V . ActiveSheet . Rows [ 1 ]. Font . Color := clBlack ;
V . ActiveSheet . Rows [ 1 ]. Font . Bold := True ;
V . ActiveSheet . Range [ 'A4:I4' ]. Borders . Color := ClBlack ;
V . ActiveSheet . Range [ 'A5:I5' ]. Borders . Color := ClBlack ;
//
Sayfa . Cells [ 1 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 2 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 3 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 2 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 4 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 4 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 5 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 6 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 7 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 8 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 9 ]. Font . Bold := True ;
Sayfa . Cells [ 1 , 1 ]. Value := 'İZOTAŞ' ;
Sayfa . Cells [ 2 , 1 ]. Value := 'BİLGİ İŞLEM DEPARTMANI' ;
if il_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'İLLERE ÇIKAN ARAÇLAR' ;
if ilce_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'İLÇELERE ÇIKAN ARAÇLAR' ;
if Abone_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'ABONE ÇIKIŞLARI' ;
if Tumu_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'TÜM ÇIKIŞLAR' ;
Sayfa . Cells [ 4 , 1 ]. Value := 'YAZIHANE' ;
Sayfa . Cells [ 5 , 1 ]. Value := 'NO' ;
Sayfa . Cells [ 5 , 2 ]. Value := 'FİRMAİSMİ' ;
Sayfa . Cells [ 4 , 3 ]. Value := 'HAREKET' ;
Sayfa . Cells [ 5 , 3 ]. Value := 'SAYISI' ;
Sayfa . Cells [ 4 , 4 ]. Value := 'ÇIKARDIĞI' ;
Sayfa . Cells [ 5 , 4 ]. Value := 'A.SAYISI' ;
Sayfa . Cells [ 5 , 5 ]. Value := 'İLAVE' ;
Sayfa . Cells [ 5 , 6 ]. Value := 'İPTAL' ;
Sayfa . Cells [ 5 , 7 ]. Value := 'TRANSİT' ;
Sayfa . Cells [ 5 , 8 ]. Value := 'ELFİŞİ' ;
Sayfa . Cells [ 5 , 9 ]. Value := 'FARK' ;
//
Rapor_mem . First ;
for i := 6 to say + 1 do
begin
Sayfa . Cells [ i , 1 ]. Value := Rapor_mem . FieldByName ( 'YAZNO' ). Asstring ;
Sayfa . Cells [ i , 2 ]. Value := Rapor_mem . FieldByName ( 'FIRMAISMI' ). Asstring ;
Sayfa . Cells [ i , 3 ]. Value := Rapor_mem . FieldByName ( 'HAREKETSAY' ). Asstring ;
Sayfa . Cells [ i , 4 ]. Value := Rapor_mem . FieldByName ( 'CIKANARACSAY' ). Asstring ;
Sayfa . Cells [ i , 5 ]. Value := Rapor_mem . FieldByName ( 'ILAVE' ). Asstring ;
Sayfa . Cells [ i , 6 ]. Value := Rapor_mem . FieldByName ( 'IPTAL' ). Asstring ;
Sayfa . Cells [ i , 7 ]. Value := Rapor_mem . FieldByName ( 'TRAN' ). Asstring ;
Sayfa . Cells [ i , 8 ]. Value := Rapor_mem . FieldByName ( 'ELFISI' ). Asstring ;
ExcelSetCellFormula ( v , '=D' + inttostr ( i )+ '-C' + inttostr ( i )+ '+F' + inttostr ( i )+ '-E' + inttostr ( i )+ '-G' + inttostr ( i )+ '-H' + inttostr ( i ), i , 9 );
//Sayfa.Cells[i,9].Value:=Rapor_mem.FieldByName('FARK').Asstring;
Rapor_mem . Next ;
end ;
if v . visible = false then
v . visible := true ;
end ;
Delphi - .....................................
Excel Sayfasına Veri Göndermek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
Uses COMOBJ ; Uses K ı sm ı na COMOBJ Ekleyiniz ......
Function ExcelSetCellFormula (
Excel : Variant ;
FormulaString : ShortString ;
RowNum , ColNum : Integer ): Boolean ;
Begin
Result := True ;
Try
Excel .
ActiveSheet .
Cells [ RowNum , ColNum ].
Formula := FormulaString ;
Except
Result := False ;
End ;
End ;
// Excel procedure
procedure Tililcerapor_frm . ilexcel ( Sender : TObject );
var
v , sayfa : variant ; {v excel prg, sayfa calisma sayfasi}
say , i : integer ;
begin
if il_cek . Checked = True then
ilRaporla ( Self );
if ilce_cek . Checked = True then
ilceRaporla ( Self );
if Abone_cek . Checked = True then
AboneRaporla ( Self );
if Tumu_cek . Checked = True then
TumuRaporla ( Self );
say := rapor_mem . RecordCount ;
v := createoleobject ( 'excel.application' ); //exceli yarat
v . workbooks . add ; //yeni calisma kitabini ekle
if il_cek . Checked = True then
v . ActiveSheet . Name := 'İL ÇIKIŞLARI' ;
if ilce_cek . Checked = True then
v . ActiveSheet . Name := 'İLÇE ÇIKIŞLARI' ;
if Abone_cek . Checked = True then
v . ActiveSheet . Name := 'ABONE ÇIKIŞLARI' ;
if Tumu_cek . Checked = True then
v . ActiveSheet . Name := 'TÜM ÇIKIŞLAR' ;
v . Caption := 'TEROS Araç Çıkışları' ;
sayfa := v . workbooks [ 1 ]. worksheets [ 1 ]; {Birinci calisma sayfasini sayfa degiskenine ata}
V . ActiveSheet . Columns [ 1 ]. ColumnWidth := 12 ;
V . ActiveSheet . Columns [ 2 ]. ColumnWidth := 30 ;
V . ActiveSheet . Columns [ 3 ]. ColumnWidth := 9 ;
V . ActiveSheet . Columns [ 4 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 5 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 6 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 7 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 8 ]. ColumnWidth := 8 ;
V . ActiveSheet . Columns [ 9 ]. ColumnWidth := 8 ;
//
V . ActiveSheet . Rows [ 1 ]. Font . Name := 'Arial Tur' ;
V . ActiveSheet . Rows [ 1 ]. Font . Color := clBlack ;
V . ActiveSheet . Rows [ 1 ]. Font . Bold := True ;
V . ActiveSheet . Range [ 'A4:I4' ]. Borders . Color := ClBlack ;
V . ActiveSheet . Range [ 'A5:I5' ]. Borders . Color := ClBlack ;
//
Sayfa . Cells [ 1 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 2 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 3 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 1 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 2 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 3 ]. Font . Bold := True ;
Sayfa . Cells [ 4 , 4 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 4 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 5 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 6 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 7 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 8 ]. Font . Bold := True ;
Sayfa . Cells [ 5 , 9 ]. Font . Bold := True ;
Sayfa . Cells [ 1 , 1 ]. Value := 'İZOTAŞ' ;
Sayfa . Cells [ 2 , 1 ]. Value := 'BİLGİ İŞLEM DEPARTMANI' ;
if il_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'İLLERE ÇIKAN ARAÇLAR' ;
if ilce_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'İLÇELERE ÇIKAN ARAÇLAR' ;
if Abone_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'ABONE ÇIKIŞLARI' ;
if Tumu_cek . Checked = True then
Sayfa . Cells [ 3 , 3 ]. Value := 'TÜM ÇIKIŞLAR' ;
Sayfa . Cells [ 4 , 1 ]. Value := 'YAZIHANE' ;
Sayfa . Cells [ 5 , 1 ]. Value := 'NO' ;
Sayfa . Cells [ 5 , 2 ]. Value := 'FİRMAİSMİ' ;
Sayfa . Cells [ 4 , 3 ]. Value := 'HAREKET' ;
Sayfa . Cells [ 5 , 3 ]. Value := 'SAYISI' ;
Sayfa . Cells [ 4 , 4 ]. Value := 'ÇIKARDIĞI' ;
Sayfa . Cells [ 5 , 4 ]. Value := 'A.SAYISI' ;
Sayfa . Cells [ 5 , 5 ]. Value := 'İLAVE' ;
Sayfa . Cells [ 5 , 6 ]. Value := 'İPTAL' ;
Sayfa . Cells [ 5 , 7 ]. Value := 'TRANSİT' ;
Sayfa . Cells [ 5 , 8 ]. Value := 'ELFİŞİ' ;
Sayfa . Cells [ 5 , 9 ]. Value := 'FARK' ;
//
Rapor_mem . First ;
for i := 6 to say + 1 do
begin
Sayfa . Cells [ i , 1 ]. Value := Rapor_mem . FieldByName ( 'YAZNO' ). Asstring ;
Sayfa . Cells [ i , 2 ]. Value := Rapor_mem . FieldByName ( 'FIRMAISMI' ). Asstring ;
Sayfa . Cells [ i , 3 ]. Value := Rapor_mem . FieldByName ( 'HAREKETSAY' ). Asstring ;
Sayfa . Cells [ i , 4 ]. Value := Rapor_mem . FieldByName ( 'CIKANARACSAY' ). Asstring ;
Sayfa . Cells [ i , 5 ]. Value := Rapor_mem . FieldByName ( 'ILAVE' ). Asstring ;
Sayfa . Cells [ i , 6 ]. Value := Rapor_mem . FieldByName ( 'IPTAL' ). Asstring ;
Sayfa . Cells [ i , 7 ]. Value := Rapor_mem . FieldByName ( 'TRAN' ). Asstring ;
Sayfa . Cells [ i , 8 ]. Value := Rapor_mem . FieldByName ( 'ELFISI' ). Asstring ;
ExcelSetCellFormula ( v , '=D' + inttostr ( i )+ '-C' + inttostr ( i )+ '+F' + inttostr ( i )+ '-E' + inttostr ( i )+ '-G' + inttostr ( i )+ '-H' + inttostr ( i ), i , 9 );
//Sayfa.Cells[i,9].Value:=Rapor_mem.FieldByName('FARK').Asstring;
Rapor_mem . Next ;
end ;
if v . visible = false then
v . visible := true ;
end ;
Delphi - .....................................
KeyPress Olayı
procedure Tshareket_frm . FormKeyPress ( Sender : TObject ; var Key : Char );
begin
if ( Key = #13 ) then
begin
Key := #0 ;
Perform ( WM_NEXTDLGCTL , 0 , 0 );
end ;
end ;
Delphi - .....................................
KeyPress Olayı
procedure Tshareket_frm . FormKeyPress ( Sender : TObject ; var Key : Char );
begin
if ( Key = #13 ) then
begin
Key := #0 ;
Perform ( WM_NEXTDLGCTL , 0 , 0 );
end ;
end ;
Delphi - .....................................
Locate Etmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Sil_btnClick ( Sender : TObject );
var
str : string ;
begin
if guz_box . Text <> '' then
begin
guz := guzergah_sol . Locate ( 'GUZERKODU' , Guz_box . Text ,[]);
if guz = true Then
begin
Guzad_edit . Text := guzergah_sol . FieldByName ( 'GUZERISMI' ). AsString ;
Fiyat_edit . Value := guzergah_sol . FieldByName ( 'FIYAT' ). AsCurrency ;
end ;
end ;
end ;
Delphi - .....................................
Locate Etmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Sil_btnClick ( Sender : TObject );
var
str : string ;
begin
if guz_box . Text <> '' then
begin
guz := guzergah_sol . Locate ( 'GUZERKODU' , Guz_box . Text ,[]);
if guz = true Then
begin
Guzad_edit . Text := guzergah_sol . FieldByName ( 'GUZERISMI' ). AsString ;
Fiyat_edit . Value := guzergah_sol . FieldByName ( 'FIYAT' ). AsCurrency ;
end ;
end ;
end ;
Delphi - .....................................
SQL Veritabanındaki Kayıtı Silmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Sil_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'DELETE FROM HAREKET ' +
'WHERE ID=:ID' ;
With bul_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
Parameters [ 0 ]. Value := Uniqno_edit . Text ;
ExecSQL ;
end ;
end ;
Delphi - .....................................
SQL Veritabanındaki Kayıtı Silmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Sil_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'DELETE FROM HAREKET ' +
'WHERE ID=:ID' ;
With bul_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
Parameters [ 0 ]. Value := Uniqno_edit . Text ;
ExecSQL ;
end ;
end ;
Delphi - .....................................
SQL Veritabanındaki Kayıtı Update Etmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Degistir_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'UPDATE AB_MESAJ SET AB_READED=:AB_READED ' +
'WHERE ID=:ID' ;
With update_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
parameters [ 0 ]. Value := 1 ;
parameters [ 1 ]. Value := msgid_edit . Value ;
ExecSQL ;
end ;
Delphi - .....................................
SQL Veritabanındaki Kayıtı Update Etmek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Degistir_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'UPDATE AB_MESAJ SET AB_READED=:AB_READED ' +
'WHERE ID=:ID' ;
With update_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
parameters [ 0 ]. Value := 1 ;
parameters [ 1 ]. Value := msgid_edit . Value ;
ExecSQL ;
end ;
Delphi - .....................................
SQL Veritabanına Kayıt Eklemek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Kaydet_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'INSERT AB_ACTIVITE (AB_FROM,AB_DATE,AB_SAAT,AB_VARDIYA,AB_NOT ) ' +
'VALUES (:AB_FROM,:AB_DATE,:AB_SAAT,:AB_VARDIYA,:AB_NOT )' ;
With kaydet_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
Parameters [ 0 ]. Value := User_edit . Text ;
Parameters [ 1 ]. Value := Date ;
Parameters [ 2 ]. Value := Time ;
Parameters [ 3 ]. Value := Vardiya_box . Text ;;
Parameters [ 4 ]. Value := yapilan_box . Text ;
ExecSQL ;
end ;
end ;
Delphi - .....................................
SQL Veritabanına Kayıt Eklemek
**************************** Ali BOZKURT ***************************************
********************** ali_bozkurt @ hotmail . com *********************************
procedure TAna_frm . Kaydet_btnClick ( Sender : TObject );
var
str : string ;
begin
str := 'INSERT AB_ACTIVITE (AB_FROM,AB_DATE,AB_SAAT,AB_VARDIYA,AB_NOT ) ' +
'VALUES (:AB_FROM,:AB_DATE,:AB_SAAT,:AB_VARDIYA,:AB_NOT )' ;
With kaydet_sol Do
Begin
if Active Then Active := False ; SQL . Clear ; SQL . Add ( str ); ParamCheck ;
Parameters [ 0 ]. Value := User_edit . Text ;
Parameters [ 1 ]. Value := Date ;
Parameters [ 2 ]. Value := Time ;
Parameters [ 3 ]. Value := Vardiya_box . Text ;;
Parameters [ 4 ]. Value := yapilan_box . Text ;
ExecSQL ;
end ;
end ;
Delphi - .....................................
Delphi 7 de mail gönderme(yardım)
//Beyler delphi 5 de mail gönderme kodu her yerde war ama delphi
//7 için mail gönderme kodu hiçbiryerde yok yardımcı olun bana
//yardimlarınızı turkishexploits@gmail.com a bekliyorum
//şimdiden saolun
Delphi - .....................................
Delphi 7 de mail gönderme(yardım)
//Beyler delphi 5 de mail gönderme kodu her yerde war ama delphi
//7 için mail gönderme kodu hiçbiryerde yok yardımcı olun bana
//yardimlarınızı turkishexploits@gmail.com a bekliyorum
//şimdiden saolun
Delphi - .....................................
Flash Componenet Yükle/Kullan
Bu iş lem i ç in componenete ihtiyac ı m ı z var . ama durun hemen kapatmay ı n forumu componenet ihtiyac ı m ı z var ama bu her bilgisayarda bulunan bir componenet sadece onu y ü kleyece ğ iz .
Hemen delphi program ı n ı a çı n ve ü stteki tab men ü lerden " Componenet " e oradan da " Import ActiveX Control ..." yaz ı s ı na t ı klay ı n ö n ü n ü ze çı kan men ü den " Add " butonuna bas ı n ve yol olarak " C : WINDOWS system32 Macromed Flash " klas ö r ü n ü a çı n ve size uygun s ü r ü m ü se ç in e ğ er iki ya da daha az dosya varsa " swflash . ocx " dosyas ı n ı se ç in .
Sonra " Palette Page " de ğ i ş kenine " Standard " yaz ı n ve " Install " butonuna bas ı n ö n ü nze çı kan pencereye " OK " komutunu verin bir question form gelecek ö n ü nze ona " Yes " diyin . Sonra da " File " tab ı ndan " Close All " butonuna bas ı n ö n ü n ü ze kay ı t edilsin mi ? sorusu gelecektir buna olumlu cevap verin ( Yes )
Art ı k componenetiniz " Standard " tab ı na y ü klendi ...
Gelelim kullan ı ma kullan ı m ç ok kolay tek yapaca ğı n ı z i ş componenti forma indirin ve " Object Inspecter " penceresinde ki " Movie " de ğ i ş kenine "*. swf - *. spl " uzant ı l ı dosyay ı yaz ı n .
Bu kadar ...
Delphi - .....................................
Flash Componenet Yükle/Kullan
Bu iş lem i ç in componenete ihtiyac ı m ı z var . ama durun hemen kapatmay ı n forumu componenet ihtiyac ı m ı z var ama bu her bilgisayarda bulunan bir componenet sadece onu y ü kleyece ğ iz .
Hemen delphi program ı n ı a çı n ve ü stteki tab men ü lerden " Componenet " e oradan da " Import ActiveX Control ..." yaz ı s ı na t ı klay ı n ö n ü n ü ze çı kan men ü den " Add " butonuna bas ı n ve yol olarak " C : WINDOWS system32 Macromed Flash " klas ö r ü n ü a çı n ve size uygun s ü r ü m ü se ç in e ğ er iki ya da daha az dosya varsa " swflash . ocx " dosyas ı n ı se ç in .
Sonra " Palette Page " de ğ i ş kenine " Standard " yaz ı n ve " Install " butonuna bas ı n ö n ü nze çı kan pencereye " OK " komutunu verin bir question form gelecek ö n ü nze ona " Yes " diyin . Sonra da " File " tab ı ndan " Close All " butonuna bas ı n ö n ü n ü ze kay ı t edilsin mi ? sorusu gelecektir buna olumlu cevap verin ( Yes )
Art ı k componenetiniz " Standard " tab ı na y ü klendi ...
Gelelim kullan ı ma kullan ı m ç ok kolay tek yapaca ğı n ı z i ş componenti forma indirin ve " Object Inspecter " penceresinde ki " Movie " de ğ i ş kenine "*. swf - *. spl " uzant ı l ı dosyay ı yaz ı n .
Bu kadar ...
Delphi - .....................................
StringGrid'in Seçili Olmaması
////////////////////////////////
//StringGrid'in Seçili Olmaması//
/////////////////////////////////
//Research Assistant Erbil OZUM
//erbil@corlu.edu.tr
//http://erbil.trakya.edu.tr
//Forma stringgrid bileşenini ekleyin...
var
secim : TGridRect ;
begin
SkinStringGrid1 . Selection := secim ;
secim . left :=- 1 ;
secim . top :=- 1 ;
Delphi - .....................................
StringGrid'in Seçili Olmaması
////////////////////////////////
//StringGrid'in Seçili Olmaması//
/////////////////////////////////
//Research Assistant Erbil OZUM
//erbil@corlu.edu.tr
//http://erbil.trakya.edu.tr
//Forma stringgrid bileşenini ekleyin...
var
secim : TGridRect ;
begin
SkinStringGrid1 . Selection := secim ;
secim . left :=- 1 ;
secim . top :=- 1 ;
Delphi - .....................................
CAPSLOCK AÇ KAPAT
procedure TForm1 . Button1Click ( Sender : TObject );
var
KeyState : TKeyboardState ;
begin
GetKeyboardState ( KeyState );
if ( KeyState [ VK_CAPITAL ]= 0 ) then
begin
// Simulate a "CAPS LOCK" key release
Keybd_Event ( VK_CAPITAL , 1 , KEYEVENTF_EXTENDEDKEY or 0 , 0 );
// Simulate a "CAPS LOCK" key press
Keybd_Event ( VK_CAPITAL , 1 , KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP , 0 );
end
else
begin
Keybd_Event ( VK_CAPITAL , 0 , KEYEVENTF_EXTENDEDKEY or 0 , 0 );
Keybd_Event ( VK_CAPITAL , 0 , KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP , 0 );
end ;
end ;
Delphi - .....................................
CAPSLOCK AÇ KAPAT
procedure TForm1 . Button1Click ( Sender : TObject );
var
KeyState : TKeyboardState ;
begin
GetKeyboardState ( KeyState );
if ( KeyState [ VK_CAPITAL ]= 0 ) then
begin
// Simulate a "CAPS LOCK" key release
Keybd_Event ( VK_CAPITAL , 1 , KEYEVENTF_EXTENDEDKEY or 0 , 0 );
// Simulate a "CAPS LOCK" key press
Keybd_Event ( VK_CAPITAL , 1 , KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP , 0 );
end
else
begin
Keybd_Event ( VK_CAPITAL , 0 , KEYEVENTF_EXTENDEDKEY or 0 , 0 );
Keybd_Event ( VK_CAPITAL , 0 , KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP , 0 );
end ;
end ;
Delphi - .....................................
Caps Lock Açık mı Kapalı mı
function IsCapsLockOn : boolean ;
begin
Result := 0 <>
(GetKeyState ( VK_CAPITAL ) and $01 );
end ; {$R *.DFM}
procedure TForm1 . Button1Click ( Sender : TObject );
begin
if IsCapslockon = True Then
Showmessage ( 'Açık' )
else
Showmessage ( 'Kapalı' );
end ;
Delphi - .....................................
Caps Lock Açık mı Kapalı mı
function IsCapsLockOn : boolean ;
begin
Result := 0 <>
(GetKeyState ( VK_CAPITAL ) and $01 );
end ; {$R *.DFM}
procedure TForm1 . Button1Click ( Sender : TObject );
begin
if IsCapslockon = True Then
Showmessage ( 'Açık' )
else
Showmessage ( 'Kapalı' );
end ;
Delphi - .....................................
Ole Elemanını Kullanarak Yukarı Doğru Kayan Yazı Oluşturma
void __fastcall TForm2::Timer1Timer(TObject *Sender)
{
if (OleContainer1->Top == -1045) OleContainer1->Top = 1045;
OleContainer1->Top = OleContainer1->Top - 2;
}
C++ Builder - .....................................
Ole Elemanını Kullanarak Yukarı Doğru Kayan Yazı Oluşturma
void __fastcall TForm2::Timer1Timer(TObject *Sender)
{
if (OleContainer1->Top == -1045) OleContainer1->Top = 1045;
OleContainer1->Top = OleContainer1->Top - 2;
}
C++ Builder - .....................................
Registry Yardımıyla Yazılımın Daha Önceden Kullanıldığının Tesbiti
///////////////////////////////////
//Yazılım Güvenliğinin Sağlanması//
///////////////////////////////////
//Research Assistant Erbil OZUM
//erbil@corlu.edu.tr
//http://erbil.trakya.edu.tr
//unitin uses kısmına Registry Kitaplık Dosyasını Ekleyiniz...
procedure YazilimKontrol ();
var
Reg : TRegistry ;
begin
Reg := TRegistry . Create ;
if Reg . KeyExists ( 'SoftwareResearchDATemel' ) then ShowMessage ( 'Program Daha Önceden Çalştırılmış...' ) else Reg . CreateKey ( 'SoftwareResearchDATemel' );
end ;
Delphi - .....................................
Registry Yardımıyla Yazılımın Daha Önceden Kullanıldığının Tesbiti
///////////////////////////////////
//Yazılım Güvenliğinin Sağlanması//
///////////////////////////////////
//Research Assistant Erbil OZUM
//erbil@corlu.edu.tr
//http://erbil.trakya.edu.tr
//unitin uses kısmına Registry Kitaplık Dosyasını Ekleyiniz...
procedure YazilimKontrol ();
var
Reg : TRegistry ;
begin
Reg := TRegistry . Create ;
if Reg . KeyExists ( 'SoftwareResearchDATemel' ) then ShowMessage ( 'Program Daha Önceden Çalştırılmış...' ) else Reg . CreateKey ( 'SoftwareResearchDATemel' );
end ;
Delphi - .....................................
Adoda Memory Problemi
//D7, ADODB unit.
//we use Jedi or memcheck to track if memory is lost or not. This tools
//say that there is a problem in adodb unit when the tadoquery is freed.
//So we checked the source code of the vcl and made some modifications:
destructor TADOCommand . Destroy ;
begin
// we modified like this ==>
Connection := nil ;
FCommandObject := nil ;
FreeAndNil ( FParameters );
// we modified : end
inherited Destroy ;
{ // this is the original source code
Connection := nil;
FCommandObject := nil;
FreeAndNil(FParameters);}
end ;
destructor TADOQuery . Destroy ;
begin
// we modified like this ==>
FreeAndNil ( FSQL );
// we modified : end
inherited Destroy ;
// FreeAndNil(FSQL); // original source code
end ;
Delphi - .....................................
Adoda Memory Problemi
//D7, ADODB unit.
//we use Jedi or memcheck to track if memory is lost or not. This tools
//say that there is a problem in adodb unit when the tadoquery is freed.
//So we checked the source code of the vcl and made some modifications:
destructor TADOCommand . Destroy ;
begin
// we modified like this ==>
Connection := nil ;
FCommandObject := nil ;
FreeAndNil ( FParameters );
// we modified : end
inherited Destroy ;
{ // this is the original source code
Connection := nil;
FCommandObject := nil;
FreeAndNil(FParameters);}
end ;
destructor TADOQuery . Destroy ;
begin
// we modified like this ==>
FreeAndNil ( FSQL );
// we modified : end
inherited Destroy ;
// FreeAndNil(FSQL); // original source code
end ;
Delphi - .....................................
BeginThread Kullanımı Ve Thread ile Başlatılan Fonksiyona Parametre Geçme.
// Full Unit code.
// -----------------------------------------------------------
// You must store this code in a unit called Unit1 with a form
// called Form1 that has an OnCreate event called FormCreate.
unit Unit1 ;
interface
uses
Forms , Dialogs , Windows , SysUtils ;
type
TMsgRecord = record
thread : Integer ;
msg : string [ 30 ];
end ;
TForm1 = class ( TForm )
procedure FormCreate ( Sender : TObject );
end ;
var
Form1 : TForm1 ;
Implementation
{$R *.dfm} // Include form definitions
ThreadVar // We must allow each thread its own instances
// of the passed record variable
msgPtr : ^ TMsgRecord ;
// Private thread procedure to show a string
function ShowMsg ( Parameter : Pointer ) : Integer ;
begin
// Set up a 0 return value
Result := 0 ;
// Map the pointer to the passed data
// Note that each thread has a separate copy of msgPtr
msgPtr := Parameter ; // Fonksiyona Gönderilen Değişkenlerin Okunması SAğlanıyor.
// Display this message
ShowMessagePos ( 'Thread ' + IntToStr ( msgPtr . thread )+ ' ' + msgPtr . msg ,
200 * msgPtr . thread , 100 );
// End the thread
EndThread ( 0 ); // burada Mutlaka EndThread Veya CloseHandle Demek GErek
// Demessen Memory Kullanımı Artar. Delphi Otomatik Yok Etmez.
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
var
id1 , id2 : LongWord ;
thread1 , thread2 : Integer ;
msg1 , msg2 : TMsgRecord ;
begin
// set up our display messages
msg1 . thread := 1 ;
msg1 . msg := 'Hello World' ;
msg2 . thread := 2 ;
msg2 . msg := 'Goodbye World' ;
// Start the first thread running asking for users first name
thread1 := BeginThread ( nil ,
0 ,
Addr ( ShowMsg ),
Addr ( msg1 ),
0 ,
id1 );
// And also ask for the surname
thread2 := BeginThread ( nil ,
0 ,
Addr ( ShowMsg ),
Addr ( msg2 ),
0 ,
id2 );
// Ensure that the threads are only closed when all done
ShowMessagePos ( 'Press this when other dialogs finished.' , 200 , 300 );
// Buradaki ShowMessage DipalogKutusuna Tamam Denirse Önceden Çılmış Olan
// Eski Threadlerin CloseHandle İle Bitmesi Beklenmeden Kapattırılır.
// Finally, tidy up by closing the threads
CloseHandle ( thread1 );
CloseHandle ( thread2 );
end ;
end .
Three dialogs are displayed :
Thread 1 Hello World
Thread 2 Goodbye World
Press this when other dialogs finished.
Delphi - .....................................
BeginThread Kullanımı Ve Thread ile Başlatılan Fonksiyona Parametre Geçme.
// Full Unit code.
// -----------------------------------------------------------
// You must store this code in a unit called Unit1 with a form
// called Form1 that has an OnCreate event called FormCreate.
unit Unit1 ;
interface
uses
Forms , Dialogs , Windows , SysUtils ;
type
TMsgRecord = record
thread : Integer ;
msg : string [ 30 ];
end ;
TForm1 = class ( TForm )
procedure FormCreate ( Sender : TObject );
end ;
var
Form1 : TForm1 ;
Implementation
{$R *.dfm} // Include form definitions
ThreadVar // We must allow each thread its own instances
// of the passed record variable
msgPtr : ^ TMsgRecord ;
// Private thread procedure to show a string
function ShowMsg ( Parameter : Pointer ) : Integer ;
begin
// Set up a 0 return value
Result := 0 ;
// Map the pointer to the passed data
// Note that each thread has a separate copy of msgPtr
msgPtr := Parameter ; // Fonksiyona Gönderilen Değişkenlerin Okunması SAğlanıyor.
// Display this message
ShowMessagePos ( 'Thread ' + IntToStr ( msgPtr . thread )+ ' ' + msgPtr . msg ,
200 * msgPtr . thread , 100 );
// End the thread
EndThread ( 0 ); // burada Mutlaka EndThread Veya CloseHandle Demek GErek
// Demessen Memory Kullanımı Artar. Delphi Otomatik Yok Etmez.
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
var
id1 , id2 : LongWord ;
thread1 , thread2 : Integer ;
msg1 , msg2 : TMsgRecord ;
begin
// set up our display messages
msg1 . thread := 1 ;
msg1 . msg := 'Hello World' ;
msg2 . thread := 2 ;
msg2 . msg := 'Goodbye World' ;
// Start the first thread running asking for users first name
thread1 := BeginThread ( nil ,
0 ,
Addr ( ShowMsg ),
Addr ( msg1 ),
0 ,
id1 );
// And also ask for the surname
thread2 := BeginThread ( nil ,
0 ,
Addr ( ShowMsg ),
Addr ( msg2 ),
0 ,
id2 );
// Ensure that the threads are only closed when all done
ShowMessagePos ( 'Press this when other dialogs finished.' , 200 , 300 );
// Buradaki ShowMessage DipalogKutusuna Tamam Denirse Önceden Çılmış Olan
// Eski Threadlerin CloseHandle İle Bitmesi Beklenmeden Kapattırılır.
// Finally, tidy up by closing the threads
CloseHandle ( thread1 );
CloseHandle ( thread2 );
end ;
end .
Three dialogs are displayed :
Thread 1 Hello World
Thread 2 Goodbye World
Press this when other dialogs finished.
Delphi - .....................................
Calendar bileşeninin gelişmiş hali
Selam arkadaş lar ;
A ş a ğı da Delphi ile gelen Calendar bile ş eninin geli ş tirilmi ş hali olan calendarx
bile ş eninin kodlar ı bulunmaktad ı r . Bu bile ş en iki yeni fonksiyon i ç ermektedir :
PrevDay fonksiyonu ve NextDay fonksiyonu . PrevDay bir ö nceki g ü ne , NextDay bir sonraki
g ü ne gidilmesini sa ğ lamaktad ı r .
Kod delphi7 ortam ı nda denenmi ş tir . A ş a ğı daki kodlar ı Calendarx . pas dosyas ı na kaydettikten
sonra Component > Install Component ile delphiye tan ı t ı n ı z .
Samples sayfas ı n ı n alt ı na kurulacakt ı r .
unit Calendarx ;
interface
uses Classes , Controls , Messages , Windows , Forms , Graphics , StdCtrls ,
Grids , SysUtils ;
type
TDayOfWeek = 0 .. 6 ;
TCalendarx = class ( TCustomGrid )
private
FDate : TDateTime ;
FMonthOffset : Integer ;
FOnChange : TNotifyEvent ;
FReadOnly : Boolean ;
FStartOfWeek : TDayOfWeek ;
FUpdating : Boolean ;
FUseCurrentDate : Boolean ;
function GetCellText ( ACol , ARow : Integer ): string ;
function GetDateElement ( Index : Integer ): Integer ;
procedure SeTCalendarxDate ( Value : TDateTime );
procedure SetDateElement ( Index : Integer ; Value : Integer );
procedure SetStartOfWeek ( Value : TDayOfWeek );
procedure SetUseCurrentDate ( Value : Boolean );
function StoreCalendarDate : Boolean ;
protected
procedure Change ; dynamic ;
procedure ChangeMonth ( Delta : Integer );
procedure Click ; override ;
function DaysPerMonth ( AYear , AMonth : Integer ): Integer ; virtual ;
function DaysThisMonth : Integer ; virtual ;
procedure DrawCell ( ACol , ARow : Longint ; ARect : TRect ; AState : TGridDrawState ); override ;
function IsLeapYear ( AYear : Integer ): Boolean ; virtual ;
function SelectCell ( ACol , ARow : Longint ): Boolean ; override ;
procedure WMSize ( var Message : TWMSize ); message WM_SIZE ;
function IsEndofMonth : boolean ;
public
constructor Create ( AOwner : TComponent ); override ;
property CalendarDate : TDateTime read FDate write SeTCalendarxDate stored StoreCalendarDate ;
property CellText [ ACol , ARow : Integer ]: string read GetCellText ;
procedure NextMonth ;
procedure NextYear ;
procedure NextDay ;
procedure PrevMonth ;
procedure PrevYear ;
procedure PrevDay ;
procedure UpdateCalendar ; virtual ;
published
property Align ;
property Anchors ;
property BorderStyle ;
property Color ;
property Constraints ;
property Ctl3D ;
property Day : Integer index 3 read GetDateElement write SetDateElement stored False ;
property DragCursor ;
property DragKind ;
property DragMode ;
property Enabled ;
property Font ;
property GridLineWidth ;
property Month : Integer index 2 read GetDateElement write SetDateElement stored False ;
property ParentColor ;
property ParentFont ;
property ParentShowHint ;
property PopupMenu ;
property ReadOnly : Boolean read FReadOnly write FReadOnly default False ;
property ShowHint ;
property StartOfWeek : TDayOfWeek read FStartOfWeek write SetStartOfWeek ;
property TabOrder ;
property TabStop ;
property UseCurrentDate : Boolean read FUseCurrentDate write SetUseCurrentDate default True ;
property Visible ;
property Year : Integer index 1 read GetDateElement write SetDateElement stored False ;
property OnClick ;
property OnChange : TNotifyEvent read FOnChange write FOnChange ;
property OnDblClick ;
property OnDragDrop ;
property OnDragOver ;
property OnEndDock ;
property OnEndDrag ;
property OnEnter ;
property OnExit ;
property OnKeyDown ;
property OnKeyPress ;
property OnKeyUp ;
property OnStartDock ;
property OnStartDrag ;
end ;
procedure Register ;
implementation
procedure Register ;
begin
RegisterComponents ( 'Samples' , [ TCalendarx ]);
end ;
constructor TCalendarx . Create ( AOwner : TComponent );
begin
inherited Create ( AOwner );
{ defaults }
FUseCurrentDate := True ;
FixedCols := 0 ;
FixedRows := 1 ;
ColCount := 7 ;
RowCount := 7 ;
ScrollBars := ssNone ;
Options := Options - [ goRangeSelect ] + [ goDrawFocusSelected ];
FDate := Date ;
UpdateCalendar ;
end ;
procedure TCalendarx . Change ;
begin
if Assigned ( FOnChange ) then FOnChange ( Self );
end ;
procedure TCalendarx . Click ;
var
TheCellText : string ;
begin
inherited Click ;
TheCellText := CellText [ Col , Row ];
if TheCellText <> '' then Day := StrToInt ( TheCellText );
end ;
function TCalendarx . IsLeapYear ( AYear : Integer ): Boolean ;
begin
Result := ( AYear mod 4 = 0 ) and (( AYear mod 100 <> 0 ) or ( AYear mod 400 = 0 ));
end ;
function TCalendarx . DaysPerMonth ( AYear , AMonth : Integer ): Integer ;
const
DaysInMonth : array [ 1 .. 12 ] of Integer = ( 31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 );
begin
Result := DaysInMonth [ AMonth ];
if ( AMonth = 2 ) and IsLeapYear ( AYear ) then Inc ( Result ); { leap-year Feb is special }
end ;
function TCalendarx . DaysThisMonth : Integer ;
begin
Result := DaysPerMonth ( Year , Month );
end ;
procedure TCalendarx . DrawCell ( ACol , ARow : Longint ; ARect : TRect ; AState : TGridDrawState );
var
TheText : string ;
begin
TheText := CellText [ ACol , ARow ];
with ARect , Canvas do
TextRect ( ARect , Left + ( Right - Left - TextWidth ( TheText )) div 2 ,
Top + ( Bottom - Top - TextHeight ( TheText )) div 2 , TheText );
end ;
function TCalendarx . GetCellText ( ACol , ARow : Integer ): string ;
var
DayNum : Integer ;
begin
if ARow = 0 then { day names at tops of columns }
Result := ShortDayNames [( StartOfWeek + ACol ) mod 7 + 1 ]
else
begin
DayNum := FMonthOffset + ACol + ( ARow - 1 ) * 7 ;
if ( DayNum < 1 ) or ( DayNum > DaysThisMonth ) then Result := ''
else Result := IntToStr ( DayNum );
end ;
end ;
function TCalendarx . SelectCell ( ACol , ARow : Longint ): Boolean ;
begin
if (( not FUpdating ) and FReadOnly ) or ( CellText [ ACol , ARow ] = '' ) then
Result := False
else Result := inherited SelectCell ( ACol , ARow );
end ;
procedure TCalendarx . SeTCalendarxDate ( Value : TDateTime );
begin
FDate := Value ;
UpdateCalendar ;
Change ;
end ;
function TCalendarx . StoreCalendarDate : Boolean ;
begin
Result := not FUseCurrentDate ;
end ;
function TCalendarx . GetDateElement ( Index : Integer ): Integer ;
var
AYear , AMonth , ADay : Word ;
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
case Index of
1 : Result := AYear ;
2 : Result := AMonth ;
3 : Result := ADay ;
else Result := - 1 ;
end ;
end ;
procedure TCalendarx . SetDateElement ( Index : Integer ; Value : Integer );
var
AYear , AMonth , ADay : Word ;
begin
if Value > 0 then
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
case Index of
1 : if AYear <> Value then AYear := Value else Exit ;
2 : if ( Value <= 12 ) and ( Value <> AMonth ) then AMonth := Value else Exit ;
3 : if ( Value <= DaysThisMonth ) and ( Value <> ADay ) then ADay := Value else Exit ;
else Exit ;
end ;
FDate := EncodeDate ( AYear , AMonth , ADay );
FUseCurrentDate := False ;
UpdateCalendar ;
Change ;
end ;
end ;
procedure TCalendarx . SetStartOfWeek ( Value : TDayOfWeek );
begin
if Value <> FStartOfWeek then
begin
FStartOfWeek := Value ;
UpdateCalendar ;
end ;
end ;
procedure TCalendarx . SetUseCurrentDate ( Value : Boolean );
begin
if Value <> FUseCurrentDate then
begin
FUseCurrentDate := Value ;
if Value then
begin
FDate := Date ; { use the current date, then }
UpdateCalendar ;
end ;
end ;
end ;
{ Given a value of 1 or -1, moves to Next or Prev month accordingly }
procedure TCalendarx . ChangeMonth ( Delta : Integer );
var
AYear , AMonth , ADay : Word ;
NewDate : TDateTime ;
CurDay : Integer ;
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
CurDay := ADay ;
if Delta > 0 then ADay := DaysPerMonth ( AYear , AMonth )
else ADay := 1 ;
NewDate := EncodeDate ( AYear , AMonth , ADay );
NewDate := NewDate + Delta ;
DecodeDate ( NewDate , AYear , AMonth , ADay );
if DaysPerMonth ( AYear , AMonth ) > CurDay then ADay := CurDay
else ADay := DaysPerMonth ( AYear , AMonth );
CalendarDate := EncodeDate ( AYear , AMonth , ADay );
end ;
procedure TCalendarx . PrevMonth ;
begin
ChangeMonth (- 1 );
end ;
procedure TCalendarx . NextMonth ;
begin
ChangeMonth ( 1 );
end ;
procedure TCalendarx . NextYear ;
begin
if IsLeapYear ( Year ) and ( Month = 2 ) and ( Day = 29 ) then Day := 28 ;
Year := Year + 1 ;
end ;
procedure TCalendarx . PrevYear ;
begin
if IsLeapYear ( Year ) and ( Month = 2 ) and ( Day = 29 ) then Day := 28 ;
Year := Year - 1 ;
end ;
procedure TCalendarx . NextDay ;
begin
if IsEndofMonth then begin ChangeMonth ( 1 ); day := 1 ; end else day := day + 1 ;
end ;
procedure TCalendarx . PrevDay ;
begin
if day = 1 then begin ChangeMonth (- 1 ); day := DaysThisMonth ; end else day := day - 1 ;
end ;
function TCalendarx . IsEndofMonth : boolean ;
begin
result := false ; if DaysThisMonth = day then result := true ;
end ;
procedure TCalendarx . UpdateCalendar ;
var
AYear , AMonth , ADay : Word ;
FirstDate : TDateTime ;
begin
FUpdating := True ;
try
DecodeDate ( FDate , AYear , AMonth , ADay );
FirstDate := EncodeDate ( AYear , AMonth , 1 );
FMonthOffset := 2 - (( DayOfWeek ( FirstDate ) - StartOfWeek + 7 ) mod 7 ); { day of week for 1st of month }
if FMonthOffset = 2 then FMonthOffset := - 5 ;
MoveColRow (( ADay - FMonthOffset ) mod 7 , ( ADay - FMonthOffset ) div 7 + 1 ,
False , False );
Invalidate ;
finally
FUpdating := False ;
end ;
end ;
procedure TCalendarx . WMSize ( var Message : TWMSize );
var
GridLines : Integer ;
begin
GridLines := 6 * GridLineWidth ;
DefaultColWidth := ( Message . Width - GridLines ) div 7 ;
DefaultRowHeight := ( Message . Height - GridLines ) div 7 ;
end ;
end .
Delphi - .....................................
Calendar bileşeninin gelişmiş hali
Selam arkadaş lar ;
A ş a ğı da Delphi ile gelen Calendar bile ş eninin geli ş tirilmi ş hali olan calendarx
bile ş eninin kodlar ı bulunmaktad ı r . Bu bile ş en iki yeni fonksiyon i ç ermektedir :
PrevDay fonksiyonu ve NextDay fonksiyonu . PrevDay bir ö nceki g ü ne , NextDay bir sonraki
g ü ne gidilmesini sa ğ lamaktad ı r .
Kod delphi7 ortam ı nda denenmi ş tir . A ş a ğı daki kodlar ı Calendarx . pas dosyas ı na kaydettikten
sonra Component > Install Component ile delphiye tan ı t ı n ı z .
Samples sayfas ı n ı n alt ı na kurulacakt ı r .
unit Calendarx ;
interface
uses Classes , Controls , Messages , Windows , Forms , Graphics , StdCtrls ,
Grids , SysUtils ;
type
TDayOfWeek = 0 .. 6 ;
TCalendarx = class ( TCustomGrid )
private
FDate : TDateTime ;
FMonthOffset : Integer ;
FOnChange : TNotifyEvent ;
FReadOnly : Boolean ;
FStartOfWeek : TDayOfWeek ;
FUpdating : Boolean ;
FUseCurrentDate : Boolean ;
function GetCellText ( ACol , ARow : Integer ): string ;
function GetDateElement ( Index : Integer ): Integer ;
procedure SeTCalendarxDate ( Value : TDateTime );
procedure SetDateElement ( Index : Integer ; Value : Integer );
procedure SetStartOfWeek ( Value : TDayOfWeek );
procedure SetUseCurrentDate ( Value : Boolean );
function StoreCalendarDate : Boolean ;
protected
procedure Change ; dynamic ;
procedure ChangeMonth ( Delta : Integer );
procedure Click ; override ;
function DaysPerMonth ( AYear , AMonth : Integer ): Integer ; virtual ;
function DaysThisMonth : Integer ; virtual ;
procedure DrawCell ( ACol , ARow : Longint ; ARect : TRect ; AState : TGridDrawState ); override ;
function IsLeapYear ( AYear : Integer ): Boolean ; virtual ;
function SelectCell ( ACol , ARow : Longint ): Boolean ; override ;
procedure WMSize ( var Message : TWMSize ); message WM_SIZE ;
function IsEndofMonth : boolean ;
public
constructor Create ( AOwner : TComponent ); override ;
property CalendarDate : TDateTime read FDate write SeTCalendarxDate stored StoreCalendarDate ;
property CellText [ ACol , ARow : Integer ]: string read GetCellText ;
procedure NextMonth ;
procedure NextYear ;
procedure NextDay ;
procedure PrevMonth ;
procedure PrevYear ;
procedure PrevDay ;
procedure UpdateCalendar ; virtual ;
published
property Align ;
property Anchors ;
property BorderStyle ;
property Color ;
property Constraints ;
property Ctl3D ;
property Day : Integer index 3 read GetDateElement write SetDateElement stored False ;
property DragCursor ;
property DragKind ;
property DragMode ;
property Enabled ;
property Font ;
property GridLineWidth ;
property Month : Integer index 2 read GetDateElement write SetDateElement stored False ;
property ParentColor ;
property ParentFont ;
property ParentShowHint ;
property PopupMenu ;
property ReadOnly : Boolean read FReadOnly write FReadOnly default False ;
property ShowHint ;
property StartOfWeek : TDayOfWeek read FStartOfWeek write SetStartOfWeek ;
property TabOrder ;
property TabStop ;
property UseCurrentDate : Boolean read FUseCurrentDate write SetUseCurrentDate default True ;
property Visible ;
property Year : Integer index 1 read GetDateElement write SetDateElement stored False ;
property OnClick ;
property OnChange : TNotifyEvent read FOnChange write FOnChange ;
property OnDblClick ;
property OnDragDrop ;
property OnDragOver ;
property OnEndDock ;
property OnEndDrag ;
property OnEnter ;
property OnExit ;
property OnKeyDown ;
property OnKeyPress ;
property OnKeyUp ;
property OnStartDock ;
property OnStartDrag ;
end ;
procedure Register ;
implementation
procedure Register ;
begin
RegisterComponents ( 'Samples' , [ TCalendarx ]);
end ;
constructor TCalendarx . Create ( AOwner : TComponent );
begin
inherited Create ( AOwner );
{ defaults }
FUseCurrentDate := True ;
FixedCols := 0 ;
FixedRows := 1 ;
ColCount := 7 ;
RowCount := 7 ;
ScrollBars := ssNone ;
Options := Options - [ goRangeSelect ] + [ goDrawFocusSelected ];
FDate := Date ;
UpdateCalendar ;
end ;
procedure TCalendarx . Change ;
begin
if Assigned ( FOnChange ) then FOnChange ( Self );
end ;
procedure TCalendarx . Click ;
var
TheCellText : string ;
begin
inherited Click ;
TheCellText := CellText [ Col , Row ];
if TheCellText <> '' then Day := StrToInt ( TheCellText );
end ;
function TCalendarx . IsLeapYear ( AYear : Integer ): Boolean ;
begin
Result := ( AYear mod 4 = 0 ) and (( AYear mod 100 <> 0 ) or ( AYear mod 400 = 0 ));
end ;
function TCalendarx . DaysPerMonth ( AYear , AMonth : Integer ): Integer ;
const
DaysInMonth : array [ 1 .. 12 ] of Integer = ( 31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 );
begin
Result := DaysInMonth [ AMonth ];
if ( AMonth = 2 ) and IsLeapYear ( AYear ) then Inc ( Result ); { leap-year Feb is special }
end ;
function TCalendarx . DaysThisMonth : Integer ;
begin
Result := DaysPerMonth ( Year , Month );
end ;
procedure TCalendarx . DrawCell ( ACol , ARow : Longint ; ARect : TRect ; AState : TGridDrawState );
var
TheText : string ;
begin
TheText := CellText [ ACol , ARow ];
with ARect , Canvas do
TextRect ( ARect , Left + ( Right - Left - TextWidth ( TheText )) div 2 ,
Top + ( Bottom - Top - TextHeight ( TheText )) div 2 , TheText );
end ;
function TCalendarx . GetCellText ( ACol , ARow : Integer ): string ;
var
DayNum : Integer ;
begin
if ARow = 0 then { day names at tops of columns }
Result := ShortDayNames [( StartOfWeek + ACol ) mod 7 + 1 ]
else
begin
DayNum := FMonthOffset + ACol + ( ARow - 1 ) * 7 ;
if ( DayNum < 1 ) or ( DayNum > DaysThisMonth ) then Result := ''
else Result := IntToStr ( DayNum );
end ;
end ;
function TCalendarx . SelectCell ( ACol , ARow : Longint ): Boolean ;
begin
if (( not FUpdating ) and FReadOnly ) or ( CellText [ ACol , ARow ] = '' ) then
Result := False
else Result := inherited SelectCell ( ACol , ARow );
end ;
procedure TCalendarx . SeTCalendarxDate ( Value : TDateTime );
begin
FDate := Value ;
UpdateCalendar ;
Change ;
end ;
function TCalendarx . StoreCalendarDate : Boolean ;
begin
Result := not FUseCurrentDate ;
end ;
function TCalendarx . GetDateElement ( Index : Integer ): Integer ;
var
AYear , AMonth , ADay : Word ;
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
case Index of
1 : Result := AYear ;
2 : Result := AMonth ;
3 : Result := ADay ;
else Result := - 1 ;
end ;
end ;
procedure TCalendarx . SetDateElement ( Index : Integer ; Value : Integer );
var
AYear , AMonth , ADay : Word ;
begin
if Value > 0 then
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
case Index of
1 : if AYear <> Value then AYear := Value else Exit ;
2 : if ( Value <= 12 ) and ( Value <> AMonth ) then AMonth := Value else Exit ;
3 : if ( Value <= DaysThisMonth ) and ( Value <> ADay ) then ADay := Value else Exit ;
else Exit ;
end ;
FDate := EncodeDate ( AYear , AMonth , ADay );
FUseCurrentDate := False ;
UpdateCalendar ;
Change ;
end ;
end ;
procedure TCalendarx . SetStartOfWeek ( Value : TDayOfWeek );
begin
if Value <> FStartOfWeek then
begin
FStartOfWeek := Value ;
UpdateCalendar ;
end ;
end ;
procedure TCalendarx . SetUseCurrentDate ( Value : Boolean );
begin
if Value <> FUseCurrentDate then
begin
FUseCurrentDate := Value ;
if Value then
begin
FDate := Date ; { use the current date, then }
UpdateCalendar ;
end ;
end ;
end ;
{ Given a value of 1 or -1, moves to Next or Prev month accordingly }
procedure TCalendarx . ChangeMonth ( Delta : Integer );
var
AYear , AMonth , ADay : Word ;
NewDate : TDateTime ;
CurDay : Integer ;
begin
DecodeDate ( FDate , AYear , AMonth , ADay );
CurDay := ADay ;
if Delta > 0 then ADay := DaysPerMonth ( AYear , AMonth )
else ADay := 1 ;
NewDate := EncodeDate ( AYear , AMonth , ADay );
NewDate := NewDate + Delta ;
DecodeDate ( NewDate , AYear , AMonth , ADay );
if DaysPerMonth ( AYear , AMonth ) > CurDay then ADay := CurDay
else ADay := DaysPerMonth ( AYear , AMonth );
CalendarDate := EncodeDate ( AYear , AMonth , ADay );
end ;
procedure TCalendarx . PrevMonth ;
begin
ChangeMonth (- 1 );
end ;
procedure TCalendarx . NextMonth ;
begin
ChangeMonth ( 1 );
end ;
procedure TCalendarx . NextYear ;
begin
if IsLeapYear ( Year ) and ( Month = 2 ) and ( Day = 29 ) then Day := 28 ;
Year := Year + 1 ;
end ;
procedure TCalendarx . PrevYear ;
begin
if IsLeapYear ( Year ) and ( Month = 2 ) and ( Day = 29 ) then Day := 28 ;
Year := Year - 1 ;
end ;
procedure TCalendarx . NextDay ;
begin
if IsEndofMonth then begin ChangeMonth ( 1 ); day := 1 ; end else day := day + 1 ;
end ;
procedure TCalendarx . PrevDay ;
begin
if day = 1 then begin ChangeMonth (- 1 ); day := DaysThisMonth ; end else day := day - 1 ;
end ;
function TCalendarx . IsEndofMonth : boolean ;
begin
result := false ; if DaysThisMonth = day then result := true ;
end ;
procedure TCalendarx . UpdateCalendar ;
var
AYear , AMonth , ADay : Word ;
FirstDate : TDateTime ;
begin
FUpdating := True ;
try
DecodeDate ( FDate , AYear , AMonth , ADay );
FirstDate := EncodeDate ( AYear , AMonth , 1 );
FMonthOffset := 2 - (( DayOfWeek ( FirstDate ) - StartOfWeek + 7 ) mod 7 ); { day of week for 1st of month }
if FMonthOffset = 2 then FMonthOffset := - 5 ;
MoveColRow (( ADay - FMonthOffset ) mod 7 , ( ADay - FMonthOffset ) div 7 + 1 ,
False , False );
Invalidate ;
finally
FUpdating := False ;
end ;
end ;
procedure TCalendarx . WMSize ( var Message : TWMSize );
var
GridLines : Integer ;
begin
GridLines := 6 * GridLineWidth ;
DefaultColWidth := ( Message . Width - GridLines ) div 7 ;
DefaultRowHeight := ( Message . Height - GridLines ) div 7 ;
end ;
end .
) ANALİZİ: