7 den cok olmaması lazım

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
professionalsnare
Üye
Mesajlar: 11
Kayıt: 31 Eki 2005 11:24
Konum: ankara
İletişim:

7 den cok olmaması lazım

Mesaj gönderen professionalsnare »

mrb
iki button ve bir edit kullanarak yapmaya calıstigim programda 0-100 arası tuttugum herhangi bir sayıyı en fazla yedi seferde bulması gerekiyor fakat asagı ya da yukarı sekilde yonlendirdigimde 7 den fazla sonuclar cıkıyor...bir turlu cıkamadım isin icinden.tşkkrler.
serkan
Üye
Mesajlar: 666
Kayıt: 10 Tem 2003 12:08
Konum: bursa

Mesaj gönderen serkan »

selam..
arama işlemi o kadar kolay olabilseydi sanırım SQL dilini yazanlar kullanırdı.SQL deki arama mantığı gibi dene istersen yani önce tuttuğun sayı 50 den büyükmü küçükmü ona bak diyelimki küçük 25 den büyükmü küçükmü ona bak diyelimki küçük 12 den büyükmü küçükmü ona bak diyelimki büyük o zaman 12 ile 25 arasını kontrol edersin buna benzer bişey yani..
kolay gelsin..
Kullanıcı avatarı
rsimsek
Admin
Mesajlar: 4482
Kayıt: 10 Haz 2003 01:48
Konum: İstanbul

Mesaj gönderen rsimsek »

@serkan'ın da anlatmaya çalıştığı gibi öncelik olası en büyük sayıyı ikiye bölüp tutulan sayı ile karşılaştırılır. Büyük ise önceki sayı (100) ile bölüm (50) toplanıp ortalama alınarak (75) tekrar karşılaştırılır. Diyelim tutulan sayı 85. Yine karşılaştırılır. Halen büyük ise bu sefer mevcut alt sınır (75) ile üst sınır (100) ortalaması alınarak karşılaştırmaya bu şekilde bulana kadar devam edilir :wink:
Bilgiyi paylaşarak artıralım! Hayatı kolaylaştıralım!!
professionalsnare
Üye
Mesajlar: 11
Kayıt: 31 Eki 2005 11:24
Konum: ankara
İletişim:

Mesaj gönderen professionalsnare »

tesekkurler ama bunları bir de kod seklinde gosterebilir myz?
Kullanıcı avatarı
rsimsek
Admin
Mesajlar: 4482
Kayıt: 10 Haz 2003 01:48
Konum: İstanbul

Mesaj gönderen rsimsek »

Doğrusu bulmaca-bilmece gibi kendini biraz zorlamadan şıppacıktan cevabı vermek doğru olmasa da, madem çok ısrar ettin verelim cevabı :wink: Gerçekten de maksimum yedi hamlede çözümü buluyor.

--Unit1.pas--

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, FlEdit;

type
  TForm1 = class(TForm)
    FloatEdit1: TFloatEdit;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    SpeedButton2: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  Ust, Alt, Ortalama, Hamle: integer;

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  if FloatEdit1.Value > 99 then
    ShowMessage('Sayı 0..99 arası olacak!!');
  Alt := 0;
  Ust := 100;
  Hamle := 1;
  Memo1.Lines.Clear;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

procedure B_Tree_Ara;
begin
  Ortalama := trunc((Ust + Alt) / 2);
  Memo1.Lines.Add(IntToStr(Hamle) + '.hamle,   Alt: ' + IntToStr(Alt) +
           ' - Üst: ' + IntToStr(Ust) + '  Ort-> ' + IntToStr(Ortalama));
  if Ortalama = round(FloatEdit1.Value) then
  begin
    Memo1.Lines.Add('-');
    Memo1.Lines.Add(IntToStr(Hamle) + ' hamlede buldum-> ' + IntToStr(Ortalama));
    exit;
  end;
  if trunc(FloatEdit1.Value) > Ortalama then
  begin
    Alt := Ortalama;
    Memo1.Text := trim(Memo1.Text) + '  büyük';
  end
  else
  begin
    Ust := Ortalama;
    Memo1.Text := trim(Memo1.Text) + '  küçük';
  end;
  inc(Hamle);
end;

