Programlama yapalım ve Öğrenelim.

YAKLAŞAN YAZI ÖRNEĞİ

FORMUN İSTEDİĞİNİZ YERİNDE YAZINIZ SİZE YAKLAŞSIN

BEN FORMDA EDİTLER KULLLANDIM ANCAK SABİT BİR FORM İÇİN

EDİT YERİNE RAKAMLARI BELİRLEYİP YAZINIZ.

besumse@hotmail.com tarafından gönderilmiştir.

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Image1: TImage;

Label1: TLabel;

Timer1: TTimer;

GroupBox1: TGroupBox;

Edit1: TEdit;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Label2: TLabel;

Edit2: TEdit;

Edit3: TEdit;

Label3: TLabel;

Edit4: TEdit;

Edit5: TEdit;

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure Delay(ms : longint);

var TheTime : LongInt;

begin

TheTime := GetTickCount + ms;

while GetTickCount < TheTime do

Application.ProcessMessages;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

label1.Caption:=edit1.text;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

Delay(100);

timer1.interval:=200;

label1.Font.size:=10;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=300;

label1.Font.size:=12;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=400;

label1.Font.size:=14;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=500;

label1.Font.size:=18;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=600;

label1.Font.size:=20;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=700;

label1.Font.size:=24;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

Delay(100);

timer1.interval:=800;

label1.Font.size:=28;

label1.Left:=(form1.Width div strtoint(edit2.text))-(label1.Width div strtoint(edit3.text));

label1.top:=(form1.height div strtoint(edit4.text))-(label1.height div strtoint(edit5.text));

timer1.interval:=201;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

timer1.Enabled:= true;

edit2.Enabled:=false;

edit3.Enabled:=false;

edit4.Enabled:=false;

edit5.Enabled:=false;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

timer1.Enabled:=false;

edit2.Enabled:=true;

edit3.Enabled:=true;

edit4.Enabled:=true;

edit5.Enabled:=true;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

form1.close;

end;

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

Programınızı Görev Yöneticisinden Saklama

selam. GENIUS arkadaşımız Nt sistemlerde programı görev yöneticisinden

saklama ile ilgili bir makale yazmıştı ve kaynak göstermişti.

Makaleyi okudum ve kaynağı aradım.

Tabi makalede de arkadaşımızın dediği gibi kaynak sitede çok kalmamış

Google'da aradım. Bulana kadar göbeğim çatladı Neyseki bir rus sitesinde buldum.

Neyse bu işi yapan componenti zipleyip geocities'de bir url'ye atıyorum.

İçinde örnek de var. Detayları Genius'un yazdığı makalede bulabilirsiniz. Kodbank'ın içinde

Genius diye arama yapın çıkacaktır.

Çalışmalarınızda başarılar dilerim

Saygılarımla

Download adresi : http://www.geocities.com/al2x2002/NtProg.zip

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

Bir form üzerindeki tüm bileşenleri read only(salt okunur) yapmaform üzerindeki herşey read only

Bir form üzerindeki tüm bileşenleri read only(salt okunur) yapma

uses kısmına typinfo unitini ekleyin.

procedure TForm1.SetReadOnly( Value : boolean ) ;

var

PropInfo : PPropInfo ;

Component : TComponent ;

i : integer ;

begin

for i := 0 to ComponentCount - 1 do begin

Component := Components[ i ] ;

if Component is TControl then begin

PropInfo := GetPropInfo( Component.ClassInfo, 'ReadOnly' ) ;

if Assigned( PropInfo ) and

( PropInfo^.PropType^.Kind = tkEnumeration ) then

SetOrdProp( Component, PropInfo, integer( Value ) ) ;

end ;

procedure TForm1.Button1Click(Sender: TObject);

begin

SetReadOnly( true ) ;

end;

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

Kredi Kartı Kontroller

function Vc(c: string): integer;

var

card: string[21];

Vcard: array[0..21] of byte absolute card;

Xcard: integer;

Cstr: string[21];

y, x: integer;

begin

Cstr := '';

