Programlama yapalım ve Öğrenelim.

engellenemeyen memory hatası

iyi Günler Ben Delphide ufak çapta Ticari programlar yapıyorum

şimdi size yaşadığım bir sorundan bahsetmek istiyorum

yaptığım bir otomasyonda bir dizi kodla arama gerçekleştiriyorum query

ile

kodda sorun yok ama arama işlemini 10 defa falan

gerçekleştirdiğimde inudification memory hatası meydana geliyor

bunu nasıl aşacağımı bulamadım.

bellek miktariını kontrol edebiliyorum. program 8mb tan fazla ram

kullanmıyor. ama yinede bu hata engellenemiyor.

Hata sistem configürasyonumdan değil sistemimde 512 MB ram

640 KB cache li AMD 2500 işlemci mevcut.

kod aşşağıdaki gibidir. yardımcı olabilirseniz sevirinirim

mail adresim hakanerikli@hotmail.com

şimdiden teşekkür ederim.

procedure TForm1.Button3Click(Sender: TObject);

var

s,sec,orj: array[1..9]of boolean;

Sname,seclabel,secname,orjname: array [1..9] of string[15];

sorgu:string;

ss,i,a,b:integer;

begin

ss:=0;

if tipchk2.checked=true then

begin

s[1]:=true;

Sname[1]:='tipchk2';

seclabel[1]:='Emlak Tipi';

end;

if cinschk2.Checked=true then

begin

s[2]:=true;

Sname[2]:='Cinschk2';

seclabel[2]:='Emlak Cinsi'

end;

if boyutchk2.Checked then

begin

s[3]:=true;

Sname[3]:='Boyutchk2';

seclabel[3]:='Boyut';

end;

if oschk2.Checked then

begin

s[4]:=true;

Sname[4]:='oschk2';

seclabel[4]:='Oda Salon';

end;

if ISICHK2.Checked then

begin

s[5]:=true;

Sname[5]:='ISICHK2';

seclabel[5]:='ISITMA';

end;

if fiyatchk2.Checked then

begin

s[6]:=true;

Sname[6]:='fiyatchk2';

seclabel[6]:='Fiyat';

end;

if ilcechk2.Checked then

begin

s[7]:=true;

Sname[7]:='ilcechk2';

seclabel[7]:='İlçe';

end;

if semtchk2.Checked then

begin

s[8]:=true;

Sname[8]:='semtchk2';

seclabel[8]:='Semt';

end;

if sitechk2.Checked then

begin

s[9]:=true;

Sname[9]:='sitechk2';

Seclabel[9]:='Site';

end;

richedit1.Text:='';

for i:= 1 to 9 do

begin

if s[i]=true then

begin

ss:=ss+1;

sec[ss]:=true;

orj[ss]:=true;

orjname[ss]:=sname[i];

secname[ss]:=sname[i];

seclabel[ss]:=seclabel[i];

end;

if ss>0 then

begin//eğer seçili checkbox varsa begin

for b:= 1 to ss do

begin // for b begin

for a:= 1 to ss do

begin

(findcomponent(secname[a])as tspskincheckradiobox).Checked:=true;

end;

(findcomponent(secname[b])as tspskincheckradiobox).Checked:=false;

begin

if (fiyatchk2.Checked) and (fiyatedit.Text='') then

application.MessageBox('Lütfen Fiyat Alnına Bilgi girin yada işareti kaldırın','Dikkat',mb_iconwarning+mb_ok)

else

if (boyutchk2.Checked)and(boyutedit.Text='') then

application.MessageBox('Lütfen Boyut Alanına Bilgi girin yada işareti kaldırın','Dikkat',mb_iconwarning+mb_ok)else

begin

if (tipchk2.Checked=false) and (cinschk2.Checked=false) and (boyutchk2.Checked=false)and(fiyatchk2.Checked=false)and(ilcechk2.Checked=false)and(semtchk2.Checked=false) and (oschk2.Checked=false)and(ISICHK2.Checked=false)and(sitechk2.Checked=false) then

application.MessageBox('Arama İşlemi için Kriter Seçmediniz','Dikkat',mb_iconwarning) else

begin

sorgu:='';

if tipchk2.Checked then

sorgu:='(emlaktipi = :emlaktip)';

if cinschk2.Checked then

if sorgu<>'' then

sorgu := sorgu + 'and (Cinsi like :Cinsi)' else

sorgu := '(Cinsi like :cinsi)';

//..................BOYUT CHK.........................

if boyutchk2.Checked then

if sorgu<>'' then

begin

if boyutuchk2.Checked then

sorgu := sorgu + 'and (Boyut >= :Boyut)';

if boyutachk2.Checked then

sorgu := Sorgu + 'And (Boyut <= :Boyut)';

if (boyutuchk2.Checked=false)and(boyutachk2.Checked=false)Then

sorgu:=Sorgu+ 'and (Boyut = :Boyut)';

end

else

begin

if boyutuchk2.Checked then

sorgu := '(Boyut >= :Boyut)';

if boyutachk2.Checked then

sorgu := '(Boyut <= :Boyut)';

if (boyutuchk2.Checked=false)and(boyutachk2.Checked=false)Then

sorgu:='(Boyut = :Boyut)';

end;

//..................BOYUT CHK END...........................

//..................ODA SALON...............................

if oschk2.Checked then

if sorgu<>'' then

begin

sorgu := sorgu + 'and (Oda = da)';

end

else

sorgu:='(Oda = da)';

//..................ODA SALON END...........................

//.................ISI......................................

if ISICHK2.Checked then

if sorgu<>'' then

begin

sorgu := sorgu + 'and (ISITMA = :ISITMA)';

end

else

sorgu:='(ISITMA = :ISITMA)';

