Облік прибутку на виробничому підприємстві

if(IBDataSet3.Fields[8].Value=null) then

ShowMessage('Введіть кор.рахунок!') else

if(IBDataSet3.Fields[9].Value=null) then

ShowMessage('Введіть кредит!') else

begin

IBDataSet3.ApplyUpdates;

Button2.Enabled:=false;

Button3.Enabled:=false;

IBDataSet3.Active:=false;

end;

end; 

procedure Tadd_vup.FormCreate(Sender: TObject);

begin

IBDataSet1.Close;

IBDataSet1.Open;

IBDataSet2.Close;

IBDataSet2.Open;

IBDataSet3.Close;

IBDataSet3.Open;

IBDataSet1.Active:=True;

IBDataSet2.Active:=True;

IBDataSet3.Active:=False;

DateTimePicker1.DateTime:=now;

Button2.Enabled:=false;

Button3.Enabled:=false;

end; 

end. 

unit Order; 

interface 

uses

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

  Dialogs, StdCtrls, DB, IBCustomDataSet, Grids, DBGridEh, FR_DSet,

  FR_DBSet, FR_Class, ComCtrls; 

type

  TPruh_order = class(TForm)

    DBGridEh1: TDBGridEh;

    IBDataSet1: TIBDataSet;

    DataSource1: TDataSource;

    IBDataSet1KOD: TIntegerField;

    IBDataSet1NOMER_ORDERA: TIntegerField;

    IBDataSet1DATA_SOSTAV: TDateField;

    IBDataSet1KREDIT: TIntegerField;

    IBDataSet1SUMMA: TIBBCDField;

    IBDataSet1PRINATO_OT: TIBStringField;

    IBDataSet1OSNOVANIE: TIBStringField;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    Label1: TLabel;

    frReport1: TfrReport;

    frDBDataSet1: TfrDBDataSet;

    Button5: TButton;

    DateTimePicker1: TDateTimePicker;

    Label2: TLabel;

    Button6: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Button5Click(Sender: TObject);

    procedure frReport1UserFunction(const Name: String; p1, p2,

      p3: Variant; var Val: Variant);

    procedure IBDataSet1FilterRecord(DataSet: TDataSet;

      var Accept: Boolean);

    procedure Button6Click(Sender: TObject);

    procedure DateTimePicker1Change(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end; 

var

  Pruh_order: TPruh_order; 

implementation 

{$R *.dfm}

uses MainForm,add_order; 

function Propis(Value: int64): string;

var

  Rend: boolean;

  ValueTemp, ValueOst: int64; 

  procedure Num(Value: byte);

  begin

    case Value of

      1: if Rend = true then Result := Result + 'один ' else Result := Result + 'одна ';

      2: if Rend = true then Result := Result + 'два ' else Result := Result + 'дві ';

      3: Result := Result + 'три ';

      4: Result := Result + 'чотири ';

      5: Result := Result + 'п`ять ';

      6: Result := Result + 'шість ';

      7: Result := Result + 'сім ';

      8: Result := Result + 'вісім ';

      9: Result := Result + 'дев`ять ';

      10: Result := Result + 'десять ';

      11: Result := Result + 'одиннадцать ';

      12: Result := Result + 'дванадцать ';

      13: Result := Result + 'тринадцать ';

      14: Result := Result + 'чотирнадцать ';

      15: Result := Result + 'п`ятнадцать ';

      16: Result := Result + 'шістнадцать ';

      17: Result := Result + 'сімнадцать ';

      18: Result := Result + 'вісімнадцать ';

      19: Result := Result + 'дев`ятнадцать ';

    end

  end; 

  procedure Num10(Value: byte);

  begin

    case Value of

      2: Result := Result + 'двадцать ';

      3: Result := Result + 'тридцать ';

      4: Result := Result + 'сорок ';

      5: Result := Result + 'п`ятьдесят ';

      6: Result := Result + 'шістьдесят ';

      7: Result := Result + 'сімдесят ';

      8: Result := Result + 'вісімдесят ';

      9: Result := Result + 'дев`яносто ';

    end;

  end; 

  procedure Num100(Value: byte);

  begin

    case Value of

      1: Result := Result + 'сто ';

      2: Result := Result + 'двісті ';

      3: Result := Result + 'триста ';

      4: Result := Result + 'чотириста ';

      5: Result := Result + 'п`ятсот ';

      6: Result := Result + 'шістсот ';

      7: Result := Result + 'сімсот ';

      8: Result := Result + 'вісімсот ';

      9: Result := Result + 'дев`ятсот ';

    end

  end; 

  procedure Num00;

  begin

    Num100(ValueTemp div 100);

    ValueTemp := ValueTemp mod 100;

    if ValueTemp < 20 then Num(ValueTemp)

    else

    begin

      Num10(ValueTemp div 10);

      ValueTemp := ValueTemp mod 10;

      Num(ValueTemp);

    end;

  end; 

  procedure NumMult(Mult: int64; s1, s2, s3: string);

  var ValueRes: int64;

  begin

    if Value >= Mult then

    begin

      ValueTemp := Value div Mult;

      ValueRes := ValueTemp;

      Num00;

      if ValueTemp = 1 then Result := Result + s1

      else if (ValueTemp > 1) and (ValueTemp < 5) then Result := Result + s2

      else Result := Result + s3;

      Value := Value - Mult * ValueRes;

    end;

  end; 

begin

  if (Value = 0) then Result := 'нуль'

  else

  begin

    Result := '';

    Rend := true;

    NumMult(1000000000000, 'триліон ', 'триліона ', 'триліонів  ');

    NumMult(1000000000, 'міліард ', 'міліарда ', 'міліардів  ');

    NumMult(1000000, 'мільйон ', 'мільйона ', 'мільйонів  ');

    Rend := false;

    NumMult(1000, 'тисяча ', 'тисячі ', 'тисяч ');

    Rend := true;

    ValueTemp := Value;

    Num00;

  end;

end; 

procedure Fst(S: string; Var  S1: string; Var  S2: string; Var  S3: string);

var

  pos: integer;

begin

  S1 := '';

  S2 := '';

  S3 := ''; 

  pos := 1; 

  while ((pos <= Length(S))and(S[pos] <> ';'))do

  begin

    S1 := S1 + S[pos];

    inc(pos);

  end;

  inc(pos); 

  while ((pos <= Length(S))and(S[pos] <> ';'))do

  begin

    S2 := S2 + S[pos];

    inc(pos);

  end;

  inc(pos); 

  while ((pos <= Length(S))and(S[pos] <> ';'))do

  begin

    S3 := S3 + S[pos];

    inc(pos);

  end;

  inc(pos);

end; 

function Ruble(Value: int64; Skl: string): string;

var

  hk10, hk20: integer;

  Skl1,Skl2,Skl3: string;

begin

  Fst(Skl,Skl1,Skl2,Skl3);

  hk10 := Value mod 10;

  hk20 := Value mod 100;

  if (hk20 > 10) and (hk20 < 20) then result := result + Skl3

  else if (hk10 = 1) then result := result + Skl1

  else if (hk10 > 1) and (hk10 < 5) then result := result + Skl2

  else result := result + Skl3;

end; 

function Kopeika(Value: integer; Skp: string): string;

var

  hk10, hk20: integer;

  Skp1,Skp2,Skp3: string;

begin

  Fst(Skp,Skp1,Skp2,Skp3);

  hk10 := Value mod 10;

  hk20 := Value mod 100;

  if (hk20 > 10) and (hk20 < 20) then result := result + Skp3

  else if (hk10 = 1) then result := result + Skp1

  else if (hk10 > 1) and (hk10 < 5) then result := result + Skp2

  else result := result + Skp3;

end; 

procedure TPruh_order.Button1Click(Sender: TObject);

begin

add_pruh_order.ShowModal;

end; 

procedure TPruh_order.FormCreate(Sender: TObject);

begin

IBDataSet1.Close;

IBDataSet1.Open;

DateTimePicker1.DateTime:=now;

end; 

procedure TPruh_order.Button3Click(Sender: TObject);

var

str:string;

begin

str:='Вы действительно  хотите удалить ордер № '+IBDataSet1NOMER_ORDERA.AsString+'?';

if (application.MessageBox(pchar(str), 'Подтверждение удаления',mb_yesno)=mryes) then

   begin

   IBDataSet1.Delete;

   DBGridEh1.ReadOnly:=false;

   end; 

end; 

procedure TPruh_order.Button2Click(Sender: TObject);

begin

DBGridEh1.ReadOnly:=false;

end; 

procedure TPruh_order.Button4Click(Sender: TObject);

begin

if(IBDataSet1.Fields[1].Value=null) then

ShowMessage('Введіть номер  ордера!') else

if(IBDataSet1.Fields[2].Value=null) then

ShowMessage('Введіть дату  поставки!') else

if(IBDataSet1.Fields[3].Value=null) then

ShowMessage('Введіть корр. рахунок!') else

if(IBDataSet1.Fields[4].Value=null) then

ShowMessage('Введіть суму!') else

if(IBDataSet1.Fields[5].Value=null) then

ShowMessage('Заповніть  поле "Прийнято від"!') else

if(IBDataSet1.Fields[6].Value=null) then

ShowMessage('Введіть підставу!') else

begin

IBDataSet1.ApplyUpdates;

DBGridEh1.ReadOnly:=true;

end;

end; 

procedure TPruh_order.Button5Click(Sender: TObject);

begin

frReport1.ShowReport;

end; 

procedure TPruh_order.frReport1UserFunction(const Name: String; p1, p2,

  p3: Variant; var Val: Variant);

begin

  if AnsiCompareText('Пропись', Name) = 0 then

    val := Propis(Trunc(frParser.Calc(p1))); 

  if AnsiCompareText('Гривна', Name) = 0 then

    val := Ruble(Trunc(frParser.Calc(p1)),frParser.Calc(p2)); 

  if AnsiCompareText('Копейка', Name) = 0 then

    val := Kopeika(Trunc(frParser.Calc(p1)),frParser.Calc(p2));

end; 

procedure TPruh_order.IBDataSet1FilterRecord(DataSet: TDataSet;

  var Accept: Boolean);

begin

Accept:=DataSet['data_sostav']=DateToStr(DateTimePicker1.Date);

end; 

procedure TPruh_order.Button6Click(Sender: TObject);

begin

IBDataSet1.Active:=true;

IBDataSet1.Filtered:=false;