fillchar(Vcard, 22, #0);

card := c;

for x := 1 to 20 do

if (Vcard[x] in [48..57]) then

Cstr := Cstr + chr(Vcard[x]);

card := '';

card := Cstr;

Xcard := 0;

if not odd(length(card)) then

for x := (length(card) - 1) downto 1 do

begin

if odd(x) then

y := ((Vcard[x] - 48) * 2)

else

y := (Vcard[x] - 48);

if (y >= 10) then

y := ((y - 10) + 1);

Xcard := (Xcard + y)

end

else

for x := (length(card) - 1) downto 1 do

begin

if odd(x) then

y := (Vcard[x] - 48)

else

y := ((Vcard[x] - 48) * 2);

if (y >= 10) then

y := ((y - 10) + 1);

Xcard := (Xcard + y)

end;

x := (10 - (Xcard mod 10));

if (x = 10) then

x := 0;

if (x = (Vcard[length(card)] - 48)) then

Vc := ord(Cstr[1])-ord('2')

else

Vc := 0

end;

//Yukarıdaki functionu programınıza ekleyin.. Bir edit bir de buton koyun. Procedürleri aşağıdadır. Kolay gelsin.

procedure TForm1.Button1Click(Sender: TObject);

var

c:integer;

begin

c:=Vc(Edit1.text);

//ShowMessage(inttostr(c));

if c=0 then Label1.Caption:='Geçersiz veya Tanınmayan Kart';

if c=1 then Label1.Caption:='Amerikan Express';

if c=2 then Label1.Caption:='Visa Kart';

if c=3 then Label1.Caption:='MasterCard';

{0 : Card is invalid or unknown

1 : Card is a valid AmEx

2 : Card is a valid Visa

3 : Card is a valid MasterCard

}

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Edit1.Text:='';

Label1.Caption :='';

end;

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

Sistemde Kullanıma Hazır com portların Adlarını Alma

// sistemde kullanıma hazır com portların adlarını

//registry'de hkey_local_machinehardwaredevicemapserialcomm

//anahtarından alır

//uses Registry

procedure TForm1.GetComPorts(const Liste:TStrings);

var

reg: TRegistry;

st: Tstrings;

i: Integer;

begin

reg := TRegistry.Create;

try

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.OpenKey('HARDWAREDEVICEMAPSERIALCOMM', False);

st := TstringList.Create;

try

Liste.Clear;

reg.GetValueNames(st);

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

Liste.Add(reg.Readstring(st.strings[i]));

finally

st.Free;

end;

reg.CloseKey;

finally

reg.Free;

end;

Kullanımı:

procedure TForm1.FormCreate(Sender: TObject);

begin

GetComPorts(ComboBox1.Items);

ComboBox1.ItemIndex:=0;

end;

Form-->Create de ComboBox1e comport adlarını doldurur.

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

bilgisayarı konuşturun

bilgisayarı konuşturun

bu kodlarla bilgisayarı konuşturun...türkçe destekli değil ama yine

de güzel okuyor microsoft sam amca...xp de sorunsuz çalışır ama 98

de kullanmak için speech özelliği yüklenmeli...microsoft.com da var.

text to speech diye aratırsanız google da bulabilirsiniz.ama xp de

gerek yok zaten yüklü...kolay gelsin...

kenanozyurt_turk@hotmail.com

unit Unit1;

interface

uses

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

Dialogs, ComObj , StdCtrls; //uses kısmına “comobj” eklenecek…

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

oleVoice: OLEVariant;

begin

oleVoice := CreateOLEObject('SAPI.SpVoice');

oleVoice.Speak(edit1.Text, 0);

end;

end.

Bu kodlarla ne yazarsanız yazın Microsoft sam amca’dan her şeyi dinleyebilirsiniz

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

adres defteri

adres defteri

çok basit ama ilk yaptığım şey sizinle paylaşmak istedim

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

ListBox1: TListBox;

ListBox2: TListBox;

ListBox3: TListBox;

ListBox4: TListBox;

ListBox5: TListBox;

ListBox6: TListBox;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn4: TBitBtn;

BitBtn5: TBitBtn;

BitBtn6: TBitBtn;

BitBtn3: TBitBtn;

Label7: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure BitBtn6Click(Sender: TObject);

procedure BitBtn5Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure BitBtn4Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure ListBox2Click(Sender: TObject);

procedure ListBox3Click(Sender: TObject);

procedure ListBox4Click(Sender: TObject);

procedure ListBox5Click(Sender: TObject);

procedure ListBox6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

showmessage('Adres Defteri Programına Hoşgeldiniz');

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

a:integer;

begin

a:=application.messagebox('Adres Defteri Programından Çıkmak İstiyor musunuz?','Çıkış',4+256+16);

if a=6 then action:=cafree;

if a=7 then action:=canone;

end;

procedure TForm1.BitBtn6Click(Sender: TObject);

begin

aboutbox.show;

end;

procedure TForm1.BitBtn5Click(Sender: TObject);

begin

form3.show;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

ad:string[20];

soyad:string[20];

sehir:string[20];

ulke:string[20];

adres:string[30];

tel:string[30];

begin

ad:=Inputbox('İSİM GİRİŞİ','Kayıt İsmini Giriniz',");

soyad:=Inputbox('SOYADI GİRİŞİ','Kayıt Soyadını Giriniz',");

sehir:=Inputbox('ŞEHİR GİRİŞİ','Kayıt Şehir Adını Giriniz',");

ulke:=Inputbox('ÜLKE GİRİŞİ','Kayıt Ülke İsmini Giriniz',");

adres:=Inputbox('ADRES GİRİŞİ','Kayıt Adresini Giriniz',");

tel:=Inputbox('TELEFON GİRİŞİ','Kayıt Telefon Numarasını Giriniz',");

listbox1.Items.add(ad);

listbox2.Items.add(soyad);

listbox3.Items.add(sehir);

listbox4.Items.add(ulke);

listbox5.Items.add(adres);

listbox6.Items.add(tel);

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

listbox1.Items.Delete(listbox1.ItemIndex);

listbox2.Items.Delete(listbox2.ItemIndex);

listbox3.Items.Delete(listbox3.ItemIndex);

listbox4.Items.Delete(listbox4.ItemIndex);

listbox5.Items.Delete(listbox5.ItemIndex);

listbox6.Items.Delete(listbox6.ItemIndex);

end;

procedure TForm1.BitBtn3Click(Sender: TObject);

begin

listbox1.Items.savetofile('ad.dat');

listbox2.Items.savetofile('soyad.dat');

listbox3.Items.savetofile('sehir.dat');

listbox4.Items.savetofile('ulke.dat');

listbox5.Items.savetofile('adres.dat');

listbox6.Items.savetofile('tel.dat');

end;

procedure TForm1.BitBtn4Click(Sender: TObject);

begin

listbox1.Items.loadfromfile('ad.dat');

listbox2.Items.loadfromfile('soyad.dat');

listbox3.Items.loadfromfile('sehir.dat');

listbox4.Items.loadfromfile('ulke.dat');

listbox5.Items.loadfromfile('adres.dat');

listbox6.Items.loadfromfile('tel.dat');

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

listbox2.ItemIndex:=listbox1.ItemIndex;

listbox3.ItemIndex:=listbox1.ItemIndex;

listbox4.ItemIndex:=listbox1.ItemIndex;

listbox5.ItemIndex:=listbox1.ItemIndex;

listbox6.ItemIndex:=listbox1.ItemIndex;

end;

procedure TForm1.ListBox2Click(Sender: TObject);

begin

listbox1.ItemIndex:=listbox2.ItemIndex;

listbox3.ItemIndex:=listbox2.ItemIndex;

listbox4.ItemIndex:=listbox2.ItemIndex;

listbox5.ItemIndex:=listbox2.ItemIndex;

listbox6.ItemIndex:=listbox2.ItemIndex;

end;

procedure TForm1.ListBox3Click(Sender: TObject);

begin

listbox1.ItemIndex:=listbox3.ItemIndex;

listbox2.ItemIndex:=listbox3.ItemIndex;

listbox4.ItemIndex:=listbox3.ItemIndex;

listbox5.ItemIndex:=listbox3.ItemIndex;

listbox6.ItemIndex:=listbox3.ItemIndex;

end;

procedure TForm1.ListBox4Click(Sender: TObject);

begin

listbox1.ItemIndex:=listbox4.ItemIndex;

listbox2.ItemIndex:=listbox4.ItemIndex;

listbox3.ItemIndex:=listbox4.ItemIndex;

listbox5.ItemIndex:=listbox4.ItemIndex;

listbox6.ItemIndex:=listbox4.ItemIndex;

end;

procedure TForm1.ListBox5Click(Sender: TObject);

begin

listbox1.ItemIndex:=listbox5.ItemIndex;

listbox2.ItemIndex:=listbox5.ItemIndex;

listbox3.ItemIndex:=listbox5.ItemIndex;

listbox4.ItemIndex:=listbox5.ItemIndex;

listbox6.ItemIndex:=listbox5.ItemIndex;

end;

procedure TForm1.ListBox6Click(Sender: TObject);

begin

listbox1.ItemIndex:=listbox6.ItemIndex;

listbox2.ItemIndex:=listbox6.ItemIndex;

listbox3.ItemIndex:=listbox6.ItemIndex;

listbox4.ItemIndex:=listbox6.ItemIndex;

listbox5.ItemIndex:=listbox6.ItemIndex;

end;

end.

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

Ağ üzerinden ve İnternetten ip adresine göre dosya alma(gönderme)

//Formumuza 3 Edit, 1 openDialod, 1 saveDialog, 1 Button, 1 NMStrm, 1 NMStrmServ, 1 İmage Ekleyin ve asagıdakı kodları yazın

procedure TForm1.FormCreate(Sender: TObject);

begin

Edit1.text:='127.0.0.1';

edit2.text:='6711';

edit3.text:='Adınızı Giriniz';

NMstrm1.timeout:=90000;

NMStrmServ1.Timeout:=90000;

end;

procedure TForm1.Edit1Change(Sender: TObject);

begin

NMStrm1.host:=edit1.text;

end;

procedure TForm1.Edit2Change(Sender: TObject);

begin

NMstrm1.port:=strtoint(edit2.text);

nmstrmserv1.port:=strtoint(edit2.text);

end;

procedure TForm1.Edit3Change(Sender: TObject);

begin

nmstrm1.fromname:=edit3.text;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Fstrm: TFileStream;

begin

if opendialog1.execute then

begin

FStrm:=TFilestream.create(Opendialog1.Filename, fmopenread);

try

NMStrm1.postit(Fstrm);

finally

FStrm.free;

end;

procedure TForm1.NMStrm1PacketSent(Sender: TObject);

begin

Caption:=inttostr(nmstrm1.bytessent)+'/'+ inttostr(nmstrm1.bytestotal);

end;

procedure TForm1.NMStrm1MessageSent(Sender: TObject);

begin

Caption:='Dosya Gönderildi';

end;

procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;

strm: TStream);

var

fstrm:tfilestream;

begin

Caption:=sfrom+'dan'+inttostr(strm.size)+'boyutund a dosya geldi';

if savedialog1.execute then

begin

if fileexists(savedialog1.filename) then

deletefile(savedialog1.filename);

fstrm:=tfilestream.create(savedialog1.filename, fmcreate);

try

fstrm.copyfrom(strm, strm.size);

finally

end;

if lowercase(Extractfileext(savedialog1.filename))='. bmp' then

image1.picture.loadfromfile(savedialog1.filename);

end;

end

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

delphi 2005 ipuçları

----------1-----------

Çok satır açıklama satırı yapmak/silmek için, satır/satırları seçin ve

CTRL+/

basın.

----------2-----------

{} yerine (* *) olduğu gibi; [ ] yerine de (. .) yapabilirsiniz...

----------3-----------

uses

Windows, Messages, SysUtils,

klas in 'C:kutuphanemklas.pas', //buraya dikkat!

Classes;

----------4-----------

compile = CTRL+F9

build = Shift+F9

----------5-----------

with obj1 do

with obj2 do

with objn do

statement

EŞİTTİR:

with obj1, obj2, ..., objn do

statement

----------6-----------

dinamik çok boyutlu dizi kullanımı

var Ints: array of array of Integer;

SetLength(Ints,10); //ilk kolon 10 elemanlı

SetLength(Ints[2], 5);//5 sütun da 2. boyut için

var (.NET için)

a: array [,,] of integer; // 3 boyutlu dizi

b: array [,] of integer; // 2 boyutlu dizi

begin

a := New(array[3,5,7] of integer); // boyut belirlemek

b := New(array[,] of integer, ((1,2,3), (4,5,6))); // ilk değer ataması

----------7-----------

out var gibidir fakat sadece output olacağından ilk değer yollansa bile gözardı edilir.

procedure GetInfo(out Info: SomeRecordType);

----------8-----------

Dizi parametre ve boyutlu string parametre olarak kullanamasak da çözümü var.

procedure Check(S: string[20]); // syntax error, parametrede boyut belirtilemez!

Çözüm

type TString20 = string[20];

procedure Check(S: TString20);

----------9-----------

parametrede ilk değer atama

function MyFunction(X: Real = 3.5; Y: Real = 3.5): Real;

olabilir ama,

function MyFunction(X, Y: Real = 3.5): Real; // syntax error

----------10----------

var

Ch: Char;

asm

MOV CH, 1 //CH char değil cx'in üst byte'ı

end;

Çözüm

MOV &Ch, 1 //üzerine bindirme operatörü override operator &

----------11----------

Standard rutinler

Procedure or function Description

Addr= Returns a pointer to a specified object.

AllocMem= Allocates a memory block and initializes each byte to zero.

ArcTan= Calculates the arctangent of the given number.

Assert= Raises an exception if the passed expression does not evaluate to true.

Assigned= Tests for a nil (unassigned) pointer or procedural variable.

Beep= Generates a standard beep.

Break= Causes control to exit a for, while, or repeat statement.

ByteToCharIndex= Returns the position of the character containing a specified byte in a string.

Chr= Returns the character for a specified integer value.

Close= Closes a file.

CompareMem= Performs a binary comparison of two memory images.

CompareStr= Compares strings case sensitively.

CompareText= Compares strings by ordinal value and is not case sensitive.

Continue= Returns control to the next iteration of for, while, or repeat statements.

Copy= Returns a substring of a string or a segment of a dynamic array.

Cos= Calculates the cosine of an angle.

CurrToStr= Converts a currency variable to a string.

Dat=e Returns the current date.

DateTimeToStr= Converts a variable of type TDateTime to a string.

DateToStr= Converts a variable of type TDateTime to a string.

Dec= Decrements an ordinal variable or a typed pointer variable.

Dispose= Releases dynamically allocated variable memory.

ExceptAddr= Returns the address at which the current exception was raised.

Exit= Exits from the current procedure.

Exp= Calculates the exponential of X.

FillChar= Fills contiguous bytes with a specified value.

Finalize= Uninitializes a dynamically allocated variable.

FloatToStr= Converts a floating point value to a string.

FloatToStrF= Converts a floating point value to a string, using specified format.

FmtLoadStr= Returns formatted output using a resourced format string.

FmtStr= Assembles a formatted string from a series of arrays.

Format= Assembles a string from a format string and a series of arrays.

FormatDateTime= Formats a date-and-time value.

FormatFloat= Formats a floating point value.

FreeMem= Releases allocated memory.

GetMem= Allocates dynamic memory and a pointer to the address of the block.

Halt= Initiates abnormal termination of a program.

Hi= Returns the high-order byte of an expression as an unsigned value.

High= Returns the highest value in the range of a type, array, or string.

Inc= Increments an ordinal variable or a typed pointer variable.

Initialize= Initializes a dynamically allocated variable.

Insert= Inserts a substring at a specified point in a string.

Int= Returns the integer part of a real number.

IntToStr= Converts an integer to a string.

Length= Returns the length of a string or array.

Lo =Returns the low-order byte of an expression as an unsigned value.

Low =Returns the lowest value in the range of a type, array, or string.

LowerCase= Converts an ASCII string to lowercase.

MaxIntValue =Returns the largest signed value in an integer array.

MaxValue= Returns the largest signed value in an array.

MinIntValue =Returns the smallest signed value in an integer array.

MinValue= Returns smallest signed value in an array.

New =Creates a dynamic allocated variable memory and references it with a specified pointer.

Now= Returns the current date and time.

Ord =Returns the ordinal integer value of an ordinal-type expression.

Pos =Returns the index of the first single-byte character of a specified substring in a string.

Pred= Returns the predecessor of an ordinal value.

Ptr =Converts a value to a pointer.

Random =Generates random numbers within a specified range.

ReallocMem =Reallocates a dynamically allocatable memory.

Round= Returns the value of a real rounded to the nearest whole number.

SetLength= Sets the dynamic length of a string variable or array.

SetString= Sets the contents and length of the given string.

ShowException= Displays an exception message with its address.

ShowMessage= Displays a message box with an unformatted string and an OK button.

ShowMessageFmt= Displays a message box with a formatted string and an OK button.

Sin Returns= the sine of an angle in radians.

SizeOf =Returns the number of bytes occupied by a variable or type.

Sqr= Returns the square of a number.

Sqrt =Returns the square root of a number.

Str= Converts an integer or real number into a string.

StrToCurr= Converts a string to a currency value.

StrToDate= Converts a string to a date format (TDateTime).

StrToDateTime= Converts a string to a TDateTime.

StrToFloat= Converts a string to a floating-point value.

StrToInt= Converts a string to an integer.

StrToTime= Converts a string to a time format (TDateTime).

StrUpper= Returns an ASCII string in upper case.

Succ= Returns the successor of an ordinal value.

Sum =Returns the sum of the elements from an array.

Time= Returns the current time.

TimeToStr= Converts a variable of type TDateTime to a string.

Trunc =Truncates a real number to an integer.

UniqueString= Ensures that a string has only one reference. (The string may be copied to produce a single reference.)

UpCase= Converts a character to uppercase.

UpperCase= Returns a string in uppercase.

VarArrayCreate= Creates a variant array.

VarArrayDimCount= Returns number of dimensions of a variant array.

VarArrayHighBound= Returns high bound for a dimension in a variant array.

VarArrayLock= Locks a variant array and returns a pointer to the data.

VarArrayLowBound =Returns the low bound of a dimension in a variant array.

VarArrayOf =Creates and fills a one-dimensional variant array.

VarArrayRedim =Resizes a variant array.

VarArrayRef= Returns a reference to the passed variant array.

VarArrayUnlock= Unlocks a variant array.

VarAsType= Converts a variant to specified type.

VarCast= Converts a variant to a specified type, storing the result in a variable.

VarClear =Clears a variant.

VarCopy= Copies a variant.

VarToStr= Converts variant to string.

VarType =Returns type code of specified variant.

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

Mp3 id3 okuma

Function Mp3id(mp3file:string):string;

type

TID3Rec = packed record

Tag : array[0..2] of Char;

Title,

Artist,

Comment,

Album : array[0..29] of Char;

Year : array[0..3] of Char;

Genre : Byte;

end;

var

id3:Tid3rec;

fmp3: TFileStream;

title,artist:string;

begin

try

fmp3:=TFileStream.Create(mp3File, fmOpenRead);

fmp3.position:=fmp3.size-128;

fmp3.Read(ID3,SizeOf(ID3));

finally

fmp3.free;

end;

if id3.Tag<>'tag' then

begin

title:='Şarkı';

artist:='Şarkıcı'

end;

title:=id3.Title;

artist:=id3.Artist;

try

except

end;

result:=title+' - '+Artist;

end;

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

form üzerine yazı yazma kodu

Delphi2005 windows form application

USES 'satırına aşagıdaki kodu ekliyoruz'

system.drawing.text

button_click

var

yazi:graphics;

yazi_tipi:system.drawing.font;

stil:fontstyle;

renk:solidbrush;

koordinat:pointf;

font_ailesi:fontfamily;

Begin

yazi:=activeform.creategraphics;

font_ailesi:=fontfamily.create('VERDANA');

stil:=fontstyle.bold;'(italic,underline)gibi alternatiflerde olabilir'

yazi_tipi:=system.drawing.font.create(font_ailesi,12,stil);

renk:=solidbrush.create(color.blue);

koordinat:=pointf.create(20,20);{x,y degerleri}

yazi.drawstring:=('CAYLAKS',yazi_tipi,renk,kordinat);

END;

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

yürüyen yazı kodu

unit Unit2;

interface

uses

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

Dialogs, Borland.Vcl.ExtCtrls, System.ComponentModel, Borland.Vcl.StdCtrls;

type

TForm2 = class(TForm)

Edit1: TEdit;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.nfm}

procedure TForm2.FormCreate(Sender: TObject);

begin

edit1.Text:='YÜRÜYEN YAZI ';

timer1.Interval:=50;

timer1.Enabled:=true;

end;

procedure TForm2.Timer1Timer(Sender: TObject);

begin

edit1.Text:=string(edit1.Text).Substring(1)+

string(edit1.Text).Substring(0,1);

end;

end.

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

Daire çizimi

Arkadaş deneyin göreceksiniz 3600 yazan yere istediğiniz açıyı yaza bilirsiniz

fuatkilinc41@hotmail.com

procedure TForm1.Button1Click(Sender: TObject);

var

lf: TLogFont;

tf: TFont;

i: integer;

begin

with Form1.Canvas do

begin

Font.Name := 'Verdana';

Font.Size := 16;

tf := TFont.Create;

tf.Assign(Font);

GetObject(tf.Handle, sizeof(lf), @lf);

lf.lfOrientation := 1000;

end;

for i := 3600 downto 1 do

begin

lf.lfEscapement := i;

tf.Handle := CreateFontIndirect(lf);

Form1.Canvas.Font.Assign(tf);

Form1.Canvas.TextOut(200, Height div 2, 'Fuat');

end;

tf.Free;

end;

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

Mesajlarınızın panelini renkli yapın

function TCMessageDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; aColor: TColor = clInfoBk): Integer;

begin

with CreateMessageDialog(Msg, DlgType, Buttons) do

try

BorderIcons := [];

Color := aColor;

Result := ShowModal;

finally

Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if TCMessageDlg('Dikkat Uyarı!!!', mtWarning, [mbYes, mbNo], clRed) = mrYes then

TCMessageDlg('Tamam!', mtInformation, [mbOk], clAqua);

end;

fuatkilinc41@hotmail.com

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

Kaynak klasörü kontrol edip klasör varsa kaynak klasörü silip, kopyalayan kod...

//********************************************************************

//*********************FORMA 3 ADET EDIT KOYUN************************

//********************Adları EKAYNAK, EHEDEF, EPART olsun*************

//************************ GRDL **********************************

//********************************************************************

// Örnek EKAYNAK'a B:EXE, EPART'a C:, EHEDEF'e C:EXE yazabilirsiniz.

procedure TGuncellemeform.GuncelyapClick(Sender: TObject);

begin

Kaynak:=EKAYNAK.Text;

Hedef:=EHEDEF.Text;

Part:=EPART.Text;

//******************* KAYNAK DOSYA KONTROL EDİLİYOR. YOKSA CIKILIYOR*****

if not DirectoryExists(pchar(kaynak)) then begin

ShowMessage('Dizin bulunamadı');

application.Terminate;

end

else

//******************* HEDEF DOSYA VARSA SİLİNİYOR. KAYNAKTAN KOPYALANIYOR******

if deldir(PCHAR(Hedef))= true then begin

if CopyDir(PCHAR(KAYNAK), PCHAR(PART)) = true then

showmessage('Güncelleme Tamamlandı..');

application.Terminate;

end else

//******************* HEDEF DOSYA YOKSA KAYNAKTAN KOPYALANIYOR******

if deldir(PCHAR(Hedef))= false then

if CopyDir(PCHAR(KAYNAK), PCHAR(PART)) = true then

showmessage('Güncelleme Tamamlandı..');

application.Terminate;

end;

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

cxgrid best fit

GridView.OptionsBehavior.BestFitMaxRecordCount

cxGrid View.ApplyBestFit

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

Status bar Gauge tarih time num ins caps seviye renkli component

{******************************************************************************

* Sattus 1.2 Versiyonu Hüseyin Açıkel Tarafından Değiştirildi. *

* KritikMin-Max Seviye Eklendi Bu Değerlerde Sarı renk oluyor. *

* Renk Paleti Eklendi Seviye renklerini istediğiniz ayarda kullanın.. *

* clayhuseyin@msn.com *

*******************************************************************************}

unit Status;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls, Menus, Gauges;

type

TStatus = class(TCustomPanel)

private

FDate : Boolean;

FKeys : Boolean;

FTime : Boolean;

FResources : Boolean;

DateTimePanel : TPanel;

ResPanel : TPanel;

ResGauge : TGauge;

CapPanel : TPanel;

NumPanel : TPanel;

InsPanel : TPanel;

HelpPanel : TPanel;

UpdateWidth : Boolean;

FTimer : TTimer;

FCurValue : Longint;

FMinValue : Longint;

FMaxValue : Longint;

FKritikMinValue : Longint;

FKritikMaxValue : Longint;

FKritikRenk,FLimitRenk,FNormalRenk :Tcolor;

procedure SetMinValue(Value: Longint);

procedure SetMaxValue(Value: Longint);

procedure SetProgress(Value: Longint);

procedure SetKritikMin(Value: Longint);

procedure SetKritikMax(Value: Longint);

procedure Kritik_Renk(newvalue:Tcolor);

procedure Limit_Renk(newvalue:Tcolor);

procedure Normal_Renk(newvalue:Tcolor);

procedure SetDate(A: Boolean);

procedure SetKeys(A: Boolean);

procedure SetTime(A: Boolean);

procedure SetResources(A: Boolean);

procedure SetCaption(A: String);

Function GetCaption: String;

function GetPercentDone: Longint;

procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure SetupPanelFields(ThePanel: TPanel);

procedure SetupPanel(ThePanel: TPanel; WidthMask: String);

procedure UpdateStatusBar(Sender: TObject);

property PercentDone: Longint read GetPercentDone;

procedure AddProgress(Value: Longint);

procedure AddKritikMin(Value: Longint);

procedure AddKritikMax(Value: Longint);

published

property ShowDate: Boolean read FDate write SetDate default True;

property ShowKeys: Boolean read FKeys write SetKeys default True;

property ShowTime: Boolean read FTime write SetTime default True;

property ShowResources: Boolean read FResources write SetResources default True;

property Seviye: Longint read FCurValue write SetProgress;

property KritikMin : Longint read FKritikMinValue write SetKritikMin default 5;

property KritikMax : Longint read FKritikMaxValue write SetKritikMax default 10;

// property MinValue: Longint read FMinValue write SetMinValue default 0;

// property MaxValue: Longint read FMaxValue write SetMaxValue default 100;

property RenkKritik:Tcolor read FKritikRenk write Kritik_Renk;

property RenkLimit :Tcolor read FLimitRenk write Limit_Renk;

property RenkNormal:Tcolor read FNormalRenk write Normal_Renk;

property BevelInner;

property BevelOuter;

property BevelWidth;

property BorderStyle;

property BorderWidth;

property Caption: string read GetCaption write SetCaption;

property Color;

property Ctl3D;

property DragCursor;

property DragMode;

property Enabled;

property Font;

property ParentColor;

property ParentCtl3d;

property ParentFont;

property ParentShowHint;

property PopUpMenu;

property ShowHint;

property Visible;

end;

procedure Register;

implementation

uses Windows;

procedure Register;

begin

RegisterComponents('Additional', [TStatus]);

end;

procedure TStatus.SetupPanelFields(ThePanel: TPanel);

begin

with ThePanel do

begin

Alignment := taCenter;

Caption := '';

BevelInner := bvLowered;

BevelOuter := bvNone;

{Set all these true so they reflect the settings of the TStatus}

ParentColor := True;

ParentFont := True;

ParentCtl3D := True;

end;

procedure TStatus.SetupPanel(ThePanel: TPanel; WidthMask: String);

begin

SetupPanelFields(ThePanel);

with ThePanel do

begin

Width := Canvas.TextWidth(WidthMask);

Align := alRight;

end;

constructor TStatus.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

Parent := TWinControl(AOwner);

FTime := True;

FDate := True;

FKeys := True;

FResources := True;

FMinValue := 0;

FMaxValue := 100;

FCurValue := 0;

FKritikMinValue:=5;

FKritikMaxValue:=10;

RenkKritik:=clRed;

RenkLimit:=clYellow;

RenkNormal:=clLime;

{Force the status bar to be aligned bottom}

Align := alBottom;

Height := 35;

BevelInner := bvNone;

BevelOuter := bvRaised;

{When UpdateWidth is set TRUE, status bar will recalculate panel widths once}

UpdateWidth := True;

Locked := True;

TabOrder := 0;;

TabStop := False;

Font.Name := 'Arial';

Font.Size := 8;

{Create the panel that will hold the date & time}

DateTimePanel := TPanel.Create(Self);

DateTimePanel.Parent := Self;

SetupPanel(DateTimePanel,' 00/00/00 00:00:00 am ');

{Create the panel that will hold the resources graph}

ResPanel := TPanel.Create(Self);

ResPanel.Parent := Self;

SetupPanel(ResPanel,' ');

{Create the 2 Gauges that will reside within the Resource Panel}

ResGauge := TGauge.Create(Self);

ResGauge.Parent := ResPanel;

ResGauge.Align := alClient;

ResGauge.ParentFont := True;

ResGauge.BackColor := Color;

ResGauge.ForeColor := clLime;

ResGauge.BorderStyle := bsNone;

{Create the panel that will hold the CapsLock state}

CapPanel := TPanel.Create(Self);

CapPanel.Parent := Self;

SetupPanel(CapPanel,' Cap ');

{Create the panel that will hold the NumLock state}

NumPanel := TPanel.Create(Self);

NumPanel.Parent := Self;

SetupPanel(NumPanel,' Num ');

{Create the panel that will hold the Insert/Overwrite state}

InsPanel := TPanel.Create(Self);

InsPanel.Parent := Self;

SetupPanel(InsPanel,' Ins ');

{Create the panel that will hold the status text}

HelpPanel := TPanel.Create(Self);

HelpPanel.Parent := Self;

SetupPanelFields(HelpPanel);

{Have the help panel consume all remaining space}

HelpPanel.Align := alClient;

HelpPanel.Alignment := taLeftJustify;

{This is the timer that will update the status bar at regular intervals}

FTimer := TTimer.Create(Self);

If FTimer <> Nil then

begin

FTimer.OnTimer := UpdateStatusBar;

{Updates will occur twice a second}

FTimer.Interval := 500;

FTimer.Enabled := True;

end;

destructor TStatus.Destroy;

begin

FTimer.Free;

HelpPanel.Free;

InsPanel.Free;

NumPanel.Free;

CapPanel.Free;

ResGauge.Free;

ResPanel.Free;

DateTimePanel.Free;

inherited Destroy;

end;

procedure TStatus.SetDate(A: Boolean);

begin

FDate := A;

UpdateWidth := True;

end;

procedure TStatus.SetKeys(A: Boolean);

begin

FKeys := A;

UpdateWidth := True;

end;

procedure TStatus.SetTime(A: Boolean);

begin

FTime := A;

UpdateWidth := True;

end;

procedure TStatus.SetResources(A: Boolean);

begin

FResources := A;

UpdateWidth := True;

end;

{When we set or get the TStatus caption, it is affecting the HelpPanel

caption instead}

procedure TStatus.SetCaption(A: String);

begin

HelpPanel.Caption := ' '+A;

end;

function TStatus.GetCaption: String;

begin

GetCaption := HelpPanel.Caption;

end;

{This procedure sets the captions appropriately}

procedure TStatus.UpdateStatusBar(Sender: TObject);

begin

if ShowDate and ShowTime then

DateTimePanel.Caption := DateTimeToStr(Now)

else

if ShowDate and not ShowTime then

DateTimePanel.Caption := DateToStr(Date)

else

if not ShowDate and ShowTime then

DateTimePanel.Caption := TimeToStr(Time)

else

DateTimePanel.Caption := '';

if UpdateWidth then with DateTimePanel do

if ShowDate or ShowTime then

Width := Canvas.TextWidth(' '+Caption+' ')

else

Width := 0;

if ShowResources then

begin

// Yeni Düzenleme

// ResGauge.Progress := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);

ResGauge.Progress := FCurValue;

if ResGauge.Progress < FKritikMinValue then //kritik seviye alti

ResGauge.ForeColor := FKritikRenk

else

if (ResGauge.Progress >= FKritikMinValue) and (ResGauge.Progress <=FKritikMaxValue) Then //kritik seviyek

ResGauge.ForeColor :=FLimitRenk

else

ResGauge.ForeColor := FNormalRenk;//Kritik üstü normal

end;

if UpdateWidth then

if ShowResources then

ResPanel.Width := Canvas.TextWidth(' ')

else

ResPanel.Width := 0;

if ShowKeys then

begin

if (GetKeyState(vk_NumLock) and $01) <> 0 then

NumPanel.Caption := ' Num ' else NumPanel.Caption := '';

if (GetKeyState(vk_Capital) and $01) <> 0 then

CapPanel.Caption := ' Caps ' else CapPanel.Caption := '';

if (GetKeyState(vk_Insert) and $01) <> 0 then

InsPanel.Caption := ' Ins ' else InsPanel.Caption := '';

end;

if UpdateWidth then

if ShowKeys then

begin

NumPanel.Width := Canvas.TextWidth(' Num ');

InsPanel.Width := Canvas.TextWidth(' Ins ');

CapPanel.Width := Canvas.TextWidth(' Caps ');

end

else

begin

NumPanel.Width := 0;

InsPanel.Width := 0;

CapPanel.Width := 0;

end;

UpdateWidth := False;

end;

{This allows font changes to be detected so the panels will be adjusted}

procedure TStatus.CMFontChanged(var Message: TMessage);

begin

inherited;

UpdateWidth := True;

end;

procedure TStatus.Kritik_Renk(newvalue:Tcolor);

begin

FKritikRenk:=newvalue;

repaint;

end;

procedure TStatus.Limit_Renk(newvalue:Tcolor);

begin

FLimitRenk:=newvalue;

repaint;

end;

procedure TStatus.Normal_Renk(newvalue:Tcolor);

begin

FNormalRenk:=newvalue;

repaint;

end;

procedure TStatus.SetProgress(Value: Longint);

var

TempPercent: Longint;

begin

TempPercent := GetPercentDone; { remember where we were }

if Value < FMinValue then

Value := FMinValue

else if Value > FMaxValue then

Value := FMaxValue;

if FCurValue <> Value then

begin

FCurValue := Value;

if TempPercent <> GetPercentDone then { only refresh if percentage changed }

Refresh;

end;

procedure TStatus.SetKritikMin(Value: Longint);

var

TempPercent: Longint;

begin

TempPercent := GetPercentDone; { remember where we were }

if Value < FMinValue then

Value := FKritikMinValue

else if Value > FMaxValue then

Value := FKritikMaxValue

else if Value > FKritikMaxValue then

Value := FKritikMinValue;

if FKritikMinValue <> Value then

begin

FKritikMinValue := Value;

if TempPercent <> GetPercentDone then { only refresh if percentage changed }

Refresh;

end;

procedure TStatus.SetKritikMax(Value: Longint);

var

TempPercent: Longint;

begin

TempPercent := GetPercentDone; { remember where we were }

if Value < FMinValue then

Value := FKritikMinValue

else if Value > FMaxValue then

Value := FKritikMaxValue

else if Value < FKritikMinValue then

Value := FKritikMaxValue;

if FKritikMaxValue <> Value then

begin

FKritikMaxValue := Value;

if TempPercent <> GetPercentDone then { only refresh if percentage changed }

Refresh;

end;

procedure TStatus.AddProgress(Value: Longint);

begin

Seviye := FCurValue + Value;

Refresh;

end;

procedure TStatus.AddKritikMin(Value: Longint);

begin

KritikMin := FKritikMinValue + Value;

Refresh;

end;

procedure TStatus.AddKritikMax(Value: Longint);

begin

KritikMax := FKritikMaxValue + Value;

Refresh;

end;

function SolveForY(X, Z: Longint): Longint;

begin

if Z = 0 then Result := 0

else Result := Longint(Trunc( (X * 100.0) / Z ));

end;

function TStatus.GetPercentDone: Longint;

begin

Result := SolveForY(FCurValue - FMinValue, FMaxValue - FMinValue);

end;

procedure TStatus.SetMinValue(Value: Longint);

begin

if Value <> FMinValue then

begin

if Value > FMaxValue then

if not (csLoading in ComponentState) then

// raise EInvalidOperation.CreateFmt(SOutOfRange, [-MaxInt, FMaxValue - 1]);

FMinValue := Value;

if FCurValue < Value then FCurValue := Value;

Refresh;

end;

procedure TStatus.SetMaxValue(Value: Longint);

begin

if Value <> FMaxValue then

begin

if Value < FMinValue then

if not (csLoading in ComponentState) then

// raise EInvalidOperation.CreateFmt(SOutOfRange, [FMinValue + 1, MaxInt]);

FMaxValue := Value;

if FCurValue > Value then FCurValue := Value;

Refresh;

end;

end.

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