//.................ISI END..................................

//.................Fiyat CHK................................

if Fiyatchk2.Checked then

if sorgu<>'' then

begin

if Fiyatuchk2.Checked then

sorgu := sorgu + 'and (Fiyat >= :Fiyat) and (Pbr = br)';

if fiyatachk2.Checked then

sorgu := Sorgu + 'And (Fiyat <= :Fiyat) and (Pbr = br)';

if (fiyatuchk2.Checked=false)and(fiyatachk2.Checked=false)Then

sorgu:=Sorgu+ 'and (Fiyat = :fiyat) and (Pbr = br)';

end

else

begin

if fiyatuchk2.Checked then

sorgu := '(Fiyat >= :Fiyat) and (Pbr = br)';

if Fiyatachk2.Checked then

sorgu := '(Fiyat <= :Fiyat) and (Pbr = br)';

if (Fiyatuchk2.Checked=false)and(Fiyatachk2.Checked=false)Then

sorgu:='(Fiyat = :Fiyat) and (Pbr = br)';

end;

//.................FİYAT CHK END............................

//................İLÇECHK..................................

if ilcechk2.Checked then

if sorgu<>'' then

sorgu := sorgu + 'and (ilce = :ilce)' else

sorgu := '(ilce = :ilce)';

//................İLÇECHK END..............................

//................SEMTCHK..................................

if semtchk2.Checked then

if sorgu<>'' then

sorgu := sorgu + 'and((semt like :semt)or(semt like :semt2)or(semt like :semt3)or(semt like :semt4))' else

sorgu := '((semt like :semt)or(semt like :semt2)or(semt like :semt3)or(semt like :semt4))';

//................SEMTCHK END..............................

//................SİTECHK..................................

if sitechk2.Checked then

if sorgu<>'' then

sorgu := sorgu + 'and (site like :site)' else

sorgu := '(site like :site)';

//................SİTECHK END..............................

Dm.emlaklarq.Close;

dm.emlaklarq.SQL.Clear;

Dm.emlaklarq.SQL.Add('Select * from emlak2');

Dm.emlaklarq.SQL.Add('Where' +Sorgu+' and (Onay="")');

if tipchk2.Checked then

Dm.emlaklarq.ParamByName('emlaktip').AsString:=Emlaktipedit.text;

if cinschk2.Checked then

Dm.emlaklarq.ParamByName('Cinsi').AsString:='%'+emlakcinsedit.Text+'%';

if boyutchk2.Checked then

Dm.emlaklarq.ParamByName('boyut').AsInteger:=Strtoint(boyutedit.Text);

if oschk2.Checked then

begin

Dm.emlaklarq.ParamByName('oda').Asstring:=(odaedit.Text)

end;

if ISICHK2.Checked then

Dm.emlaklarq.ParamByName('ISITMA').AsString:=ISICBOX.Text;

if fiyatchk2.Checked then

begin

Dm.emlaklarq.parambyname('Fiyat').AsCurrency:=strtocurr(fiyatedit.Text);

Dm.emlaklarq.ParamByName('Pbr').AsString:=fiyatcbox.Text;

end;

if ilcechk2.Checked then

Dm.emlaklarq.ParamByName('ilce').AsString:=ilceedit.Text;

if semtchk2.Checked then

begin

if semtedit.Text <>'' then

Dm.emlaklarq.ParamByName('Semt').AsString:='%'+semtedit.Text+'%' else Dm.emlaklarq.ParamByName('Semt').AsString:='';

if semtedit2.Text<>'' then

Dm.emlaklarq.ParamByName('Semt2').AsString:='%'+semtedit2.Text+'%' else Dm.emlaklarq.ParamByName('Semt2').AsString:='';

if semtedit3.Text<>'' then

Dm.emlaklarq.ParamByName('Semt3').AsString:='%'+semtedit3.Text+'%' else Dm.emlaklarq.ParamByName('Semt3').AsString:='';

if semtedit4.Text<>'' then

Dm.emlaklarq.ParamByName('Semt4').AsString:='%'+semtedit4.Text+'%' else Dm.emlaklarq.ParamByName('Semt4').AsString:='';

end;

if sitechk2.Checked then

Dm.emlaklarq.ParamByName('Site').AsString:='%'+siteedit.Text+'%';

Dm.emlaklarq.ExecSQL;

Dm.emlaklarq.Open;

Richedit1.Lines.Add('Eğer '+seclabel[b]+' kriteri seçilmeseydi '+inttostr(Dm.emlaklarq.RecordCount));

(findcomponent(secname[b])as tspskincheckradiobox).Checked:=true;

end;

end;//for b end

end;//eğer seçilii checkbox varsa end

end;

Delphi - .....................................

Form Heryerinden Tasi

void __fastcall TForm1::FormMouseDown(TObject *Sender, TMouseButton Button,

TShiftState Shift, int X, int Y)

{

ReleaseCapture();

SendMessage(Handle, WM_SYSCOMMAND, 0xF012, 0);

}

C++ Builder - .....................................

C++ Builder ile basit bir TRenkEdit bileseni

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

#ifndef RenkliEditH

#define RenkliEditH

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

#include <SysUtils.hpp>

#include <Classes.hpp>

#include <Controls.hpp>

#include <StdCtrls.hpp>

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

class PACKAGE TRenkliEdit : public TEdit

{

private:

TColor FRenk; // sinif üye degiskeni

protected:

public:

__fastcall TRenkliEdit(TComponent* Owner);

virtual void __fastcall SetRenk(TColor Value);

__published:

__property TColor ArkaRenk = {read = FRenk, write = SetRenk }; // özellik

};

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

#endif

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

#include <basepch.h>

#pragma hdrstop

