Hangi ay kaç gün Çeker

Aug 30,2008 00:00 by RubeNiS

Bu örneği mesala
Müşteri kaydında 10 taksit yapacaksınız
kullanıcı başlangıç tarihini seçtiğinden itibaren döngüye sokarak taksitlendirme işi yapabilirsiniz.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Lb1: TListBox;
    cb1: TComboBox;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure cb1Enter(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  AyGrubu = Set Of Byte;

var
  Form1: TForm1;

Const
  gun31 : Array  [1..7] of Byte =(1,3,5,7,8,10,12);

  gun30 : Array [1..4 ] of Byte =(4,6,9,11);

  gun28 : Array [1..1 ] of Byte =(2);

Const

  AyIsimList : Array[1..12] of String =
  ('OCAK','ŞUBAT','MART','NİSAN','MAYIS','HAZİRAN','TEMMUZ','AĞUSTOS','EYLÜL','EKİM','KASIM','ARALIK');

implementation

{$R *.dfm}

function GunDonder (Ay:byte):byte;
var
i:integer;
begin

{ for i:= 1 to 7 do
   begin
        if ay = gun31[i] then

   end;
    result:= 31;
    exit;
    }

     i:= 0 ;
   // While- do döngüsü ile de çalışmaktadır ..
   // While i >=0 do
   Repeat
    begin
       inc(i);
       if ay  = gun31[i] then
         begin
            result := 31;
            break;
         end else
            begin
           if ay  = gun30[i] then
         begin
              result := 30;
              break;
         end else
         begin
            if ay  = gun28[i] then
         begin
              result := 28;
              break;
         end;
        Continue ;
     end;
    end;

   end;
      until i= 12 ;
   end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:byte;
begin

try
a:=  gundonder (StrToInt (cb1.text) );
  edit2.text := inttostr(a);
  except
     if cb1.text = " then
     begin
     ShowMessage('değer giriniz') ;
     cb1.SetFocus ;
     exit;
     end;
     end;

end;

Function KacGun (Ay:Byte):Byte;

var
gun30x:AyGrubu ;
gun31x:AyGrubu;
gun28x:AyGrubu ;
   begin
   gun30x := [4,6,9,11];
   gun31x := [1,3,5,7,8,10,12];
   gun28x := [2];

    if Ay in gun30x then
                    Result := 30;
    if Ay in gun31x then
                    Result := 31;
    if Ay in gun28x then
                    Result := 28;

end;

procedure TForm1.Button2Click(Sender: TObject);

var
a:byte;
begin

try
a:=  KacGun (StrToInt (cb1.text) );
  edit2.text := inttostr(a);
  except
     if cb1.text = " then
     begin
       ShowMessage('değer giriniz') ;
       cb1.SetFocus ;
       exit;
     end;
     end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
j :integer;
begin

   for j:=1 to 12  do
     begin
          Lb1.Items.Add(inttostr(j)+' '+AyIsimList[j]+' Ayı : '+inttostr(KacGun(j)) +' gün çeker');
    end;
end;

procedure TForm1.cb1Enter(Sender: TObject);
begin
edit2.Text :=";
end;

end.