Kod Bankası

Z1rT · 11 Ocak 2012

# MS-Access veri tabanını uygulama içinde sıkıştırmaya ve onarmaya yarıyor.

# D6-BDS2006-CG2007

PHP Kodu:
CompactAndRepair(sOldMDB : String; sNewMDB : String) : Boolean;
const
sProvider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
oJetEng : JetEngine;
begin
sOldMDB := sProvider + 'Data Source=' + sOldMDB;
sNewMDB := sProvider + 'Data Source=' + sNewMDB;

try
oJetEng := CoJetEngine.Create;
oJetEng.CompactDatabase(sOldMDB, sNewMDB);
oJetEng := Nil;
Result := True;
except
oJetEng := Nil;
Result := False;
end;
end;

if CompactAndRepair('e:\Old.mdb', 'e:\New.mdb') then
ShowMessage('İşlem Başarılı.')
else
ShowMessage('İşlemde Hata Oluştu.');

# Önemli Not:
1- JRO_TLB unit ini uses bölümüne ekleyin.
2- Database sıkıştırılırken kimse database i açıp kullanmamalıdır.
3- Eðer JRO_TLB unit i ile ilgili Delphi hata verirse aşağıdakileri yapın
a) Delphi menüsünde Project - Import Type Library i seçin
b) "Microsoft Jet and Replication Objects 2.1 Library" i bulun.
c) Install butonunu tıklayın.
d) Programınızı tekrar derleyin

Z1rT · 11 Ocak 2012

[h=2]Code Gear 2007 For ASP.NET Web.Config[/h]# Bazı ASP.NET sunucularının güvenlik ayarları nedeniyle Code Gear yerleşik sınıf ve yöntemlerinin bazıları çalışmaz. Bunu düzeltmek için ilgili asp.net projesinin web.config dosyasının system.web anahtarı altına aşağıdaki satırları ekleyin...

#CG-2007 For ASP.Net

PHP Kodu:
<system.web>
<trust level="Full" originUrl="" />
......
......
......

# Not : Kessinlikle <system.web> takısı arasına eklenmeli. Bu çözümü @burhanmt bulmuş ve test etmiştir.

Z1rT · 11 Ocak 2012

[h=2]Delphi Püfleri - 001[/h]# Delphi ile ilgili bir çok püf noktasının toplandığı dökuman...Ek dosyada aşağıdaki başlıklara ait örnekler bulunmaktadır...

VERİ TABANI/BDE

AĞ IŞLEMLERI

SES VE GRAFİK İŞLEMLERİ

FORM VE PENCERE IŞLEMLERI

DİSK VE DOSYA İŞLEMLERİ

GENEL

# Gerekli düzenlemeler ile tüm versiyonlarda çalışırlar

Z1rT · 11 Ocak 2012

[h=2]Delphi Püfleri - 003[/h]# BDS 2006 ve Codegear 2007 ile ASP.NET tabanlı site tasarlarken tasarımın farklı tarayıcılarda düzgün görüntülenmesini sağlar. Aşağıdaki satırları asp.net uygulamanızın web.config dosyasında <system.web> </system.web> anahtarları arasına ekleyiniz...

# Delphi 2006 (BDS 2006) - CodeGear 2007

PHP Kodu:

<browserCaps>



<case match="^Mozilla/5\.0 $[^)]*$ (Gecko/[-\d]+)(?'VendorProductToken' (?'type'[^/\d]*)([\d]*)/(?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*)))?">
browser=Gecko
<filter>
<case match="(Gecko/[-\d]+)(?'VendorProductToken' (?'type'[^/\d]*)([\d]*)/(?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*)))">
type=${type}
</case>
<case> 
type=Mozilla
</case>
</filter>
frames=true
tables=true
cookies=true
javascript=true
javaapplets=true
ecmascriptversion=1.5
w3cdomversion=1.0
css1=true
css2=true
xml=true
tagwriter=System.Web.UI.HtmlTextWriter
<case match="rv

?'version'(?'major'\d+)(?'minor'\.\d+)(?'letters'\w*))">
version=${version}
majorversion=0${major}
minorversion=0${minor}
<case match="^b" with="${letters}">
beta=true
</case>
</case>
</case>


<case match="AppleWebKit/(?'version'(?'major'\d?)(?'minor'\d{2})(?'letters'\w*)?)">
browser=AppleWebKit
version=${version}
majorversion=0${major}
minorversion=0.${minor}
frames=true
tables=true
cookies=true
javascript=true
javaapplets=true
ecmascriptversion=1.5
w3cdomversion=1.0
css1=true
css2=true
xml=true
tagwriter=System.Web.UI.HtmlTextWriter
<case match="AppleWebKit/(?'version'(?'major'\d)(?'minor'\d+)(?'letters'\w*))(.* )?(?'type'[^/\d]*)/.*( |$)">
type=${type}
</case>
</case>


<case match=".+[K|k]onqueror/(?'version'(?'major'\d+)(?'minor'(\.[\d])*)(?'letters'[^;]*));\s+(?'platform'[^;\)]*)(;|\))">
browser=Konqueror
version=${version}
majorversion=0${major}
minorversion=0${minor}
platform=${platform}
type=Konqueror
frames=true
tables=true
cookies=true
javascript=true
javaapplets=true
ecmascriptversion=1.5
w3cdomversion=1.0
css1=true
css2=true
xml=true
tagwriter=System.Web.UI.HtmlTextWriter
</case>


<case match="Opera[ /](?'version'(?'major'\d+)(?'minor'\.(?'minorint'\d+))(?'letters'\w*))">
<filter match="[7-9]" with="${major}">
tagwriter=System.Web.UI.HtmlTextWriter
</filter>
<filter>
<case match="7" with="${major}">
<filter>
<case match="[5-9]" with="${minorint}">
ecmascriptversion=1.5
</case>
<case>
ecmascriptversion=1.4
</case>
</filter>
</case>
<case match="[8-9]" with="${major}">
ecmascriptversion=1.5
</case>
</filter>
</case>
</browserCaps>

Z1rT · 11 Ocak 2012

[h=2]Delphi ASP.NET ile Resim İşlemleri[/h]# Delphi ile geliştirilen ASP.NET web projelerinde kullanılmak üzere lokal sunucu üzerinden resim yüklenmesi, resmin yeniden oluşturulması ve uygun bir isim ve klasör altına kaydedilmesi.

# BDS-2006 - CG-2007

Resimlerin yüklendiği ASPX ana sayfasının kodu

PHP Kodu:
<%@ Page language="c#" Debug="true" Codebehind="m_resimekle.pas" AutoEventWireup="false" Inherits="m_uyeresimekle.TWebFormm_Resim_Ekle" %>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Yeni Resim Ekleyin</title>
<meta http-equiv="Content-Language" content="tr">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<link rel="stylesheet" type="text/css" href="./css/ana.css" />
<link rel="stylesheet" type="text/css" href="./css/profil_tabview.css" />
<style type="text/css">.gonderbutton {
BORDER-RIGHT: medium none; PADDING-RIGHT: 2px; BORDER-TOP: medium none; PADDING-LEFT: 2px; BACKGROUND-IMAGE: url(img/nr_bck.gif); PADDING-BOTTOM: 2px; FONT: bold 9pt tahoma,arial,verdana; OVERFLOW: visible; BORDER-LEFT: medium none; WIDTH: 70px; CURSOR: hand; COLOR: #000054; PADDING-TOP: 2px; BORDER-BOTTOM: medium none; HEIGHT: 25px
}
</style>
<link rel="stylesheet" type="text/css" href="./css/profil.css" />
<SCRIPT LANGUAGE="JavaScript">

