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 - .....................................
Harika Bir Başlangıç Formu Yapalım
düşündüm düşündüm yeni ve hoş birşey yapayım dedim ve yaptım, benim çok hoşuma gitti
dedim sizlerle de paylaşayım...
ikinci forma (splash) bir adet Timer nesnesi ekleyin, ve intervalini 150 yapın.
formun borderstyle özelliğini bsNone yapın, position özelliğini poOwnerFormCenter
yapın ki ana ekranınızın tam ortasında çıksın..
yine ikinci formunuzun Transparent color özelliğini True, transparen colorunu ise
clWhite yapın. şimdi: farzedelim yapacağınız programın ismi 5 harf, o zaman forma
5 adet label nesnesi yerleştirin bunların top özelliklerini aynı yapın ( veya eğer
farklı bir görüntü isterseniz farklı da olabilir)
Mesela:
Label1.caption:='D';
Label2.caption:='e';
Label3.caption:='l';
Label4.caption:='p';
Label5.caption:='i'; //Delphi'nin yazılışını biliyorum ama başta 5 harf dedik artık 
şimdi bunları yanyana yerleştirin...
label nesnelerinin caption özelliklerini istediğiniz kelimeleri oluşturacak şekilde sıralayın.
ve ikinci formunuzun ana ekranı ile label nesnelerinizin color değerlerini (font color değil)
clWhite yapın, daha sonra tüm label nesnelerinin visible özelliklerinide False yapın..
Bu arada label nesnelerinin font renklerini, büyüklüklerini, konumlarını sıralarını değiştirerek
farklı şeyler elde edebilirsiniz... Hatta isterseniz visible özelliklerini true bırakıp sadece renk
değişimleri ile de güzel şeyler elde etmek mümkün...
ve timer1'in ontimer olayına aşağıdaki kodları yazın..
Bu arada en altta olduğu gibi formun açılışında i:=0 yapmayı unutmayın.
herşey bitince çok hoş bir görünüm elde edeceksiniz... 
Herkese çalışmalarında başarılar...
var
Form2: TForm2;
i:Integer; <<------------------------------------------------ Burayı unutmatın
implementation
{$R *.dfm}
procedure TForm2.Timer1Timer(Sender: TObject);
begin
i:=i+1;
case i of
1:begin
Label1.Visible:=True;
Label2.Visible:=False;
Label3.Visible:=False;
Label4.Visible:=False;
Label5.Visible:=False;
end;
2:begin
Label1.Visible:=False;
Label2.Visible:=True;
Label3.Visible:=False;
Label4.Visible:=False;
Label5.Visible:=False;
end;
3:begin
Label2.Visible:=False;
Label3.Visible:=True;
Label4.Visible:=False;
Label5.Visible:=False;
end;
4:begin
Label3.Visible:=False;
Label4.Visible:=True;
Label5.Visible:=False;
end;
5:begin
Label4.Visible:=False;
Label5.Visible:=True;
end;
6:begin
Label5.Visible:=False;
end;
7:begin
timer1.Interval:=250;
Label1.Visible:=False;
Label2.Visible:=False;
Label3.Visible:=False;
Label4.Visible:=False;
Label5.Visible:=False;
end;
8:begin
Label1.Visible:=True;
Label2.Visible:=True;
Label3.Visible:=True;
Label4.Visible:=True;
Label5.Visible:=True;
end;
9:begin
Label1.Visible:=False;
Label2.Visible:=False;
Label3.Visible:=False;
Label4.Visible:=False;
Label5.Visible:=False;
end;
10:begin
Label1.Visible:=True;
Label2.Visible:=True;
Label3.Visible:=True;
Label4.Visible:=True;
Label5.Visible:=True;
end;
11:begin
Label1.Visible:=False;
Label2.Visible:=False;
Label3.Visible:=False;
Label4.Visible:=False;
Label5.Visible:=False;
end;
12:begin
Label1.Visible:=True;
Label2.Visible:=True;
Label3.Visible:=True;
Label4.Visible:=True;
Label5.Visible:=True;
end;
end;
if i=13 then Close;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
i:=0;<<-------------------------------------------------------- Burayı unutmayın
end;
end.
Delphi - .....................................
Delphi ile split
//Ahmet YANAR
procedure split(const cumle:string;del:Char;donen:TStrings);
var
k,tmp:integer;
begin
k:=1;
tmp:=0;
donen.BeginUpdate;
while tmp<>-1 do
begin
tmp:=pos(del,Copy(cumle,k,length(cumle)) )-1;
if tmp=-1 then
begin
if Length(cumle)>0 then
begin
donen.Add(Copy(cumle,k,length(cumle)-k+1));
end;
end
else
begin
donen.Add(Copy(cumle,k,tmp));
k:=k+tmp+1;
end;
end;
donen.EndUpdate;
end;
Delphi - .....................................
Splash Screen, MDI form ve Giriş Ekranı üçlüsünü hep birlikte kullanmak
{
merhaba arkadaşlar.
yıllar oldu bu platforma uğramayalı. ama özlüyorum eski günleri.
sizlerle yararlı bir iki kod paylaşayım.
herkesin sorunudur hem splash screen hemde giriş formu ve mdi form üçlemesini aynı anda kullanmak.
baktığımda çok farklı kodlar yazmışlar arkadaşlar ve her yerde bulunan şablon splash screen kodu
kullanılmış. büyük projelerde veritabanı kullanıcı girişiniz mutlaka olacaktır.
haliyle programınızın reklamını ve logosunu içeren giriş ekranıda.
aşağıdaki kodla bu işlemi çok verimli kullanabilirsiniz.
aşağıdaki kodu project-view code yaparak proje kodunu açınız.
ve aşağıdaki kodları kendinize göre uyarlayınız.
(Proje kodu Delphi 2007 for win32 ye göre hazırlanmıştır.)
frmAcilis -> Splash Screen olarak gösterilen form
frmAnaPencere -> MDI form
dmVeriler -> Tabloları içeren Data Module
frmSifre -> Kullanıcı giriş ekranı.
tüm arkadaşlara başarılar
Sinan ERGİN.
Bilg. Müh.
}
var
frmAcilis : TfrmAcilis;
begin
frmAcilis := TfrmAcilis.Create(nil);
try
frmAcilis.Show;
Application.Initialize;
frmAcilis.Update;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TfrmAnaPencere, frmAnaPencere);
Application.CreateForm(TdmVeriler, dmVeriler);
frmAcilis.Hide;
finally
frmAcilis.Free;
end;
Application.CreateForm(TfrmSifre, frmSifre);
frmSifre.ShowModal;
if (frmSifre.ModalResult = mrOk) then
begin
frmSifre.Free;
Application.Run;
end
else
Halt(0);
end.
Delphi - .....................................
Standart StringGrid'de Başlığa Göre Sıralama Yapmak
procedure Sortgrid(Grid : TStringGrid; SortCol:integer);
var
i,j : integer;
temp:tstringlist;
begin
temp:=tstringlist.create;
with Grid do
for i := FixedRows to RowCount - 2 do {because last row has no next row}
for j:= i+1 to rowcount-1 do
if AnsiCompareText(Cells[SortCol, i], Cells[SortCol,j]) > 0
then
begin
temp.assign(rows[j]);
rows[j].assign(rows[i]);
rows[i].assign(temp);
end;
temp.free;
end;
//KULLANIMI
procedure TForm1.Button1Click(Sender: TObject);
begin
Sortgrid(StringGrid1,10); // Burada 10, 10uncu Kolonun Başlığını Temsil Ediyor...
end;
Çalışmalarınızda Başarılar...
Delphi - .....................................
Memo İçinde Bul ve Değiştir
Acil yardım yazar arkadaşa hitaben..
projenin uses kısmında StrUtils yazmalısın..
procedure TForm1.Button1Click(Sender: TObject);
var
Metin, Sonuc : AnsiString;
begin
Metin := memo1.lines.text;
Sonuc := AnsiReplaceStr(Metin , 'Var' , 'Haber');
Caption := Sonuc; // Ne Haber yazar
end;
Delphi - .....................................
Acil Yardım ltfn
s.a. akadarşlar
arkadaşlar ben edit yada memo içerisindeki istediğim kelimeyi değiştirmek istiyorum.
procedure TForm1.Button1Click(Sender: TObject);
var
Metin, Sonuc : AnsiString;
begin
Metin := 'Ne Var';
Sonuc := AnsiReplaceStr(Metin , 'Var' , 'Haber');
Caption := Sonuc; // Ne Haber yazar
end;
ben bu şekilde yazıyorum fakat şu hatayı veriyor ;
[DCC Error] Unit1.pas(32): E2003 Undeclared identifier: 'AnsiReplaceStr'
[DCC Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'
yardımcı olursanız sevinirm arkadaşlar acil lazım (Bu arada delphi 2007 Kullanıyırum)
Delphi - .....................................
ArSoft: Excel'e DB den Veri aktarma
procedure TAnaForm.MenuItem1Click(Sender: TObject);
var
aralik:ExcelRange;
I,satir:integer;
bookmark:TBookmarkStr;
begin
//Excel Uygulaması oluşturma
ExcelApplication1.Visible[0]:=true;
ExcelApplication1.Workbooks.Add(null,0);
//Hücreleri doldur
aralik:=ExcelApplication1.ActiveCell;
aralik.Value2:='Stok Kodu';
aralik.ColumnWidth:=25;
aralik:=aralik.Next;
aralik.Value2:='Stok Adı';
aralik.ColumnWidth:=60;
aralik:=aralik.Next;
aralik.Value2:='Birim Fiyatı';
aralik.ColumnWidth:=10;
aralik:=aralik.Next;
aralik.Value2:='Miktar';
aralik.ColumnWidth:=10;
aralik:=aralik.Next;
aralik.Value2:='Birim';
aralik.ColumnWidth:=10;
aralik:=aralik.Next;
aralik.Value2:='Tutar';
aralik.ColumnWidth:=10;
aralik:=aralik.Next;
//Alanları Satırlara ekle
try
bookmark:=dm.FiyatListesi.Bookmark;
try
DB.First;
satir:=3; //3.satırdan itibaren
while not DB.Eof do
begin
aralik:=ExcelApplication1.Range['A'+IntToStr(satir),'A'+Inttostr(satir)];
aralik.Value2;
aralik.Value2:=DBMamulKodu.AsString;
aralik:=aralik.Next;
aralik.Value2:=DBMamulAdi.AsString;
aralik:=aralik.Next;
aralik.Value2:=DBBirimFiyati.AsFloat;
aralik:=aralik.Next;
aralik.Value2:=DBMiktar.AsFloat;
aralik:=aralik.Next;
aralik.Value2:=DBBirimi.AsString;
aralik:=aralik.Next;
aralik.Value2:=DBFiyat.AsFloat;
aralik:=aralik.Next;
DB.Next;
Inc(satir);
end;
finally
DB.Bookmark:=bookmark;
end;
finally
end;
ExcelApplication1.Disconnect;
end;
{
Mustafa AKDEMİR
Yazılım Uzmanı
makdemir08@hotmail.com
www.arsoft.com.tr
}
Delphi - .....................................
ArSoft: Netsise sipariş gönderme ve Depolar arası transfer
{
Netsise sipariş gönderebilmek için aşağıdaki tablolar ve alanları yanlarındaki açıklamalarda
olduğu gibi kullanılmalıdır. Herkese projelerinde başarılar.
}
{
TBLSIPAMAS SIPARIS UST BILGILERININ TUTULDUGU TABLO
--------------------------------------------------------
SUBE_KODU '0' DEFAULT DEGER
FTIRSIP '6' DEFAULT DEGER
FATIRS_NO SIPARIS NUMARASI 15 KARAKTER
CARI_KODU MUSTERI KODU
TARIH TARIH
TIPI '2' DEFAULT DEGER
BRUTTUTAR SIPARIS ICINDEKI KALEMLERIN TOPLAM KDV HARIC ISKONTOSUZ BRUT DEGERI
SAT_ISKT SATIR ISKONTOLARININ TOPLAM RAKAMI
MFAZ_ISKT MAL FAZLASI OLARAK VERILEN VARSA ONLARIN TOPLAM DEGERI
GEN_ISK1T FATURA ALTI ISKONTO 1 TUTARI
GEN_ISK2T FATURA ALTI ISKONTO 2 TUTARI
GEN_ISK3T FATURA ALTI ISKONTO 3 TUTARI
GEN_ISK1O FATURA ALTI ISKONTO 1 ORANI
GEN_ISK2O FATURA ALTI ISKONTO 2 ORANI
GEN_ISK3O FATURA ALTI ISKONTO 3 ORANI
KDV FATURANIN BRUTTUTAR-ISKONTOLARDAN SONRA HESAPLANAN KDV RAKAMI
ACIKLAMA SIPARIS FATURA VE IRSALIYEDE UST BILGILER KISMINDA GELEN ACIKLAMA BOLUMU BURAYA MUHTELIF SATISLARIN MUSTERI ADI YAZILIYOR
KDV_DAHILMI 'H' (HAYIR)
FATKALEM_ADEDI SIPARIS ICINDEKI KALEM SATIR SAYISI MIKTAR DEGIL DIKKAT KAC KALEM MALZEME VARSA ONUN SAYISI
SIPARIS_TEST SIPARIS TESLIM TARIHI
GENELTOPLAM SIPARIS IN GENEL TOPLAM RAKAMI
D_YEDEK10 SIPARIS TESLIM TARIHI ISTENILEN
ISLETME_KODU '1' DEFAULT DEGER
TBLSIPATRA SIPARIS KALEM BILGILERININ TUTULDUGU TABLO
----------------------------------------------------------
STOK_KODU URUN KODU
FISNO SIPARIS NUMARASI
STHAR_GCMIK SIPARIS MIKTARI
STHAR_GCKOD 'C' CIKIS
STHAR_TARIH SIPARIS TARIHI
STHAR_NF URUN NET FIYATI ISKONTOLU
STHAR_BF URUN BRUT FIYATI ISKONTOSUZ
STHAR_KDV URUN KDV ORANI
DEPO_KODU HANGI DEPODAN SATILACAKSA O DEPO KODU URUN DEPO KODU
STHAR_ACIKLAMA CARI KODU
STHAR_SATISK SATIR ISKONTO ORANI
STHAR_MALFISK MAL FAZLASI ISKONTOSU BU KULLANILDIGINDA 100 DEFAULT DEGERDIR
STHAR_FTIRSIP '6' DEFAULT DEGER
STHAR_SATIK2 SATIR ISKONTOSU 2 ORANI
STHAR_HTUR 'H' DEFAULT DEGER
STRA_SATISK4 SATIS ISKONTO 4 ORANI
STRA_SATISK5 SATIS ISKONTO 5 ORANI
STRA_SATISK6 SATIS ISKONTO 6 ORANI
STHAR_BGTIP 'I' DEFAULT DEGER
STHAR_CARIKOD CARI KODU
SIRA SIPARIS ICINDEKI URUNUN SIRA NUMARASI 1,2,3.... GIBI
STRA_SIPKONT SIPARIS ICINDEKI URUNUN SIPARIS TAKIP NUMARASI 1,2,3,... GIBI
STHAR_TESTAR SIPARIS TESLIM TARIHI
SUBE_KODU '0' DEFAULT DEGER
DEPOLAR ARASI TRANSFER ICIN KULLANILACAK TABLO (TBLSTHAR)
---------------------------------------------------------
CIKIS KAYDI ICIN
----------------
STOK_KODU STOK KODU
FISNO DEPOLAR ARASI TRANSFER FISNO
STHAR_GCMIK MIKTAR
STHAR_GCKOD 'C' CIKIS
STHAR_TARIH DEPO TRANSFER FISI TARIHI
STHAR_NF FIYAT EGER FIYATLI TRANSFER YAPILACAKSA
DEPO_KODU CIKIS YAPILAN DEPO KODU
STHAR_ACIKLAMA CIKISDEPOKODU-GIRISDEPOKODU
STHAR_FTIRSIP '8' CIKIS KAYDI ICIN
STHAR_HTUR 'B' DEFAULT DEGER
STHAR_BGTIP 'I' DEFAULT DEGER
SIRA DEPO TARNSFER FISI ICINDEKI MALIN SIRASI 1,2,3... GIBI
OLCUBR '1' DEFAULT VE BUTUN ISLEMLER HEP 1.OLCU BIRIMI UZERINDEN YAPILMALI MIKTARLAR 1.OLCU BIRIMINDEN OLACAK
SUBE_KODU '0' DEFAULT
I_YEDEK8 CIKIS DEPO KODU
GIRIS KAYDI ICIN
----------------
STOK_KODU STOK KODU
FISNO DEPOLAR ARASI TRANSFER FISNO
STHAR_GCMIK MIKTAR
STHAR_GCKOD 'G' GIRIS
STHAR_TARIH DEPO TRANSFER FISI TARIHI
STHAR_NF FIYAT EGER FIYATLI TRANSFER YAPILACAKSA
DEPO_KODU GIRIS YAPILAN DEPO KODU
STHAR_ACIKLAMA CIKISDEPOKODU-GIRISDEPOKODU
STHAR_FTIRSIP '9' CIKIS KAYDI ICIN
STHAR_HTUR 'B' DEFAULT DEGER
STHAR_BGTIP 'I' DEFAULT DEGER
SIRA DEPO TARNSFER FISI ICINDEKI MALIN SIRASI 1,2,3... GIBI
OLCUBR '1' DEFAULT VE BUTUN ISLEMLER HEP 1.OLCU BIRIMI UZERINDEN YAPILMALI MIKTARLAR 1.OLCU BIRIMINDEN OLACAK
SUBE_KODU '0' DEFAULT
I_YEDEK8 GIRIS DEPO KODU
}
{
Mustafa AKDEMİR
Yazılım Uzmanı
makdemir08@hotmail.com
www.arsoft.com.tr
}
Delphi - .....................................
ArSoft: Formül Hesaplama Fonksiyonu Ör: (D+G)*[5]
{ Bu fonksiyon çok büyük bir projede kullandığım ve programın içerisinde yukarıdaki
gibi formüller bulunan
hücre değerlerini kendisine gönderilen değişkenlere göre hesaplayan bir fonksiyon.
Değişken değerlere göre değişken formüller yazarak programınızın çok daha farklı bir
sistem çalışmasını sağlayabilirsiniz.
}
function TAnaForm.fhesapla(h:real;g:real;d:real;x:real;y:real;z:real;formul:string;Krt:string;Kformul:string;Olcu:string):real;
var
toplamdeger,pdeger:real;
i,islem,pislem,k,kf:integer;
sayi:string;
deger,parantez:boolean;
label don;
begin
toplamdeger:=0;
sayi:='';
islem:=0;
deger:=false;
parantez:=false;
pdeger:=0;
pislem:=0;
for i:=0 to length(formul) do
begin
if deger then
begin
if copy(formul,i,1)<>'[' then
if copy(formul,i,1)<>']' then
begin
sayi:=sayi+copy(formul,i,1);
goto don;
end
else
begin
deger:=false;
if parantez then
begin
case pislem of
0: pdeger:=strtofloat(sayi);
1: pdeger:=pdeger+strtofloat(sayi);
2: pdeger:=pdeger-strtofloat(sayi);
3: pdeger:=pdeger*strtofloat(sayi);
4: pdeger:=pdeger/strtofloat(sayi);
end;
end
else
begin
case islem of
0: toplamdeger:=strtofloat(sayi);
1: toplamdeger:=toplamdeger+strtofloat(sayi);
2: toplamdeger:=toplamdeger-strtofloat(sayi);
3: toplamdeger:=toplamdeger*strtofloat(sayi);
4: toplamdeger:=toplamdeger/strtofloat(sayi);
end;
end;
sayi:='';
goto don;
end;
end;
if copy(formul,i,1)='H' then
begin
if parantez then
begin
case pislem of
0: pdeger:=h;
1: pdeger:=pdeger+h;
2: pdeger:=pdeger-h;
3: pdeger:=pdeger*h;
4: pdeger:=pdeger/h;
end;
end
else
begin
case islem of
0: toplamdeger:=h;
1: toplamdeger:=toplamdeger+h;
2: toplamdeger:=toplamdeger-h;
3: toplamdeger:=toplamdeger*h;
4: toplamdeger:=toplamdeger/h;
end;
end;
goto don;
end;
if copy(formul,i,1)='G' then
begin
if parantez then
begin
case pislem of
0: pdeger:=g;
1: pdeger:=pdeger+g;
2: pdeger:=pdeger-g;
3: pdeger:=pdeger*g;
4: pdeger:=pdeger/g;
end;
end
else
begin
case islem of
0: toplamdeger:=g;
1: toplamdeger:=toplamdeger+g;
2: toplamdeger:=toplamdeger-g;
3: toplamdeger:=toplamdeger*g;
4: toplamdeger:=toplamdeger/g;
end;
end;
goto don;
end;
if copy(formul,i,1)='D' then
begin
if parantez then
begin
case pislem of
0: pdeger:=d;
1: pdeger:=pdeger+d;
2: pdeger:=pdeger-d;
3: pdeger:=pdeger*d;
4: pdeger:=pdeger/d;
end;
end
else
begin
case islem of
0: toplamdeger:=d;
1: toplamdeger:=toplamdeger+d;
2: toplamdeger:=toplamdeger-d;
3: toplamdeger:=toplamdeger*d;
4: toplamdeger:=toplamdeger/d;
end;
end;
goto don;
end;
if copy(formul,i,1)='X' then
begin
if parantez then
begin
case pislem of
0: pdeger:=x;
1: pdeger:=pdeger+x;
2: pdeger:=pdeger-x;
3: pdeger:=pdeger*x;
4: pdeger:=pdeger/x;
end;
end
else
begin
case islem of
0: toplamdeger:=x;
1: toplamdeger:=toplamdeger+x;
2: toplamdeger:=toplamdeger-x;
3: toplamdeger:=toplamdeger*x;
4: toplamdeger:=toplamdeger/x;
end;
end;
goto don;
end;
if copy(formul,i,1)='Y' then
begin
if parantez then
begin
case pislem of
0: pdeger:=y;
1: pdeger:=pdeger+y;
2: pdeger:=pdeger-y;
3: pdeger:=pdeger*y;
4: pdeger:=pdeger/y;
end;
end
else
begin
case islem of
0: toplamdeger:=y;
1: toplamdeger:=toplamdeger+y;
2: toplamdeger:=toplamdeger-y;
3: toplamdeger:=toplamdeger*y;
4: toplamdeger:=toplamdeger/y;
end;
end;
goto don;
end;
if copy(formul,i,1)='Z' then
begin
if parantez then
begin
case pislem of
0: pdeger:=z;
1: pdeger:=pdeger+z;
2: pdeger:=pdeger-z;
3: pdeger:=pdeger*z;
4: pdeger:=pdeger/z;
end;
end
else
begin
case islem of
0: toplamdeger:=z;
1: toplamdeger:=toplamdeger+z;
2: toplamdeger:=toplamdeger-z;
3: toplamdeger:=toplamdeger*z;
4: toplamdeger:=toplamdeger/z;
end;
end;
goto don;
end;
if copy(formul,i,1)='+' then
begin
if parantez then
pislem:=1
else
islem:=1;
goto don;
end;
if copy(formul,i,1)='-' then
begin
if parantez then
pislem:=2
else
islem:=2;
goto don;
end;
if copy(formul,i,1)='*' then
begin
if parantez then
pislem:=3
else
islem:=3;
goto don;
end;
if copy(formul,i,1)='/' then
begin
if parantez then
pislem:=4
else
islem:=4;
goto don;
end;
if copy(formul,i,1)='[' then
begin
deger:=true;
goto don;
end;
if copy(formul,i,1)='(' then
begin
parantez:=true;
pdeger:=0;
goto don;
end;
if parantez then
if copy(formul,i,1)=')' then
begin
parantez:=false;
case islem of
0: toplamdeger:=pdeger;
1: toplamdeger:=toplamdeger+pdeger;
2: toplamdeger:=toplamdeger-pdeger;
3: toplamdeger:=toplamdeger*pdeger;
4: toplamdeger:=toplamdeger/pdeger;
end;
pdeger:=0;
end;
don:
end;
for k:=1 to length(kformul) do
begin
if copy(kformul,k,1)=krt then
for kf:=k to length(kformul) do
begin
if copy(kformul,kf,1)='>' then
if copy(kformul,kf+1,1)=olcu then
begin
if copy(kformul,kf+2,1)='X' then
toplamdeger:=toplamdeger-x
else
if copy(kformul,kf+2,1)='Y' then
toplamdeger:=toplamdeger-y
else
if copy(kformul,kf+2,1)='Z' then
toplamdeger:=toplamdeger-z;
end
else
if length(kformul)>4 then
if copy(kformul,kf+4,1)=olcu then
begin
if copy(kformul,kf+5,1)='X' then
toplamdeger:=toplamdeger-x
else
if copy(kformul,kf+5,1)='Y' then
toplamdeger:=toplamdeger-y
else
if copy(kformul,kf+5,1)='Z' then
toplamdeger:=toplamdeger-z;
end;
end;
end;
fhesapla:=toplamdeger;
end;
{
Mustafa AKDEMİR
Yazılım Uzmanı
makdemir08@hotmail.com
www.arsoft.com.tr
}
Delphi - .....................................