begin
  Memo1.Lines.Clear;
  while (Ortalama <> round(FloatEdit1.Value)) and (Hamle < 100) do
    B_Tree_Ara;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Randomize;
  FloatEdit1.Value := Random(100);
end;

end.
--Unit1.dfm--

Kod: Tümünü seç

object Form1: TForm1
  Left = 430
  Top = 255
  BorderStyle = bsDialog
  Caption = '0..99 arası sayı bul'
  ClientHeight = 324
  ClientWidth = 279
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 32
    Width = 201
    Height = 16
    Caption = '0..99 arası bir sayı girin..'
    Font.Charset = TURKISH_CHARSET
    Font.Color = clMaroon
    Font.Height = -13
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object SpeedButton1: TSpeedButton
    Left = 136
    Top = 80
    Width = 105
    Height = 22
    Caption = '&Sayıyı bul'
    ParentShowHint = False
    ShowHint = False
    OnClick = SpeedButton1Click
  end
  object SpeedButton2: TSpeedButton
    Left = 16
    Top = 80
    Width = 49
    Height = 22
    Hint = 'rastgele sayı üret'
    Caption = '---->'
    ParentShowHint = False
    ShowHint = True
    OnClick = SpeedButton2Click
  end
  object FloatEdit1: TFloatEdit
    Left = 80
    Top = 80
    Width = 49
    Height = 21
    TabOrder = 0
    Text = '0'
    OnChange = FormShow
    Digits = 0
    Max = 99.000000000000000000
    ErrorMessage = '[No Text]'
    Alignment = taRightJustify
  end
  object Memo1: TMemo
    Left = 16
    Top = 128
    Width = 249
    Height = 177
    TabOrder = 1
  end
end
Bu da sayısal alanlar için kullandığım FloatEdit bileşeni için Fledit.pas. Onun yerine uygun çevrimi yaparak (StrToInt(Edit1.Text)) Edit1 dahi kullanabilirsin.

Kod: Tümünü seç

unit FlEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFloatEdit = class(TEdit)
  private
    { Private-Deklarationen }
    FDigits : byte;
    FMin,FMax    : extended;
    fdec         : char;
    Fertext      : string;
    foldval      : extended;
    falignment   : talignment;
    fonenterpress : tkeypressevent;
  protected
    { Protected-Deklarationen }
    procedure CreateParams(var Params:TCreateParams); override;
    procedure setvalue(Newvalue : extended);
    procedure setmin(Newvalue : extended);
    procedure setmax(Newvalue : extended);
    procedure setdigits(Newvalue : byte);
    function getvalue : extended;
    procedure KeyPress(var Key: Char); override;
    procedure doexit;override;
    procedure doEnter;override;
    procedure SetAlignment(Value:TAlignment);
  public
    { Public-Deklarationen }
  published
    { Published-Deklarationen }
    property OnEnterPress : tkeypressevent read fonenterpress write fonenterpress;
    property Digits   : byte read FDigits write setDigits;
    property Value    : extended read getvalue write setValue;
    property Min : extended read Fmin write setMin;
    property Max : extended read Fmax write setmax;
    property ErrorMessage :string read fertext write fertext;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    constructor create (aowner : TComponent);override;
  end;

procedure Register;
const
  notext = '[No Text]';

implementation

constructor TFloatEdit.create (aowner : TComponent);
begin
  inherited create(aowner);
  falignment := tarightjustify;
  fdec := decimalseparator;
  fdigits := 0;
  fmin := 0;
  fmax := 99999999;
  fertext := notext;
  setvalue(0.0);
end;

procedure TfloatEdit.SetAlignment(Value:TAlignment);
begin
  if FAlignment<>Value then
  begin
    FAlignment:=Value;
    RecreateWnd;
  end;
end;