</SCRIPT>

<script type="text/javascript">

</script>
</head>
<body style="BACKGROUND-IMAGE: url(img/gradinent/dino.gif)" onunload="JavaScript

pener.ListeyiYenile();">
<form enctype="multipart/form-data" runat="server">
<table style="WIDTH: 100%">
<tr>
<td class="etiket9pt" style="WIDTH: 69px">Resim Seçin</td>
<td class="etiket9pt">
<input id="dosya" type="file" name="dosya" viewstate="true" runat="server" class="editbox" onchange="resim_goster(1,'resimdiv',this.value);" title="Eklenecek Resmi Seçin"></td>
<td class="etiket9pt">
 </td>
</tr>
<tr>
<td colspan="3">
<table style="WIDTH: 100%">
<tr>
<td class="etiket9pt" style="WIDTH: 79px">Albüm Adı</td>
<td>

<ASP

ropDownList id="DropDownList_Album" runat="server" cssclass="editbox"></ASP

ropDownList></td>
<td class="etiket9pt">
 </td>
</tr>
<tr>
<td class="etiket9pt" style="WIDTH: 79px">Resim Adı</td>
<td>
<ASP:TextBox id="TextBox_resim_adi" runat="server" CssClass="editbox"></ASP:TextBox></td>
<td class="etiket9pt">
<ASP:CheckBox id="CheckBox_Ozel" runat="server" text="Yalnızca arkadaşlarım görebilir" enableviewstate="False"></ASP:CheckBox>
</td>
</tr>
<tr>
<td class="etiket9pt" style="WIDTH: 79px">kategori</td>
<td>
<ASP:TextBox id="TextBox_Kategori" runat="server" CssClass="editbox" enableviewstate="False"></ASP:TextBox></td>
<td class="etiket9pt">
</td>
</tr>
<tr>
<td colspan="3" class="etiket9pt">Resim Açıklaması
<input size="5" name="thisSayac" id="thisSayac" value="1000" class="readonlyeditbox" readonly="true"> Karakter kaldı...</td>
</tr>
<tr>
<td colspan="3" class="etiket9pt">
<asp:TextBox runat="server" id="TextBox_resim_aciklama" TextMode="MultiLine" Rows="4" Width="99%" CssClass="editbox"></asp:TextBox>
</td>
</tr>
<tr>
<td colspan="3" align="center" class="etiket8pt">
<ASP:Label
id="Label_Msg" runat="server" enableviewstate="False">Yükleyeceğiniz resimlerin formatı jpg veya gif ve dosya büyüklüğü max. 512 KB olmalıdır.</ASP:Label></td>
</tr>
<tr>
<td colspan="3" align="center">
<ASP:Button id="Button_Kapat" runat="server" text=" Kapat " enableviewstate="False" cssclass="gonderbutton" CausesValidation="False"></ASP:Button>
<asp:Button runat="server" Text=" Ekle " id="Button_Ekle" cssclass="gonderbutton" /></td>
</tr>
</table>
</td>
</tr>
<tr>
<td colspan="3" class="etiket11pt" style="FONT-WEIGHT: 900; FONT-SIZE: 16pt; BACKGROUND-IMAGE: url(img/gradinent/marigold.gif); COLOR: #cc3300; FONT-FAMILY: tahoma, Helvetica, Verdana, Arial" align="center" valign="middle">
<ASP:Label id="Label_Eklenen" runat="server">0 Resim Eklendi</ASP:Label></td>
</tr>
<tr>
<td colspan="3" style="BORDER-RIGHT: #fdefc6 2px dotted; BORDER-TOP: #fdefc6 2px dotted; BORDER-LEFT: #fdefc6 2px dotted; BORDER-BOTTOM: #fdefc6 2px dotted" align="center" valign="middle">
<div id="resimdiv" style="BACKGROUND-POSITION: center center; BACKGROUND-IMAGE: url(img/resimgoster.jpeg); WIDTH: 100%; BACKGROUND-REPEAT: no-repeat; HEIGHT: 225px; TEXT-ALIGN: center">
<ASP:Label id="Label_Resim" runat="server" enableviewstate="False">***</ASP:Label>
</div>
</td>
</tr>
<tr>
<td class="etiket8pt" colspan="3" align="center" valign="middle"><ASP:Label id="Label_KullanimDurumu" runat="server">Size ayrılan 1024 KB. Alanın 512 KB. Bölümünü Kullanıyorsunuz. Toplam 4096 Kb. Kullanılabilir Alanınız Mevcut...</ASP:Label></td>
</tr>

</table>
</form>
</body>
</html>

# Resimleri sayfaya basan bir yordam...

PHP Kodu:
procedure TWebUserControl_pg_resimpaylasyorumekle.ResimleriBas(Const UID,AID,ResimID:String);
Var
Baglantim : MySqlConnection;
Komutcu : MySqlCommand;
Okuyucu : MySqlDataReader;
TamEkran : String;
begin
try
TamEkran := '';
Baglantim := MySqlConnection.Create(GetBaglantiText);
Komutcu := MySqlCommand.Create('select * from tbl_resimler where id="'+ResimID+'"',Baglantim);
Baglantim.Open;

Okuyucu := Komutcu.ExecuteReader;
if Okuyucu.Read then
begin
TamEkran := '<a href="http://'+GetSiteAdresi+UyelerResimKlasoru+AID+'/orj/'+Okuyucu.Item['bresim_dosyasi'].ToString+'" Title="'+Okuyucu.Item['resim_adi'].ToString+' İsimli resmi orjinal boyutlarında göster" target="_blank">';
Label_Resim_Adi.Text := StrToHTml(Okuyucu.Item['resim_adi'].ToString);
Label_KResim_Dosyasi.Text := TamEkran+ResimGoster(AID, Page.Server.MapPath(Sabitler.UyelerResimKlasoru+AID+'/'+Okuyucu.Item['bresim_dosyasi'].ToString),Okuyucu.Item['bresim_dosyasi'].ToString)+'</a>';
Label_Resim_Aciklama.Text := StrToHtml(Okuyucu.Item['resim_aciklama'].ToString);
end;
finally
Komutcu.Free;
Baglantim.Close;
Baglantim.Free;
end;
end;

procedure TWebForm_Profilim_Uye_Resim_Ekle.YuklenebilecekResimBoyutu(Const UID:String;Out Ayrilan,KullanilanYer,BosYer : Double);
Var
Baglantim : MySqlConnection;
Komutcu : MySqlCommand;
Okuyucu : MySqlDataReader;
Begin
Try
Ayrilan := 0;
KullanilanYer := 0;
BosYer := 0;
Baglantim := MySqlConnection.Create(GetBaglantiText);
Komutcu := MySqlCommand.Create('Select resim_size From uyeler Where id="'+UID+'"',Baglantim);
Baglantim.Open;
Okuyucu := Komutcu.ExecuteReader;
if Okuyucu.Read then
begin
Ayrilan := Okuyucu.GetDouble(0);
Okuyucu.Close;
end;

Komutcu := MySqlCommand.Create('Select sum(bresim_size) as kullanilan From tbl_resimler Where uye_id="'+UID+'"',Baglantim);
Okuyucu := Komutcu.ExecuteReader;
if Okuyucu.Read then
begin
KullanilanYer := Okuyucu.GetDouble(0);
Okuyucu.Close;
end;

