CheckBox Durumuna Göre Enabled
CheckBox'un OnClick Olayına;
var
durum : boolean ;
begin
durum := CheckBox1 . Checked ;
Edit1 . Enabled := durum ;
end ;
yazarsan ı z CheckBox Her T ı kland ığı nda edit 'in
durumu de ğ i ş ir . Ç ok basit bir ş ey ama ç oklu se ç imlerde i ş e yarayabilir .
Sayg ı lar ..
Delphi - .....................................
make each MDIChild fill the entire client area of the main form?
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms , Dialogs ;
type
TMDIForm = class ( TForm )
private
{ Private declarations }
FMainWindowClientCoordinates : TRect ;
procedure SetMainWindowClientCoordinates ( const Value : TRect );
procedure NewChild ( Sender : TObject );
public
{ Public declarations }
// property used to read MainForm client coordinates
property MainWindowClientCoordinates : TRect
read FMainWindowClientCoordinates write SetMainWindowClientCoordinates ;
end ;
var
MDIForm : TMDIForm ; // Main form, property "formStyle" has to be fsMdiForm
implementation
{$R *.DFM}
uses
Child ; // Defines TMDIchild class, property "formStyle" has to be fsMdiChild
procedure TMDIForm . SetMainWindowClientCoordinates ( const Value : TRect );
begin
FMainWindowClientCoordinates := Value ;
end ;
procedure TMDIForm . SetMainWindowCoordinates ( const Value : TRect );
begin
FMainWindowCoordinates := Value ;
end ;
procedure TMDIForm . FormShow ( Sender : TObject );
begin
// Reads MDIForm client coordinates
Windows . GetClientRect ( ClientHandle , fMainWindowClientCoordinates );
end ;
procedure TMDIForm . NewChild ( Sender : TObject );
var
LocalMDIChildForm : TMDIChildForm ;
begin
// You can execute this procedure each time you
// create a new child, for example you can call this
// procedure from a button
LocalMDIChildForm := TMDIChildForm . Create ( Self );
with LocalMDIChildForm do
begin
Caption := 'Child Form: ' + IntToStr ( MDIChildCount );
Top := MainWindowClientCoordinates . Top ;
Left := MainWindowClientCoordinates . Left ;
Width := MainWindowClientCoordinates . Right ;
Height := MainWindowClientCoordinates . Bottom ;
Show ;
end ; // with ...
end ;
end .
Delphi - .....................................
Şifreli excel dosyasını açma
/*/*/*/*/*/* /*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
KODBANK 'A SORU SORMAYINIZ DELPHITURK FORUM LARINI KULLANINIZ......!
/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
var
xls , xlw : Variant ;
begin
xls := CreateOLEObject ( 'Excel.Application' );
xlw := xls . WorkBooks . Open ( FileName := 'd:book1.xls' , Password := 'qq' , ReadOnly := True );
xlw . SaveAs ( FileName := 'd:book2.xls' , Password := '' );
xlw := UnAssigned ;
xls := UnAssigned ;
end ;
//şifresiyle açılıyor, şifresiz kayıt ediliyor..
Delphi - .....................................
Windows kullanıcı ayarları tesbiti (bölgesel ayarlar)_Ek
NeverFear - kaheri579 @ hotmail . com
Windows kullan ı c ı ayarlar ı tesbiti ( b ö lgesel ayarlar ) konu ba ş l ığı ile 10 Ocak 2008 'de
g ö ndermi ş oldu ğ um yaz ı ya ek olarak " Windows Vista Home Basic " y ü kl ü bir sistemde
b ö lgesel ayarlar ı n tutuldu ğ u kay ı t anahtarlar ı a ş a ğı dad ı r . Ancak proje i ç inde
denenmemi ş tir .
[ HKEY_USERS . DEFAULT Control Panel International ]
[ HKEY_USERS S - 1 - 5 - 18 Control Panel International ]
[ HKEY_USERS S - 1 - 5 - 19 Control Panel International ]
[ HKEY_USERS S - 1 - 5 - 20 Control Panel International ]
[ HKEY_USERS S - 1 - 5 - 21 - 1535456688 - 4156088507 - 3177086748 - 1000 Control Panel International ]
Reg . RootKey := HKEY_USERS ;
Reg . OpenKey ( '.DEFAULTControl PanelInternational' , False );
sCountry := Reg . ReadString ( 'sCountry' );
İş inizi g ö rmesi dile ğ imle ,
Ç al ış malar ı n ı zda ba ş ar ı lar dilerim .
NeverFear - kaheri579 @ hotmail . com
Delphi - .....................................
AdoTable ile sıralama
{Sql kullanılmayan durumlarda, bazen verilerinizin sıralı olarak karşınıza
gelmesini ve tabloya yeni kayıt ekleme durumlarında bu sıralama işleminin devam
etmesini isteye bilirsiniz.}
ADOTable1 . Sort := 'Derece DESC, Kademe ASC, AyrilmaTarihi ASC' ;
Delphi - .....................................
TStringList ve TStrings ornek kullanımı
....
private
{ Private declarations }
Elemanlar : TStringList ;
....
procedure TForm1 . FormShow ( Sender : TObject );
begin
Elemanlar := TStringList . Create ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
Elemanlar . Add ( Edit1 . Text );
ListBox1 . Items := TStrings ( Elemanlar );
// ya da
// ListBox1.Items:=Elemanlar;
end ;
Delphi - .....................................
sql server 2005 uzak bağlantı yapılandırması
SQL Server 2005 'i uzak bağlantılara izin verecek biçimde yapılandırma
Bu makalenin ge ç erli oldu ğ u ü r ü nleri g ö r ü n .
Makale numaras ı : 914277
Son G ö zden Ge ç irme : 29 Aral ı k 2007 Cumartesi
G ö zden ge ç irme : 1.0
Bu Sayfada
G İ R İŞ
Daha fazla bilgi
SQL Server 2005 Express veya SQL Server 2005 Developer Edition i ç in uzak ba ğ lant ı lar ı etkinle ş tirme
SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmetini etkinle ş tirme
Windows Firewall 'da (Windows Güvenlik Duvarı) özel durumlar oluşturma
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server 2005 için bir özel durum oluşturma
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server Browser (SQL Server Tarayıcısı) hizmeti için bir özel durum oluşturma
G İ R İŞ
Uzak bilgisayardaki bir Microsoft SQL Server 2005 ö rne ğ ine ba ğ lanmaya ç al ış t ığı n ı zda
bir hata iletisi alabilirsiniz . Bu sorun , SQL Server 'a bağlanmak için herhangi bir
program kulland ığı n ı zda olu ş abilir . Ö rne ğ in , SQL Server 'a bağlanmak için SQLCMD
yard ı mc ı program ı n ı kulland ığı n ı zda a ş a ğı daki hata iletisini al ı rs ı n ı z :
Sqlcmd : Error : Microsoft SQL Native Client : An error has occurred while establishing a connection to the server .
When connecting to SQL Server 2005 , this failure may be caused by the fact that
under the default settings SQL Server does not allow remote connections .
( Sqlcmd : Hata : Microsoft SQL Ö zg ü n İ stemcisi : Sunucu ba ğ lant ı s ı olu ş turulurken bir hata olu ş tu .
SQL Server 2005 'e bağlanırken, bu hata, SQL Server varsayılan ayarlarının uzak bağlantılara izin vermemesi nedeniyle oluşabilir.)
Bu sorun , SQL Server 2005 uzak ba ğ lant ı lar ı kabul edecek bi ç imde yap ı land ı r ı lmam ış sa olu ş abilir .
SQL Server 2005 Express Edition ve SQL Server 2005 Developer Edition varsay ı lan
olarak uzak ba ğ lant ı lara izin vermez . SQL Server 2005 'i uzak bağlantılara izin verecek biçimde yapılandırmak için,
a ş a ğı daki ad ı mlar ı n t ü m ü n ü tamamlay ı n : • Uzak bilgisayardan ba ğ lanmak istedi ğ iniz SQL Server ö rne ğ inde uzak ba ğ lant ı lar ı etkinle ş tirin .
• SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmetini a çı n .
• G ü venlik duvar ı n ı, SQL Server ve SQL Server Browser ( SQL Server Taray ı c ı s ı)
hizmeti ile ili ş kili a ğ trafi ğ ine izin verecek bi ç imde yap ı land ı r ı n .
Bu makalede , bu ad ı mlar ı n her birinin nas ı l tamamlanaca ğı a çı klan ı r .
Ü ste
Daha fazla bilgi
SQL Server 2005 ö rne ğ inde uzak ba ğ lant ı lar ı etkinle ş tirmek ve SQL Server Browser
( SQL Server Taray ı c ı s ı) hizmetini a ç mak i ç in , SQL Server 2005 Surface Area Configuration
( Y ü zey Alan ı Yap ı land ı rmas ı) arac ı n ı kullan ı n . Surface Area Configuration ( Y ü zey Alan ı Yap ı land ı rmas ı) arac ı, SQL Server 2005 ile birlikte y ü klenir .
Ü ste
SQL Server 2005 Express veya SQL Server 2005 Developer Edition i ç in uzak ba ğ lant ı lar ı etkinle ş tirme
Uzak bilgisayardan ba ğ lanmak istedi ğ iniz her SQL Server 2005 ö rne ğ i i ç in uzak ba ğ lant ı lar ı
etkinle ş tirmelisiniz . Bunu yapmak i ç in ş u ad ı mlar ı izleyin :
1. Start 'ı (Başlat) tıklatın, Programs' ı n ( Programlar ) ü zerine gelin ,
Microsoft SQL Server 2005 'in üzerine gelin, Configuration Tools' un
( Yap ı land ı rma Ara ç lar ı) ü zerine gelin ve sonra da SQL Server Surface Area Configuration 'ı
( SQL Server Y ü zey Alan ı Yap ı land ı rmas ı) t ı klat ı n .
2. SQL Server 2005 Surface Area Configuration ( SQL Server 2005 Y ü zey Alan ı Yap ı land ı rmas ı) sayfas ı nda ,
Surface Area Configuration for Services and Connections 'ı (Hizmetler ve Bağlantılar için Yüzey Alanı Yapılandırması) tıklatın.
3. Surface Area Configuration for Services and Connections ( Hizmetler ve Ba ğ lant ı lar i ç in
Y ü zey Alan ı Yap ı land ı rmas ı) sayfas ı nda , Database Engine 'i (Veritabanı Altyapısı) genişletin, Remote Connections' ı
(Uzak Ba ğ lant ı lar ) t ı klat ı n , Local and remote connections 'ı (Yerel ve uzak bağlantılar)
t ı klat ı n , ç al ış ma ortam ı n ı za uygun olan protokol ü t ı klat ı n ve sonra da Apply 'ı (Uygula) tıklatın.
Not A ş a ğı daki iletiyi ald ığı n ı zda OK 'i (Tamam) tıklatın:
Changes to Connection Settings will not take effect until you restart the Database Engine service .
( Veritaban ı Altyap ı s ı hizmeti yeniden ba ş lat ı l ı ncaya kadar Ba ğ lant ı Ayarlar ı de ğ i ş iklikleri etkili olmaz .)
4. Surface Area Configuration for Services and Connections ( Hizmetler ve Ba ğ lant ı lar i ç in Y ü zey Alan ı Yap ı land ı rmas ı)
sayfas ı nda , Database Engine 'i (Veritabanı Altyapısı) genişletin, Service' i ( Hizmet ) t ı klat ı n , Stop 'u (Durdur) tıklatın,
MSSQLSERVER hizmeti durduruluncaya kadar bekleyin ve sonra da MSSQLSERVER hizmetini yeniden ba ş latmak ü zere Start 'ı (Başlat) tıklatın.
Ü ste
SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmetini etkinle ş tirme
SQL Server 2005 'i bir örnek adı kullanarak çalıştırıyorsanız ve bağlantı dizenizde belirli bir
TCP / IP ba ğ lant ı noktas ı numaras ı kullanm ı yorsan ı z , uzak ba ğ lant ı lara izin vermek i ç in SQL Server Browser
( SQL Server Taray ı c ı s ı) hizmetini etkinle ş tirmelisiniz .
Ö rne ğ in , SQL Server 2005 Express varsay ı lan olarak Bilgisayar Ad ı SQLEXPRESS ö rnek ad ı yla y ü klenir .
Ç al ış t ı rd ığı n ı z SQL Server 2005 ö rne ğ i say ı s ı ndan ba ğı ms ı z olarak , SQL Server Browser
( SQL Server Taray ı c ı s ı) hizmetini bir kez etkinle ş tirmeniz gerekir . SQL Server Browser
( SQL Server Taray ı c ı s ı) hizmetini etkinle ş tirmek i ç in a ş a ğı daki ad ı mlar ı izleyin .
Ö nemli Bu ad ı mlar g ü venlik riskinizi art ı rabilir . Bu ad ı mlar , bilgisayar ı n ı z ı n veya
a ğı n ı z ı n k ö t ü niyetli kullan ı c ı lar veya vir ü sler gibi k ö t ü ama ç l ı yaz ı l ı mlar taraf ı ndan
ger ç ekle ş tirilecek sald ı r ı lara kar şı daha savunmas ı z kalmas ı na neden olabilir .
Programlar ı n tasarland ı klar ı ş ekilde ç al ış mas ı n ı veya belirli program becerilerini
kullanmas ı n ı sa ğ lamak i ç in , bu makalede anlat ı lan i ş lemi ö neririz .
Bu de ğ i ş iklikleri yapmadan ö nce , bu i ş lemin ç al ış ma ortam ı n ı zda uygulanmas ı yla
ili ş kili riskleri de ğ erlendirmeniz ö nerilir . Bu i ş lemi kullanmay ı se ç erseniz ,
sisteminizin korunmas ı na yard ı mc ı olabilecek ek ad ı mlar ı da ger ç ekle ş tirin .
Bu i ş lemi , yaln ı zca ç ok gerekliyse kullanman ı z ı ö neririz .
1. Start 'ı (Başlat) tıklatın, Programs' ı n ( Programlar ) ü zerine gelin , Microsoft SQL Server 2005 'in üzerine gelin,
Configuration Tools 'un (Yapılandırma Araçları) üzerine gelin ve sonra da SQL Server Surface Area Configuration' ı
( SQL Server Y ü zey Alan ı Yap ı land ı rmas ı) t ı klat ı n .
2. SQL Server 2005 Surface Area Configuration ( SQL Server 2005 Y ü zey Alan ı Yap ı land ı rmas ı)
sayfas ı nda , Surface Area Configuration for Services and Connections 'ı (Hizmetler ve Bağlantılar için Yüzey Alanı Yapılandırması) tıklatın.
3. Surface Area Configuration for Services and Connections
( Hizmetler ve Ba ğ lant ı lar i ç in Y ü zey Alan ı Yap ı land ı rmas ı) sayfas ı nda , SQL Server Browser 'ı
( SQL Server Taray ı c ı s ı) t ı klat ı n , Startup type ( Ba ş lang ıç t ü r ü) olarak Automatic 'i (Otomatik) seçin ve ardından Apply' ı ( Uygula ) t ı klat ı n .
Not Automatic ( Otomatik ) se ç ene ğ ini t ı klatt ığı n ı zda , Microsoft Windows 'u her
ba ş latt ığı n ı zda SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmeti otomatik olarak ba ş lat ı l ı r .
4. Start 'ı (Başlat) ve sonra OK' i ( Tamam ) t ı klat ı n .
Not Bir bilgisayarda SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmetini ç al ış t ı rd ığı n ı zda ,
bilgisayar , ç al ış makta olan her SQL Server ö rne ğ i i ç in ö rnek ad ı ve ba ğ lant ı bilgilerini g ö r ü nt ü ler .
Bu risk , SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmeti etkinle ş tirilmeyerek ve
SQL Server ö rne ğ ine atanm ış bir TCP ba ğ lant ı noktas ı ü zerinden do ğ rudan ba ğ lan ı larak azalt ı labilir .
SQL Server ö rne ğ ine atanm ış bir TCP ba ğ lant ı noktas ı ü zerinden do ğ rudan ba ğ lanma konusu bu makalenin kapsam ı d ışı ndad ı r .
SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmeti ve SQL Server ö rne ğ ine ba ğ lanma konusunda daha fazla bilgi i ç in ,
SQL Server Books Online 'da aşağıdaki konulara bakın: • SQL Server Browser Service (SQL Server Tarayıcısı Hizmeti)
• Connecting to the SQL Server Database Engine ( SQL Server Veritaban ı Altyap ı s ı na Ba ğ lanma )
• Client Network Configuration (İ stemci A ğ Yap ı land ı rmas ı)
Ü ste
Windows Firewall 'da (Windows Güvenlik Duvarı) özel durumlar oluşturma
Bu ad ı mlar , Windows XP Service Pack 2 'nin (SP2) ve Windows Server 2003' ü n i ç erdi ğ i Windows Firewall
( Windows G ü venlik Duvar ı) i ç in ge ç erlidir . Farkl ı bir g ü venlik duvar ı sistemi kullan ı yorsan ı z ,
daha fazla bilgi i ç in g ü venlik duvar ı belgelerinize bak ı n .
SQL Server 2005 ç al ış an bilgisayarda bir g ü venlik duvar ı ç al ış t ı r ı yorsan ı z ,
SQL Server 2005 'e dış bağlantıların engellenmemesi için SQL Server 2005' in ve
SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmetinin g ü venlik duvar ı ü zerinden ileti ş im kurabilmesi gerekir .
Uzak ba ğ lant ı lar ı kabul etmesini istedi ğ iniz her SQL Server 2005 ö rne ğ i i ç in birer ö zel durum ve SQL Server Browser ( SQL Server Taray ı c ı s ı) hizmeti i ç in bir ö zel durum olu ş turmal ı s ı n ı z .
SQL Server 2005 'in program dosyaları yüklenirken yolun parçası olarak bir örnek kimliği kullanır. Her bir SQL Server örneği için bir özel durum oluşturmak için, doğru örnek kimliğini belirtmelisiniz. Örnek kimliğini edinmek için şu adımları izleyin: 1. Start' ı ( Ba ş lat ) t ı klat ı n , Programs 'ın (Programlar) üzerine gelin, Microsoft SQL Server 2005' in ü zerine gelin , Configuration Tools 'un (Yapılandırma Araçları) üzerine gelin ve sonra da SQL Server Configuration Manager' ı ( SQL Server Yap ı land ı rma Y ö neticisi ) t ı klat ı n .
2. SQL Server Configuration Manager 'da (SQL Server Yapılandırma Yöneticisi), sağdaki bölmeden SQL Server Browser (SQL Server Tarayıcısı) hizmetini tıklatın, ana pencereden örnek adını sağ tıklatın ve ardından Properties' i (Ö zellikler ) t ı klat ı n .
3. SQL Server Browser Properties ( SQL Server Taray ı c ı s ı Ö zellikleri ) sayfas ı nda , Advanced ( Geli ş mi ş) sekmesini t ı klat ı n , ö zellik listesinde ö rnek kimli ğ ini bulun ve sonra da OK 'i (Tamam) tıklatın.
Windows Firewall 'u (Windows Güvenlik Duvarı) açmak için, Start' ı ( Ba ş lat ) t ı klat ı n , Run 'ı (Çalıştır) tıklatın, firewall.cpl yazın ve OK' i ( Tamam ) t ı klat ı n .
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server 2005 için bir özel durum oluşturma
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server 2005 için bir özel durum oluşturmak üzere şu adımları izleyin: 1. Windows Firewall' da ( Windows G ü venlik Duvar ı), Exceptions (Ö zel Durumlar ) sekmesini ve ard ı ndan Add Program 'ı (Program Ekle) tıklatın.
2. Add a Program ( Program Ekle ) penceresinde Browse 'u (Gözat) tıklatın.
3. C : Program Files Microsoft SQL Server MSSQL . 1 MSSQL Binn sqlservr . exe y ü r ü t ü lebilir program ı n ı t ı klat ı n , Open 'ı (Aç) tıklatın ve sonra da OK' i ( Tamam ) t ı klat ı n .
Not SQL Server 2005 'in yüklü olduğu konuma bağlı olarak, bu yol farklı olabilir. MSSQL.1, önceki yordamın 3. adımında edindiğiniz örnek kimliği için bir yer tutucudur.
4. Ö zel durum olu ş turulmas ı gereken her SQL Server 2005 ö rne ğ i i ç in 1. ile 3. ad ı mlar aras ı n ı yineleyin .
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server Browser (SQL Server Tarayıcısı) hizmeti için bir özel durum oluşturma
Windows Firewall 'da (Windows Güvenlik Duvarı) SQL Server Browser (SQL Server Tarayıcısı) hizmeti için bir özel durum oluşturmak üzere şu adımları izleyin: 1. Windows Firewall' da ( Windows G ü venlik Duvar ı), Exceptions (Ö zel Durumlar ) sekmesini ve ard ı ndan Add Program 'ı (Program Ekle) tıklatın.
2. Add a Program ( Program Ekle ) penceresinde Browse 'u (Gözat) tıklatın.
3. C : Program Files Microsoft SQL Server 90 Shared sqlbrowser . exe y ü r ü t ü lebilir program ı n ı t ı klat ı n , Open 'ı (Aç) tıklatın ve sonra da OK' i ( Tamam ) t ı klat ı n .
Not SQL Server 2005 'in yüklü olduğu konuma bağlı olarak, bu yol farklı olabilir.
Delphi - .....................................
karekter olarak kod arttır
Function TDM . StrArttir ( Gelen : String ): String ;
Var
Sayi , s : integer ;
Sayilar , Sifir , karakter : String [ 50 ];
Begin
Karakter := '' ;
Sifir := '' ;
For s := length ( Gelen ) downto 1 do
begin
case Gelen [ s ] of
'0' .. '9' : insert ( Gelen [ s ], Sayilar , 1 );
else
Begin
Karakter := copy ( Gelen , 1 , s );
Break ;
End ;
End ;
End ;
For s := 1 to length ( Sayilar ) do
if Sayilar [ s ]= '0' then
Sifir := Sifir + '0'
else break ;
val ( Sayilar , sayi , s );
sayi := sayi + 1 ;
if ( Sayi = 10 ) or ( Sayi = 100 ) or ( Sayi = 1000 ) or ( Sayi = 100000 ) or ( Sayi = 100000 )
or ( Sayi = 1000000 ) or ( Sayi = 10000000 ) or ( Sayi = 100000000 ) or ( Sayi = 1000000000 ) then
if length ( Sifir )> 0 then
Sifir := Copy ( sifir , 1 , length ( sifir )- 1 );
result := Karakter + sifir + inttostr ( sayi );
End ;
**********************************************************************************************
function TDM . StrDuzenle ( gelen : String ): String ;
var sonuc : string ;
A : integer ;
begin
sonuc := '' ;
for A := 1 to Length ( gelen ) do
begin
if ( copy ( gelen , a , 1 )<> '''' ) and ( copy ( gelen , a , 1 )<> '"' ) then
sonuc := sonuc + copy ( gelen , a , 1 );
end ;
Result := sonuc ;
end ;
function TDM . SayiDuzenle ( gelen : String ): String ;
var a : smallint ;
D_giden : string ;
begin
D_giden := '' ;
if Trim ( gelen ) = '' then
result := '0'
else
begin
for A := 1 to Length ( gelen ) do
begin
if copy ( gelen , a , 1 ) = ',' then
D_giden := D_giden + '.'
else
D_giden := D_giden + copy ( gelen , a , 1 );
end ;
Result := D_giden ;
end ;
end ;
***************************************************************************************
Delphi - .....................................
ListBox Satırlarına Farklı Fontlar
// s.a. server dan gelen veriyi parçalayıp komut , mesaj ve fonta
// bölüyoruz.Sonra komut ne ise onu işletip mesajı StrToFont fonksiyonu
// ile listbox a ekliyoruz.Yalnız bu satırları görebilmek için listbox ın
// sytle özelliği lbOwnerDrawFixed olmalıdır.Ayrıca my_font string dizisi
// global olarak tanımlanmalı.Aksi takdirde sorun çıkarabiliyor.Bunu chat
// programımda kullandım.Gayet hoş bir görüntü oldu.
var
Form1 : TForm1 ;
my_font : array of String ;
implementation
{$R *.dfm}
//-----------------------------------------------------------------------
procedure TForm1 . ClientSocket1Read ( Sender : TObject ;
Socket : TCustomWinSocket );
var
s , cmd , msg , font_m : ansistring ;
kes : integer ;
begin
s := Socket . ReceiveText ;
cmd := Copy ( s , 1 , 3 );
delete ( s , 1 , 3 );
kes := AnsiPos ( '<|>' , s );
msg := Copy ( s , 1 , kes - 1 );
delete ( s , 1 , kes + 2 );
font_m := s ;
if cmd = 'msg' then
begin
SetLength ( my_font , length ( my_font )+ 1 );
my_font [ length ( my_font )- 1 ]:= font_m ;
iletiler . Items . Add ( msg ); // listbox
end ;
end ;
//-----------------------------------------------------------------------
procedure TForm1 . iletilerDrawItem ( Control : TWinControl ; Index : Integer ;
Rect : TRect ; State : TOwnerDrawState );
begin
StrToFont ( my_font [ index ],( Control As TListBox ). Canvas . Font );
( Control As TListBox ). Canvas . FillRect ( Rect );
( Control As TListBox ). Canvas . TextOut ( Rect . Left , Rect . Top , ( Control As TListBox ). Items [ Index ]);
iletiler . ItemIndex := iletiler . Items . Capacity - 1 ; // listbox son satırda
end ;
//-----------------------------------------------------------------------
function FontToStr ( Font : TFont ): string ;
var
sColor , sStyle : string ;
begin
sColor := '$' + IntToHex ( ColorToRGB ( Font . Color ), 8 );
sStyle := IntToStr ( byte ( Font . Style ) );
result := Font . Name + '|' + IntToStr ( Font . Size ) + '|' + sColor + '|' + sStyle ;
end ;
//------------------------------------------------------------------------------
function StrToFont ( const s : string ; Font : TFont ): boolean ;
var
afont : TFont ;
Strs : TStringList ;
begin
afont := TFont . Create ;
try
afont . Assign ( Font );
Strs := TStringList . Create ;
try
Strs . Text := StringReplace ( s , '|' , #10 , [ rfReplaceAll ]);
result := Strs . Count = 4 ;
if result then begin
afont . Name := Strs [ 0 ];
afont . Size := StrToInt ( Strs [ 1 ]);
afont . Color := StrToInt ( Strs [ 2 ]);
afont . Style := TFontStyles ( byte ( StrToInt ( Strs [ 3 ])));
end ;
Font . Assign ( afont );
finally
Strs . Free ;
end ;
finally
afont . Free ;
end ;
end ;
end .
Delphi - .....................................
Veritabanında Başlığa Göre Sıralama (Access - ADOTable - DBGrid)
//Lazım oldu aradım ve buldum sizlerle paylaşayım dedim.
//Farzedelim bir Access veritanınız var ve bu veritabanını ADOTable Nesnesi ile
//DBGrid nesnesine ilişkilendirdiniz ve bu Grid'de başlıklara tıkladığınızda
//Başlık alanının adına göre tablonuzda sıralama yapılmasını istiyorsunuz o zaman
//DBGrid nesnenizin OnTitleClik yordamına aşağıdaki kodu ekleyin yeter...
procedure TForm1 . DBGrid1TitleClick ( Column : TColumn );
begin
adotable1 . IndexFieldNames := Column . FieldName ;
end ;
Delphi - .....................................
FontToStr , StrToFont
function FontToStr ( Font : TFont ): string ;
var
sColor ,
sStyle : string ;
begin
sColor := '$' + IntToHex ( ColorToRGB ( Font . Color ), 8 );
sStyle := IntToStr ( byte ( Font . Style ) );
result := Font . Name + '|' + IntToStr ( Font . Size ) + '|' + sColor + '|' + sStyle ;
end ;
function StrToFont ( const s : string ; Font : TFont ): boolean ;
var
afont : TFont ;
Strs : TStringList ;
begin
afont := TFont . Create ;
try
afont . Assign ( Font );
Strs := TStringList . Create ;
try
Strs . Text := StringReplace ( s , '|' , #10 , [ rfReplaceAll ]);
result := Strs . Count = 4 ;
if result then begin
afont . Name := Strs [ 0 ];
afont . Size := StrToInt ( Strs [ 1 ]);
afont . Color := StrToInt ( Strs [ 2 ]);
afont . Style := TFontStyles ( byte ( StrToInt ( Strs [ 3 ])));
end ;
Font . Assign ( afont );
finally
Strs . Free ;
end ;
finally
afont . Free ;
end ;
end ;
// burak_489@hotmail.com
// msn benzeri chat programı üzerinde çalışıyorum.
// ilgililere duyrulur.
Delphi - .....................................
cxGridde arama yapmak
function GriddeAra ( AView : TcxCustomGridTableView ; AText : string ; AColumnIndex : Integer ): Integer ;
var
I : Integer ;
begin
Result := - 1 ;
with AView . ViewData do
for I := 0 to RecordCount - 1 do
if StrPos ( PChar ( Records [ I ]. DisplayTexts [ AColumnIndex ]), PChar ( AText )) <> nil then
begin
Result := Records [ I ]. RecordIndex ;
Break ;
end ;
end ;
Kullan ı m ı
var
tmp : integer ;
begin
tmp := GriddeAra ( View1 , 'Aranacak Kelime' , View1Column1 . Index );
/////////////////////////////////////////////////
sonuc e ğ er - 1 d ö nerse kay ı t bulunamad ı
- 1 den farkl ı d ö nerse kay ı t bulunmu ş tur .
Kaan K .
ETS Yaz ı l ı m - kaank @ etsyazilim . com
Delphi - .....................................
e yuh artık
Arkadaşı m tuncerr eczane program ı yapacam diyosun yap . buras ı forum deil diye
y ü zlerce kez s ö yledik sen neredeydin . Yazd ığı n yaz ı y ı tekrar okurmusun .
Ne bi soru i ç eriyo ne yard ı mc ı bi bilgi . soru sormak yasak ama sen a ş m ışı n
art ı k soru bile yok . Ona da raz ı yd ı k . Millet sana programm ı yazs ı n yoksa
ak ı l hocal ığı m ı yaps ı n . Buran ı n y ö neticileri umar ı m art ı k y ö netimi ele al ı rda
elini kolunu sallayan burada cirit atmaz .
Delphi - .....................................
eczane programı acillllll
arkadaş lar bana acil eczane program ı laz ı m . ki ş i bilgilerini kay ı t edecek , stoklar ı kontrol edeck , ila ç bilgilerini kontrol edcek gibi ö zellikleri koymay ı d üşü n ü orum programa . yard ı mc ı olursan ı z sewinirim ;)
Delphi - .....................................
MSN de NE DİLİYORUM
/// ---Herşey Kodbank İçin---
//kodda herhangi bir component kullanılmamıştır ve %100 çalışıyor.
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , StdCtrls , MPlayer , ExtCtrls ;
type
TForm1 = class ( TForm )
Button1 : TButton ;
Edit1 : TEdit ;
MediaPlayer1 : TMediaPlayer ;
OpenDialog1 : TOpenDialog ;
Timer1 : TTimer ;
procedure CurrentPlay ( ARTIST : string ; bStop : boolean );
procedure Button1Click ( Sender : TObject );
procedure Timer1Timer ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
procedure tform1 . CurrentPlay ( ARTIST : string ; bStop : boolean );
var
handleMSN : THandle ;
structCopy : TCopyDataStruct ;
stringBuffer : array [ 0 .. 127 ] of WideChar ;
begin
artist := form1 . Edit1 . Text ;
ARTIST := copy ( ARTIST , 1 , 75 );
FillChar ( stringBuffer , SizeOf ( stringBuffer ), #0 );
if Not bStop then
StringToWideChar ( ' Music ' + '1' + ' ' + '{0}' + ' ' + ARTIST + ' ' + 'WMContentID' + #0 ,@ stringBuffer [ 0 ], 128 )
else // parça stop edildi ise
StringToWideChar ( ' Music ' + '0' + ' ' + '{0}' + ' ' + ARTIST + ' ' + 'WMContentID' + #0 ,@ stringBuffer [ 0 ], 128 );
// orjinal hali
StringToWideChar ( ' Music ' + '1' + ' ' + '{0} - {1}' + ' ' + ARTIST + ' ' + ' ' + ' ' + 'WMContentID' + #0 ,@ stringBuffer [ 0 ], 128 );
ZeroMemory (@ structCopy , SizeOf ( TCopyDataStruct ));
with structCopy do
begin
cbData := SizeOf ( stringBuffer );
dwData := $547 ;
lpData :=@ stringBuffer [ 0 ];
end ;
handleMSN := FindWindowEx ( 0 , 0 , 'MsnMsgrUIManager' , nil );
while handleMSN <> 0 do
begin
SendMessage ( handleMSN , WM_COPYDATA , 0 , Integer (@ structCopy ));
handleMSN := FindWindowEx ( 0 , handleMSN , 'MsnMsgrUIManager' , nil );
end ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
artist : string ;
begin
opendialog1 . Execute ;
mediaplayer1 . FileName := opendialog1 . FileName ;
mediaplayer1 . Open ;
mediaplayer1 . Play ;
timer1 . Enabled := true ;
end ;
procedure TForm1 . Timer1Timer ( Sender : TObject );
var
artist : string ;
begin
artist := edit1 . text ;
edit1 . Text := extractfilename ( mediaplayer1 . FileName );
CurrentPlay ( edit1 . Text , true );
end ;
end .
Delphi - .....................................
Codebank www.dogusoft.com
East Codebank terar sizlerle buluş tu . Uzun bir ara dan sonra
east codebank ı tekar d ü zenledik ve sizlerle bulu ş turduk buyrun .
Tek kelimeyle harika .
www . east - software . com
www . dogusoft . com
ve Forum sayfam ı z a çı ld ı.
Delphi - .....................................
East Codebank Tekrar sizlerle
East Codebank terar sizlerle buluş tu . Uzun bir ara dan sonra
east codebank ı tekar d ü zenledik ve sizlerle bulu ş turduk buyrun .
Tek kelimeyle harika .
www . east - software . com
www . dogusoft . com
ve Forum sayfam ı z a çı ld ı.
Delphi - .....................................
Yazıcı Bilgileri
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms ,
Dialogs , winspool , StdCtrls , printers ;
type
TForm1 = class ( TForm )
Button1 : TButton ;
Memo1 : TMemo ;
Button2 : TButton ;
Button3 : TButton ;
Label1 : TLabel ;
Label2 : TLabel ;
procedure Button1Click ( Sender : TObject );
procedure Button2Click ( Sender : TObject );
procedure Button3Click ( Sender : TObject );
private
{ Déclarations privées }
public
{ Déclarations publiques }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
procedure TForm1 . Button1Click ( Sender : TObject );
var
I : integer ;
ByteCnt : DWORD ; //Nb d'octets à réserver pour récupérer le tableau de structures
StructCnt : DWORD ; //Nb de structures récupérees = nb imprimantes
p : pointer ; //pointe sur le tableau de structures retourné par EnumPrinters
PrinterInfo : PPrinterInfo2 ; //Pointeur de structures de type _Printer_Info_2
//Descriptif : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_9otu.asp
begin
Memo1 . Clear ;
//initialisation des paramètres
ByteCnt := 0 ;
StructCnt := 0 ;
PrinterInfo := nil ;
p := nil ;
//Cette fonction retourne un pointeur sur les structures des imprimantes
//Le while permet d'effectuer une réservation suffisante pour le tableau de structures
while not EnumPrinters ( PRINTER_ENUM_LOCAL , nil , 2 , p , ByteCnt , ByteCnt , StructCnt ) do
begin
if ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) then
begin
p := AllocMem ( ByteCnt );
end ;
end ;
//Maintenant il ne reste plus qu'à lire le contenu des structures du tableau
for I := 0 to StructCnt - 1 do //On lit chaques structures propre à chaque imprimante
begin
//On se déplace dans le tableau de structures
PrinterInfo := PPrinterInfo2 ( LongInt ( P )+ I * sizeof ( _Printer_Info_2 ));
Memo1 . lines . add ( PrinterInfo . pPrinterName );
Memo1 . lines . add ( #9 + 'Port -> ' + PrinterInfo . pPortName );
Memo1 . lines . add ( #9 + 'Pilote -> ' + PrinterInfo . pDriverName );
Memo1 . lines . add ( #9 + 'Commentaire -> ' + PrinterInfo . pComment );
end ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
var
I : integer ;
buf : string ;
ByteCnt , StructCnt : DWORD ;
DriverDirectory : pchar ;
begin
Memo1 . Clear ;
ByteCnt := 0 ;
DriverDirectory := nil ;
//Cette fonction retourne un pointeur chaine contenant le répertoire en question
//Le while permet d'effectuer une réservation suffisante pour la chaine de caractères
while not GetPrinterDriverDirectory ( nil , nil , 1 , DriverDirectory , ByteCnt , ByteCnt ) do
begin
if ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) then
begin
DriverDirectory := AllocMem ( ByteCnt );
end ;
end ;
Memo1 . Lines . Add ( DriverDirectory );
end ;
procedure TForm1 . Button3Click ( Sender : TObject );
var
I : integer ;
ByteCnt : DWORD ; //Nb d'octets à réserver pour récupérer le tableau de structures
StructCnt : DWORD ; //Nb de structures récupérees = nb de drivers
p : pointer ; //pointe sur le tableau de structures retourné par EnumPrinterDrivers
DriverInfo : PDriverInfo3 ; //Pointeur de structures de type _Driver_Info_2
//Descriptif : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_7egi.asp
begin
Memo1 . Clear ;
//initialisation des paramètres
ByteCnt := 0 ;
StructCnt := 0 ;
DriverInfo := nil ;
p := nil ;
//Cette fonction retourne un pointeur sur les structures des pilotes
//Le while permet d'effectuer une réservation suffisante pour le tableau de structures
while not EnumPrinterDrivers ( nil , nil , 3 , p , ByteCnt , ByteCnt , StructCnt ) do
begin
if ( GetLastError = ERROR_INSUFFICIENT_BUFFER ) then
begin
p := AllocMem ( ByteCnt );
end ;
end ;
//Maintenant il ne reste plus qu'à lire le contenu des structures du tableau
for I := 0 to StructCnt - 1 do //On lit chaques structures propre à chaque pilote
begin
//On se déplace dans le tableau de structures
DriverInfo := PDriverInfo3 ( LongInt ( P )+ I *( sizeof ( _Driver_Info_3 )));
Memo1 . lines . add ( '' );
Memo1 . lines . add ( DriverInfo . pName );
Memo1 . lines . add ( #9 + 'Environnement (type d''OS) -> ' + DriverInfo . pEnvironment );
Memo1 . lines . add ( #9 + 'Chemin du pilote -> ' + DriverInfo . pDriverPath );
Memo1 . lines . add ( #9 + 'Chemin des données du pilote -> ' + DriverInfo . pDataFile );
Memo1 . lines . add ( #9 + 'Chemin du fichier de conf. du pilote -> ' + DriverInfo . pConfigFile );
Memo1 . lines . add ( #9 + 'Chemin du fichier d''aide -> ' + DriverInfo . pHelpFile );
Memo1 . lines . add ( #9 + 'Fichiers supp. dont dépend le pilote -> ' + DriverInfo . pDependentFiles );
end ;
end ;
end .
Delphi - .....................................
Dahili PC SpeakerDan Bip (Beep) sesi çıkartma
by DrDelphi
www. hostmatik . net hosting , dedicated , reseller , colocation
PHP Guru
*********************************************************************
procedure SetPort ( address , Value : Word );
var
bValue : Byte ;
begin
bValue := trunc ( Value and 255 );
asm
mov dx, address
mov al, bValue
out dx, al
end ;
end ;
function GetPort ( address : Word ): Word ;
var
bValue : Byte ;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end ;
GetPort := bValue ;
end ;
procedure Sound ( aFreq , aDelay : Integer );
procedure DoSound ( Freq : Word );
var
B : Byte ;
begin
if Freq > 18 then
begin
Freq := Word ( 1193181 div Longint ( Freq ));
B := Byte ( GetPort ( $61 ));
if ( B and 3 ) = 0 then
begin
SetPort ( $61 , Word ( B or 3 ));
SetPort ( $43 , $B6 );
end ;
SetPort ( $42 , Freq );
SetPort ( $42 , Freq shr 8 );
end ;
end ;
procedure Delay ( MSecs : Integer );
var
FirstTickCount : LongInt ;
begin
FirstTickCount := GetTickCount ;
repeat
Sleep ( 1 );
//or use Application.ProcessMessages instead of Sleep
until (( GetTickCount - FirstTickCount ) >= Longint ( MSecs ));
end ;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
Windows . Beep ( aFreq , aDelay );
end
else
begin
DoSound ( aFreq );
Delay ( aDelay );
end ;
end ;
procedure NoSound ;
var
Value : Word ;
begin
if not ( Win32Platform = VER_PLATFORM_WIN32_NT ) then
begin
Value := GetPort ( $61 ) and $FC ;
SetPort ( $61 , Value );
end ;
end ;
Test i ç in
Sound ( 900 , 200 );
NoSounD ;
Delphi - .....................................
ShowMessage kullanmayın !...
Var
MSNNo : Integer ;
Procedure MesajVer ( Mesajimiz : string );
Var
MSNPencere : TsuiMSNPopForm ;
Begin
Try
MSNPencere := TsuiMSNPopForm . Create ( Form1 );
MSNPencere . Name := 'MSN' + IntToStr ( MSNNo );
MSNPencere . Title := 'Bilgi ! ...' ;
MSNPencere . MessageText := Mesajimiz ;
MSNPencere . AnimateTime := 500 ;
MSNPencere . StayTime := 4000 ;
MSNPencere . PositionX := 0 ;
MSNPencere . PositionY := 0 ;
MSNPencere . AutoPosition := True ;
MSNPencere . ClickHide := True ;
MSNPencere . TitleFont . Name := 'Tahoma' ;
MSNPencere . MessageFont . Name := 'Tahoma' ;
MSNNo := MSNNo + 1 ;
MSNPencere . Popup ;
Except
End;
end ;
//Kullanımı : MesajVer('www.enderaRslanturk.com.tr sunar...
Sayg ı lar ı mla ,
Ender ARSLANT Ü RK
www . enderaRslanturk . com . tr
Delphi - .....................................
Procedure le ilk harf büyük
var
KucukMetin : String ;
Procedure IlkHarfBuyuk ( Kelime : String );
var
IlkHarf , Metin : AnsiString ;
begin
KucukMetin := '' ;
IlkHarf := AnsiLeftStr ( Kelime , 1 );
IlkHarf := AnsiReplaceStr ( IlkHarf , 'i' , 'İ' );
IlkHarf := AnsiReplaceStr ( IlkHarf , 'ı' , 'I' );
IlkHarf := AnsiUpperCase ( IlkHarf );
Kelime := AnsiReplaceStr ( Kelime , 'İ' , 'i' );
Kelime := AnsiReplaceStr ( Kelime , 'I' , 'ı' );
Kelime := AnsiLowerCase ( Kelime );
Metin := Copy ( Kelime , 2 , Length ( Kelime ) );
KucukMetin := IlkHarf + Metin ;
end ;
//Kullanımı : Edit1.Text:=IlkHarfBuyuk(Edit1.Text);
Sayg ı lar ı mla ,
Ender ARSLANT Ü RK
www . enderaRslanturk . com . tr
Delphi - .....................................
Function la Tablaya bağlantı
Function TabloyaBaglan ( QueryAdi , SQL , Tip : String ): Boolean ;
Var
I : Integer ;
Begin
for I := 0 to Form1 . ComponentCount - 1 do
if ( Form1 . Components [ I ] is TADOQuery ) then
If ( Form1 . Components [ i ] as TAdoQuery ). Name = QueryAdi Then
begin
( Form1 . Components [ i ] as TAdoQuery ). Close ;
(Form1 . Components [ i ] as TAdoQuery ). SQL . Clear ;
(Form1 . Components [ i ] as TAdoQuery ). SQL . Add ( SQL );
try
If AdoConnection1 . Connected = False Then
AdoConnection1 . Connected := True ;
except
end;
If Tip = 'Open' Then ( Form1 . Components [ i ] as TAdoQuery ). Open
If Tip = 'ExecSQL' Then ( Form1 . Components [ i ] as TAdoQuery ). ExecSQL ;
End ;
End ;
//Kullanımı : TabloyaBaglan('AdoQuery1' , 'Select* From Urunler' , 'Open');
//Kullanımı : TabloyaBaglan('AdoQuery1' , 'Delete From Urunler Where UrunNo=25' , 'ExecSQL'); .... gibi
Sayg ı lar ı mla ,
Ender ARSLANT Ü RK
www . enderaRslanturk . com . tr
Delphi - .....................................
ASM - CopyFile - DeleteFile - MoveFile - WinExec
procedure WinExec ( const a : string );
var b : pchar ;
begin
b := Pchar ( a );
asm
push 0
push b
Call WinExec_
end ;
end ;
procedure MoveFile ( const a , b : pchar );
begin
asm
push b
push a
Call MoveFile_
end ;
end ;
procedure DeleteFile ( const f : string );
var a : pchar ;
begin
a := Pchar ( f );
asm
push a
Call DeleteFile_
end ;
end ;
procedure CopyFile ( const a , b : pchar );
begin
asm
push 0
push b
push a
Call CopyFile_
end ;
end ;
Delphi - .....................................
Windows Directory
Getting the Windows Directory }
function GetWinDir : string ;
var
dir : array [ 0 .. MAX_PATH ] of Char ;
begin
GetWindowsDirectory ( dir , MAX_PATH );
Result := StrPas ( dir );
end ;
// or:
function WindowsDirectory : string ;
var
WinDir : PChar ;
begin
WinDir := StrAlloc ( MAX_PATH );
GetWindowsDirectory ( WinDir , MAX_PATH );
Result := string ( WinDir );
if Result [ Length ( Result )] <> '' then
Result := Result + '' ;
StrDispose ( WinDir );
end ;
// or:
function GetWindowsDirectory ( var S : String ): Boolean ;
var
Len : Integer ;
begin
Len := Windows . GetWindowsDirectory ( nil , 0 );
if Len > 0 then
begin
SetLength ( S , Len );
Len := Windows . GetWindowsDirectory ( PChar ( S ), Len );
SetLength ( S , Len );
Result := Len > 0 ;
end else
Result := False ;
end ;
{ Getting the System Directory }
function SystemDir : string ;
var
dir : array [ 0 .. MAX_PATH ] of Char ;
begin
GetSystemDirectory ( dir , MAX_PATH );
Result := StrPas ( dir );
end ;
// or:
function SystemDirectory : string ;
var
SysDir : PChar ;
begin
SysDir := StrAlloc ( MAX_PATH );
GetSystemDirectory ( SysDir , MAX_PATH );
Result := string ( SysDir );
if Result [ Length ( Result )] <> '' then
Result := Result + '' ;
StrDispose ( SysDir );
end ;
// or:
function GetSystemDirectory ( var S : String ): Boolean ;
var
Len : Integer ;
begin
Len := Windows . GetSystemDirectory ( nil , 0 );
if Len > 0 then
begin
SetLength ( S , Len );
Len := Windows . GetSystemDirectory ( PChar ( S ), Len );
SetLength ( S , Len );
Result := Len > 0 ;
end else
Result := False ;
end ;
{ Getting the Temporary Directory }
function GetTempDir : string ;
var
Buffer : array [ 0 .. MAX_PATH ] of Char ;
begin
GetTempPath ( SizeOf ( Buffer ) - 1 , Buffer );
Result := StrPas ( Buffer );
end ;
// or:
function GetTempPath : string ;
var
TmpDir : PChar ;
begin
TmpDir := StrAlloc ( MAX_PATH );
GetTempPath ( TmpDir , MAX_PATH );
Result := string ( TmpDir );
if Result [ Length ( Result )] <> '' then
Result := Result + '' ;
StrDispose ( TmpDir );
end ;
// or:
function GetTempPath ( var S : String ): Boolean ;
var
Len : Integer ;
begin
Len := Windows . GetTempPath ( 0 , nil );
if Len > 0 then
begin
SetLength ( S , Len );
Len := Windows . GetTempPath ( Len , PChar ( S ));
SetLength ( S , Len );
Result := Len > 0 ;
end else
Result := False ;
end ;
// ****************************
// Example Calls:
procedure TForm1 . Button1Click ( Sender : TObject );
begin
label1 . Caption := GetWinDir ;
label2 . Caption := GetSysDir ;
label3 . Caption := GetTempDir ;
end ;
Delphi - .....................................
ConvertWMF2BMP
procedure CevirWMF2BMP
( const WMFFileName , BMPFileName : TFileName ) ;
var
MetaFile : TMetafile ;
Bitmap : TBitmap ;
begin
Metafile := TMetaFile . Create ;
Bitmap := TBitmap . Create ;
try
MetaFile . LoadFromFile ( WMFFileName ) ;
with Bitmap do
begin
Height := Metafile . Height ;
Width := Metafile . Width ;
Canvas . Draw ( 0 , 0 , MetaFile ) ;
SaveToFile ( BMPFileName ) ;
end ;
finally
Bitmap . Free ;
MetaFile . Free ;
end ;
end ;
Kullan ı m ı:
CevirWMF2BMP (’ c : mypic . wmf ’, 'c:mypic.bmp’)
Delphi - .....................................
SharedMemory.pas
unit SharedMemory ;
interface
uses
Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms , Dialogs ;
type
TSharedMemory = class ( TComponent )
private
hFileMapping : THandle ;
FHandle : string ;
lp : pointer ;
FSize : integer ;
procedure SetContents ( const Value : string );
procedure SetHandle ( const Value : string );
function GetContents : string ;
procedure SetSize ( const Value : integer );
protected
public
constructor Create ( AOwner : TComponent ); override ;
destructor Destroy ; override ;
property Contents : string read GetContents write SetContents ;
published
property Handle : string read FHandle write SetHandle ;
property Size : integer read FSize write SetSize default 255 ;
end ;
procedure Register ;
implementation
procedure Register ;
begin
RegisterComponents ( 'Silicon Commander' , [ TSharedMemory ] );
end ;
constructor TSharedMemory . Create ( AOwner : TComponent );
begin
inherited Create ( AOwner );
FSize := 255 ;
end ;
destructor TSharedMemory . Destroy ;
begin
inherited Destroy ;
if lp <> nil then
UnmapViewOfFile ( lp );
if hFileMapping <> 0 then
CloseHandle ( hFileMapping );
end ;
function TSharedMemory . GetContents : string ;
begin
if lp = nil then
Result := ''
else
Result := StrPas ( lp );
end ;
procedure TSharedMemory . SetContents ( const Value : string );
begin
if ( csDesigning in ComponentState ) then
Exit ;
(* If a mapping does not exist, do nothing *)
if lp = nil then
Exit ;
StrPCopy ( lp , Value );
end ;
procedure TSharedMemory . SetHandle ( const Value : string );
begin
if FHandle = Value then
Exit ;
FHandle := Value ;
if ( csDesigning in ComponentState ) then
Exit ;
(* Close down any file mapping that may be currently open *)
if lp <> nil then
UnmapViewOfFile ( lp );
if hFileMapping <> 0 then
CloseHandle ( hFileMapping );
(* See if a file mapping already exists with this name *)
hFileMapping := OpenFileMapping ( FILE_MAP_ALL_ACCESS , FALSE , PChar ( FHandle ) );
(* If not, create a new one *)
if hFileMapping = 0 then
hFileMapping := CreateFileMapping ( $ffffffff , nil , PAGE_READWRITE or SEC_COMMIT , 0 , FSize , PChar ( FHandle ) );
if hFileMapping = 0 then
raise Exception . Create ( 'CreateFileMapping failed with error code ' + IntToStr ( GetLastError ) );
(* Map the view of the file *)
lp := MapViewOfFile ( hFileMapping , FILE_MAP_ALL_ACCESS , 0 , 0 , FSize );
if lp = nil then
raise Exception . Create ( 'MapViewOfFile failed with error code ' + IntToStr ( GetLastError ) );
end ;
procedure TSharedMemory . SetSize ( const Value : integer );
begin
FSize := Value ;
end ;
end .
Delphi - .....................................
dsada
sdasdasd
Delphi - .....................................
MSSQL Field Description Bilgilerini Almak
SELECT * FROM fn_listextendedproperty ( NULL , 'user' , 'dbo' , 'table' , 'Tabloadi' , 'column' , default )
default de ğ eri yerine Kolon ad ı n ı yazarsan ı z sadece o alan ı n bilgileri gelir default b ı rak ı rsan ı z
t ü m kolon bilgileri gelir .
sadece description almak isteyenler de Select Value from fn_ ...... ş eklinde queryi d ö nd ü rmelidir .
Kolay gelsin
Delphi - .....................................
YTL yi Yazıya Dönüştüren Algoritma (Kuruşu dahil)
// Hoşuma giden bulamadım netten felan Bende yazdım bitane
// sadece kuruşu virgülle ayırın başka ayraç kullanmayın yeterli.
// Hep kod almak olmaz birazda faydalı olmak gerek dimi
function YtltoStr ( para : string ; KurusGoster : boolean ): string ;
var
kurus , lira , grup , gson , bulunan : string ;
gr : array [ 1 .. 6 ] of string ;
b1 , b2 : array [ 0 .. 9 ] of string ;
grupsay , i : integer ;
function SayiBul ( grup : string ): string ;
var
i , sayi : integer ;
yazi : string ;
begin
for i := length ( grup ) downto 1 do
begin
sayi := strtoint ( grup [ length ( grup )+ 1 - i ]);
if sayi = 0 then Continue ;
if i = 1 then yazi := yazi + b1 [ sayi ];
if i = 2 then yazi := yazi + b2 [ sayi ];
if i = 3 then
begin
if sayi <> 0 then
if sayi = 1 then
yazi := 'YÜZ' + yazi
else
yazi := b1 [ sayi ]+ 'YÜZ' + yazi ;
end ;
end ;
result := yazi ;
end ;
begin
b1 [ 0 ]:= '' ; b1 [ 1 ]:= 'BİR' ; b1 [ 2 ]:= 'İKİ' ; b1 [ 3 ]:= 'ÜÇ' ; b1 [ 4 ]:= 'DÖRT' ; b1 [ 5 ]:= 'BEŞ' ; b1 [ 6 ]:= 'ALTI' ; b1 [ 7 ]:= 'YEDİ' ; b1 [ 8 ]:= 'SEKİZ' ; b1 [ 9 ]:= 'DOKUZ' ;
b2 [ 0 ]:= '' ; b2 [ 1 ]:= 'ON' ; b2 [ 2 ]:= 'YİRMİ' ; b2 [ 3 ]:= 'OTUZ' ; b2 [ 4 ]:= 'KIRK' ; b2 [ 5 ]:= 'ELLİ' ; b2 [ 6 ]:= 'ALTMIŞ' ; b2 [ 7 ]:= 'YETMİŞ' ; b2 [ 8 ]:= 'SEKSEN' ; b2 [ 9 ]:= 'DOKSAN' ;
gr [ 2 ]:= 'BİN' ; gr [ 3 ]:= 'MİLYON' ; gr [ 4 ]:= 'MİLYAR' ; gr [ 5 ]:= 'TRİLYON' ; gr [ 6 ]:= 'KATRİLYON' ;
kurus := copy ( para , pos ( ',' , para )+ 1 , 2 );
if pos ( ',' , para ) = 0 then kurus := '' ;
if length ( kurus ) = 1 then kurus := kurus + '0' ;
lira := para ;
delete ( lira , pos ( ',' , lira ), 3 );
grupsay := (( length ( lira )- 1 ) div 3 )+ 1 ;
i := 0 ;
while length ( lira )>= 1 do
begin
inc ( i );
if i <> 1 then gson := gr [ i ];
grup := copy ( lira , length ( lira )- 2 , 3 );
if length ( lira ) <= 3 then lira := '' ;
delete ( lira , length ( lira )- 2 , 3 );
bulunan := SayiBul ( grup );
if bulunan <> '' then result := bulunan + gson + ' ' + result ;
end ;
if KurusGoster then
begin
if SayiBul ( kurus ) <> '' then
Result := result + ' LİRA ' + SayiBul ( kurus ) + ' KURUŞ' ;
end ;
end ;
Delphi - .....................................
');