#include "RenkliEdit.h"

#pragma package(smart_init)

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

// Mit ValidCtrCheck wird sichergestellt, daß die erzeugten Komponenten

// keine rein virtuellen Funktionen besitzen.

static inline void ValidCtrCheck(TRenkliEdit *)

{

new TRenkliEdit(NULL);

}

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

__fastcall TRenkliEdit::TRenkliEdit(TComponent* Owner) // Destructor // olusturucu

: TEdit(Owner)

{

Color = clYellow ;

}

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

void __fastcall TRenkliEdit::SetRenk(TColor Value) // üye fonksiyon

{

if (FRenk != Value)

{

FRenk = Value;

Color = FRenk;

Invalidate();

}

namespace Renkliedit

{

void __fastcall PACKAGE Register()

{

TComponentClass classes[1] = {__classid(TRenkliEdit)};

RegisterComponents("Beyaz", classes, 0);

}

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

C++ Builder - .....................................

Delphi Bulunan Ord fonksiyonunun C++ builder da karsligi

Delphi karakterlerin ascii kodlarini alma isi ord fonksiyonu ile yapilir C++ daha gelismis oldugu icin direkt olarak bu fonksiyonu vermemistir, zaten kodlar A..Z islemciye göre hersey 0 - 1 gibi binar sayidir.

int KarekterToAscii(unsigned char X)

{

return X;

}

void __fastcall TForm1::Button1Click(TObject *Sender)

{

Label1->Caption = KarekterToAscii('a'); // 97

}

C++ Builder - .....................................

Delphi Bulunan Ord fonksiyonunun C++ builder da karsligi

int KarekterToAscii(unsigned char X)

{

return X;

}

void __fastcall TForm1::Button1Click(TObject *Sender)

{

Label1->Caption = KarekterToAscii('a'); // 97

}

C++ Builder - .....................................

Delphinin cos ve tan fonksiyonları

Merhaba arkadaşlar

Windowsun standart hesap makinesininde aşağıdaki işlemler

yapıldığında şu değerler bulunur:

Cos 90 = 0

Tan 90 = İşlev için geçersiz giriş

Bu değerler normaldir. Oysa aynı işlemleri delphi7'de

yaptığımda şu değerleri buluyorum:

Cos 90 = -2,71050543121376e-20

Tan 90 = -3,689348811474191e19

Bu hata delphiden mi kaynaklanıyor? Yoksa başka bir hata mı var?

Fikri olan arkadaşlar lütfen cevap göndersin...

Kullandığım kod şu şekildedir:

label1.Caption:=floattostr(cos(pi/180*strtofloat(edit1.text)));

label2.Caption:=floattostr(tan(pi/180*strtofloat(edit1.text)));

Delphi - .....................................

Delphinin cos ve tan fonksiyonları

Merhaba arkadaşlar

Windowsun standart hesap makinesininde aşağıdaki işlemler

yapıldığında şu değerler bulunur:

Cos 90 = 0

Tan 90 = İşlev için geçersiz giriş

Bu değerler normaldir. Oysa aynı işlemleri delphi7'de

yaptığımda şu değerleri buluyorum:

Cos 90 = -2,71050543121376e-20

Tan 90 = -3,689348811474191e19

Bu hata delphiden mi kaynaklanıyor? Yoksa başka bir hata mı var?

Fikri olan arkadaşlar lütfen cevap göndersin...

Kullandığım kod şu şekildedir:

label1.Caption:=floattostr(cos(pi/180*strtofloat(edit1.text)));

label2.Caption:=floattostr(tan(pi/180*strtofloat(edit1.text)));

Delphi - .....................................

C++ Builder ile Analog saat compenent i

C++ Builder bilesen install etmesi Delphi nazaran daha sorunludur. Eger sorun cikarsa bilesenden degil Builder dandir.

C++ Builder kullanan arkadaslar üzülmesin C++ builder ile rahatlikla Delphi gibi bilesenler olusturmak mümkündür!

________________________________________________________________________

Horloge.h

#ifndef HorlogeH

#define HorlogeH

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

#include <SysUtils.hpp>

#include <Controls.hpp>

#include <Classes.hpp>

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

class PACKAGE THorloge : public TGraphicControl

{

private:

TTimer *Timer1;

Graphics::TBitmap *Image1;

bool FSec;

bool __fastcall CanResize(int &NewWidth, int &NewHeight);

protected:

void __fastcall Tempo(TObject* Owner);

void __fastcall Paint();

public:

__fastcall THorloge(TComponent* Owner);

virtual __fastcall ~THorloge();

__published:

__property Anchors;

__property ParentShowHint;

__property ShowHint;

__property Visible;

__property bool Seconde = {read=FSec, write=FSec, default=true};

};

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

#endif

Horloge.cpp

#include <vcl.h>

#include <math.h> #pragma hdrstop

#include "Horloge.h"

#pragma package(smart_init)

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

static inline void ValidCtrCheck(THorloge *)

{

new THorloge(NULL);

}

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

__fastcall THorloge::THorloge(TComponent* Owner)

: TGraphicControl(Owner)

{

ControlStyle << csOpaque;

Image1 = new Graphics::TBitmap();

Timer1 = new TTimer(NULL);

Timer1->OnTimer = Tempo;

FSec=true;

Width = 120;

Height = 120;

Image1->Width = Width;

Image1->Height = Height;

}

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

__fastcall THorloge::~THorloge()

{

delete Image1;

delete Timer1;

}

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

bool __fastcall THorloge::CanResize(int &NewWidth, int &NewHeight)

{

NewWidth = 120;

NewHeight = 120;

return true;

}

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

void __fastcall THorloge::Tempo(TObject* Sender)

{

Invalidate();

}

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

void __fastcall THorloge::Paint()

{

float n,z,u,x0,y0,x1,y1,x2,y2,x3,y3;

TDateTime heure;

TPoint points[4];

Word wHour, wMinute, wSeconde;

heure = Now();

DecodeTime(heure, wHour, wMinute, wSeconde, NULL);

// Couleur de fond.

Image1->Canvas->Brush->Color = Color;

Image1->Canvas->Pen->Color = Color;

Image1->Canvas->Rectangle(0,0,Image1->Width,Image1->Height);

// Dessin du cercle.

Image1->Canvas->Pen->Color = clBlack;

Image1->Canvas->Pen->Width = 2;

Image1->Canvas->Ellipse(2,2,118,118);

// Dessin du texte.

Image1->Canvas->Font->Name = "Arial";

Image1->Canvas->Font->Color = clBlack;

Image1->Canvas->Font->Size = 8;

Image1->Canvas->TextOut( 50,80,"CGi");

Image1->Canvas->TextOut( 55,6,"12");

Image1->Canvas->TextOut( 58,101,"6");

Image1->Canvas->TextOut( 8,53,"9");

Image1->Canvas->TextOut( 105,53,"3");

Image1->Canvas->TextOut( 81,13,"1");

Image1->Canvas->TextOut( 97,30,"2");

Image1->Canvas->TextOut( 98,76,"4");

Image1->Canvas->TextOut( 81,94,"5");

Image1->Canvas->TextOut( 33,94,"7");

Image1->Canvas->TextOut( 15,76,"8");

Image1->Canvas->TextOut( 14,30,"10");

Image1->Canvas->TextOut( 32,13,"11");

Image1->Canvas->Pen->Width = 1;

// Dessin aiguille des secondes si FSec à true.

if (FSec)

{

n = wSeconde*200/60;

z = n/100*3.14159;

u = (n+50)/100*3.14159;

x0 = sin(z)*50;

y0 = -cos(z)*50;

x1 = -sin(z)*10;

y1 = cos(z)*10;

x2 = sin(u)*2;

y2 = -cos(u)*2;

x3 = -sin(u)*2;

y3 = cos(u)*2;

points[0] = Point(x1+60,y1+60);

points[1] = Point(x2+60,y2+60);

points[2] = Point(x0+60,y0+60);

points[3] = Point(x3+60,y3+60);

Image1->Canvas->Brush->Color = clRed;

Image1->Canvas->Polygon(points, 3);

}

// Dessin aiguille des minutes.

n = wMinute*200/60 + wSeconde*200/60/60;

z = n/100*3.14159;

u = (n+50)/100*3.14159;

x0 = sin(z)*50;

y0 = -cos(z)*50;

x1 = -sin(z)*10;

y1 = cos(z)*10;

x2 = sin(u)*4;

y2 = -cos(u)*4;

x3 = -sin(u)*4;

y3 = cos(u)*4;

points[0] = Point(x1+60,y1+60);

points[1] = Point(x2+60,y2+60);

points[2] = Point(x0+60,y0+60);

points[3] = Point(x3+60,y3+60);

Image1->Canvas->Brush->Color = clAqua;

Image1->Canvas->Polygon(points, 3);

// Dessin aiguille des heures.

n = wHour*200/12 + wMinute*200/60/12;

z = n/100*3.14159;

u = (n+50)/100*3.14159;

x0 = sin(z)*35;

y0 = -cos(z)*35;

x1 = -sin(z)*10;

y1 = cos(z)*10;

x2 = sin(u)*4;

y2 = -cos(u)*4;

x3 = -sin(u)*4;

y3 = cos(u)*4;

points[0] = Point(x1+60,y1+60);

points[1] = Point(x2+60,y2+60);

points[2] = Point(x0+60,y0+60);

points[3] = Point(x3+60,y3+60);

Image1->Canvas->Brush->Color = clYellow;

Image1->Canvas->Polygon(points, 3);

Canvas->Draw(0,0,Image1);

}

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

namespace Horloge

{

void __fastcall PACKAGE Register()

{

TComponentClass classes[1] = {__classid(THorloge)};

RegisterComponents("Beyaz", classes, 0);

}

C++ Builder - .....................................

pixel ölçüsü milimetreye nasıl çevrilir

procedure PixelsPerMM(

canvas: TCanvas;

var x, y: single) ;

var

H:HDC;

hres,vres,

hsiz,vsiz:integer;

begin

H:=canvas.handle;

hres := GetDeviceCaps(H,HORZRES) ;

vres := GetDeviceCaps(H,VERTRES) ;

hsiz := GetDeviceCaps(H,HORZSIZE) ;

vsiz := GetDeviceCaps(H,VERTSIZE) ;

x := hres/hsiz;

y := vres/vsiz;

end;

Delphi - .....................................

pixel ölçüsü milimetreye nasıl çevrilir

procedure PixelsPerMM(

canvas: TCanvas;

var x, y: single) ;

var

H:HDC;

hres,vres,

hsiz,vsiz:integer;

begin

H:=canvas.handle;

hres := GetDeviceCaps(H,HORZRES) ;

vres := GetDeviceCaps(H,VERTRES) ;

hsiz := GetDeviceCaps(H,HORZSIZE) ;

vsiz := GetDeviceCaps(H,VERTSIZE) ;

x := hres/hsiz;

y := vres/vsiz;

end;

Delphi - .....................................

hafta yıldaki hangi haftada oldugunu gösterir

delphi kod banktaki hatalı hatayı düzeltim

function WeekOfYear(ADate : TDateTime) : word;

var

day : word;

month : word;

ARTGN,year : word;

FirstOfYear : TDateTime;

begin

DecodeDate(ADate, year, month, day);

FirstOfYear := EncodeDate(year, 1, 1);

case dayofweek(FirstOfYear) of

1:ARTGN:=1;//PAZAR

2:ARTGN:=0; //PAZARTESİ

3:ARTGN:=6;

4:ARTGN:=5;

5:ARTGN:=4;

6:ARTGN:=3;

7:ARTGN:=2;

end;

Result := Trunc( (ADate-ARTGN) - FirstOfYear) div 7 + 1;

end;

// Kullanımı:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(WeekOfYear(Date)));

end;

Delphi - .....................................

hafta yıldaki hangi haftada oldugunu gösterir

delphi kod banktaki hatalı hatayı düzeltim

function WeekOfYear(ADate : TDateTime) : word;

var

day : word;

month : word;

ARTGN,year : word;

FirstOfYear : TDateTime;

begin

DecodeDate(ADate, year, month, day);

FirstOfYear := EncodeDate(year, 1, 1);

case dayofweek(FirstOfYear) of

1:ARTGN:=1;//PAZAR

2:ARTGN:=0; //PAZARTESİ

3:ARTGN:=6;

4:ARTGN:=5;

5:ARTGN:=4;

6:ARTGN:=3;

7:ARTGN:=2;

end;

Result := Trunc( (ADate-ARTGN) - FirstOfYear) div 7 + 1;

end;

// Kullanımı:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(WeekOfYear(Date)));

end;

Delphi - .....................................

virgülden sonra

// 3 edit, 1 buton koyup deneyin

procedure TForm1.Button1Click(Sender: TObject);

Var OndalikT,Durum,i,Basamak:Integer;

C,Ondalik,Tam,OnSonuc:String;

begin

Tam:='';

Durum:=0;

Ondalik:='';

Basamak:=StrToInt(Edit2.Text);

For i:=1 To Length(Edit1.Text) Do

Begin

C:=Copy(Edit1.text,i,1);

If (C='.') Or (C=',') Then Durum:=1;

If (Durum=0) And (C<>',') AND (C<>'.') Then Tam:=Tam+C;

If (Durum=1) And (C<>',') AND (C<>'.') Then Ondalik:=Ondalik+C;

End;

If Length(Ondalik)>Basamak Then

Begin

OndalikT:=StrToInt(Copy(Ondalik,1,Basamak));

Ondalik:=Copy(Ondalik,Basamak+1,Length(Ondalik));

Durum:=0;

For i:=1 To Length(Ondalik) Do

Begin

C:=Copy(Ondalik,i,1);

If Durum=0 Then

Begin

If StrToInt(c)>4 Then Begin Durum:=1; OndalikT:=OndalikT+1; End;

If StrToInt(c)<4 Then Durum:=1;

End;

If Length(IntToStr(OndalikT))>Basamak Then

Begin

Ondalik:='';

For i:=1 To Basamak Do

Begin

Ondalik:=Ondalik + '0';

End;

Tam:=IntToStr(StrToInt(Tam) + 1);

End Else Ondalik:=IntToStr(OndalikT);

Edit3.Text:=Tam + '.' + Ondalik;

end;

Delphi - .....................................

virgülden sonra

// 3 edit, 1 buton koyup deneyin

procedure TForm1.Button1Click(Sender: TObject);

Var OndalikT,Durum,i,Basamak:Integer;

C,Ondalik,Tam,OnSonuc:String;

begin

Tam:='';

Durum:=0;

Ondalik:='';

Basamak:=StrToInt(Edit2.Text);

For i:=1 To Length(Edit1.Text) Do

Begin

C:=Copy(Edit1.text,i,1);

If (C='.') Or (C=',') Then Durum:=1;

If (Durum=0) And (C<>',') AND (C<>'.') Then Tam:=Tam+C;

If (Durum=1) And (C<>',') AND (C<>'.') Then Ondalik:=Ondalik+C;

End;

If Length(Ondalik)>Basamak Then

Begin

OndalikT:=StrToInt(Copy(Ondalik,1,Basamak));

Ondalik:=Copy(Ondalik,Basamak+1,Length(Ondalik));

Durum:=0;

For i:=1 To Length(Ondalik) Do

Begin

C:=Copy(Ondalik,i,1);

If Durum=0 Then

Begin

If StrToInt(c)>4 Then Begin Durum:=1; OndalikT:=OndalikT+1; End;

If StrToInt(c)<4 Then Durum:=1;

End;

If Length(IntToStr(OndalikT))>Basamak Then

Begin

Ondalik:='';

For i:=1 To Basamak Do

Begin

Ondalik:=Ondalik + '0';

End;

Tam:=IntToStr(StrToInt(Tam) + 1);

End Else Ondalik:=IntToStr(OndalikT);

Edit3.Text:=Tam + '.' + Ondalik;

end;

Delphi - .....................................

Registry'de sadece String Veri Türü Listeleme

Delphiturk'e 2 haftadır sorduğum soruya bir türlü yanıt

alamamıştım.Ama azmin yapamayacağı şey yok gibi.Aslında

çözümü basit olan konular bile bazen insanları zorluyor.

Aşağıdaki kodu yazmak belki 5 dakikamı bile almadı.

Önemli olan mantığı zorlamak ve kolaya kaçmamak...

Aşağıdaki kod parçacığı ;

'HKEY_LOCAL_MACHINESOFTWARESerSoftRegDeneme'

anahtarında bulunan verilerden sadece string olanlarını

ListBox1 nesnesine yerleştirir...

Herkese iyi çalışmalar...

unreachableboy@hotmail.com

[Unutmayın Türk Coderlar Herzaman Zeki ve Güçlüdür]

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

reg:TRegistry;

i:integer;

datatypex:TRegDataType;

liste:TStringList;

begin

liste:=TStringList.Create;

liste.Clear;

reg:=TRegistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

reg.OpenKey('SOFTWARESerSoftRegDeneme',False);

reg.GetValueNames(liste);

for i:=0 to liste.Count - 1 do

begin

datatypex:=reg.GetDataType(liste.Strings[i]);

if datatypex = rdstring then // burada gördüğünüz rdstring verinin

begin // string olmasını sağlıyor...

ListBox1.Items.Add(liste.Strings[i]);

end;

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Delphi - .....................................

Registry'de sadece String Veri Türü Listeleme

Delphiturk'e 2 haftadır sorduğum soruya bir türlü yanıt

alamamıştım.Ama azmin yapamayacağı şey yok gibi.Aslında

çözümü basit olan konular bile bazen insanları zorluyor.

Aşağıdaki kodu yazmak belki 5 dakikamı bile almadı.

Önemli olan mantığı zorlamak ve kolaya kaçmamak...

Aşağıdaki kod parçacığı ;

'HKEY_LOCAL_MACHINESOFTWARESerSoftRegDeneme'

anahtarında bulunan verilerden sadece string olanlarını

ListBox1 nesnesine yerleştirir...

Herkese iyi çalışmalar...

unreachableboy@hotmail.com

[Unutmayın Türk Coderlar Herzaman Zeki ve Güçlüdür]

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

reg:TRegistry;

i:integer;

datatypex:TRegDataType;

liste:TStringList;

begin

liste:=TStringList.Create;

liste.Clear;

reg:=TRegistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

reg.OpenKey('SOFTWARESerSoftRegDeneme',False);

reg.GetValueNames(liste);

for i:=0 to liste.Count - 1 do

begin

datatypex:=reg.GetDataType(liste.Strings[i]);

if datatypex = rdstring then // burada gördüğünüz rdstring verinin

begin // string olmasını sağlıyor...

ListBox1.Items.Add(liste.Strings[i]);

end;

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Delphi - .....................................

Windows Servislerinin Gösterilmesi(Hem Ad hem Görüntü Adı)

const

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_FILE_SYSTEM_DRIVER = $00000002;

SERVICE_ADAPTER = $00000004;

SERVICE_RECOGNIZER_DRIVER = $00000008;

SERVICE_DRIVER =

(SERVICE_KERNEL_DRIVER or

SERVICE_FILE_SYSTEM_DRIVER or

SERVICE_RECOGNIZER_DRIVER);

SERVICE_WIN32_OWN_PROCESS = $00000010;

SERVICE_WIN32_SHARE_PROCESS = $00000020;

SERVICE_WIN32 =

(SERVICE_WIN32_OWN_PROCESS or

SERVICE_WIN32_SHARE_PROCESS);

SERVICE_INTERACTIVE_PROCESS = $00000100;

SERVICE_TYPE_ALL =

(SERVICE_WIN32 or

SERVICE_ADAPTER or

SERVICE_DRIVER or

SERVICE_INTERACTIVE_PROCESS);

uses WinSvc;

// sMachine:

// machine name, ie: SERVER

// empty = local machine

// dwServiceType

// SERVICE_WIN32,

// SERVICE_DRIVER or

// SERVICE_TYPE_ALL

// dwServiceState

// SERVICE_ACTIVE,

// SERVICE_INACTIVE or

// SERVICE_STATE_ALL

// slServicesList

// TStrings variable to storage

function ServiceGetList(sMachine : string;dwServiceType,dwServiceState : DWord;

slServicesList : TStrings ): boolean;

const

cnMaxServices = 4096;

type

TSvcA = array[0..cnMaxServices]

of TEnumServiceStatus;

PSvcA = ^TSvcA;

var

j : integer;

schm : SC_Handle;

nBytesNeeded,

nServices,

nResumeHandle : DWord;

ssa : PSvcA;

begin

Result := false;

connect to the service

control manager

schm := OpenSCManager(

PChar(sMachine),

Nil,

SC_MANAGER_ALL_ACCESS);

if(schm > 0)then

begin

nResumeHandle := 0;

New(ssa);

EnumServicesStatus(schm,dwServiceType,dwServiceState,ssa^[0],

SizeOf(ssa^),nBytesNeeded,nServices,nResumeHandle );

for j := 0 to nServices-1 do

begin

slServicesList.

Add( StrPas(

ssa^[j].lpDisplayName ) ); // ---------------->>>>>>>>> buraya dikkat edin

end; // bu satırdaki "lpDisplayName" direk "Görüntü Adlarını" verir

// "lpServiceName" yaparsanız "Servis Adlarını" alırsınız

Result := true;

Dispose(ssa);

CloseServiceHandle(schm);

end;

// KULLANIMINA BİR ÖRNEK

ServiceGetList('',SERVICE_WIN32,SERVICE_STATE_ALL,Memo1.Lines); // bütün servisler

ServiceGetList('',SERVICE_WIN32,SERVICE_ACTIVE,Memo1.Lines); // çalışan servisler

ServiceGetList('',SERVICE_WIN32,SERVICE_INACTIVE,Memo1.Lines); // durgun servisler

Delphi - .....................................

Windows Servislerinin Gösterilmesi(Hem Ad hem Görüntü Adı)

const

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_FILE_SYSTEM_DRIVER = $00000002;

SERVICE_ADAPTER = $00000004;

SERVICE_RECOGNIZER_DRIVER = $00000008;

SERVICE_DRIVER =

(SERVICE_KERNEL_DRIVER or

SERVICE_FILE_SYSTEM_DRIVER or

SERVICE_RECOGNIZER_DRIVER);

SERVICE_WIN32_OWN_PROCESS = $00000010;

SERVICE_WIN32_SHARE_PROCESS = $00000020;

SERVICE_WIN32 =

(SERVICE_WIN32_OWN_PROCESS or

SERVICE_WIN32_SHARE_PROCESS);

SERVICE_INTERACTIVE_PROCESS = $00000100;

SERVICE_TYPE_ALL =

(SERVICE_WIN32 or

SERVICE_ADAPTER or

SERVICE_DRIVER or

SERVICE_INTERACTIVE_PROCESS);

uses WinSvc;

// sMachine:

// machine name, ie: SERVER

// empty = local machine

// dwServiceType

// SERVICE_WIN32,

// SERVICE_DRIVER or

// SERVICE_TYPE_ALL

// dwServiceState

// SERVICE_ACTIVE,

// SERVICE_INACTIVE or

// SERVICE_STATE_ALL

// slServicesList

// TStrings variable to storage

function ServiceGetList(sMachine : string;dwServiceType,dwServiceState : DWord;

slServicesList : TStrings ): boolean;

const

cnMaxServices = 4096;

type

TSvcA = array[0..cnMaxServices]

of TEnumServiceStatus;

PSvcA = ^TSvcA;

var

j : integer;

schm : SC_Handle;

nBytesNeeded,

nServices,

nResumeHandle : DWord;

ssa : PSvcA;

begin

Result := false;

connect to the service

control manager

schm := OpenSCManager(

PChar(sMachine),

Nil,

SC_MANAGER_ALL_ACCESS);

if(schm > 0)then

begin

nResumeHandle := 0;

New(ssa);

EnumServicesStatus(schm,dwServiceType,dwServiceState,ssa^[0],

SizeOf(ssa^),nBytesNeeded,nServices,nResumeHandle );

for j := 0 to nServices-1 do

begin

slServicesList.

Add( StrPas(

ssa^[j].lpDisplayName ) ); // ---------------->>>>>>>>> buraya dikkat edin

end; // bu satırdaki "lpDisplayName" direk "Görüntü Adlarını" verir

// "lpServiceName" yaparsanız "Servis Adlarını" alırsınız

Result := true;

Dispose(ssa);

CloseServiceHandle(schm);

end;

// KULLANIMINA BİR ÖRNEK

ServiceGetList('',SERVICE_WIN32,SERVICE_STATE_ALL,Memo1.Lines); // bütün servisler

ServiceGetList('',SERVICE_WIN32,SERVICE_ACTIVE,Memo1.Lines); // çalışan servisler

ServiceGetList('',SERVICE_WIN32,SERVICE_INACTIVE,Memo1.Lines); // durgun servisler

Delphi - .....................................

sayfam form

AlphaBlend := true;

AlphaBlendValue := 100;

Delphi - .....................................

sayfam form

AlphaBlend := true;

AlphaBlendValue := 100;

Delphi - .....................................

Bileşenin ismine özel bir sayısal değer üretme

{Bileşenlerin ismine özel bir sayısal değer istiyorsanız bu fonksiyonu

güvenle (?) kullanabilirsiniz. (Acaba farklı iki isme aynı değeri üreteceği

bileşen ismi var mıdır?)}

function AdinaRakamVer(const BilesenIsmi:String):Integer;

const

RakamCarpani = 100; GenRakamCarpani = 100000;

BuyukCarpani = 1000; GenBuyukCarpani = 10000;

KucukCarpani = 10; GenKucukCarpani = 1000000;

AltTireCarpani = 1; GenAltTireCarpani = 10000000;

var i,j,Kucuk,Buyuk,Rakam,AltTire:Byte;

begin

i:=Length(BilesenIsmi);

Result:=i*35000;

Rakam:=0;Kucuk:=0;Buyuk:=0;AltTire:=0;

while i>0 do begin

j:=Ord(BilesenIsmi[i]);

case j of

95:begin//_

Inc(AltTire);

Result:=Result+AltTire*AltTireCarpani*i*j;

end;

48..57 :begin//0..9

Inc(Rakam);

Result:=Result+Rakam*RakamCarpani*j*i;

end;

65..90:begin//A..Z

Inc(Buyuk);

Result:=Result+Buyuk*BuyukCarpani*j*i;

end;

97..122:begin//a..z

Inc(Kucuk);

Result:=Result+Kucuk*KucukCarpani*j*i;

end;

else

Inc(Result,i*j);

end;

Dec(i);

end;

Result:=Result+GenRakamCarpani*Rakam+GenBuyukCarpani*Buyuk+GenKucukCarpani*Kucuk+GenAltTireCarpani*AltTire;

end;

Delphi - .....................................

Bileşenin ismine özel bir sayısal değer üretme

{Bileşenlerin ismine özel bir sayısal değer istiyorsanız bu fonksiyonu

güvenle (?) kullanabilirsiniz. (Acaba farklı iki isme aynı değeri üreteceği

bileşen ismi var mıdır?)}

function AdinaRakamVer(const BilesenIsmi:String):Integer;

const

RakamCarpani = 100; GenRakamCarpani = 100000;

BuyukCarpani = 1000; GenBuyukCarpani = 10000;

KucukCarpani = 10; GenKucukCarpani = 1000000;

AltTireCarpani = 1; GenAltTireCarpani = 10000000;

var i,j,Kucuk,Buyuk,Rakam,AltTire:Byte;

begin

i:=Length(BilesenIsmi);

Result:=i*35000;

Rakam:=0;Kucuk:=0;Buyuk:=0;AltTire:=0;

while i>0 do begin

j:=Ord(BilesenIsmi[i]);

case j of

95:begin//_

Inc(AltTire);

Result:=Result+AltTire*AltTireCarpani*i*j;

end;

48..57 :begin//0..9

Inc(Rakam);

Result:=Result+Rakam*RakamCarpani*j*i;

end;

65..90:begin//A..Z

Inc(Buyuk);

Result:=Result+Buyuk*BuyukCarpani*j*i;

end;

97..122:begin//a..z

Inc(Kucuk);

Result:=Result+Kucuk*KucukCarpani*j*i;

end;

else

Inc(Result,i*j);

end;

Dec(i);

end;

Result:=Result+GenRakamCarpani*Rakam+GenBuyukCarpani*Buyuk+GenKucukCarpani*Kucuk+GenAltTireCarpani*AltTire;

end;

Delphi - .....................................

Delphi bileşenlerin kaynak kodları

merhaba arkadaşlar

Delphi bileşenlerin kaynak kodları delphi ile gelmektedir.

Kynak kodları delphinin kurulduğu yerden bulmak mümkündür.

Örneğin

C:Program FilesBorlandDelphi7Source

Delphi - .....................................

Delphi bileşenlerin kaynak kodları

merhaba arkadaşlar

Delphi bileşenlerin kaynak kodları delphi ile gelmektedir.

Kynak kodları delphinin kurulduğu yerden bulmak mümkündür.

Örneğin

C:Program FilesBorlandDelphi7Source

Delphi - .....................................

Ekran resmini cekip Image da göstermek

void __fastcall TForm1::Button1Click(TObject *Sender)

{

Image1->Width = Screen->Width;

Image1->Height = Screen->Height;

HWND Handle = GetDesktopWindow();

HDC Dc = GetDC(Handle);

BitBlt(Image1->Canvas->Handle,0,0,Screen->Width,

Screen->Height,Dc,0,0,SRCCOPY);

}

C++ Builder - .....................................

Ekran resmini cekip Image da göstermek

void __fastcall TForm1::Button1Click(TObject *Sender)

{

Image1->Width = Screen->Width;

Image1->Height = Screen->Height;

HWND Handle = GetDesktopWindow();

HDC Dc = GetDC(Handle);

BitBlt(Image1->Canvas->Handle,0,0,Screen->Width,

Screen->Height,Dc,0,0,SRCCOPY);

}

C++ Builder - .....................................

Form üzerinde bulunan tüm kontrolleri tek hamlede saklamak

Parent Bilesenlerin yasadigi yere denir.

-ControlCount- özelligi tüm elemanlarin toplam sayisini veren bir özelliktir.

void __fastcall TForm1::Button1Click(TObject *Sender)

{

int i;

for (i = 0; i <= Form1->ControlCount-1; i++)

Form1->Controls[i]->Visible = false;

}

C++ Builder - .....................................

Form üzerinde bulunan tüm kontrolleri tek hamlede saklamak

Parent Bilesenlerin yasadigi yere denir.

-ControlCount- özelligi tüm elemanlarin toplam sayisini veren bir özelliktir.

void __fastcall TForm1::Button1Click(TObject *Sender)

{

int i;

for (i = 0; i <= Form1->ControlCount-1; i++)

Form1->Controls[i]->Visible = false;

}

C++ Builder - .....................................

Edite yazılan parayı ytl formatlı yazdırma

{

formunuza bir adet LabeledEdit koymanız yeterli

}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

LabeledEdit1: TLabeledEdit;

procedure LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

procedure LabeledEdit1Change(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

begin

if Key=Char(44) then

begin

if pos(Char(44),LabeledEdit1.Text)>0 then

begin

Key:=Char(0);

end

else if LabeledEdit1.Text = '' then

begin

Key:=Char(0);

end;

end

else if ((Key<'0') or (Key>'9')) and (Key<>Char(VK_BACK)) then

begin

Key:=Char(0);

end;

procedure TForm1.LabeledEdit1Change(Sender: TObject);

begin

if LabeledEdit1.Text <> '' then

begin

LabeledEdit1.EditLabel.Caption:='Para Miktarı : ' + FloatToStrF(StrToFloat(LabeledEdit1.Text),ffNumber,20,2) + ' YTL';

end

else

begin

LabeledEdit1.EditLabel.Caption:='Para Miktarı : 0,00';

end;

procedure TForm1.FormShow(Sender: TObject);

begin

LabeledEdit1.Text:='0';

LabeledEdit1.EditLabel.Caption:='Para Miktarı : 0,00';

end;

end.

Delphi - .....................................

Edite yazılan parayı ytl formatlı yazdırma

{

formunuza bir adet LabeledEdit koymanız yeterli

}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

LabeledEdit1: TLabeledEdit;

procedure LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

procedure LabeledEdit1Change(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.LabeledEdit1KeyPress(Sender: TObject; var Key: Char);

begin

if Key=Char(44) then

begin

if pos(Char(44),LabeledEdit1.Text)>0 then

begin

Key:=Char(0);

end

else if LabeledEdit1.Text = '' then

begin

Key:=Char(0);

end;

end

else if ((Key<'0') or (Key>'9')) and (Key<>Char(VK_BACK)) then

begin

Key:=Char(0);

end;

procedure TForm1.LabeledEdit1Change(Sender: TObject);

begin

if LabeledEdit1.Text <> '' then

begin

LabeledEdit1.EditLabel.Caption:='Para Miktarı : ' + FloatToStrF(StrToFloat(LabeledEdit1.Text),ffNumber,20,2) + ' YTL';

end

else

begin

LabeledEdit1.EditLabel.Caption:='Para Miktarı : 0,00';

end;

procedure TForm1.FormShow(Sender: TObject);

begin

LabeledEdit1.Text:='0';

LabeledEdit1.EditLabel.Caption:='Para Miktarı : 0,00';

end;

end.