Dostum Ben ÇÖzdÜm Olayi Artik 0.00 Şeklİnde Alabİlİyorum Ama Yİne Bİr Problem OluŞtu Adet Lerde 0.00 Şeklİnde Çikti ÜrÜn 1 Tane İse 1.00 Çikiyor Adte Ve Fiyat "real" TanimlanmiŞ Ve Pascalda R:0:0 Ibaresİ Var Onu R:0:2 Yaptim KuruŞ Hanesİ AÇti Adet De 0.00 Çikti Ama Olmasada BÖle İdere Edİcez Napalim Yinede SaĞol

evet yaptım BAKİYE kısmında örneğin : 1 tane ise 1.00 çıkıyor problemim bu yanlış olmasın var EtaF : File of EtaRectyp; EtaRec : etaRectyp; Kod1, Kod2 : String ; Adet : integer; Top, topBakiye : real; doviz : string ; class : string ; arabakiye, araTutar : real; Status : integer; etaLast, etaref : longint; Nfiyat : integer; etaValid : boolean; SirketIsim : string ;

Xafer demiş ki: hata verdi bu kodu yazınca ama bunun bir unit kodu var sanırım tüm iş onda bitior TSTOK. PAS aşaşıda sunuyorum unit Tstok; interface uses crt, dos, objects, sirket; Const Nkod = 2; Ncins = 40; Naciklama1 = 70; Naciklama2 = 85; NFiyat1 = 100; NFiyat2 = 108; Nfiyat3 = 116; NFiyat4 = 124; Nfiyat5 = 132; NBakiye = 412; Nbirim1 = 439; Nbirim2 = 444; Nartigen : integer = -1; Lartigen : integer = 0; type EtaRecTyp = array of char; var EtaF : File of EtaRectyp; EtaRec : etaRectyp; Kod1, Kod2 : String ; Adet : word; Top, topBakiye : real; doviz : string ; class : string ; arabakiye, araTutar : real; Status : integer; etaLast, etaref : longint; Nfiyat : integer; etaValid : boolean; SirketIsim : string ; Type StokColl = object function compare(k1, k2 : pointer):integer;virtual; end; ArtColl = object function compare(k1, k2 : pointer):integer;virtual; end; PstokRec = ^StokRec; StokRec = Record Kod : String ; Cins : String ; Artigen : String ; Bakiye : real; Fiyat : real; end; Procedure Error ; procedure Kontrol; Function Num :String; Procedure Creal ; Procedure Cstr ; Procedure OpenEta; function getFiyatNo : integer; procedure getAralik; function readeta : boolean; Function Art : Boolean; function artigenNo : integer; procedure closeEta; var Stoklar : StokColl; Artigens : ArtColl; implementation function StokColl.compare; begin if PstokRec(k1)^. Kod > PstokRec(k2)^. Kod then compare := 1 else if PstokRec(k1)^. Kod < PstokRec(k2)^. Kod then compare := -1 else compare := 0; end; function ArtColl.compare; begin if PstokRec(k1)^. artigen > PstokRec(k2)^. artigen then compare := 1 else if PstokRec(k1)^. artigen < PstokRec(k2)^. artigen then compare := -1 else compare := 0; end; Procedure Error ; begin writeln; writeLn(

kod üzerinde değiştirmem gerek yerleri söylersen sevinirim hiç bilmiyorum ben yazmadım bunu

: exit; '1' : begin NArtigen := Naciklama1;Lartigen := 15;end; '2' : begin NArtigen := Nbirim1;Lartigen := 5;end; '3' : begin NArtigen := Nbirim2;Lartigen := 5;end; '4' : Nartigen := -1; end; Case C of '1' : SirketIsim := 'Migros'; '2' : SirketIsim := 'PasaBahce'; '3' : SirketIsim := 'Metro'; '4' : SirketIsim := 'Ordu'; end; artigenNo := Nartigen; end; end. Hepsini görmek için tıklayın... BU KODUN TPU SUNU NASIL YARATABİLİRİM

ah be kardeşim bende bilmiyorum azcık anlasam dağıtırdım zaten

(Srec. Bakiye <> 0.0) then begin new ; o direk tek hane görüyo yani sen burda yuvarlatmayı hesaplamıyıp sadece 1 hane vermişsin oda bir hane görüyo vede sonrakini direk yuvarlıyo bakiyen 10,0 olsa nasıl olcak bence burda hatan var. Programı çalıştırma imkanım yok çünkü pascal fdisk atınca gitmişti bidahada kurmadım ama dediğimi bi yap

adet:0:0 yaptığımda error 89 veriyor

dediğimi yaptın mı?

pascal hiç bilmiyorum sadece kodu okumaya çalıştım ve adet değerinin tam sayı olduğunu gördüm. biraz bilseydim yardım ederdim.

pascal bilmem ama değişken türü dönüşümünde bi hatan olabilir adet sayısını reel sayı olarak tut reel/reel bölme yap

çok yardım edemedim gerçi sen olayı kendin çözdün

Arkadaşlar aşağıda verdiğim kod ETA stok dosyasından bilgileri alarak ALTTOPLAM lı olarak döküm yapıyor tl de iken sorun yoktu fakat ytl ye geçince kuruş hanesini göstermiyor ve rakamı yuvarlıyor bunu düzeltmenin bir yolu varsa lütfen yardımcı olurmusunuz ÇIKTISI VE KOD U VERİYORUM STOK DEGERLEME RAPORU KOD CINSI BAKIYE FIYAT STOK DEGERI FIRNA B1-12AD-S SARI BUZLU LIMONATA BARDAGI 1 1 1 FIRNA B1-12AD-Y YESIL BUZLU LIMONATA BARDAGI 4 1 5 FIRNA B1-12AP-I ISTIRIDYELI LIMONATA BARDAGI 634 1 431 FIRNA B1-12AP-Y YILDIZLI LIMONATA BARDAGI 6 1 4 FIRNA B1-12APC-M MAVI KALIN CIZGILI UZUN BARDAK 4 1 4 FIRNA B1-12APC-P PEMBE KALIN CIZGILI UZUN BARDA 2 1 2 FIRNA B1-12APC-S SARI KALIN CIZGILI UZUN BARDAK -1 1 -1 FIRNA B1-12APC-Y YESIL KALIN CIZGILI UZUN BARDA 204 1 186 FIRNA B1-9BBGFSC ISTIRIDYELI JEL MUM 15 11 169 FIRNA H1-J13AF JAR KUCUK KOSELI KAVANOZ 59 2 106 FIRNA H1-J21AF JAR ORTA BOY KOSELI KAVANOZ 4 2 8 FIRNA H1-J29AF JAR BUYUK BOY KOSELI KAVANOZ 533 2 1 221 FIRNA M8-13AF BIRA BARDAGI 3 098 2 4 895 FIRNA P42-10AF SU BARDAGI 3 0 1 FIRNA P6-14AP-B BEYAZ INCE CIZGILI UZUN BARDAK 371 1 338 FIRNA P6-14AP-M MAVI INCE CIZGILI UZUN BARDAK 1 1 1 FIRNA P6-14AP-S SARI INCE CIZGILI UZUN BARDAK -14 1 -13 FIRNA P6-14APY YESIL YAPRAKLI UZUN BARDAK 1 342 1 1 221 Ara Toplam : 6 266 8 578 Toplam 6 266 8 578 LISTELENEN : 18 ADET uses crt, dos, objects, Tstok, sirket; Procedure Convert ; begin with Srec do begin Cstr(etaRec ,20, Kod); Cstr(etaRec ,30, Cins); Creal ; Creal ; end; end; Function Giris : Boolean; var C : char; begin writeln; giris := false; getSirket; if getfiyatNo = -1 then exit; writeLn; getAralik; giris := true; end; Procedure TransFer; var Srec : StokRec; P : PStokRec; begin if not Giris then exit; OpenEta; while readEta do begin if etaValid then begin Convert ; if (Srec. Kod >= Kod1) and (Srec. Kod <= Kod2) and (Srec. Bakiye <> 0.0) then begin new ; P^ := Srec; Stoklar. insert ; end; end; end; closeeta; end; Procedure Rapor ; var Txt : Text; ref : Longint; Key : String ; Okey : boolean; Count : Integer; tutar : real; Procedure disp ; begin S := copy(S,1, Len); write(Txt, S,'':Len - Length ; end; procedure AltCizgi; begin disp('',20); disp('',30); disp('',16); disp('',16); disp('',16); writeln ; inc ; end; Procedure Baslik; begin writeLn ; writeLn ; writeLn ; writeln ; disp('KOD',20); disp('CINSI',30); disp(' BAKIYE',16); disp(' FIYAT',16); disp(' STOK DEGERI',16); writeln ; altcizgi; Count := 6; end; procedure Alt; var I : integer; begin For I := count + 1 to 66 do writeln ; end; procedure AraToplam; begin writeln ; inc ; if Count = 58 then begin Alt;Baslik;end; Disp('',20); disp('Ara Toplam :',30); write(Txt, num(araBakiye,16)); write(txt,'':16); writeLn(Txt, num(araTutar,16)); inc ; araTutar := 0.0; arabakiye := 0.0; if Count = 58 then begin Alt;Baslik;end; writeln ; inc ; if Count = 58 then begin Alt;Baslik;end; end; var I : integer; sp : PstokRec; araTc : integer; begin araTc := -1; Adet := 0; topBakiye := 0.0; top := 0.0; assign ; rewrite ; if IoResult <> 0 then Error ; Baslik; araTutar := 0.0; arabakiye := 0.0; class := ''; for I := 0 to stoklar. count - 1 do begin Sp := Stoklar. at ; with sp^ do begin if class = '' then class := copy(Kod,1,4); if (class <> copy(kod,1,4)) then begin araTc := Stoklar. count; araToplam; class := copy(Kod,1,4); end; Disp(Kod,20); disp(Cins,30); write(txt, num(Bakiye,16)); write(txt, num(Fiyat,16)); Tutar := Bakiye Fiyat; araTutar := araTutar + Tutar; araBakiye := araBakiye + Bakiye; writeLn(Txt, num(Tutar,16)); Top := Top + tutar; topBakiye := TopBakiye + Bakiye; inc ; inc ; if Count = 58 then begin Alt;Baslik;end; if (I = stoklar. count - 1) and then begin araTc := Stoklar. count; araToplam; end; end; end; if count > 6 then begin writeLn ; inc ; altCizgi; Disp('',20); disp(' Toplam',30); write(txt, Num(TopBakiye,16)); disp('',16); writeLn(Txt, Num(top,16)); writeln ; inc ; writeln ; inc ; Alt; end; Close ; end; begin Transfer; Rapor('LPT1'); end. -

Adet : word; satırı var yukarlarda. onu Adet : integer; olarak dene.

en alttaki writeln ; satırını writeln(txt,' LISTELENEN : ', Adet:0:0,' ADET'); yaparsan küsürat göstermez. başka sorunun varsa yardımcı olmaya çalışayım.

: exit; '1' : begin NArtigen := Naciklama1;Lartigen := 15;end; '2' : begin NArtigen := Nbirim1;Lartigen := 5;end; '3' : begin NArtigen := Nbirim2;Lartigen := 5;end; '4' : Nartigen := -1; end; Case C of '1' : SirketIsim := 'Migros'; '2' : SirketIsim := 'PasaBahce'; '3' : SirketIsim := 'Metro'; '4' : SirketIsim := 'Ordu'; end; artigenNo := Nartigen; end; end.

hata verdi bu kodu yazınca ama bunun bir unit kodu var sanırım tüm iş onda bitior TSTOK. PAS aşaşıda sunuyorum unit Tstok; interface uses crt, dos, objects, sirket; Const Nkod = 2; Ncins = 40; Naciklama1 = 70; Naciklama2 = 85; NFiyat1 = 100; NFiyat2 = 108; Nfiyat3 = 116; NFiyat4 = 124; Nfiyat5 = 132; NBakiye = 412; Nbirim1 = 439; Nbirim2 = 444; Nartigen : integer = -1; Lartigen : integer = 0; type EtaRecTyp = array of char; var EtaF : File of EtaRectyp; EtaRec : etaRectyp; Kod1, Kod2 : String ; Adet : word; Top, topBakiye : real; doviz : string ; class : string ; arabakiye, araTutar : real; Status : integer; etaLast, etaref : longint; Nfiyat : integer; etaValid : boolean; SirketIsim : string ; Type StokColl = object function compare(k1, k2 : pointer):integer;virtual; end; ArtColl = object function compare(k1, k2 : pointer):integer;virtual; end; PstokRec = ^StokRec; StokRec = Record Kod : String ; Cins : String ; Artigen : String ; Bakiye : real; Fiyat : real; end; Procedure Error ; procedure Kontrol; Function Num :String; Procedure Creal ; Procedure Cstr ; Procedure OpenEta; function getFiyatNo : integer; procedure getAralik; function readeta : boolean; Function Art : Boolean; function artigenNo : integer; procedure closeEta; var Stoklar : StokColl; Artigens : ArtColl; implementation function StokColl.compare; begin if PstokRec(k1)^. Kod > PstokRec(k2)^. Kod then compare := 1 else if PstokRec(k1)^. Kod < PstokRec(k2)^. Kod then compare := -1 else compare := 0; end; function ArtColl.compare; begin if PstokRec(k1)^. artigen > PstokRec(k2)^. artigen then compare := 1 else if PstokRec(k1)^. artigen < PstokRec(k2)^. artigen then compare := -1 else compare := 0; end; Procedure Error ; begin writeln; writeLn(

bütün programı inceleyemiom üzgünüm vaktim yok. çıktı komutun bu dimi writeln ; eğer buraysa writeln(txt,' LISTELENEN : ', Adet:0:0,' ADET'); yapman lazım adet değişkenide integer yada real falan olması lazım. bu şekilde sorunun çözülmesi gerekio. bakiye falan demişsin. bakiye yazdırırken sorun varsa write(txt, Num(TopBakiye,16)); gibi satırlar gördüm programda write(txt, Num(TopBakiye:0:0,16)); dene diicem. pek tutarmı bu bilemem

integer yaptınmı dediim gibi?

: exit; '1' : Nfiyat := Nfiyat1; '2' : Nfiyat := Nfiyat2; '3' : Nfiyat := Nfiyat3; '4' : Nfiyat := Nfiyat4; '5' : Nfiyat := Nfiyat5; end; getFiyatNo := Nfiyat; end; procedure getAralik; begin writeln; write ; readln(Kod1); write ; readln(Kod2); if Kod2 = '' then Kod2 :=