Komutcu := MySqlCommand.Create('Select count(id) as toplam From tbl_resimler Where uye_id="'+UID+'"',Baglantim);
Okuyucu := Komutcu.ExecuteReader;
if Okuyucu.Read then
begin
Label_Eklenen.Text := 'Klasörünüzde '+Okuyucu.Item['toplam'].ToString+' Resim Var...';
Okuyucu.Close;
end else
Label_Eklenen.Text := 'Kayıtlı Resim Yok';
BosYer := Ayrilan - KullanilanYer;
Finally
Komutcu.Free;
Baglantim.Close;
Baglantim.Free;
end;
END;

Function TWebForm_Profilim_Uye_Resim_Ekle.tbl_resimler_Insert(UID,BResimDosyasi,KResimDosyasi,bEn,bBoy,bSize,kEn,kBoy,kSize,kategori:String):Int16;
Var
Baglantim : MySqlConnection;
Komutcu : MySqlCommand;
Okuyucu : MySqlDataReader;
KayitSayisi : Int16;
Begin
KayitSayisi := 0;
Try
Baglantim:= MySqlConnection.Create(GetBaglantiText);
Komutcu := MySqlCommand.Create('INSERT INTO tbl_resimler (uye_id,resim_adi,resim_aciklama,'+
'resim_gonderme_tarihi,bresim_dosyasi,bresim_en,bresim_boy,bresim_size,kresim_dosyasi,kresim_en,kresim_boy,kresim_size,kategori,'+
'album_id,album_adi,ozel) VALUES('+
'"'+UID+'" ,'+
'"'+IlkHarfBuyuk(Duzelt(TextBox_resim_adi.Text))+'" ,'+
'"'+IlkHarfBuyuk(Duzelt(TextBox_resim_aciklama.Text))+'" ,'+
'"'+Sabitler.GetBugun+'" ,'+
'"'+bResimDosyasi+'" ,'+
'"'+bEn+'" ,'+
'"'+bBoy+'" ,'+
'"'+bSize+'" ,'+
'"'+kResimDosyasi+'" ,'+
'"'+kEn+'" ,'+
'"'+kBoy+'" ,'+
'"'+kSize+'" ,'+
'"'+IlkHarfBuyuk(Duzelt(kategori))+'" ,'+
'"'+DropDownList_Album.SelectedValue+'" ,'+
'"'+DropDownList_Album.SelectedItem.Text+'" ,'+
'"'+CheckIsareti(CheckBox_ozel.Checked)+'")',Baglantim);
Baglantim.Open;
KayitSayisi := Komutcu.ExecuteNonQuery;
Finally
Komutcu.Free;
Baglantim.Close;
Baglantim.Free;
Result := KayitSayisi;
end;
END;

function TWebForm_Profilim_Uye_Resim_Ekle.ResimEklenebilirmi:Boolean;
Var
S : String;
begin
Result := False;
S := '';
if Dosya.PostedFile.FileName = '' then
begin
S := 'Yüklemek İçin Önce Bir Dosya Seçin...<br />';
end;
if (Dosya.PostedFile.ContentType <> 'image/pjpeg') and (Dosya.PostedFile.ContentType <> 'image/gif') then
begin
S := 'JPEG veya Gif Formatlı Resim Yüklemelisiniz...<br />';
end;
if Dosya.PostedFile.ContentLength > Sabitler.UyeHerResimMaxKB then
begin
S := 'Yüklenecek Resim Dosyası Max.'+Convert.ToString(Sabitler.UyeHerResimMaxKB)+' Kb. Olmalı';
end;
if ViewState['bosyer'] <> Nil then
begin
if Convert.ToDouble(ViewState['bosyer'].ToString) <= (Dosya.PostedFile.ContentLength) then
S := 'Toplam '+SayiFormatla(Convert.ToDouble(ViewState['bosyer'].ToString),True,2)+' KB. Boş Yeriniz Var.'+
'Yüklemek İstediğiniz Dosya '+SayiFormatla(Dosya.PostedFile.ContentLength,True,2)+' KB. Yeterli Yer Yok !';
end;

Label_Msg.Text := S;
Result := S = '';
end;

# Resim upload edip veri tabanına kaydetme yordamları

PHP Kodu:
function TWebForm_Profilim_Uye_Resim_Ekle.ResimYukle(Const ID : String; out ResimDosyasiAdi:String):Boolean;
Var
DosyaKlasoru : String;
DosyaAdi : String;
TamYol : String;
OrjYol : String;
DosyaKontrol : String;
I : Integer;
KisaResimDosyaAdi : String;
AResim : System.Drawing.Image;
AResimStream : Filestream;
Oranti,x,y : Double;
OrjinalX,OrjinalY : Double;
ResimFormat : ImageFormat;
AFileInfo : FileInfo;
OFileInfo : FileInfo; // orjinaldosya bilgileri
bEn,bBoy,bSize,
kEn,kBoy,kSize : String;
begin
TamYol := '';
OrjYol := ''; // orjinal kopya için
Result := False;
if Dosya.PostedFile.ContentType = 'image/pjpeg' then
ResimFormat := ImageFormat.Jpeg
else
if Dosya.PostedFile.ContentType = 'image/gif' then
ResimFormat := ImageFormat.Gif
else
ResimFormat := ImageFormat.Jpeg;

// Üyenin resimlerinin saklanacağı klasör uyeler/resimler/1/ şeklinde 1= üye ID
DosyaKlasoru := Server.MapPath(Sabitler.UyelerResimKlasoru+ID);
// Thumb boyutlu resim için Klasör yoksa yarat
if Not &Directory.Exists(DosyaKlasoru) then &Directory.CreateDirectory(DosyaKlasoru);

// Orjinal boyutlu resim için Klasör yoksa yarat
if Not &Directory.Exists(DosyaKlasoru+'\orj') then &Directory.CreateDirectory(DosyaKlasoru+'\orj');

DosyaAdi := Path.GetFileName(Dosya.PostedFile.FileName);
//* Her Halükarda Bu ismi tabloya kaydediyoruz...*//
KisaResimDosyaAdi := DosyaAdi;
//sunucuya kayıt edilecek konum ve dosya
TamYol := Path.Combine(DosyaKlasoru,DosyaAdi);
OrjYol := Path.Combine(DosyaKlasoru+'\orj',DosyaAdi);
//Sunucuda bu isimde bir dosya varsa yeni isim seç - Dosya isimleri benzersiz olmalı
//Burası benzer dosya adlarından dolayı sistemi yavaşlatabilir, tablonun bir alanı ile çalışmak gerek...
I := 0;
While &File.Exists(TamYol) do
begin
DosyaKontrol := 'ur_'+I.ToString+'_'+DosyaAdi;
KisaResimDosyaAdi := DosyaKontrol;
TamYol := Path.Combine(DosyaKlasoru,DosyaKontrol);
OrjYol := Path.Combine(DosyaKlasoru+'\Orj',DosyaKontrol);
Inc(I);
end;

if TamYol <> '' then
begin
ResimDosyasiAdi := '<img src="'+Sabitler.UyelerResimKlasoru+ID+'/'+KisaResimDosyaAdi+'" border="0" />'
end else
ResimDosyasiAdi := '';

//Dosyayi yükle
try
// Geçici dosyayı yüklüyoruz... sondaki ~ bu dosya sileceğimizden koyduk...
Dosya.PostedFile.SaveAs(TamYol+'~');
// Yeniden boyutlandır *//
AResimStream := Filestream.Create(TamYol+'~',Filemode.Open);
Aresim := System.Drawing.Image.FromStream(AResimStream);
X := AResim.Width;
Y := AResim.Height;

// orjinal kopya için //
OrjinalX := X;
OrjinalY := Y;