procedure tfloatedit.CreateParams(var Params:TCreateParams);
const
  Alignments: array[TAlignment] of Longint=(ES_LEFT,ES_RIGHT,ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or es_multiline or Alignments[FAlignment];
end;

procedure tfloatedit.doenter;
begin
  foldval:=getvalue;
  inherited;
end;

procedure TFloatedit.doexit;
var
  ts: string;
  result: extended;
begin
  ts := text;
  inherited;
  try
    result := strtofloat(ts);
  except
    if fertext <> notext then
      showmessage(fertext);
    setvalue(foldval);
    selectall; setfocus;
    exit;
  end;
  if (result < fmin) or (result > fmax) then
  begin
    if fertext <> notext then
      showmessage(fertext);
    setvalue(foldval);
    selectall; setfocus;
    exit;
  end;
  // Ausgabe formatieren
  text:= floattostrf(result,fffixed,18,fdigits);
  value:= strtofloat(text);
  inherited;
end;

procedure TFloatedit.setvalue(Newvalue : extended);
var
  tmp: string;
begin
  if newvalue > fmax then
  begin
    if fertext <> notext then
      showmessage(fertext);
    newvalue := fmax;
  end;
  if newvalue < fmin then
  begin
    if fertext <> notext then
      showmessage(fertext);
    newvalue := fmin;
  end;
  tmp:= floattostrf(newvalue,fffixed,18,fdigits);
  text:= tmp;
end;

function TFloatedit.getvalue : extended;
var
  ts: string;
begin
  ts := text;
  if (ts = '-') or (ts = fdec) or (ts = '') then ts := '0';
  try
    result := strtofloat(ts);
  except
    //if fertext <> notext then showmessage(fertext);
    result := fmin;
  end;
  if result < fmin then
  begin
    //if fertext <> notext then showmessage(fertext);
    result := fmin;
  end;
  if result > fmax then
  begin
    //if fertext <> notext then showmessage(fertext);
    result := fmax;
  end;
end;

procedure TFloatedit.setdigits;
begin
  if fdigits <> newValue then
  begin
    if newvalue > 18 then
      newvalue := 18;
    fdigits := newvalue;
    setvalue(getvalue);
  end;
end;

procedure TFloatedit.setmin;
begin
  if fmin <> newValue then
  begin
    if fmin > fmax then
    begin
      showmessage('Min-Value has to be less than or equal to Max-Value !');
      newvalue := fmax;
    end;
    fmin := newvalue;
    setvalue(getvalue);
  end;
end;

procedure TFloatedit.setmax;
begin
  if fmax <> newValue then
  begin
    if fmin > fmax then
    begin
      showmessage('Max-Value has to be greater than or equal to Min-Value !');
      newvalue := fmin;
    end;
    fmax := newvalue;
    setvalue(getvalue);
  end;
end;

procedure TFloatedit.keypress;
var
  ts: string;
  result: extended;
begin
  if (key = #13) or (key = #10) then
  begin
    key := #0;
    if assigned(fonenterpress) then
      fonenterpress(self,key);
  end;
  if key = #27 then
  begin
    setvalue(foldval);
    selectall;
    inherited;
    exit;
  end;
  if key < #32 then
  begin
    inherited;
    exit;
  end;
  ts := copy(text,1,selstart)+copy(text,selstart+sellength+1,500);
  if (key <'0') or (key > '9') then if (key <> fdec) and (key <> '-') then
  begin
    inherited;
    key := #0; exit;
  end;
  if key = fdec then if pos(fdec,ts) <> 0 then
  begin
    inherited;
    key := #0; exit;
  end;
  if key = '-' then if pos('-',ts) <> 0 then
  begin
    inherited;
    key := #0; exit;
  end;
  if key = '-' then if fmin >= 0 then
  begin
    inherited;
    key := #0; exit;
  end;
  if key = fdec then if fdigits = 0 then
  begin
    inherited;
    key := #0; exit;
  end;
  // seltext durch key ersetzen
  ts := copy(text,1,selstart)+key+copy(text,selstart+sellength+1,500);
  // Überprüfen, ob gültiger wert;
  if key > #32 then if pos(fdec,ts)<> 0 then
  begin
    if length(ts)-pos(fdec,ts) > fdigits then
    begin
      inherited;
      key := #0; exit;
    end;
  end;
  if key = '-' then if pos('-',ts) <> 1 then
  begin
    inherited;
    key := #0; exit;
  end;
  if ts ='' then
  begin
    inherited;
    key := #0;
    text := floattostrf(fmin,fffixed,18,fdigits);
    selectall; exit;
  end;
  if ts = '-' then
  begin
    inherited;
    key := #0;
    text := '-0'; selstart := 1; sellength:=1;
    exit;
  end;
  if ts = fdec then
  begin
    inherited;key:=#0;
    text := '0'+fdec+'0';
    selstart := 2;
    sellength := 1; exit;
  end;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('Toplama', [TFloatEdit]);
end;

end.
Bilgiyi paylaşarak artıralım! Hayatı kolaylaştıralım!!
professionalsnare
Üye
Mesajlar: 11
Kayıt: 31 Eki 2005 11:24
Konum: ankara
İletişim:

Mesaj gönderen professionalsnare »

cok cok tesekkur ederim sabahtan beri bilgisayar basındayım ama bir hafta ugrassam yapamazdım cok cok saolun... :)
Kullanıcı avatarı
rsimsek
Admin
Mesajlar: 4482
Kayıt: 10 Haz 2003 01:48
Konum: İstanbul

Mesaj gönderen rsimsek »

Önemli değil. Nasıl yapılacağına karar verip yöntemi tespit ettikten sonra bilgisayar diline dökmesi inan büyüttüğün kadar zor değil :wink:
Umarım işine yarar.
Bilgiyi paylaşarak artıralım! Hayatı kolaylaştıralım!!
professionalsnare
Üye
Mesajlar: 11
Kayıt: 31 Eki 2005 11:24
Konum: ankara
İletişim:

Mesaj gönderen professionalsnare »

yalnız bir sorun var floatedit1 bulunamadı gibi bir hata veriyor...
daha dogrusu nasıl kullanabilirm kodu nereye yazmalıyım yeni bir imge sanırım...
Kullanıcı avatarı
rsimsek
Admin
Mesajlar: 4482
Kayıt: 10 Haz 2003 01:48
Konum: İstanbul

Mesaj gönderen rsimsek »

Zaten bulamıyacağını tahmin ederek onun kaynak kodunu da mesajın altında vermiştim. Sanırım farketmedin. Sana düşen onu bir bileşen gibi eklemen.. kısaca; Delphi IDE den Component / Install Component.. -> Into new package .. tab ı. Package file name e Bilesenlerim deyip, unit file name e de yukarıdaki fledit.pas ı File / New -> Unit den seç/kopyala/yapıştır yaparak fledit.pas şeklinde, Tools / Environment -> Library deki tanımlı dizinlerin herhangi birine en doğrusu kendine D:\DCL diye bir klasör açıp oraya fledit.pas ı kopyalaman ve bunu Library ye D:\DCL diye eklemen yeterli. Bu işlemleri Install Component.. işlemine başlamadan önce yapmalısın.. fledit.pas ı seçtikten sonra çıkan formdan compile ve install tuşlarına basman yeterli.. Bu işlemlerden sonra bileşenler arasında Toplama başlığı altında FloatEdit bileşenini görmen gerekir :wink:
Bilgiyi paylaşarak artıralım! Hayatı kolaylaştıralım!!
professionalsnare
Üye
Mesajlar: 11
Kayıt: 31 Eki 2005 11:24
Konum: ankara
İletişim:

Mesaj gönderen professionalsnare »

hata veriyor ve anlamadım fledit.pas i yuklemem karsin hala aynı hatayı veriyor...[Fatal Error] Project1.dpr(1): Unit not found: 'System.pas' or binary equivalents (DCU,DPU) gibi bir hata mesajı geciyor...

Kod: Tümünü seç

program Project1;

uses
  Forms,
  Unit1 in '..\..\..\..\Documents and Settings\Pro\Belgelerim\Yeni Ödevler\3\Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
fduman
Moderator
Mesajlar: 2749
Kayıt: 17 Ara 2004 12:02
Konum: Ankara

Mesaj gönderen fduman »

professionalsnare yazdı:

Kod: Tümünü seç

uses
  Forms,
  Unit1 in '..\..\..\..\Documents and Settings\Pro\Belgelerim\Yeni Ödevler\3\Unit1.pas' {Form1};
Recep abi bu arkadaşın ödeviymiş bakar mısın? :) Kendisi yapsa daha iyi değil mi?
Kullanıcı avatarı
rsimsek
Admin
Mesajlar: 4482
Kayıt: 10 Haz 2003 01:48
Konum: İstanbul

Mesaj gönderen rsimsek »

coderlord yazdı:..
Recep abi bu arkadaşın ödeviymiş bakar mısın? :) Kendisi yapsa daha iyi değil mi?
Furkan kardeş ben de söyledim ama ısrar edince yazdım bir kere :roll:
Bilgiyi paylaşarak artıralım! Hayatı kolaylaştıralım!!
Cevapla