Evrak Numarası veya Dosya Adını Rakamsal olarak arttırmak
{String bir değerde bulunan rakamsal değerleri kullanarak bir sonraki değeri bulur.
Mesela..:
A91773212 i-> A91773213
A009 u -> A010
ve
XYZ999'u -> XYZ1000 yapar
Daha çok çoklu dosya kaydı yaparken dosya adlarını bulmada ve fatura irsaliye
gibi evrak numaralarının bir sonrakini elde etmede kullanılır}
function DegerArt(const S:String):String;
var i:Integer; Ch:Char; Normal:Boolean;
begin
Result:=S;
i:=Length(Result);
Normal:=False;
while (i>0) and not Normal do begin
Ch:=Result[i];
if Ch in ['0'..'9'] then begin
if Ch='9' then Ch:='0' else begin
Inc(Ch);
Normal:=True;
end;
Result[i]:=Ch;
end else Break;
dec(i);
end;
if not Normal then Insert('1',Result,i+1);
end;
Delphi - .....................................
Delphi'de Aktif Klasörden Geri gitmek
Eğer o an bulunduğunuz aktif klasör c:abcdefghijkl: is ve siz "abc" klasöründeki "xyz"
klasörünün içineki 123.jpg resmine ulaşmak istiyorsanız belirtmeniz gereken adres:
//3 kademe yukarı gitmek istediğimiz için 3 kez ".." kullandık
Image1.Picture.LoadFromFile('......xyz123.jpg') dir...
Basit ama önemli ;)
Delphi - .....................................
Formun Boyutlarını Sabitlemek / No Resize
Aslında biliyorum forumda var ancak bu kod diğerlerine nazaran daha kısa diğerleri işi
8 satırda hallederken bu iki satırda hallediyor.. Gerçi kontrol sayısı da daha az ama
eğer amacınız formumun boyutları AxB olsun başkada birşey istemem ise en uygun
kod bu:
type
TForm1 = class(TForm)
.
.
.
protected
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
end;
.
.
.
procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
with Message.MinMaxInfo^ do
begin
ptMinTrackSize := Point(800, 600); //minimum Genişlik X Yükseklik
ptMaxTrackSize := Point(1024, 768); //maksimum Genişlik X Yükseklik
end;
end;
Delphi - .....................................
SQL Tarih Fonksiyonları
Ayın İlk Günü
select DATEADD(mm, DATEDIFF(mm,0,getdate()), 0)
Bulunduğumuz Haftanın İlk Günü Tarihi
select DATEADD(wk, DATEDIFF(wk,0,getdate()), 0)
Haftanın Günleri Günlerini Ayarlar
set DATEFIRST 1 //Pazartesi
select DATEADD(dd, 1 - DATEPART(dw, getdate()), getdate())
Yılın İlk Günü
select DATEADD(yy, DATEDIFF(yy,0,getdate()), 0)
Çeyrek Dönemin İlk Günü
select DATEADD(qq, DATEDIFF(qq,0,getdate()), 0)
Geçerli Günün Gece Yarısı tam saatini verir
select DATEADD(dd, DATEDIFF(dd,0,getdate()), 0)
Geçen Ayın Son Günü
select dateadd(ms,-3,DATEADD(mm, DATEDIFF(mm,0,getdate() ), 0))
Geçen Yılın Son Günü
select dateadd(ms,-3,DATEADD(yy, DATEDIFF(yy,0,getdate() ), 0))
Geçerli Ayın Son Günü
select dateadd(ms,-3,DATEADD(mm, DATEDIFF(m,0,getdate() )+1, 0))
Geçerli Yılın Son Günü
select dateadd(ms,-3,DATEADD(yy, DATEDIFF(yy,0,getdate() )+1, 0))
Geçerli Ayın İlk Pazartesi Günü
select DATEADD(wk, DATEDIFF(wk,0,
dateadd(dd,6-datepart(day,getdate()),getdate())
), 0)
Delphi - .....................................
Memodaki yazıyı kopyalama işlemi
memo1.lines.selectall;
memo1.copytoclirtbort;
Delphi - .....................................
Otomatik Kod ver
BU KOD İLE 120.100.00256 TARZINDA MUHASEBE PLANI KODU VEYA BENZERİ ALFASAYISAL
KOD VERİLMESİ GEREKEN KOD UYGULAMALARI İÇİN hazırlanmış bir fonksiyon
datamodul içerisinde QHesapkod adında adoquery tanımlanıştır.
hesapplani tablosunda tablo yapısı
hesapno varchar(25) // hesap no 120 - 120.100 - 120.100.00256
hesapadi varchar(150) // hesap açıklaması
müşteri kaydının tutu7lduğu tabloda hesapkodu için verilmiş bir tanımlama alanı
olmalı ve hesapno alanı ile senkronize çalışmalıdır
function TAnaForm.kodver(MOtoKod: string): string;
var
gelen:string;
boyut,sorgu,i,j: Integer;
begin
with dmana.QhesapKod do
begin
close;
sql.clear;
sql.Add('select * from hesapplani where hesapno like '+#39+MOtoKod+#39);
open;
end;
sorgu:=0;
if dmana.QhesapKod.RecordCount=0 then result:='00001';
if dmana.QhesapKod.RecordCount=1 then
begin
for i := 0 to 4 do
begin
if LeftStr(gelen,1)='0' then
begin
sorgu:=sorgu+1;
gelen:=RightStr(gelen,(5-sorgu));
end ;
end;
sorgu:=strtoint(gelen);
sorgu:=sorgu+1;
result:=inttostr(sorgu);
end;
if dmana.QhesapKod.RecordCount>1 then
begin
boyut:= dmana.QhesapKod.RecordCount;
dmana.qhesapkod.First;
for i := 0 to boyut-1 do
begin
gelen:= RightStr( dmana.QhesapKodHesapNo.AsString,5);
for j := 0 to 4 do
begin
if LeftStr(gelen,1)='0' then
begin
gelen:=RightStr(gelen,(5-j));
end else break;
end;
if sorgu< strtoint(gelen) then sorgu:=strtoint(gelen);
dmana.QhesapKod.Next;
end;
sorgu:=sorgu+1;
gelen:=inttostr(sorgu);
case (5-Length(gelen)) of
0:
begin
result := gelen;
end;
1:
begin
result := '0'+gelen;
end;
2:
begin
result := '00'+gelen;
end;
3:
begin
result := '000'+gelen;
end;
4:
begin
result := '0000'+gelen;
end;
end;
end;
end;
kullanımı
procedure TMusteri.Button1Click(Sender: TObject);
begin
MaskEdit1.Text:=anaform.kodver('120.100.%');
end;
Delphi - .....................................
Editde yazılanı kopyalama istemi
CopyFile(Edit1.text,Edit2.text,False);
//ya da
CopyFile(PChar(Edit1.text),PChar(Edit2.text),False);
Alıntıdır...
Delphi - .....................................
Delphi'de Çok Hoş Bir Resim Geçişi
Arkadaşlar merhabalar, aslına bakarsanız şu aralar Delphide FlyingCow ve CoverFlow ile ilgileniyorum ve aklıma ekstra
herhangi bir bileşen olmadanda delphide hoş ve güzel resim geçişleri uyapılabileceği geldi..
ve bende basit birşey hazırlayıverdim. Bunun için forma
1 adet Panel
2 adet Image
3 adet Button
1 adet Timer
nesnesi yerleştirip image1 ve image2 nesnelerini panel'in içine yerleştirin. Ben panelin ve image'lerin
genişlik ve yükseklik değerlerini aynı yaptım ve image2.left:=image1.left+image1.width şeklinde ayarladım böylece
resimler'den her biri panele tam sığıyor ayrıca sağa ve sola kaymadan sonra da sadece yeni resim görünüyor
eğer daha değişik fikirleriniz varsa sizde bu ayarları değiştirerek yeni şeyler elde edebilirsiniz. Mesela yukarıdan
aşağı ve aşağıdan yukarı ekleyebilirsiniz. Bu arada eğer 2'den fazla resim isterseniz yeni bir image nesnesi
eklemek yerine görüntüden çıkan image'in koordinatlarını ayarlayıp bu image'e yeni bir resim yolu verip
tekrar görüntülenmesini de sağlayabilirsiniz...
Neyse, geliştirme işini sizin zevkinize bırakıyorum...
Benim yaptığım gibi sadece iki yönde ve tam sığacak şekilde yapmak için aşağıdai kodu uygulayın...
sol butonuna tıkladığınızda resim her iki resimde sola doğru kayacak, sağa tıklandığında ise sağa kayacak
3. button ise durdurmak için, durduktan sonra sağa veya sola tıklarsanız yine o yöne gider...
bu arada ben timer'ın interval değerini 50 ayarladım yine bu da size kalmış....
İşlerinizde ve hayatınızda başarılar...
kodların tamamını yani basit ibr program halini aşağıdaki linkten indirebilirsiniz..
http://rapidshare.com/files/139087450/resimefekt.rar
unit resimgecisi;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
Image1: TImage;
Image2: TImage;
Timer1: TTimer;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
sagsol:Integer;
procedure TForm1.BitBtn1Click(Sender: TObject); // image 1 ve 2 deki resimler sola doğru kayacak
begin
sagsol:=0;
timer1.Enabled:=True;
end;
procedure TForm1.BitBtn2Click(Sender: TObject); // image 1 ve 2 deki resimler sağa doğru kayacak
begin
sagsol:=1;
timer1.Enabled:=True;
end;
procedure TForm1.BitBtn3Click(Sender: TObject); // durdurma butonu
begin
timer1.Enabled:=False;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if sagsol=1 then //sağadoğru
begin
if image1.Left>-200 then //her iki image'in de width değeri 200 olduğundan benim kodlamam böyle
begin
image1.Left:=image1.Left-20;
image2.Left:=image2.Left-20;
end;
end;
if sagsol=0 then //sola doğru
begin
if image1.Left<0 then //benim kodlamamda panel genişliği 200 olduğundan image1.Left 0 olduğunda image 1 ekranda
begin //image2 ise ekrandan çıkmış olacak...
image1.Left:=image1.Left+20;
image2.Left:=image2.Left+20;
end;
end;
end;
end.
Delphi - .....................................
PageControle runtime Tabsheet ekleme
Selam arkadaşlar,
PageControle Runtime (Program çalışırken) içinde RichEdit bulunan bir TabSheet
(TabSayfası) ekleme kodunu veriyorum. Biraz değiştirilirse diğer bileşenlere de
uygulanabilir. Kod BDS 2006 ile denenmiştir.
Yeni bir proje açarak boş bir PageControl ve bir button ekliyoruz.
var
Form1: TForm1;
t:Array[1..10]of TTabsheet; //Bu satır ile 10a kadar tabsheet ekleyebileceğiz
r:Array[1..10]of TRichEdit; //Bu satır ile 10a kadar richedit ekleyebileceğiz
i:byte=0;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
inc(i); if i>10 then exit;
T[i]:=TTabSheet.Create(self);
T[i].Name:='Sayfa'+inttostr(i);
T[i].PageControl:=Pagecontrol1;
r[i]:=TRichEdit.Create(self);
r[i].Name:='Edit'+inttostr(i);
r[i].Parent:=T[i];
r[i].Align:=alclient;
r[i].Lines.Clear;
end;
Delphi - .....................................
İmdattt'a Cevap - Şifre Olayı
selam. kardeş istediğin şeyi anlatamamışsın.
daha doğrusu istediğini söylediğin şeyden iki anlam çıkıyor..
1- Edit'e girilen şey doğru şifre mi yanlış şifre mi kontrol etmek istiyorum
2- Edit'e girilen şeyi şifre olarak kaydetmek istiyorum.
1-'in cevabı
bir button'un onclick olayına şunu yaz.
var
sifre:string;
begin
sifre:='12345';
if edit1.text=sifre then begin
showmessage('Doğru şifre') end else begin
showmessage('Yanlış şifre') end; end;
2'nin cevabı...
şifreyi edit'ten de kaydedebilirsin..
bir button'un onclick olayına şunu yaz.
var
sifre:TStringList;
begin
sifre:=TStringlist.Create;
sifre:=edit1.text;
sifre.savetofile('Şifre_dosyam.txt');
showmessage('Şifre kaydedildi');
end;
Delphi - .....................................
WebBrowser Örneği
//SsEeRrCcAaNn
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ExtCtrls, StdCtrls, OleCtrls, SHDocVw, Menus;
type
TForm1 = class(TForm)
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
ComboBox1: TComboBox;
SpeedButton6: TSpeedButton;
MainMenu1: TMainMenu;
Dosya1: TMenuItem;
N1: TMenuItem;
Dzen1: TMenuItem;
WebBrowser1: TWebBrowser;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
procedure WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate(ComboBox1.text);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
try
WebBrowser1.GoBack;
except
SpeedButton1.Enabled:=false;
end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
try
WebBrowser1.GoForward;
Except //hata olursa işler
SpeedButton2.Enabled:=false;
end;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
WebBrowser1.Navigate(ComboBox1.Text);
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
WebBrowser1.GoHome;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ComboBox1.Text:=WebBrowser1.LocationURL;
end;
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 Then
end;
procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
begin
Combobox1.Text:=Text;
Form1.Caption:=Text;
end;
end.
Delphi - .....................................
Kısa Yol Üret
//SsEeRrCcAaNn
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject:=CreateComObject(CLSID_ShellLink);
SLink:=IObject as IShellLink;
PFile:=IObject as IPersistFile;
with SLink do
begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateLink('c:windowsnotepad.exe','c:MyNotePad.lnk','','');
end;
Delphi - .....................................
İstenilen alanları Combobox'a yazdırma...
//SsEeRrCcAaNn
procedure TForm1.FormCreate(Sender: TObject);
begin
with Table1 do begin
DisableControls;
try
First
while not EOF do begin
with MyCombo.Items do
Objects[Add(FieldByName('Terms').AsString)] := Pointer((FieldByName('EmpNo').AsInteger));
Next;
end;
finally
EnableControls;
end;
end;
end;
procedure TForm1.MyComboClick(Sender: TObject);
var EmpNo: Integer;
begin
with MyCombo do
EmpNo:=LongInt(Items.Objects[ ItemIndex ]);
ShowMessage('Emp.No.: ' + IntToStr(EmpNo));
End;
Delphi - .....................................
DELPHİ DLL ÖRNEKLERİ
Bu kodlar delphi freezoka com tarafından çıkarılan
projelerinizde rahatlıkla kullanabileceginiz örnekler.
umarım arkadaşlara bir yararı olur.
-----------------------
DLL İLE ŞİFRELEME (şifre:1234)
İNDİRME LİNKİ;
http://rapidshare.com/files/124748622/dll_ile___351_ifre__a__287___305_rma.rar.html
----------------------
DLL İLE DEMO YAPMA
(Açıklama:Öncelikle proje hakkında bir aciklama yapayim,dll içinde ben kişinin kullanımını 5 yaptim
yani kullanici 4 sefer bu projeyi acabilir şimdi kullanim kisitlamasi yapmak için genelde
registrye kayit edilir kişi tekrar actiğinda o pc de registry okuyacagi için kullanamaylacaktır,
bizde dll içine değişik bir deneme yaparak ini yapilandirma dosyasi attik,bunun yolunu
sizlere örnek amacli olduğu için C:deneme olarak adlandırdım siz bu yolu kullanıcının
bulamayacagi bir yer gösterebilirsiniz örnek;C:Windowssistem32win.ini gibi orada bir
dosya yaratacak ve kişi format atmadiği sürece 4 kullanim hakki bittiğinde bir daha
bu projeyi kullanamayacaktir.
dll ve diğer kaynak kodları dosya içerisindedir.)
İNDİRME LİNKİ;
http://rapidshare.com/files/125651917/sure_deneme.rar.html
-------------------
DLL İLE FORM AÇMA
İNDİRME LİNKİ;
http://rapidshare.com/files/124077635/dll_ile_form.rar.html
--------------------
KOLAY GELSİN
Delphi - .....................................
Sadece ilk karakteri(mesela decimalseperator) tutup geri kalanını silmek
kimi zaman kullanıcılara verdiğiniz esneklik başa bela olur, mesela bir hesap makinesi
yapıyorsunuz ve kullanıcı ondalıklı sayı girebiliyor, ancak yanlışlıkla birden fazla
virgül girdi. O zaman bu fonksiyon ile sadece ilk virgülün kalmasını geri kalanın
silinmesini sağlayabilirsiniz
function fazlasil(chr:Char;txt:String) : string;
var ind:Integer;
begin
ind:=Pos(chr,txt);
delete(txt,ind,1);
txt:=AnsiReplaceText(txt,chr,'');
insert(chr,txt,ind);
Result := txt;
end;
Kullanımı:// mesela fazladan decimal seperator girilmiş bir metni düzeltmek istiyorsanız,
// 2,2,3652,,36,36,,, gibi bir değeri 2,236523636 yapacaktır...
//NOT: Sadece ilk bulunan virgül korunur...
Edit1.Text:=fazlasil(DecimalSeparator,Edit1.Text);
Delphi - .....................................