// orjinal kopyayı kaydet
AResim := AResim.GetThumbnailImage(Convert.ToInt32(OrjinalX),Convert.ToInt32(OrjinalY),nil,nil);
AResim.Save(OrjYol,ResimFormat);
OFileInfo := FileInfo.Create(OrjYol);
bSize := Convert.ToString(OFileInfo.Length);
bEn := Convert.ToString(AResim.Width);
bBoy := Convert.ToString(AResim.Height);

//thumbal görüntü//
Oranti := 1;
//aspect ratio algoritması //
if X > Y then
Oranti := X / Sabitler.UyeKResimBoy
else
Oranti := Y / Sabitler.UyeKResimBoy;

X := X / Oranti;
Y := Y / Oranti;

try
AResim := AResim.GetThumbnailImage(Convert.ToInt32(X),Convert.ToInt32(Y),nil,nil);
AResim.Save(TamYol,ResimFormat);
AFileInfo := FileInfo.Create(TamYol);
kSize := Convert.ToString(AFileInfo.Length);
kEn := Convert.ToString(AResim.Width);
kBoy := Convert.ToString(AResim.Height);

tbl_resimler_Insert(ID,KisaResimDosyaAdi,KisaResimDosyaAdi,bEn,bBoy,bSize,kEn,KBoy,KSize,IlkHarfBuyuk(Duzelt(TextBox_Kategori.Text)));
finally
AFileInfo.Free;
AResimStream.Close;
AResim.Dispose;
if &File.Exists(TamYol+'~') then &File.Delete(TamYol+'~');
end;
Result := True;

except on E:Exception do
Result := False;
end;
end;

# Açıklamalar : Resim işlemleri için System.IO uzay adının (Name Space - Eski Dilde Unit), Upload edilen resimleri yeniden oluşturabilmek için System.Drawing ve System.Drawing.Imaging uzay adının, veri tabanı bağlantısı içinde mysql için MySql.Data uzay adının USES bildirimine eklenmesi gerekir.

Z1rT · 11 Ocak 2012

[h=2]ASP.NET - Klasör isimlerinin DropDownList İle Gösterilmesi[/h]# ASP.NET - Klasör isimlerinin DropDownList İle Gösterilmesi

# BDS2006 - CG-2007

PHP Kodu:
procedure TWebForm_GaleriDuzenle.Button_Galeri1_Click(sender: System.Object; e: System.EventArgs);
Var
DirInfo : DirectoryInfo;
DirList : Array of DirectoryInfo ;
i : Integer;
Item : ListItem;
begin
try
DirInfo := DirectoryInfo.Create(Server.MapPath('../galeri/kucukboy'));
DirList := DirInfo.GetDirectories;
DropDownList_DirList.Items.Clear;
For i:=Low(DirList) to High(DirList) do
begin
Item := ListItem.Create(DirList[i].get_Name.ToString,DirList[i].get_Name.ToString);
DropDownList_DirList.Items.Add(Item);
end;
finally
DirInfo.Free;
end;
end;

Z1rT · 11 Ocak 2012

[h=2]ASP.NET - Resimler & Thumb[/h]# Ön izleme için resimleri yeniden oluşturup ölçeklendirir

# BDS-2006 - CG-2007

PHP Kodu:
uses System.IO,System.Drawing.Imaging;

