Paradox i ç in BDE Alias 'ı Oluşturma
* BDE Administrator 'ü açın. Denetim Masası veya Delphi linklerinden
* Object -> New komutunu verin
* Database Driver Name 'de STANDART seçili olsun, OK' a bas ı n
* Alias 'a istediğiniz bir isim verin, enter' a bas ı n
* Path k ı sm ı ndan tablolar ı n oldu ğ u klas ö r ü se ç in
* Object -> Apply komutunu verin .
---------------------------------------------------------------------------
Paradox 'ta Bilgilerin Kaybolması
Elektirik kesintisi gibi durumlarda paradox tablosundaki verilerin kayb ı n ı ö nlemek i ç in :
Uses a BDE ekleyin ve her table veya query nin afterpost olay ı na a ş a ğı daki kodu yaz . Bir daha elektrik kesilmesinden etkilenmezsin ve index bozulmalar ı da ya ş amazs ı n ı z .
try
DBISaveChanges (( DataSet As TBDEDataSet ). Handle )
except
On EDatabaseError do
ShowMessage ( 'Tabloya Kaydetme hatası !...' );
end ;
--------------------------------------------------------------------------------
DisableControls - EnableControls
Mesela bir tabloda kay ı tlar ı ba ş tan sonra tar ı yorsan ı z , bu kodlar ı yazmazsan ı z , ge ç erli kay ı t ı n bilgileri ba ğ l ı DBEdit , DBGrid vs . de g ü ncellenir . Bu hem g ö r ü nt ü a çı s ı ndan ho ş olmuyor , hem de i ş lemi yava ş lat ı yor . Bu kodlar ı yazarsan ı z ba ğ l ı bile ş enlerle irtibat kesiliyor ve bu olumsuzluklar olmuyor , tekrar ba ğ l ı yorsunuz .
--------------------------------------------------------------------------------
Open ile ExecSql aras ı ndaki fark nedir ?
Delphi 'de Query' ler iki ş ekilde a çı labilir : Open veya ExecSql . Peki ne zaman Open , ne zaman ExecSql kullan ı l ı r ? Bu ç al ış t ı rd ığı n ı z SQL c ü mlesine ba ğ l ı. E ğ er SQL c ü mlesi sonu ç ta size kay ı t ( lar ) d ö nd ü r ü yorsa Open kullanmal ı s ı n ı z . Mesela SQL c ü mleniz " SELECT *..." gibi ise . E ğ er SQL c ü mleniz hi ç ibr kay ı t d ö nd ü rm ü yorsa , ExecSQL kullanmal ı s ı n ı z . Mesela UPDATE , INSERT , DELETE gibi bir sql c ü mlesi yazm ış san ı z .
--------------------------------------------------------------------------------
Database 'i açtığım anda Login ekranı çıkmasın
TDatabase nesnesi veya benzer i ş levi g ö ren ( mesela TAdoConnection ) bir bile ş eni a ç t ığı n ı z zaman kar şı n ı za Login ekran ı gelir ve sizden kullan ı c ı ismi ile ş ifre girmeniz istenir . Bu ekran ı n çı kmamas ı i ç in LoginPrompt ö zelli ğ ini False yap ı n .
--------------------------------------------------------------------------------
DBLookupComboBox 'ın içerisini temizlemek
Delphi 'de temel kural olarak, DB bileşenlere (DBEdit, DBLookupComboBox vs) atama yapmayın, ilgili field' a atama yap ı n . DBLokupComboBox 'ın içeriğini temizlemek için KeyValue' sinin de ğ erini null yap ı n . Ö rne ğ in PERSONEL tablosunda BOLUM_NO alan ı na kar şı l ı k BOLUM_ADINI getiriyorsan ı z :
PERSONELBOLUM_NO . Clear ;
--------------------------------------------------------------------------------
Tekrarlanan kay ı tlar ı tespit etme
Baz ı kay ı tlardan ç ift ise problem çı kartabilir . Bu tip kay ı tlar ı SQL ile ç ok kolay bir ş ekilde tespit edebilirsiniz . Mesela PERSONEL tablosunda , birden fazla ayn ı isme sahip kay ı tlar ı d ö kmek i ç in :
SELECT AD_SOYAD , COUNT (*)
FROM TABLO_ADI
GROUP BY AD_SOYAD
HAVING COUNT(*) > 1
Delphi - .....................................
mac adresi tesbiti kapalıyken bile
This article has some errors, forst , it not close lib at end . second , can only used
NT/ 2000 / XP . Here i gave another copy , it can works on 98 / nt / 2000 / xp ...
function MacAddress : string ;
var
Lib : Cardinal ;
Func : function ( GUID : PGUID ): Longint ; stdcall ;
GUID1 , GUID2 : TGUID ;
begin
Result := '' ;
Lib := LoadLibrary ( 'rpcrt4.dll' );
if Lib <> 0 then
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
@ Func := GetProcAddress ( Lib , 'UuidCreate' )
else @ Func := GetProcAddress ( Lib , 'UuidCreateSequential' );
if Assigned ( Func ) then
begin
if ( Func (@ GUID1 ) = 0 ) and
( Func (@ GUID2 ) = 0 ) and
( GUID1 . D4 [ 2 ] = GUID2 . D4 [ 2 ]) and
( GUID1 . D4 [ 3 ] = GUID2 . D4 [ 3 ]) and
( GUID1 . D4 [ 4 ] = GUID2 . D4 [ 4 ]) and
( GUID1 . D4 [ 5 ] = GUID2 . D4 [ 5 ]) and
( GUID1 . D4 [ 6 ] = GUID2 . D4 [ 6 ]) and
( GUID1 . D4 [ 7 ] = GUID2 . D4 [ 7 ]) then
begin
Result :=
IntToHex ( GUID1 . D4 [ 2 ], 2 ) + '-' +
IntToHex ( GUID1 . D4 [ 3 ], 2 ) + '-' +
IntToHex ( GUID1 . D4 [ 4 ], 2 ) + '-' +
IntToHex ( GUID1 . D4 [ 5 ], 2 ) + '-' +
IntToHex ( GUID1 . D4 [ 6 ], 2 ) + '-' +
IntToHex ( GUID1 . D4 [ 7 ], 2 );
end ;
end ;
FreeLibrary ( Lib );
end ;
Delphi - .....................................
Bmp To Emf dönüştürme
Ç evrim İş lemi Bitmap to EMF format olarak nas ı l yap ı l ı r ?
function bmp2emf ( const SourceFileName : TFileName ): Boolean ;
// Converts a Bitmap to a Enhanced Metafile (*.emf)
var
Metafile : TMetafile ;
MetaCanvas : TMetafileCanvas ;
Bitmap : TBitmap ;
begin
Metafile := TMetaFile . Create ;
try
Bitmap := TBitmap . Create ;
try
Bitmap . LoadFromFile ( SourceFileName );
Metafile . Height := Bitmap . Height ;
Metafile . Width := Bitmap . Width ;
MetaCanvas := TMetafileCanvas . Create ( Metafile , 0 );
try
MetaCanvas . Draw ( 0 , 0 , Bitmap );
finally
MetaCanvas . Free ;
end ;
finally
Bitmap . Free ;
end ;
Metafile . SaveToFile ( ChangeFileExt ( SourceFileName , '.emf' ));
finally
Metafile . Free ;
end ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
bmp2emf ( 'C:TestBitmap.bmp' );
end ;
Delphi - .....................................
Delphi ile Uzak MySql bağlantısı makale
Makaleyi
http: //rapidshare.com/files/75380616/MysqlUzak.rar.html
adresinden indirebilirsiniz .
Delphi - .....................................
Advantage Bağlantı İşlemi
AdsConnection1. DisConnect ; //Bağlantıyı Kes
AdsConnection1 . ConnectPath := 'C:TestVeriler.add' ; //Veri Sözlüğünün yolu
AdsConnection1 . Connect ; //Bağlan
AdsQuery1 . Close ;
AdsQuery1 . SQL . Clear ;
AdsQuery1 . SQL . Add ( 'Select* from Tablo Where Adi Is Not Null' ); //adı doluysa
if DateTimePicker1 . Date <> DateTimePicker2 . Date Then // tarihler birbirine eşit değilse
AdsQuery1 . SQL . Add ( 'and Tarih>=' + QuotedStr ( DateToStr ( DateTimePicker1 . Date ))+ ' and Tarih<=' + QuotedStr ( DateToStr ( DateTimePicker2 . Date )));
If Not AdsQuery1 . Prepared Then
AdsQuery1 . Prepared ;
AdsQuery1 . Open ;
___________________________________________________________
R ü yalar ı n projesi 2.2 : http : //www.enderarslanturk.com.tr/ZIP/Turkiye.ZIP
Ö rnek Resim : http : //www.enderarslanturk.com.tr/default.asp
Delphi - .....................................
Pixel To CM (Pikselden Santimetreye) Dönüşüm
function PxToCm ( dPixel : integer ): Extended ;
Const
Inch : Real = 2.54 ;
begin
PPI := Screen . PixelsPerInch ;
Result := ( dPixel div PPI ) * Inch ;
end ;
Delphi - .....................................
Thread Kullanımına Örnek.
program CreateThreadTest ;
{$APPTYPE CONSOLE}
uses
Windows ,
Classes ,
SysUtils ;
function ThreadProc1 ( p : Pointer ): Integer ;
begin
Write ( 'proc1 ' );
Result := 0 ;
end ;
function ThreadProc2 ( p : Pointer ): Integer ;
begin
Write ( 'proc2 ' );
Result := 0 ;
end ;
var
h1 , h2 : THandle ;
temp : DWORD ;
begin
h1 := CreateThread ( nil , 0 , @ ThreadProc1 , nil , CREATE_SUSPENDED , temp );
h2 := CreateThread ( nil , 0 , @ ThreadProc2 , nil , CREATE_SUSPENDED , temp );
SetThreadPriority ( h2 , THREAD_PRIORITY_TIME_CRITICAL ); // 2. threadin önceliğini yükselt. thread lerin önceliklerini nasıl ayarlarım sorusuna cevap.
ResumeThread ( h1 );
ResumeThread ( h2 ); // 2 thread da resume edildiği halde önceliği yüksek olan 2. thread ilk olarak çalıştırılacakdır.
Write ( 'start ' );
WaitForSingleObject ( h1 , INFINITE ); // 1. thread in sonlanmasını bekle. ne kadar bekler? INFINITE = DWORD($FFFFFFFF); 4.294.967.295 ms. kadar.
WaitForSingleObject ( h2 , INFINITE ); // 2. thread in sonlanmasını bekle. ne kadar bekler? INFINITE = DWORD($FFFFFFFF); 4.294.967.295 ms. kadar.
Write ( 'stop ' );
// TerminateThread(h1); aklınızda olsun işlem yapmakda olan bir thread i terminate ile kapatmayı denerseniz başarısız olacakdır.
Readln ;
end .
Delphi - .....................................
Resim Döndürme
HER ŞEY VATAN İÇİN!
Bu kodda resmi kendi üzerine yapıştırıyoruz. Fakat Rect yapısında ufak bir oynama ile döndürme yapabilirsiniz...
enum TRotateFlag{ROTATE_HOR,ROTATE_VER};
typedef Set<TRotateFlag, ROTATE_HOR,ROTATE_VER> TRotateFlags;
//Yatay ve Dikey döndürme yapabilirsiniz.
//////////////////////////////////////////////////////////////
void Rotate(Graphics::TBitmap* Bmp,TRotateFlags Flag)
{
TRect R=Rect(0,0,Bmp->Width,Bmp->Height);
if (Flag.Contains(ROTATE_HOR))
{
R.Left=R.Right;
R.Right=0;
}
if (Flag.Contains(ROTATE_VER))
{
R.Top=R.Bottom;
R.Bottom=0;
}
Bmp->Canvas->StretchDraw(R,Bmp);
}
/////////////////////////////////////////////////////////////
//Kullanım
void __fastcall TForm1::Button1Click(TObject *Sender)
{
Rotate(Image1->Picture->Bitmap,TRotateFlags()<<ROTATE_VER<<ROTATE_HOR);
}
//---------------------------------------------------------------------
C++ Builder - .....................................
Resmi Grileştirme
Türkiyede C++ hakkında örnek kod bulmak zor olduğu için yazdığım örnekleri yollamaya karar verdim..
HER ŞEY VATAN İÇİN!
Kod Açıklama: Windowsta renkler 32 bitlik bellek(değişken) içerisinde
0x00BBGGRR şeklinde saklanmaktadır.
Aşağıdaki makrolar ile R=Kırmızı,G=Yeşil,B=Mavi, değerlerini kaydırma işlemi ile elde ediyoruz. Bu değerler 1 Bytelık(0-255) sayıdır.
Gri renklerde R=G=B olarak işlem görür. Bunun için üç rengin ortalaması ile Gri rengin tonunu buluyoruz.
GRİ=(R+G+B)/3
tekrar aldığımız yere R=GRİ, G=GRİ, B=GRİ olarak yerleştiriyoruz.
#define GetRValue(rgb) ((BYTE) (rgb))
#define GetGValue(rgb) ((BYTE) (((WORD) (rgb)) >>8))
#define GetBValue(rgb) ((BYTE) ((rgb) >> 16))
#define RGB(r, g ,b) ((DWORD) (((BYTE) (r) |
((WORD) (g) <<
(((DWORD) (BYTE) (b)) << 16)))
void Gri(Graphics::TBitmap* Bmp)
{
BYTE R,G,B,GRAY;
for (int x=0;x<Bmp->Width;x++)
for (int y=0;y<Bmp->Height;y++)
{
R=GetRValue(Bmp->Canvas->Pixels[x][y]);
G=GetGValue(Bmp->Canvas->Pixels[x][y]);
B=GetBValue(Bmp->Canvas->Pixels[x][y]);
GRAY=(R+G+B)/3;
Bmp->Canvas->Pixels[x][y]=RGB(GRAY,GRAY,GRAY);
}
}
//Kullanımı
void __fastcall TForm1::Button1Click(TObject *Sender)
{
Gri(Image1->Picture->Bitmap);
}
//--------------------------------------------------------------
C++ Builder - .....................................
Open Dilalog
HERŞEY VATAN İÇİN!
if (OpenDialog1->Execute())
{
Memo1->Lines->LoadFromFile(OpenDialog1->FileName);
}
C++ Builder - .....................................
KARAMEMET:STRING ŞİFRELEME VE OKUMA
//MAXBUFFER CONST BİR DEĞERDİR. ŞİFRELEYECEĞİNİZ KAYIT BÜYÜKLÜĞÜNE GÖRE BELİRLEYEBİLİRSİNİZ.
FUNCTION SIFRELE ( SIFREX : string ): STRING ;
VAR
Buffer : array [ 0 .. MAXBUFFER ] of char ;
Buffer1 : array [ 0 .. MAXBUFFER ] of char ;
hex : string ;
uzunluk , num16 , I , num : INTEGER ;
sifre : string ;
begin
sifre := '' ;
for i := 0 to maxbuffer - 1 do
begin
buffer [ i ]:= char ( 32 );
end ;
uzunluk := length ( SIFREX );
StrLCopy ( Buffer , PChar ( SIFREX ), uzunluk );
for i := 0 to uzunluk - 1 do
begin
if buffer [ i ]<> char ( 32 ) then
begin
// BURADA İSTERSENİZ MATAMATİKSEL BİR FONKSİYON KULLANABİLİRSİNİZ
// ÖRNEĞİN Y=(3X*4)/5
num :=( ord ( buffer [ i ]));
NUM16 := TRUNC ( NUM / 16 )
Case num mod 16 of
0 : hex := '0' ;
1 : hex := '1' ;
2 : hex := '2' ;
3 : hex := '3' ;
4 : hex := '4' ;
5 : hex := '5' ;
6 : hex := '6' ;
7 : hex := '7' ;
8 : hex := '8' ;
9 : hex := '9' ;
10 : hex := 'A' ;
11 : hex := 'B' ;
12 : hex := 'C' ;
13 : hex := 'D' ;
14 : hex := 'E' ;
15 : hex := 'F' ;
end ;
if num16 > 9 then
begin
sifre := sifre + hex + inttostr ( num16 )+ '-' ;
end else
begin
sifre := sifre + hex + inttostr ( num16 );
end ;
end ;
end ;
uzunluk := length ( sifre );
StrLCopy ( Buffer1 , PChar ( sifre ), uzunluk );
if buffer1 [ uzunluk - 1 ]= '-' then
RESULT :=( sifre + 'AAAA' )
else
RESULT :=( sifre );
end ;
//
FUNCTION SIFRELEOKU ( SIFREXX : string ): STRING ;
VAR
Buffer : array [ 0 .. MAXBUFFER ] of char ;
hex1 , uzunluk , I , num : INTEGER ;
sifre , krkt : string ;
begin
sifre := '' ;
{memo2.Clear;}
for i := 0 to maxbuffer - 1 do
begin
buffer [ i ]:= char ( 32 );
end ;
uzunluk := length ( SIFREXX );
StrLCopy ( Buffer , PChar ( SIFREXX ), uzunluk );
krkt :=( buffer [ uzunluk - 5 ]+ buffer [ uzunluk - 4 ]+ buffer [ uzunluk - 3 ]+ buffer [ uzunluk - 2 ]+ buffer [ uzunluk - 1 ]);
if krkt = '-AAAA' then uzunluk := uzunluk - 5 ;
for i := 0 to uzunluk - 1 do
begin
if ( buffer [ i ]<> char ( 32 )) and ( buffer [ i ]<> '-' ) then
begin
if ( i mod 2 )<> 0 then
begin
num := 0 ;
Case ( buffer [ i - 1 ]) of
'0' : hex1 := 0 ;
'1' : hex1 := 1 ;
'2' : hex1 := 2 ;
'3' : hex1 := 3 ;
'4' : hex1 := 4 ;
'5' : hex1 := 5 ;
'6' : hex1 := 6 ;
'7' : hex1 := 7 ;
'8' : hex1 := 8 ;
'9' : hex1 := 9 ;
'A' : hex1 := 10 ;
'B' : hex1 := 11 ;
'C' : hex1 := 12 ;
'D' : hex1 := 13 ;
'E' : hex1 := 14 ;
'F' : hex1 := 15 ;
end ;
if buffer [ i + 2 ]= '-' then
begin
num := trunc ( strtoint ( buffer [ i ]+ buffer [ i + 1 ])* 16 + hex1 );
sifre := sifre + char ( num );
end else
begin
num := trunc ( strtoint ( buffer [ i ])* 16 + hex1 );
sifre := sifre + char ( num );
end ;
end ;
end ;
end ;
RESULT := sifre ;
end ;
Delphi - .....................................
word programı
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , ImgList , StdCtrls , ComCtrls , BandActn , StdActns , ExtActns ,
ActnList , ToolWin , ExtCtrls , ActnMan , ActnCtrls , ActnMenus ,
XPStyleActnCtrls , StdStyleActnCtrls ;
type
TForm1 = class ( TForm )
ActionManager1 : TActionManager ;
ActionMainMenuBar1 : TActionMainMenuBar ;
ToolActionBar1 : TActionToolBar ;
ToolActionBar2 : TActionToolBar ;
ToolActionBar3 : TActionToolBar ;
EditCut1 : TEditCut ;
EditCopy1 : TEditCopy ;
EditPaste1 : TEditPaste ;
EditSelectAll1 : TEditSelectAll ;
EditUndo1 : TEditUndo ;
EditDelete1 : TEditDelete ;
RichEditBold1 : TRichEditBold ;
RichEditItalic1 : TRichEditItalic ;
RichEditUnderline1 : TRichEditUnderline ;
RichEditStrikeOut1 : TRichEditStrikeOut ;
RichEditBullets1 : TRichEditBullets ;
RichEditAlignLeft1 : TRichEditAlignLeft ;
RichEditAlignRight1 : TRichEditAlignRight ;
RichEditAlignCenter1 : TRichEditAlignCenter ;
FileOpen1 : TFileOpen ;
FileSaveAs1 : TFileSaveAs ;
FileRun1 : TFileRun ;
FileExit1 : TFileExit ;
SearchFind1 : TSearchFind ;
SearchFindNext1 : TSearchFindNext ;
SearchReplace1 : TSearchReplace ;
SearchFindFirst1 : TSearchFindFirst ;
CustomizeActionBars1 : TCustomizeActionBars ;
RichEdit1 : TRichEdit ;
ImageList1 : TImageList ;
StatusBar1 : TStatusBar ;
StdStyleActn : TAction ;
XPStyleActn : TAction ;
ShadowActn : TAction ;
FilePageSetup1 : TFilePageSetup ;
procedure FileOpen1Accept ( Sender : TObject );
procedure FileSaveAs1Accept ( Sender : TObject );
procedure ActionManager1StateChange ( Sender : TObject );
procedure StdStyleActnExecute ( Sender : TObject );
procedure XPStyleActnExecute ( Sender : TObject );
procedure FormCreate ( Sender : TObject );
procedure ShadowActnExecute ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
procedure TForm1 . FileOpen1Accept ( Sender : TObject );
begin
RichEdit1 . Lines . LoadFromFile ( FileOpen1 . Dialog . FileName );
end ;
procedure TForm1 . FileSaveAs1Accept ( Sender : TObject );
begin
RichEdit1 . Lines . SaveToFile ( FileSaveAs1 . Dialog . FileName );
end ;
procedure TForm1 . ActionManager1StateChange ( Sender : TObject );
begin
RichEdit1 . ReadOnly := ActionManager1 . State <> asNormal ;
end ;
procedure TForm1 . StdStyleActnExecute ( Sender : TObject );
begin
ActionManager1 . Style := StandardStyle ;
end ;
procedure TForm1 . XPStyleActnExecute ( Sender : TObject );
begin
ActionManager1 . Style := XPStyle ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
XPStyleActn . Checked := ActionManager1 . Style = XPStyle ;
StdStyleActn . Checked := ActionManager1 . Style = StandardStyle ;
end ;
procedure TForm1 . ShadowActnExecute ( Sender : TObject );
begin
ActionMainMenuBar1 . Shadows := ShadowActn . Checked ;
end ;
end .
kendi wordun ü kendin yap
Delphi - .....................................
HAYIR İŞARETLİ GELEN SORU PENCERESİ
if Application . MessageBox (
PChar ( 'Kayıt Silinecek Onaylıyor musunuz?' ),
PChar ( 'Kayıt Silme' ),
MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION ) = IDYES then
Mesaj ( 'Silindi' )
else
Mesaj ( 'Silmedin,Devam et..' );
// KaanK ETS YAZILIM
Delphi - .....................................
Büyük ve Küçük Ünlü Uyumları
function buyukunluuyumu ( cevirlecek : string ): Boolean ;
var
kelimeuzunlugu , i , n : integer ;
konum : integeR ;
sonuc : string ;
unludeposu : String ;
kalinvar , incevar : Boolean ;
begin
kalinvar := false ;
incevar := false ;
unludeposu := '' ;
for i := 1 to length ( cevirlecek ) do
begin
sonuc := copy ( cevirlecek , i , 1 );
if ( sonuc = 'a' ) or ( sonuc = 'ı' ) or ( sonuc = 'o' ) or ( sonuc = 'u' ) or ( sonuc = 'e' ) or ( sonuc = 'i' ) or ( sonuc = 'ö' ) or ( sonuc = 'ü' ) then
unludeposu := unludeposu + sonuc ;
end ;
sonuc := '' ;
for n := 1 to Length ( unludeposu ) do
begin
sonuc := copy ( unludeposu , n , 1 );
if ( sonuc = 'a' ) or ( sonuc = 'ı' ) or ( sonuc = 'o' ) or ( sonuc = 'u' ) then
kalinvar := true ;
if ( sonuc = 'e' ) or ( sonuc = 'i' ) or ( sonuc = 'ö' ) or ( sonuc = 'ü' ) then
incevar := true ;
end ;
if ( incevar = false ) and ( kalinvar = true ) then
Application . MessageBox ( 'Büyük Ünlü Uyumuna Uyar' , 'Bilgi' , MB_ICONINFORMATION + MB_OK );
if ( incevar = true ) and ( kalinvar = false ) then
Application . MessageBox ( 'Büyük Ünlü Uyumuna Uyar' , 'Bilgi' , MB_ICONINFORMATION + MB_OK );
if ( incevar = true ) and ( kalinvar = true ) then
Application . MessageBox ( 'Büyük Ünlü Uyumuna Uymaz.!' , 'Dikkat!' , MB_ICONWARNING + MB_OK );
end ;
function kucukunluuyumukuralbir ( kelime : string ): Boolean ;
var
sonuc : string ;
n : integer ;
begin
for n := 1 to length ( kelime ) do
begin
sonuc := copy ( kelime , n , 1 );
if ( sonuc = 'a' ) or ( sonuc = 'ı' ) or ( sonuc = 'e' ) or ( sonuc = 'i' ) then
result := true ;
if ( sonuc = 'o' ) or ( sonuc = 'ü' ) or ( sonuc = 'ö' ) or ( sonuc = 'u' ) then
begin
Result := false ;
exit ;
end ;
end ;
end ;
function kucukunluuyumukuraliki ( kelime : string ): Boolean ;
var
sonuc : string ;
n : integer ;
sonucnext : string ;
begin
for n := 1 to length ( kelime ) do
begin
sonuc := copy ( kelime , n , 1 );
if ( sonuc = 'o' ) then
begin
sonucnext := copy ( kelime , n , 1 );
if ( sonucnext = 'a' ) or ( sonucnext = 'e' ) or ( sonucnext = 'u' ) or ( sonucnext = 'ü' ) then
result := true ;
end ;
if ( sonuc = 'u' ) then
begin
sonucnext := copy ( kelime , n , 1 );
if ( sonucnext = 'a' ) or ( sonucnext = 'e' ) or ( sonucnext = 'u' ) or ( sonucnext = 'ü' ) then
result := true ;
end ;
if ( sonuc = 'ö' ) then
begin
sonucnext := copy ( kelime , n , 1 );
if ( sonucnext = 'a' ) or ( sonucnext = 'e' ) or ( sonucnext = 'u' ) or ( sonucnext = 'ü' ) then
result := true ;
end ;
if ( sonuc = 'ü' ) then
begin
sonucnext := copy ( kelime , n , 1 );
if ( sonucnext = 'a' ) or ( sonucnext = 'e' ) or ( sonucnext = 'u' ) or ( sonucnext = 'ü' ) then
result := true ;
end ;
if ( sonuc = 'ı' ) or ( sonuc = 'i' ) then
begin
Result := false ;
exit ;
end ;
end ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
buyukunluuyumu ( Edit3 . Text )
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
if kucukunluuyumukuralbir ( Edit3 . Text )= true then
Application . MessageBox ( 'Kural 1 e Göre Uyar' , 'Bilgi' , MB_ICONINFORMATION + MB_OK ) else
Application . MessageBox ( 'Kural 1 e Göre Uymaz' , 'Dikkat !' , MB_ICONWARNING + MB_OK ) ;
if kucukunluuyumukuraliki ( Edit3 . Text )= true then
Application . MessageBox ( 'Kural 2 ye Göre Uyar' , 'Bilgi' , MB_ICONINFORMATION + MB_OK ) else
Application . MessageBox ( 'Kural 2 ye Göre Uymaz' , 'Dikkat !' , MB_ICONWARNING + MB_OK )
end ;
procedure TForm1 . edit3Change ( Sender : TObject );
begin
Edit3 . Text := AnsiLowerCase ( Edit3 . Text )
end ;
end .
Delphi - .....................................
Tek tıkla PC kapatmak. Windows'un tüm versiyonlarına uyar.
procedure Delay ( ms : longint );
var TheTime : LongInt ;
begin
TheTime := GetTickCount + ms ;
while GetTickCount < TheTime do
Application . ProcessMessages ;
end ;
function ShutMeDown : string ;
var
hToken : THandle ;
tkp , p : TTokenPrivileges ;
RetLen : DWord ;
ExReply : LongBool ;
Reply : DWord ;
begin
case Win32Platform of VER_PLATFORM_WIN32_WINDOWS : //***Windows 9x/ME***//
begin
ExReply := ExitWindowsEx ( EWX_POWEROFF or EWX_SHUTDOWN or EWX_FORCE , 0 );
if ExReply then
Result := 'Shutdown Initiated'
else
Result := 'Shutdown failed with ' + IntToStr ( GetLastError );
end ;
VER_PLATFORM_WIN32_NT : //***Windows NT/2000/XP***//
begin
if OpenProcessToken ( GetCurrentProcess , TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY , hToken ) then
begin
if
LookupPrivilegeValue ( nil , 'SeShutdownPrivilege' , tkp . Privileges [ 0 ]. Luid ) then
begin
tkp . PrivilegeCount := 1 ;
tkp . Privileges [ 0 ]. Attributes :=
SE_PRIVILEGE_ENABLED ;
AdjustTokenPrivileges ( hToken , False , tkp , SizeOf ( TTokenPrivileges ), p , RetLen );
Reply := GetLastError ;
if Reply = ERROR_SUCCESS then
begin
ExReply := ExitWindowsEx ( EWX_POWEROFF or EWX_FORCE , 0 );
if ExReply then
Result := 'Shutdown Initiated'
else
Result := 'Shutdown failed with ' + IntToStr ( GetLastError );
end ;
end ;
end ;
end ; //case bitişi
end ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
ShutMeDown ;
end ;
end .
Delphi - .....................................
Programdan windows wallpaper'i degistirme islemi
procedure TForm1 . ChangeWallPaper ( const FileName : string );
begin
SystemParametersInfoA ( SPI_SETDESKWALLPAPER , 0 ,
PChar ( FileName ), SPIF_UPDATEINIFILE );
end ;
Delphi - .....................................
Eliptik form olusturulmasi
procedure TForm1 . FormCreate ( Sender : TObject );
var
region : HRgn ;
begin
{ koselerden 25 pixel keser }
region := CreateRoundRectRgn ( 1 , 1 , 484 , 312 , 25 , 25 );
SetWindowRgn ( handle , region , true );
end ;
Delphi - .....................................
Programdan bir internet adresini yeni ve istenilen ozelliklerde bir pencerede acmak
uses
comobj ;
procedure TFmMain . GotoUrl ( SUrl : string ; Width , Height : Integer ; ToolBar : Boolean );
const
csOLEObjName = 'InternetExplorer.Application' ;
var
IE : Variant ;
WinHanlde : HWnd ;
begin
if ( VarIsEmpty ( IE ) ) then
begin
IE := CreateOleObject ( csOLEObjName );
IE . Visible := true ;
IE . Toolbar := Toolbar ;
if Width > 0 then IE . Width := Width ;
if Height > 0 then IE . Height := Height ;
IE . Navigate ( sURL );
end else
begin
WinHanlde := FindWIndow ( 'IEFrame' , nil );
if ( 0 <> WinHanlde ) then
begin
IE . Navigate ( sURL );
SetForegroundWindow ( WinHanlde );
end else
begin
ShowMessage ( 'Internet Explorer acilamadi' );
end ;
end ;
end ;
// kullanimi:
{adresi yukseklik ve genislik belirtmeden acar }
GotoUrl ( 'http://.....................................' , 0 , 0 , True );
{adresi yukseklik ve genislik belirterek toolbar
olmayan bir pencerede acar }
GotoUrl ( 'http://.....................................' , 400 , 400 , False );
Delphi - .....................................
Bir klasörün toplam boyutu nasil alinir ?
function GetDirectorySize ( const ADirectory : string ): Integer ;
var
Dir : TSearchRec ;
Ret : integer ;
Path : string ;
begin
Result := 0 ;
Path := ExtractFilePath ( ADirectory );
Ret := Sysutils . FindFirst ( ADirectory , faAnyFile , Dir );
if Ret <> NO_ERROR then
exit ;
try
while ret = NO_ERROR do
begin
inc ( Result , Dir . Size );
if ( Dir . Attr in [ faDirectory ]) and ( Dir . Name [ 1 ] <> '.' ) then
Inc ( Result , GetDirectorySize ( Path + Dir . Name + '*.*' ));
Ret := Sysutils . FindNext ( Dir );
end ;
finally
Sysutils . FindClose ( Dir );
end ;
end ;
//Kullanimi:
procedure TForm1 . Button1Click ( Sender : TObject );
begin
label1 . caption := Format ( 'Boyut: %d bytes' , [ GetDirectorySize ( 'C:Windows' )]);
end ;
Delphi - .....................................
Form'u transparan yapmak ?
procedure TForm1 . Button1Click ( Sender : TObject );
var
i : integer ;
begin
i := GetWindowLong ( Button1 . Handle , GWL_STYLE );
SetWindowLong ( Button1 . Handle , GWL_STYLE , i or BS_MULTILINE );
Button1 . Caption := 'satır1' #13#10 'satır2' ;
end ;
Delphi - .....................................
Programdan dosya kopyalama islemi
procedure FileCopy ( const SourceFileName , TargetFileName : string );
var
S , T : TFileStream ;
begin
S := TFileStream . Create ( sourcefilename , fmOpenRead );
try
T := TFileStream . Create ( targetfilename , fmOpenWrite or fmCreate );
try
T . CopyFrom ( S , S . Size ) ;
finally
T . Free ;
end ;
finally
S . Free ;
end ;
end ;
Delphi - .....................................
Herhangi bir Wincontrol' veya tüm ekran nasil bitmap olarak alinir ?
function GetDcAsBitmap ( DC : HDC ; Bitmap : TBitmap ; W , H : Cardinal ): Boolean ;
var
hdcCompatible : HDC ;
hbmScreen : HBitmap ;
begin
Result := False ;
if DC = 0 then Exit ;
hdcCompatible := CreateCompatibleDC ( DC );
hbmScreen := CreateCompatibleBitmap ( DC , W , H );
if ( hbmScreen = 0 ) then Exit ;
if ( SelectObject ( hdcCompatible , hbmScreen )= 0 ) then Exit ;
if not ( BitBlt ( hdcCompatible , 0 , 0 , W , H , DC , 0 , 0 , SRCCOPY )) then
Exit ;
Bitmap . Handle := HbmScreen ;
Bitmap . Dormant ;
Result := True ;
end ;
function GetScreenAsBitmap ( Bitmap : TBitmap ): Boolean ;
var ScreenDC : HDC ;
begin
ScreenDC := CreateDC ( 'DISPLAY' , nil , nil , nil );
Result := GetDCAsBitmap ( ScreenDC , Bitmap ,
GetDeviceCaps ( ScreenDC , HORZRES ),
GetDeviceCaps ( ScreenDC , VERTRES )
);
end ;
function GetWindowAsBitmap ( const WindowName : string ;
Bitmap : TBitmap ): Boolean ;
var Wnd : HWnd ;
Rect : TRect ;
begin
Wnd := FindWindow ( nil , PChar ( WindowName ));
GetWindowRect ( Wnd , Rect );
Result := GetDCAsBitmap ( GetWindowDC ( Wnd ), Bitmap ,
Rect . Right - Rect . Left , Rect . Bottom - Rect . Top );
end ;
function GetWindowAsBitmap ( Wnd : HWnd ; Bitmap : TBitmap ): Boolean ;
var
Rect : TRect ;
begin
GetWindowRect ( Wnd , Rect );
Result := GetDCAsBitmap ( GetWindowDC ( Wnd ), Bitmap ,
Rect . Right - Rect . Left , Rect . Bottom - Rect . Top );
end ;
// Kullanimi:
{Button1 yüzeyini resim olarak al}
GetWindowAsBitmap ( Button1 . Handle , Image1 . Picture . Bitmap );
{Tüm ekrani resim olarak al}
GetScreenAsBitmap ( Image1 . Picture . Bitmap );
Delphi - .....................................
Ekran koruyucunun durumunu ve kendisini öğrenmek
Selam arkadaş lar ,
Denetim masas ı ilgili regedit ayarlar ı na
HKEY_CURRENT_USER Control Panel Desktop anahtar ı ndan ula ş mak m ü mk ü nd ü r .
Ekran koruyucunun aktif veya pasif oldu ğ unu öğ renmek i ç in ise
HKEY_CURRENT_USER Control Panel Desktop ScreenSaveActive = 0
ise ekran koruyucu yok se ç ilmi ş tir ,
HKEY_CURRENT_USER Control Panel Desktop ScreenSaveActive = 1
ise ekran koruyucuyu öğ renmek i ç in
HKEY_CURRENT_USER Control Panel Desktop SCRNSAVE . EXE
anahtar ı na bakmak yeterlidir . Bu anahtar sadece ekran koruyucu
aktif halde iken bulunmaktad ı r .
Delphi - .....................................
Disable/Enable Network
Selam arkadaslar/
Ben Delphi ile lokal sebekeni Enable veya Disable etmek istiyirem . bilen varsa yardim etsin .
Qabaqcadan tesekkurler
Delphi - .....................................
Sayı ve Harf Ayırma
Bana lazı md ı. formumda benden ö nce birisi sormu ş. Datron arkada ş da yan ı tlam ış.
Kod ç ok i ş imi g ö rd ü.
Bu kod kar ışı k bir metinden say ı lar ı ay ı r ı r .
Uses k ı sm ı na StrUtils ekleyin .
function harfsil ( text : string ): string ;
var
i : integer ;
begin
for i := 1 to length ( text ) do
begin
if StrScan ( '0123456789' , text [ i ])= nil then text [ i ]:= ':' ;
end ;
result := AnsiReplaceText ( text , ':' , '' );
end ;
//kullanımı
edit1 . text := harfsil ( edit1 . text );
A ş a ğı daki kodu da yukar ı daki fonksiyona g ö re de ğ i ş tirdim .
Bu kod da kar ışı k bir metinden say ı lar ı siler .
yine uses k ı sm ı na StrUtils ekliyoruz .
function sayisil ( text : string ): string ;
var
i : integer ;
begin
for i := 1 to length ( text ) do
begin
if StrScan ( 'qwertyuıopğüasdfghjklşizxcvbnmöç' , text [ i ])= nil then text [ i ]:= ':' ;
end ;
result := AnsiReplaceText ( text , ':' , '' );
end ;
//kullanımı
edit1 . text := sayisil ( edit1 . text );
umar ı m yard ı mc ı olur . ( bana laz ı m olmu ş tu .)
buradan da tekrar Datron arkada ş a te ş ekk ü rler .
ç al ış malar ı n ı zda ba ş ar ı lar dilerim .
Delphi - .....................................
SQL Server 2000-2005 ilgili Gerekli Dökümanlar
arkadaş lar i ş te gerekli bir site tavsiye ederim ...
http : //www.databasejournal.com/article.php/3300441
SQL Server 2005 Articles :
Upload multiple XML files to an XML data type column - May 16 , 2007
Query XML data from a table with XML data type - May 2 , 2007
Error handling in SQL Server 2005 - January 5 , 2007
SYNONYM in SQL Server 2005 - October 4 , 2006
Upload multiple files to VarBinary column in SQL Server 2005 - September 22 , 2006
SQL Server 2005 – DML Usage on an untyped XML column - September 6 , 2006
Database Mail in SQL Server 2005 - August 16 , 2006
INTERSECT Operator in SQL Server 2005 - May 17 , 2006
Except Operator in SQL Server 2005 - May 3 , 2006
OUTPUT clause in SQL Server 2005 - April 19 , 2006
SQL Server 2005 's EXECUTE AS statement - April 5, 2006
SQL Server 2005 TableDiff Utility - March 29 , 2006
COPY_ONLY Backups in SQL Server 2005 - March 15 , 2006
System Tables and Catalog Views - March 1 , 2006
OPENROWSET function in SQL Server 2005 - February 16 , 2006
SQL Server 2005 - Data Definition Language Triggers - February 1 , 2006
Row_Number () function in SQL Server 2005 – Part II - January 18 , 2006
Row_Number () function in SQL Server 2005 - January 4 , 2006
" TOP " Clause in SQL Server 2005 - September 7 , 2005
SQL Server 2005 – Automating Creation of Database Snapshots - August 3 , 2005
Cross - Tab reports in SQL Server 2005 - July 19 , 2005
SQL Server 7 / 2000 Articles :
Backup your SQL Server Analytical Database – Part II - December 20 , 2005
Backup your SQL Server Analytical Database – Part I - December 7 , 2005
Monitor CPU Usage of All Running Processes – Part II - November 16 , 2005
Monitor CPU Usage of All Running Processes – Part I - November 2 , 2005
Compress SQL Server backups using WinZip – Part II - October 26 , 2005
Compress SQL Server backups using WinZip – Part I - October 19 , 2005
Automatic Email Alerts for Low SQL Server Disk Space - September 20 , 2005
Executing the result set - August 16 , 2005
Data Portion and Used threshold - July 6 , 2005
Import Security event logs using Log parser and SQL Server - June 29 , 2005
Enumerate SQL Server Names from " SQL Server Enterprise Manager " - June 1 , 2005
Monitor SQL Server CPU Loads - May 17 , 2005
SQL Server : Customized Calendar Tables - May 4 , 2005
Generate Script for objects and dependent objects - April 29 , 2005
Monitor the CPU Usage of your SQL Servers - April 28 , 2005
SQL Server : How to Check the Status of a File Before Processing - April 18 , 2005
Formatted emails from SQL Server - April 7 , 2005
All about the 'Case' - March 15 , 2005
Checking the status of weekly rebooted SQL Servers - March 2 , 2005
Replicating Identity columns in SQL Server - Customizing replication - February 16 , 2005
Rebuilding SQL Server Cluster Nodes - February 2 , 2005
Connect to Lotus Domino using SQL Server Linked Server - January 25 , 2005
Find TCP / IP Sockets Net - Libraries port number used by SQL Server 2000 - January 20 , 2005
Setting up a reboot cycle for Active / Passive Cluster SQL Server - January 13 , 2005
Transaction Log Backups Based on Log Usage Threshold - January 5 , 2005
Upload multiple files to SQL Server Image column - December 14 , 2004
Checking Latency on SQL Server 2000 - December 1 , 2004
Compare Query Results - Part II - November 16 , 2004
SQL Server : Compare Query Results - Part I - November 3 , 2004
" sysperfinfo " in SQL Server - October 28 , 2004
Monitor Blocking in SQL Server 2000 - Part II - October 26 , 2004
Monitor Blocking in SQL Server 2000 - Part 1 - October 20 , 2004
Restore multiple DTS packages - October 6 , 2004
Scanning the network for SQL Server for a range of IP addresses - September 29 , 2004
Scalar Sub - Queries in SQL Server - September 22 , 2004
Automating " Save DTS package " - September 15 , 2004
Automating " Generate SQL Script " - September 1 , 2004
Scanning the network for SQL Server - August 24 , 2004
Restoring a SQL Database - August 18 , 2004
Finding inactive machines using Active Directory - August 4 , 2004
Bits in SQL Server - July 14 , 2004
Auto - Number and Cumulative sum in SQL Server Query results - July 7 , 2004
Inventorying hardware and OS information on all SQL Servers - June 16 , 2004
Production Releases on to Multiple Databases - Part 2 - June 2 , 2004
Production releases on to multiple databases - Part I - May 19 , 2004
Checking SQL Server 's Heart Beat - May 5, 2004
Monitor Database Growth on Multiple SQL Servers - April 14 , 2004
OpenRowSource and OpenRowSet in SQL Server 2000 - April 7 , 2004
Import Multiple Files to SQL Server Using DTS - March 24 , 2004
Import multiple Files to SQL Server using T - SQL - March 16 , 2004
" File Watcher " for SQL Server - March 3 , 2004
Storing scanned web - pages and files to SQL Server - February 25 , 2004
DTS Servers and Schedulers for MS SQL - February 23 , 2004
Monitor Event Viewer on Multiple SQL Servers - February 11 , 2004
SQL Server and Collation - January 28 , 2004
Monitor Disk Space on Multiple SQL Servers - January 14 , 2004
Control your SQL Server 7.0 and 2000 via E - Mail - December 31 , 2003
Updating SQL Server Connection Properties from the DTS Package INI File - September 5 , 2003
Compressed Backup of SQL Server 6.5 , 7.0 and 2000 on Windows 2000 - August 20 , 2003
Enhanced SQL Server Security Auditing - August 1 , 2003
How to Create ODBC DSN on multiple SQL server machines - July 24 , 2003
Export a Table to a Date Stamped File Name in SQL Server - June 20 , 2003
Backup Table Data in SQL Server 7.0 and 2000 - May 16 , 2003
A Server by Any Other Name - April 24 , 2003
Backup -- Transfer -- FTP ! - April 22 , 2003
Synchronizing Production Data with a Test Database on SQL Server - April 3 , 2003
Import Files with Date - stamped Filenames or Paths - March 10 , 2003
Linking SQL Server to Heterogeneous Systems - Feb . 28 , 2003
SMTP Email Setup for SQL Server Cluster Server - February 18 , 2003
Scripts :
Check if column is NULL or empty - May 11 , 2007
UNIX POSIX Time - October 6 , 2006
Find what database and object a column belongs to - August 10 , 2006
Generate UserNames - August 4 , 2006
Find the Zodiac - August 2 , 2006
Find ssnetlib . dll version in SQL Server 2000 - July 10 , 2006
Reboot Machines - May 12 , 2005
NZ function in SQL Server - April 20 , 2005
Get the MDF Size of a given database - February 1 , 2005
First day of previous month - January 6 , 2005
Check File Size - December 6 , 2004
Beginning date of any week in a year - August 9 , 2004
Padding - July 23 , 2004
Say , as in Roman Calendar - July 21 , 2004
Spell the numbers - July 1 , 2004
Find all numbers in a string - May 21 , 2004
Find string in procedure , view , functions , defaults etc . - April 30 , 2004
Generate GRANT EXEC script for existing users in the database - April 30 , 2004
Last day of previous month - April 20 , 2004
PreviousQuarter - April 19 , 2004
Displays range of dates - Calendar - April 11 , 2004
Delete Old Files - April 10 , 2004
Comma Separated or Slash Separated Row Values in a Column - August 4 , 2003
VB Scripts
Delete Older Files - July 1 , 2005
Display FQDN of a machine - June 22 , 2005
Display CPU Information - May 3 , 2005
Send a simple email using CDOSys - April 25 , 2005
NZ function in SQL Server - April 20 , 2005
Enumerate members of a domain group - April 20 , 2005
Test SQL Connectivity - April 4 , 2005
List Processes - March 30 , 2005
Check Windows Process - November 17 , 2004
Search for a string in today , yesterday or the day before 's files - July 1, 2004
Delete Old Folders - June 17 , 2004
Delphi - .....................................
SQL serve'de Exists Kullanımı
if Exists ( select * from tablo where Yas = 22 )
begin
end
Arkada ş lar Bu kod delphi i ç erisinde sql server veritaban ı ndan arama yap ı yormu ş.
Ayr ı ca Findkey () veya Locate () Metodunun yerine daha sa ğ l ı kl ı arama yap ı yor imi ş.
Bu kodlaman ı n do ğ rulu ğ unu bilen varsa bana bir ö rnekle d ö nerse sevinirim .
Sayg ı lar ı mla :....
Delphi - .....................................
Windows Dizinlerini Bulma Konusuna ek
Selam arkadaş lar ,
Daha ö nceden KodBank 'ta verilmiş olan "Windows Dizinlerini Bulma" konusuna
ek yapmak istiyorum
Konuda ad ı ge ç en ShlObj k ü t ü phanesinde bulunan SHGetSpecialFolderLocation fonksiyonu ile windows
dizinleri gayet rahat bulunmaktad ı r . Bu windowsun geli ş mi ş bir fonksiyonudur .
BDS2006 n ı n yard ı m dosyalar ı na bakt ığı mda sistemin bir ç ok dizinini bulabildi ğ ini g ö rd ü m .
Fakat BDS2006 'nın bu fonksiyonun bulunduğu ShlObj kütüphanesinde bu fonksiyonun
bulabildi ğ i dizinlerin tamam ı tan ı mlanmam ış. ShlObj k ü t ü phanesinde bu tan ı mlamalar ı n
olmamas ı ndan dolay ı fonksiyonun bulabildi ğ i dizinlerin say ı s ı k ı s ı tl ı kalmaktad ı r .
Ö rne ğ in " Program Files " dizini bu fonksiyonla bulunabilmekte fakat ShlObj k ü t ü phanesinde
tan ı m ı olmad ığı kullan ı lamamaktad ı r .
A ş a ğı da yaz ı l ı tan ı mlar ı program ı n ı za ekleyerek fonksiyonu tam verimli kullanabilirsiniz .
Detayl ı bilgi ve fonksiyonun kullan ı m ı BDS2006 'nın yardım dosyasında vardır.
const
CSIDL_PROGRAM_FILES = $0026 ;
CSIDL_ADMINTOOLS = $0030 ;
CSIDL_CDBURN_AREA = $003b ;
CSIDL_COMMON_ADMINTOOLS = $002f ;
CSIDL_COMMON_ALTSTARTUP = $001e ;
CSIDL_COMMON_APPDATA = $0023 ;
CSIDL_COMMON_MUSIC = $0035 ;
CSIDL_COMMON_PICTURES = $0036 ;
CSIDL_COMMON_TEMPLATES = $002d ;
CSIDL_COMMON_VIDEO = $0037 ;
CSIDL_LOCAL_APPDATA = $001c ;
CSIDL_MYDOCUMENTS = $000c ;
CSIDL_MYMUSIC = $000d ;
CSIDL_MYPICTURES = $0027 ;
CSIDL_MYVIDEO = $000e ;
CSIDL_PRINTHOOD = $001b ;
CSIDL_PROFILE = $0028 ;
CSIDL_PROFILES = $003e ;
CSIDL_PROGRAM_FILES = $0026 ;
CSIDL_PROGRAM_FILES_COMMON = $002b ;
CSIDL_SYSTEM = $0025 ;
CSIDL_WINDOWS = $0024 ;
***********************************************************
" WINDOWS DIZILERINI BULMA " KONUSUNUN ORJ İ NAL İ
//Windowsun Kişisel Dizinlerini Bulmaya Yarayan Kodlar...
uses ShlObj , ActiveX ;
function DizinAl ( Klasor : Integer ): string ;
var
PIDL : PItemIDList ;
Yol : LPSTR ;
AMalloc : IMalloc ;
begin
Yol := StrAlloc ( MAX_PATH );
SHGetSpecialFolderLocation ( Application . Handle , Klasor , PIDL );
if SHGetPathFromIDList ( PIDL , Yol ) then
Result := Yol ;
SHGetMalloc ( AMalloc );
AMalloc . Free ( PIDL );
StrDispose ( Yol );
end ;
// Klasör Değişkenin Yerine Yazılacaklar...
//CSIDL_DESKTOP Masaüstü Dizini
//CSIDL_DESKTOPDIRECTORY Masaüstü Dizini
//CSIDL_FONTS Fontlar Dizini
//CSIDL_NETHOOD Nethood Klasörü
//CSIDL_PERSONAL Belgelerim Klasörü
//CSIDL_PROGRAMS Başlat Menüsü Programlar Dizini
//CSIDL_RECENT Geçmişte Açılanlar Klasörü
//CSIDL_SENDTO Gönder Klasörü
//CSIDL_STARTMENU Başlat Dizini
//CSIDL_STARTUP Başlangıç Dizini
//CSIDL_TEMPLATES Yeni Oluştur Dizini
//Kullanımı:
//Forma Label Koyun ve Onclick Olayına Yazın
procedure TForm1 . Label1Click ( Sender : TObject );
begin
label1 . Caption := DizinAl ( CSIDL_TEMPLATES )
end ;
//Not Kodlar Yabancı Siteden Alıntıdır...
//Fikri007@hotmail.com
Delphi - .....................................
STRTOWCHAR
function StrToWChar ( const Deger : String ): PWideChar ;
var
Ara : PWideChar ;
begin
GetMem ( Ara , 512 );
StringToWideChar ( Deger , PWideChar ( Ara ), 256 );
Result := PWideChar ( Ara );
end ;
Delphi - .....................................
DBGrid'de Matematiksel İşlemler - 2 (sütun toplamı)
NeverFear - kaheri579 @ hotmail . com
* Karma şı k fonksiyonlara girmeden basite indirgenmi ş kodlama .
* Form ü zerine 1 Table , 1 DataSource , 1 DBGrid ve 1 Edit b ı rak ı n .
* Edit bile ş enini ReadOnly -> True , TabStop -> False yap ı n .
---------- *. pas ---------------------------------------------------------------
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , ExtCtrls , StdCtrls , Buttons , DB , DBTables , Grids , DBGrids , Mask ,
DBCtrls ;
type
TForm1 = class ( TForm )
DBGrid1 : TDBGrid ;
Table1 : TTable ;
DataSource1 : TDataSource ;
Edit1 : TEdit ;
procedure FormCreate ( Sender : TObject );
procedure Table1AfterPost ( DataSet : TDataSet );
procedure DBGrid1KeyDown ( Sender : TObject ; var Key : Word ;
Shift : TShiftState );
private
{ Private declarations }
public
procedure ToplamStok_Hesapla ;
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
procedure TForm1 . FormCreate ( Sender : TObject );
begin
Edit1 . Text := '' ;
Table1 . Active := True ;
ToplamStok_Hesapla ;
end ;
procedure TForm1 . ToplamStok_Hesapla ;
Label 1 ; // Yeni başlayanların dikkatine ...!
// Bu satırı TLabel bileşeni ile karıştırmayın.
// bknz: Delphi Help 'goto statements' konusu.
var Toplam : Real ;
begin
if Table1 . RecordCount = 0 then begin Edit1 . Text := '0' ; GoTo 1 ; end ;
//Veritabanında kayıt yoksa, sonraki kodları yürütmez ve 1:// satırına gider.
Table1 . First ;
Toplam := 0 ;
repeat
if not Table1 . FieldByName ( 'GuncelStok' ). IsNull then
// Bu satırı kodlamayabilirsin.
// 'GuncelStok' isimli saha kayıtlarında boşluk olup olmadığını kontrol eder.
// Eğer
Toplam:= Toplam + StrToFloat ( DBGrid1 . Fields [ 9 ]. Text );
// DBGrid1.Fields[9].Text --> DBGrid1.Fields[X].Text
// X ==>> Toplamını aldırmak istediğiniz sütun numarasını girin.
Table1 . Next ;
until Table1 . EOF ;
Edit1 . Text := FormatFloat ( '#,###.##0' , Toplam );
// Edit1'deki görünümü 1.000,000 şeklinde.
// ( 1.000 kısmı KiloGram)-( ,000 kısmı Gram)
1 : //Veritabanında Kayıt Yok ---> Not: Bu satırı silmeyin( Label 1 ve GoTo 1 kodlu ).
{NOT: Eğer
repeat ... until döngüsünü bunun içine kodlamalısın.
Örneğin:
if Table1.FindKey([DBGrid1.Fields[0].Text]) then
//DBGrid1.Fields[0].Text --> 'StokNo' sahası MasterIndex [ixPrimary, ixUnique]
//kabul edildi.
begin
repeat
if not Table1.FieldByName('GuncelStok').IsNull then
Toplam:= Toplam + StrToFloat(DBGrid1.Fields[9].Text);
Table1.Next;
until Table1.EOF;
end;
SQL ve ADO
Toplam:= Toplam + StrToFloat(DBGrid1.Fields[X].Text); satırı geçerlidir.}
end ;
procedure TForm1 . Table1AfterPost ( DataSet : TDataSet );
begin
ToplamStok_Hesapla ;
end ;
procedure TForm1 . DBGrid1KeyDown ( Sender : TObject ; var Key : Word ;
Shift : TShiftState );
begin
if ( Shift = [ ssCtrl ]) then Key := 0 ;
// "Ctrl" tuşu hiçbir zaman çalışmaz (Ctrl+Del
//if (Shift = [ssAlt]) then Key:= 0;
// "Alt" tuşu hiçbir zaman çalışmaz (Alt+F4 ... v.b.).
//if (Shift = [ssShift]) then Key:= 0;
// "Shift" tuşu hiçbir zaman çalışmaz (Shift+F10 ... v.b.).
end ;
end .
--------------------------------------------------------------------------------
İş inizi g ö rmesi dile ğ imle ,
Ç al ış malar ı n ı zda ba ş ar ı lar dilerim .
NeverFear - kaheri579 @ hotmail . com
Delphi - .....................................
PHYTON DEMO PROGRAM
PHYTHON(PİTON) PROGRAMLAMA DİLİNE BAŞLAMAK İSTEYENLERE EN BASİT ÖRNEKLERDEN BİRİ
KOD ARABİRİMLİ PHYTHON ZOR OLSADA NASA,GOOGLE,MİCROSOFT GİBİ DEV KURULUŞLARIN TERCİH ETTİĞİ BİR
PROGRAMLAMA DİLİDİR......
KOLAY GELSİN:)
from Tkinter import *
import re
class ReDemo:
def __init__(self, master):
self.master = master
self.promptdisplay = Label(self.master, anchor=W,
text="Hasan TurmuS DENEME PROGRAMI:")
self.promptdisplay.pack(side=TOP, fill=X)
self.regexdisplay = Entry(self.master)
self.regexdisplay.pack(fill=X)
self.regexdisplay.focus_set()
self.addoptions()
self.statusdisplay = Label(self.master, text="", anchor=W)
self.statusdisplay.pack(side=TOP, fill=X)
self.labeldisplay = Label(self.master, anchor=W,
text="STRING ARAM
self.labeldisplay.pack(fill=X)
self.labeldisplay.pack(fill=X)
self.showframe = Frame(master)
self.showframe.pack(fill=X, anchor=W)
self.showvar = StringVar(master)
self.showvar.set("BİRİNCİ")
self.showfirstradio = Radiobutton(self.showframe,
text="YÜKSEK",
variable=self.showvar,
value="BİR",
command=self.recompile)
self.showfirstradio.pack(side=LEFT)
self.showallradio = Radiobutton(self.showframe,
text="Highlight all matches",
variable=self.showvar,
value="all",
command=self.recompile)
self.showallradio.pack(side=LEFT)
self.stringdisplay = Text(self.master, width=60, height=4)
self.stringdisplay.pack(fill=BOTH, expand=1)
self.stringdisplay.tag_configure("hit", background="yellow")
self.grouplabel = Label(self.master, text="Groups:", anchor=W)
self.grouplabel.pack(fill=X)
self.grouplist = Listbox(self.master)
self.grouplist.pack(expand=1, fill=BOTH)
self.regexdisplay.bind('<Key>', self.recompile)
self.stringdisplay.bind('<Key>', self.reevaluate)
self.compiled = None
self.recompile()
btags = self.regexdisplay.bindtags()
self.regexdisplay.bindtags(btags[1:] + btags[:1])
btags = self.stringdisplay.bindtags()
self.stringdisplay.bindtags(btags[1:] + btags[:1])
def addoptions(self):
self.frames = []
self.boxes = []
self.vars = []
for name in ('IGNORECASE',
'LOCALE',
'MULTILINE',
'DOTALL',
'VERBOSE'):
if len(self.boxes) % 3 == 0:
frame = Frame(self.master)
frame.pack(fill=X)
self.frames.append(frame)
val = getattr(re, name)
var = IntVar()
box = Checkbutton(frame,
variable=var, text=name,
offvalue=0, onvalue=val,
command=self.recompile)
box.pack(side=LEFT)
self.boxes.append(box)
self.vars.append(var)
def getflags(self):
flags = 0
for var in self.vars:
flags = flags | var.get()
flags = flags
return flags
def recompile(self, event=None):
try :
self.compiled = re.compile(self.regexdisplay.get(),
self.getflags())
bg = self.promptdisplay['background']
self.statusdisplay.config(text="", background=bg)
except re.error, msg:
self.compiled = None
self.statusdisplay.config(
text="re.error: %s" % str(msg),
background="red")
self.reevaluate()
def reevaluate(self, event=None):
try :
self.stringdisplay.tag_remove("hit", "1.0", END)
except TclError:
pass
try :
self.stringdisplay.tag_remove("hit0", "1.0", END)
except TclError:
pass
self.grouplist.delete (0, END)
if not self.compiled:
return
self.stringdisplay.tag_configure("hit", background="yellow")
self.stringdisplay.tag_configure("hit0", background="orange")
text = self.stringdisplay.get("1.0", END)
last = 0
nmatches = 0
while last <= len(text):
m = self.compiled.search(text, last)
if m is None:
break
first, last = m.span()
if last == first:
last = first+1
tag = "hit0"
else :
tag = "hit"
pfirst = "1.0 + %d chars" % first
plast = "1.0 + %d chars" % last
self.stringdisplay.tag_add(tag, pfirst, plast)
if nmatches == 0:
self.stringdisplay.yview_pickplace(pfirst)
groups = list(m.groups())
groups.insert(0, m .group())
for i in range(len(groups)):
g = "%2d: %r" % (i, groups[i])
self.grouplist.insert(END, g)
nmatches = nmatches + 1
if self.showvar.get() == "first":
break
if nmatches == 0:
self.statusdisplay.config(text="(no match)",
background="yellow")
else :
self.statusdisplay.config(text="")
# Main function, run when invoked as a stand-alone Python program.
def main():
root = Tk()
demo = ReDemo(root)
root.protocol('WM_DELETE_WINDOW', root.quit)
root.mainloop()
if __name__ == '__main__':
main()
C++ Builder - .....................................
C# [ Ini Dosyası Kullanımı ]
---------------------- ini . cs -----------------------------------
using System ;
using System . IO ;
using System . Runtime . InteropServices ;
using System . Text ;
namespace Ini
'{'
public class IniFile
'{'
public string path ;
[ DllImport (" kernel32 ")]
private static extern long WritePrivateProfileString ( string section , string key , string val , string filePath );
[ DllImport (" kernel32 ")]
private static extern int GetPrivateProfileString ( string section , string key , string def , StringBuilder retVal , int size , string filePath );
public IniFile ( string INIPath )
'{'
path = INIPath ;
'}'
public void IniWriteValue ( string Section , string Key , string Value )
'{'
WritePrivateProfileString( Section , Key , Value , this . path );
'}'
public string IniReadValue ( string Section , string Key )
'{'
StringBuilder temp = new StringBuilder ( 255 );
int i = GetPrivateProfileString ( Section , Key ,"", temp , 255 , this . path );
return temp. ToString ();
'}'
'}'
'}' // Tırnak işaretleri silinecek
kullan ı m ı
--------------------- Form . cs -----------------------------
using System ;
using System . Drawing ;
using System . Collections ;
using System . ComponentModel ;
using System . Windows . Forms ;
using System . Data ;
using Ini ;
namespace IniTest
'{'
public class Form1 : System . Windows . Forms . Form
'{'
private System . Windows . Forms . TextBox name ;
private System . Windows . Forms . TextBox lname ;
private System . ComponentModel . Container components = null ;
public Form1 ()
'{'
InitializeComponent();
'}'
protected override void Dispose ( bool disposing )
'{'
if ( disposing )
'{'
if ( components != null )
'{'
components. Dispose ();
'}'
'}'
base. Dispose ( disposing );
'}'
Windows Form Designer generated code
[ STAThread ]
static void Main ()
'{'
Application. Run ( new Form1 ());
'}'
private void Form1_Closing ( object sender , System . ComponentModel . CancelEventArgs e )
'{'
IniFile ini = new IniFile (" C : test . ini ");
ini. IniWriteValue (" Info "," Name ", name . Text );
ini. IniWriteValue (" Info "," LastName ", lname . Text );
'}'
private void Form1_Load ( object sender , System . EventArgs e )
'{'
IniFile ini = new IniFile (" C : test . ini ");
name. Text = ini . IniReadValue (" Info "," Name ");
lname. Text = ini . IniReadValue (" Info "," LastName ");
'}'
'}'
'}'
Delphi.NET - .....................................
IDHTTP1 HATA MSG ALANLAR.
IDHTTP1. GET VE POSTLARINDA
HTTP 1.1 / NOT FOUND VB ... gibi Hata mesajlar ı al ı yorsan ı z
ve do ğ al olarak get post kullanam ı yorsan ı z complementi ekledikten sonra
HandleRedirects Ö zelli ğ ini True Yap ı n Ozaman Complement Sorunsuz Ç al ış acakt ı r .
// Siz Elle Yapın Daha iyi
idhttp1 . HandleRedirects : True ;
Delphi - .....................................
) |