procedure TWebForm_GaleriDuzenle.ResimKucult(ResimKlasoru,ResimDosyasi : String);
Var
BDosya : String;
KDosya : String; // küçük resim dosyası
AResim : System.Drawing.Image;
AResimStream : Filestream;
Oranti,x,y : Double;
ResimFormat : ImageFormat;
AFileInfo : FileInfo;
kEn,kBoy,kSize : String;
begin
BDosya := Server.MapPath('galeri\buyukboy\'+ResimKlasoru+'\'+ResimDosyasi);
KDosya := Server.MapPath('galeri\kucukboy\'+ResimKlasoru+'\'+ResimDosyasi);

try
AResim := System.Drawing.Image.FromFile(BDosya);
X := AResim.Width;
Y := AResim.Height;
ResimFormat := AResim.RawFormat;

if X > Y then
Oranti := X / 150
else
Oranti := Y / 150;

X := X / Oranti;
Y := Y / Oranti;

AResim := AResim.GetThumbnailImage(Convert.ToInt32(X),Convert.ToInt32(Y),nil,nil);
AResim.Save(KDosya,ResimFormat);
finally
AResim.Dispose;
end;
end;

procedure TWebForm_GaleriDuzenle.DosyalardanKucukKopyaCikart(Klasor: String;Mask:String='');
Var
DListesi : Array of String;
Yol : String;
i : Integer;
S : String;
DosyaAdi : String;
begin
Yol := Server.MapPath('galeri\buyukboy\'+Klasor+'\');
if Mask <> '' then
DListesi := &Directory.GetFiles(Yol,Mask)
else
DListesi := &Directory.GetFiles(Yol);

S := '';
For i:=0 to High(DListesi) do
begin
DListesi := DListesi.Remove(0,Yol.Length);
DosyaAdi := Path.GetFileName(DListesi.ToString);
if Not &File.Exists(Server.MapPath('galeri\kucukboy\'+Klasor+'\'+DosyaAdi)) then
ResimKucult(Klasor,DosyaAdi);
end;
end;

Z1rT · 11 Ocak 2012

[h=2]ASP.NET - E-Posta Göndermek[/h]
# ASP.NET web uygulamarından e-posta göndermek

# BDS-2006 - CG-2007

PHP Kodu:
// System.Web.Mail name space uses bölümüne ekleyin...

var
eMail: MailMessage;
begin
eMail := MailMessage.Create;
eMail.BodyFormat := MailFormat.Text; //Bunu MailFormat.Html de yapabilirsiniz
eMail.From := 'bizden@bizden.com'; //kimden
//smtp sunucu adresi
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtsperver'] := 'mail.bizimsunucu.com';
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtpserverport'] := Convert.ToString(25);
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendusing'] := Convert.ToString(2);
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/smtpauthenticate'] := Convert.ToString(1);
//doğrulanacak mail adresi
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendusername'] := 'bizimmailadresi@bizimsunucu.com';
//doğrulanacak mail adresinin şifresi
eMail.Fields['http://schemas.microsoft.com/cdo/configuration/sendpassword'] := 'şifremiz';
eMail.&to := 'size@hotmail.com'; //kime
eMail.Subject := 'Kodbank Konusu'; //konu
eMail.Body := 'ASP.NET ile smtp/pop3 mail göndermek'; //mesaj
//smtp sunucu adresi
SmtpMail.SmtpServer := 'mail.bizimsunucu.com';
//gönder
SmtpMail.Send(eMail);
end;

Z1rT · 11 Ocak 2012

Bir Tablodaki Veriyi Diğer Bir Tabloya Aynen Aktarma
Benim için çok yararlı bir bilgiyi sizinle paylamak istedim. Elbette burada Eski TAblo ve yeni tablo yapıları aynı olmalıdır.

Kod:

Kaydet.Close; Kaydet.SQL.Clear; Kaydet.SQL.Add('INSERT INTO _YENITABLO select * From ESKITABLO where DosyaNo=''' + Label113.Caption + ''' '); Kaydet.ExecSQL;

Z1rT · 11 Ocak 2012

[h=2]Pointer ın üzerinde bulunduğu kaydın Kopyasını Çıkartmak[/h]# Pointer ın üzerinde bulunduğu kaydın (Record) kopyasını çıkartır ve Post için bekler...

# Tüm Sürümler

PHP Kodu:
procedure TForm1.KayitCogalt(DataSeti : TDataSet);
var
StrBuffer: TStringList;
FieldStream: TMemoryStream;
I: integer;
begin
StrBuffer := TStringList.Create;
try
with DataSeti do begin
for I := 0 to FieldCount - 1 do
with Fields[I] do
if DataType in [ftString..ftDateTime] then
StrBuffer.Add(AsString)
else if DataType in [ftBytes..ftGraphic] then begin
FieldStream := TMemoryStream.Create;
if (Fields[I] is TMemoField) then
TMemoField(Fields[I]).SaveToStream(FieldStream)
else if (Fields[I] is TGraphicField) then
TGraphicField(Fields[I]).SaveToStream(FieldStream)
else if (Fields[I] is TBlobField) then
TBlobField(Fields[I]).SaveToStream(FieldStream)
else if (Fields[I] is TBytesField) then begin
FieldStream.SetSize(Fields[I].DataSize);
TBytesField(Fields[I]).GetData(FieldStream.Memory);
end
else if (Fields[I] is TVarBytesField) then begin
FieldStream.SetSize(Fields[I].DataSize);
TVarBytesField(Fields[I]).GetData(FieldStream.Memory);
end;
StrBuffer.AddObject(IntToStr(FieldStream.Size), FieldStream);
end;
Append;
for I := 0 to FieldCount - 1 do
if Fields[I].DataType in [ftString..ftDateTime] then
Fields[I].AsString := StrBuffer.Strings[I]
else if Fields[I].DataType in [ftBytes..ftGraphic] then begin
FieldStream := TMemoryStream(StrBuffer.Objects[I]);
FieldStream.Seek(0,0);
if (Fields[I] is TMemoField) then
TMemoField(Fields[I]).LoadFromStream(FieldStream)
else if (Fields[I] is TGraphicField) then
TGraphicField(Fields[I]).LoadFromStream(FieldStream)
else if (Fields[I] is TBlobField) then
TBlobField(Fields[I]).LoadFromStream(FieldStream)
else if (Fields[I] is TBytesField) then begin
TBytesField(Fields[I]).SetData(FieldStream.Memory);
end
else if (Fields[I] is TVarBytesField) then
TVarBytesField(Fields[I]).SetData(FieldStream.Memory);
StrBuffer.Objects[I] := nil;
FieldStream.Free;
end;
end;
finally
if StrBuffer <> nil then
for I := 0 to StrBuffer.Count - 1 do
if StrBuffer.Objects[I] <> nil then begin
FieldStream := TMemoryStream(StrBuffer.Objects[I]);
FieldStream.Free;
StrBuffer.Objects[I] := nil;
end;
StrBuffer.Free;
end;
end;

Z1rT · 11 Ocak 2012

[h=2]ASP.NET - WYSIWYGEditor Örneği[/h]# Web ugulamalarınıza zengin metin editörü ve html etiketlerini, flash, video, mp3 ekleyebilen bir editörün asp.net ile nasıl kullanılacağını anlatır. Tasarladığım tüm sitelerin yönetim panellerinde sorunsuz kullandım...

# ASP.NET için ilgili editörü InnovaStudio WYSIWYG Editor - Online HTML Editor for Web Applications & Content Management Systems adresinden indirebilirsiniz.

# BDS-2006 - CG-2007

1. WYSIWYGEditor.dll dosyasını bin klasörüne yerleştirip projeye add references seçeneği ile dahil edin...
2. ASPX dosyasına :

<%@ Register TagPrefix="editor" Assembly="WYSIWYGEditor" namespace="InnovaStudio" %>

satırını ekleyin...

3. Aspx sayfasında editörü konumlandıracağınız yerde

<EDITOR:WYSIWYGEDITOR Runat="server" scriptPath="./scripts/" ID="oEdit1" EditMode="HTMLBody" UseDIV="false" />

deklarasyonu yapın...

4. code-behind içinde
Uses InnovaStudio ile editör tanımı ekleyin...
strict protected
oEdit1: InnovaStudio.WYSIWYGEditor;

ile editörü deklare edin....

5. Editör için assetmanager kullanımı ve image/media ekleme işlemlerinin ayarlanması

a. Editöre Assetmanager boyut tanımları yapılır...(Yükseklik, genişlik)
b. Editöre assetmanager klasörünün ve assetmanager.asp dosyasının yeri gösterilir.
Yer gösterme işleminde adres göreceli path / işaretiyle başlar
* EditorAssetManagerKlasoru = '/teksevgi/assetmanager/assetmanager.asp';
c. Assertmanager klasöründe settings.asp dosyasında aşağıdaki satır düzenlenir
arrBaseFolder(0)="/teksevgi/yaziimg/"'Use "Relative to Root" Path
arrBaseName(0)="Resimler"
d. resim ve medya klasörüne iis_xxx kullanıcıları için yazma izni verilir

6. İkide bir boyut ve ayarlarla uğraşmamak için :

PHP Kodu:
procedure TWebForm_YaziDuzenle.SetEditorOzellikleri;
begin
With oEdit1 do
begin
EditorWidth := '100%';
EditorHeight := '650';
btnPrint := true;
btnPasteText := true;
btnFlash := true;
btnMedia := true;
btnLTR := true;
btnRTL := true;
btnSpellCheck := true;
btnStrikethrough := true;
btnSuperscript := true;
btnSubscript := true;
btnClearAll := true;
btnStyles := true; //'Show "Styles/Style Selection" button

AssetManagerWidth := '640';
AssetManagerHeight := '475';
AssetManager := Sabitler.GetAssertScriptYeri;
end;
end;

Z1rT · 11 Ocak 2012

[h=2]Binary Veriyi Windows Kayıt Defteri (Registery) İçinde Kaydetmek[/h]
# Binary verinin Windows kayıt defterine (registry) kaydedilmesi.
# Tüm Delphi Sürümleri

PHP Kodu:
procedure BinaryOkuYaz;
type
TSite = record
AlanAdi: string;
UrlID : Integer;
end;
var Reg: TRegistry;
Veri, Oku: TSite;
begin
Reg := TRegistry.Create;

with Veri do
begin
AlanAdi := 'www.ceviz.net';
UrlID := 1;
end;

with Reg do
try
if OpenKey('sitelerim', True) then
begin
WriteBinaryData('Veri', Veri, Sizeof(Veri));
ReadBinaryData('Veri', Oku, Sizeof(Veri));
ShowMessage(Oku.AlanAdi);
end;
finally
Free;
end;
end;

Z1rT · 11 Ocak 2012

[h=2]Bağımsız Excel Dosyaları Oluşturmak - Excel Sınıfı[/h]# Kodlar değerli üstat Tuğrul HELVACI'ya ait. Ortamdan bağımsız (Ole ve MS-Excel) Excel dosyaları oluşturmak için kullanılır.
# Delphi.NET

PHP Kodu:
TExcelFile = class
strict private
fStream : TStream;

iRow,
iCol : Integer;

constructor Create; overload;
procedure SetValue(aRow, aCol : Word; const Value : TObject);

procedure WriteNumber(Value : Double);
procedure WriteString(Value : String);
procedure WriteBegin;
procedure WriteEnd;
function GetByteArray(const aArray : TWordArray) : TByteArray;

property Stream : TStream read fStream;
public
constructor Create(const FileName : String); overload;
destructor Destroy; override;

property Cells[Row, Col : Word] : TObject write SetValue;
end;

constructor TExcelFile.Create;
begin
inherited;
end;

constructor TExcelFile.Create(const FileName: String);
begin
inherited Create;

fStream := TFileStream.Create(FileName, fmCreate);
WriteBegin;
end;

destructor TExcelFile.Destroy;
begin
WriteEnd;
if Assigned(fStream) then FreeAndNil(fStream);

inherited;
end;

function TExcelFile.GetByteArray(const aArray: TWordArray): TByteArray;
var
wWord : Word;
iCounter : Integer;
begin
iCounter := 0;
SetLength(Result, (High(aArray)+1) * 2);

for wWord in aArray do
begin
Result[iCounter] := Lo(wWord);
Result[iCounter+1] := Hi(wWord);
Inc(iCounter, 2);
end;
end;

procedure TExcelFile.SetValue(aRow, aCol : Word; const Value : TObject);
var
typ : System.&Type;
begin
iRow := aRow;
iCol := aCol;

typ := Value.GetType;

case System.&Type.GetTypeCode(typ) of
TypeCode.SByte,
TypeCode.Byte,
TypeCode.Int16,
TypeCode.UInt16,
TypeCode.Int32,
TypeCode.UInt32,
TypeCode.Int64,
TypeCode.UInt64,
TypeCode.Single,
TypeCode.Double,
TypeCode.Decimal : WriteNumber(Convert.ToDouble(Value));

TypeCode.Object,
TypeCode.Char,
TypeCode.DateTime,
TypeCode.String : WriteString(Value.ToString) ;

TypeCode.Empty,
TypeCode.DBNull,
TypeCode.Boolean : WriteString('BOS');
else raise Exception.Create('Tanımsız veri tipi..!!');
end;
end;

procedure TExcelFile.WriteBegin;
var
aArray : array[0..5] of Word;
begin
aArray[0] := $809;
aArray[1] := 8;
aArray[2] := 00;
aArray[3] := $10;
aArray[4] := 0;//BuildNumber
aArray[5] := 0;

Stream.WriteBuffer(GetByteArray(aArray), 12);
end;

procedure TExcelFile.WriteEnd;
var
aArray : array[0..1] of Word;
begin
aArray[0] := $0A;
aArray[1] := 00;

Stream.WriteBuffer(GetByteArray(aArray), 4);
end;

procedure TExcelFile.WriteNumber(Value: Double);
var
aArray : array[0..4] of Word;

begin
aArray[0] := $203;
aArray[1] := 14;
aArray[2] := iRow;
aArray[3] := iCol;
aArray[4] := 0;

Stream.WriteBuffer(GetByteArray(aArray), 10);
Stream.WriteBuffer(Value, 8);
end;

procedure TExcelFile.WriteString(Value: String);
var
iLen : Word;
aArray : array[0..5] of Word;
begin
iLen := Length(Value);
aArray[0] := $204;
aArray[1] := 8 + iLen;
aArray[2] := iRow;
aArray[3] := iCol;
aArray[4] := 0;
aArray[5] := iLen;

Stream.WriteBuffer(GetByteArray(aArray), 12);
Stream.WriteBuffer(System.Text.ASCIIEncoding.Default.GetBytes(Value), iLen);
end;

Z1rT · 11 Ocak 2012

GRID'ler Hakkında Birkaç Özellik
KAYDIRMA ÇUBUKLARINI AYARLAMA

//-------------------------------------------------------------------
Kod:

TStringGrid( DBGrid1 ).ScrollBars := ssBoth; // yatay göster , dikey gizle TStringGrid( DBGrid1 ).ScrollBars := ssNone; // yatay gizle , dikey göster TStringGrid( DBGrid1 ).ScrollBars := ssHorizontal; // her 2sinide göster
//-------------------------------------------------------------------
GRİDE SHİT + DELETE TUŞU İLE BASARAK SİLMEYİ ÖNLEME
ÇUBUKLARINI AYARLAMA
Kod:

if (ssctrl in shift) and ( Key=VK_delete) then begin Key:=0; ShowMessage('Bu şekilde Kayıt Silinemez'); end;
//-------------------------------------------------------------------

Gridin Belli Bir Sütununu Toplayıp Labellere Yazdırma

Kod:

Alacak:=0.0; // toplam:curreny; olrak tanımlayınız Borc:=0.0; ADOQuery1.first; while not ADOQuery1.eof do begin alacak:=alacak+dbgrid1.columns.grid.fields[11].AsCurrency; Borc:=Borc+dbgrid1.columns.grid.fields[10].AsCurrency; //devir burda son satırı verir // Lbl4.Caption:= floattostr ((adoquery1.fieldbyname('Borc').asfloat) - (adoquery1.fieldbyname('Alacak').asfloat)); ADOQuery1.next; end; Label2.Caption:=currtostr(alacak); Label2.Caption:=FormatFloat('##,###0.00',strtofloat(Label2.Caption)); // Alacak Label3.Caption:=currtostr(Borc); Label3.Caption:=FormatFloat('##,###0.00',strtofloat(Label3.Caption)); // Borç Bakiye:=Borc-Alacak; Label4.Caption:=currtostr(Bakiye); Label4.Caption:=FormatFloat('##,###0.00',strtofloat(Label4.Caption)); // Bakiye Lbl2.Caption:=(Currtostr(DBGrid1.DataSource.DataSet.RecordCount)); // Kayıtsayısı

//-------------------------------------------------------------------

SATIR SATIR RENKLENDİRME VE GRİDİN BAŞINA İCON KOYMA

Kod:

procedure TForm18.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var Icon: TBitmap; begin If (gdSelected in state) then // eğer seçili ise begin DBGrid1.Canvas.Brush.Color := $00FD959C; // zemin rengi DbGrid1.Canvas.Font.Color := clYellow; // font rengi Label1.Caption:=dbgrid1.Fields[9].Text; // Tel 1 Label2.Caption:=dbgrid1.Fields[10].Text; // Tel 2 Label3.Caption:=dbgrid1.Fields[11].Text; // FAx Label4.Caption:=dbgrid1.Fields[12].Text; // Cep Label11.Caption:=dbgrid1.Fields[4].Text + dbgrid1.Fields[5].Text; // Adresi Label13.Caption:=dbgrid1.Fields[2].Text // Ünvanı end else if DBGrid1.Fields[37].asstring <>'0' then begin DBGrid1.Canvas.Brush.Color := clRed; dbGrid1.Canvas.Font.Color:=clYellow; // Fontun rengini değiştirir.. DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State); end else if (DBGrid1.datasource.dataset.recno mod 2) =0 then DBGrid1.Canvas.Brush.Color := $00C8FBFD else DBGrid1.Canvas.Brush.Color := $00BFD7B5; DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State); // if (Column.index=0 ) then begin // DbGridin 1. Sütunu // with DBGrid1.Canvas do begin // MainForm.ImageList2.GetBitmap(13,Icon); // imagelistten 13.inci resim alınıyor... // TextRect(Rect,Rect.Left+25,Rect.Top,Column.Field.AsString); // Alan yazılıyor.. buradaki "rect.left+25" değeri ise 16x16 pix. resimden sonra 5 pixdaha sağa kayması için. // Draw(rect.Left+1,Rect.Top,Icon); // Resim Konuyor..buradaki rect.Left+1 değeri resmin grid duvarına yapışmaması için 2 px sağa kay. // end; // end // else if (dbgrid1.datasource.dataset.recno mod 2) =0 // then DBGrid1.Canvas.Brush.Color := $00C8FBFD // else DBGrid1.Canvas.Brush.Color := $00BFD7B5; // DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State); end;

//-------------------------------------------------------------------
Satır Sil
Kod:

if DbGrid4.RowExist(DbGrid4.SelectedRow) then DbGrid4.DeleteRow(DbGrid4.SelectedRow);timepicker7.date;
//-------------------------------------------------------------------
SATIR EKLE
Kod:

DbGrid4.AddRow; DbGrid4.SelectLastRow;
YADA

Kod:

DbGrid4.AddRow(); DbGrid4.Cell[2, DbGrid4.LastAddedRow].AsString := 'Top Level'; DbGrid4.Cell[3, DbGrid4.LastAddedRow].AsInteger := Random(100); DbGrid4.SelectLastRow;
//-------------------------------------------------------------------
SONRAKİ SATIR
Kod:

var Pos: Integer; begin Pos := DbGrid4.GetNextSibling(DbGrid4.SelectedRow); if DbGrid4.RowExist(Pos) then DbGrid4.SelectedRow := Pos;
//-------------------------------------------------------------------
ÖNCEKİ SATIR
Kod:

var Pos: Integer; begin Pos := DbGrid4.GetPrevSibling(DbGrid4.SelectedRow); if DbGrid4.RowExist(Pos) then DbGrid4.SelectedRow := Pos;
//-------------------------------------------------------------------
SALT OKUNUR
Kod:

procedure TForm1.DbGrid4BeforeEdit(Sender: TObject; ACol, ARow: Integer; var Accept: Boolean); begin if ((ACol = 2) and (ARow = 2)) or ((ACol = 1) and (ARow = 3)) then begin ShowMessage('OnBeforeEditEvent: Editing this cell is disabled.'); Accept := False; end; end;
//-------------------------------------------------------------------
TAMAMLANDI İSE ÜSTÜ ÇİZGİLİ YAZ
Kod:

procedure TForm1.Button1Click(Sender: TObject); begin if DbGrid4.RowCount = 0 then Exit; DbGrid4.CellByName['ProgressColumn1', 'Selected'].AsInteger := 100; DbGrid4.RefreshRow(DbGrid4.SelectedRow); end;
Kod:

procedure TForm1.DbGrid4CellFormating(Sender: TObject; ACol, ARow: Integer; var TextColor: TColor; var FontStyle: TFontStyles; CellState: TCellState); begin if DbGrid4.CellByName['ProgressColumn1', ARow].AsInteger = 100 then begin TextColor := clGrayText; FontStyle := FontStyle + [fsStrikeOut]; end; end;
//-------------------------------------------------------------------
YENİ SATIRA İSTENİLENLERİ EKLE
Kod:

procedure TForm1.Button2Click(Sender: TObject); begin with DbGrid4 do begin AddRow; Cell[0, RowCount - 1].AsInteger := 0; Cell[1, RowCount - 1].AsString := 'Low'; Cell[2, RowCount - 1].AsString := 'This is sample task'; end; end;
//-------------------------------------------------------------------
SEÇİLİ SÜTÜNU SAĞA SOLA DAYA
Kod:

DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment := taLeftJustify; SÜTUNU CELLDE DÜŞEY KONUMLA DbGrid4.Columns[DbGrid4.SelectedColumn].VerticalAlignment := taAlignTop;
//-------------------------------------------------------------------
SATIRI KOMPLE AŞAĞI YADA YUKARI TAŞI
Kod:

DbGrid4.MoveRow(DbGrid4.SelectedRow, DbGrid4.SelectedRow - 1); DbGrid4.SelectedRow := DbGrid4.SelectedRow - 1;
//-------------------------------------------------------------------
SÜTUNU BİR ÖNCEKİ SÜTUNA TAŞI Kod:

procedure TForm1.ToolButton18Click(Sender: TObject); var o, n: Integer; begin o := DbGrid4.Columns[DbGrid4.SelectedColumn].Position; if o = 0 then Exit; n := o - 1; DbGrid4.Columns.ChangePosition(o, n); end;
//-------------------------------------------------------------------
SEÇİLİ CELLİ KALIN YAZ
Kod:

procedure TForm1.btnBoldClick(Sender: TObject); begin with DbGrid4 do if CellBounds(SelectedColumn, SelectedRow) then if TToolButton(Sender).Down then Cell[SelectedColumn, SelectedRow].FontStyle := Cell[SelectedColumn, SelectedRow].FontStyle + [fsBold] else Cell[SelectedColumn, SelectedRow].FontStyle := Cell[SelectedColumn, SelectedRow].FontStyle - [fsBold]; end;
//-------------------------------------------------------------------
SEÇİLİ CELLİ İSTENİLEN RENGE BOYA ( ColorPickerEditor1.SelectedColor ONCHANGE'ine YAZILACAK )
Kod:

with DbGrid4 do if CellBounds(SelectedColumn, SelectedRow) then begin if ColorPickerEditor1.SelectedColor = clNone then Cell[SelectedColumn, SelectedRow].Color := Color else Cell[SelectedColumn, SelectedRow].Color := ColorPickerEditor1.SelectedColor; end;
//-------------------------------------------------------------------
TÜM SATIRI SEÇ YADA SEÇME
Kod:

if TMenuItem(Sender).Checked then DbGrid4.Options := DbGrid4.Options + [goSelectFullRow] else DbGrid4.Options := DbGrid4.Options - [goSelectFullRow];
//-------------------------------------------------------------------
GRİD ÇİZGİLERİNİ GÖSTER YADA GİZLE
Kod:

if TMenuItem(Sender).Checked then DbGrid4.Options := DbGrid4.Options + [goGrid] else DbGrid4.Options := DbGrid4.Options - [goGrid];
//-------------------------------------------------------------------
İNDİGATOR GÖSTER YADA GÖSTERME
Kod:

if TMenuItem(Sender).Checked then DbGrid4.Options := DbGrid4.Options + [goIndicator] else DbGrid4.Options := DbGrid4.Options - [goIndicator]; //-------------------------------------------------------------------
CELL FORMAT'a Yazılacak
Kod:

if (ACol = 5) then begin if (DbGrid4.Cell[5, ARow].AsInteger < 200) then TextColor := clRed; if (DbGrid4.Cell[5, ARow].AsInteger > 1800) then TextColor := clBlue; end;
//-------------------------------------------------------------------
SATIR SİLME ONCELL CLICK' E YAZILACAK
Kod:

procedure TForm1.DbGrid4CellClick(Sender: TObject; ACol, ARow: Integer); begin if ACol = 9 then begin if DbGrid4.Cells[9, ARow] = '0' then DbGrid4.DeleteRow(ARow); end; end;
//-------------------------------------------------------------------
ON EDİT ACCEPT E YAZILACAK
Kod:

if Value = '-1' then begin Accept := False; ShowMessage('Geçersiz Değer'); end;
//-------------------------------------------------------------------
Kod:

procedure TForm1.DbGrid4SelectCell(Sender: TObject; ACol, ARow: Integer); begin if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taLeftJustify then btnLeftAlignment.Down := True; if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taCenter then btnCenterAlignment.Down := True; if DbGrid4.Columns[DbGrid4.SelectedColumn].Alignment = taRightJustify then btnRightAlignment.Down := True; btnBold.Down := fsBold in DbGrid4.Cell[ACol, ARow].FontStyle; btnItalic.Down := fsItalic in DbGrid4.Cell[ACol, ARow].FontStyle; btnUnderline.Down := fsUnderline in DbGrid4.Cell[ACol, ARow].FontStyle; ColorPickerEditor1.SelectedColor := DbGrid4.Cell[ACol, ARow].Color; end;
//-------------------------------------------------------------------
Kod:

procedure TForm1.DbGrid4BeforeEdit(Sender: TObject; ACol, ARow: Integer; var Accept: Boolean); begin if ((ACol = 2) and (ARow = 2)) or ((ACol = 1) and (ARow = 3)) then begin ShowMessage('OnBeforeEditEvent: Değiştirme İzni Yok'); Accept := False; end; end;
//-------------------------------------------------------------------

Z1rT · 11 Ocak 2012

gridden listboxa aktarma

procedure TForm1.Button4Click(Sender: TObject); var i: Integer; begin ListBox1.Clear; for i := 0 to DBGrid1.RowCount - 1 do begin if DBGrid1.Selected then ListBox1.Items.Add(DBGrid1.Cells[1, i] + ', ' + DBGrid1.Cells[2, i]); end; end;

Z1rT · 11 Ocak 2012

DOSYA KOPYALAMA ( NetWork Üzerindede Sorunsuz Çalışıyor )
İstenilen Klasöre İstenilen Dosyayı Network üzerinde veya Local Pcde Sorunsuzca Kopyalayabilirsiniz. Bizzat kullandığım kodlardır.

Önemli Ek Bilgi : Network üzerinde kullanacaksanız İlgili Klasörü MAP etmelisiniz....!!

Buton1 ile önce Dosyayı seçelim. Sonra ilgili editlere yazdıralım

Kod:

var Dosyauzantisi:AnsiString; DosyaAd:AnsiString; begin OpenDialog1.Title:='HASAR DOSYASINA BELGE EKLE '; OpenDialog1.FilterIndex:=1; OpenDialog1.InitialDir:='c:\'; if OpenDialog1.Execute then Begin Dosyauzantisi:=ExtractFileExt(OpenDialog1.FileName); // Dosya Uzantısı DosyaAd:=ExtractFileNAme(OpenDialog1.FileName); // Dosya Adı. ( Uzantısıyla) Edit1.Text:=GetCurrentDir + '\' + DosyaAd; Edit3.Text:=Dosyaad; Edit4.Text:=Dosyauzantisi; end;

Sonra Klasör Kontrolü yapalım ve Dosyamızı Kopyalayalım

Kod:

Var Baglanti : String; Veritabani : String; KlasorAdi:String; KaydetmeYolu:AnsiString; begin KlasorAdi:=Label7.Caption; // Müşteri Kodu olarak Klasör Adı veriliyor KaydetmeYolu:=Edit2.Text; if Edit1.Text='' then begin ShowMessage('Lütfen Önce Dosya Seçiniz'); end else begin if not DirectoryExists('w:\PoliceDosyalari\'+KlasorAdi) then // Klasör Yoksa Oluşturp kopyala // 3 üde oluyor begin createDir('w:\PoliceDosyalari\'+KlasorAdi); // MüşteriKodu createDir('w:\PoliceDosyalari\'+KlasorAdi+'\'+Label8.Caption); // MüşteriKodu\PoliçeNo CopyFile( PChar(Edit1.Text), PChar('W:\PoliceDosyalari\'+'\'+ KlasorAdi+'\'+Label8.Caption+'\'+Edit3.Text),True); // True ise üstüne yazmaz. ShowMessage('Klasör Yoktu, Oluşturulup , Dosya Eklenmiştir' + KlasorAdi); end else // Klasör Varsa sadece kopyala begin createDir('w:\PoliceDosyalari\'+KlasorAdi+'\'+Label8.Caption); // MüşteriKodu\PoliçeNo CopyFile( PChar(Edit1.Text), PChar('W:\PoliceDosyalari\'+'\'+ KlasorAdi+'\'+Label8.Caption+'\'+Edit3.Text),True); // True ise üstüne yazmaz. ShowMessage('Klasör Vardı, Dosya Eklenmiştir'); end; end;

Z1rT · 11 Ocak 2012

DATABASE ALANINA DOSYA KAYDETME
Alan tipini blob olarak ayarla. Dosyayı binary olarak oku ve kaydet..

Aşağıdaki Kod Cemakli hocamın linkinden alınmıştır.
http://forum.ceviz.net/mysql-de-resi...tml#post403103

Kod:

/// kaydetmek için procedure TForm1.Button1Click(Sender: TObject); begin openpicturedialog1.filter:='Resim Dosyaları *.bmp'; if openpicturedialog1.Execute then begin table1.edit; dbimage1.Picture.loadfromfile(openpicturedialog1.filename); table1.post; end; end; ///Okumak için //1. yol procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.Bitmap.Assign(Table1Bitmap); end; //2. yol procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.Bitmap.Assign(TBLOBField(Table1.Fields[1])); end; //3. yol procedure TForm1.Button1Click(Sender: TObject); var B: TBitmap; begin B := TBitmap.Create; try B.Assign(Table1Bitmap); Image1.Picture.Bitmap.Assign(B); finally B.Free; end; end;

Z1rT · 11 Ocak 2012

[h=2]DateTimePicker ' daki Bilgiyi AY - YIL- GÜN olarak Ayırma[/h]Bu fonksiyonu projemde kullanmak zorunda kaldım,

Kodu sizlerle paylaşıyorum ki hazırlarken kaydettiğim zamanı siz de kaydetmeyin

Umarım yararlı olur

Kod:

var YeniTarihim : TDateTime; SadeceGun : string; SadeceAy : string; SadeceYIL : string; begin YeniTarihim := SeciliTarih.Date; DateTimeToString(SadeceGun, 'dd', YeniTarihim); G.Text:=SadeceGun; DateTimeToString(SadeceAy, 'mm', YeniTarihim); A.Text:=SadeceAy; DateTimeToString(SadeceYIL, 'yyyy', YeniTarihim); Y.Text:=SadeceYIL;

Z1rT · 11 Ocak 2012

MERKEZ BANKASI DÖVİZ KURLARI ALMA

Sadece Kopyalayıp , Yapıştırın

Kolay gelsin...

Malzemeler

1 adet IdHTTP
1 adet Memo
1 adet Buton
4 adet Edit

YAPILIŞI

Kod:

var z,s,alis,satis,aranan:string; yer,i:Integer; begin Memo1.Clear; Edit1.Text:=''; Edit2.Text:=''; Edit3.Text:=''; Edit4.Text:=''; s:=IDHttp1.Get('http://www.tcmb.gov.tr/kurlar/today.html'); z:=IDHttp1.Get('http://www.tcmb.gov.tr/kurlar/today.html'); aranan:='1 ABD DOLARI'; for i:=1 to 2 do begin yer:=pos(aranan,s); yer:=pos(aranan,z); if yer=0 then begin ShowMessage('Kur bilgisi yok'); exit; end else begin yer:=yer+length(aranan); s:=copy(s,yer,length(s)-yer); z:=copy(z,yer,length(s)-yer); s:=trim(s); z:=trim(z); alis:=copy(s,1,9); satis:=copy(z,14,9); Memo1.Lines.Add(aranan +' Alış = ' + alis); Memo1.Lines.Add(aranan +' Satış = ' + satis); aranan:='1 EURO'; Edit1.Text:=copy(Memo1.Lines.Text,23,8); Edit2.Text:=copy(Memo1.Lines.Text,55,8); Edit3.Text:=copy(Memo1.Lines.Text,82,8); Edit4.Text:=copy(Memo1.Lines.Text,108,8); end;

Z1rT · 11 Ocak 2012

[h=2]Şifreli Access Dosyasına Kolayından Bağlantı Kurma[/h]

procedure DataBaglantim; var veritabani : String; Begin veritabani := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=VT.mdb;Jet OLEDB

atabase Password=123000;'; qry1.ConnectionString := veritabani; end;

Ara

Ara

Kod Bankası

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT

Z1rT