unit ProdFrame;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus;

type
  TDataChangingEvent = procedure(Sender: TObject; obj_name: string) of object;

  TfrmProd = class(TFrame)
    Panel1: TPanel;
    pnlObjName: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    pnlProdName: TPanel;
    pnlPostav: TPanel;
    List: TListView;
    pnlProdButtons: TPanel;
    Memo: TMemo;
    btAdd: TBitBtn;
    btEmpty: TBitBtn;
    btDel: TBitBtn;
    btArhiv: TBitBtn;
    BitBtn1: TBitBtn;
    PopupMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    mnuProdMode: TMenuItem;
    procedure btAddClick(Sender: TObject);
    procedure btDelClick(Sender: TObject);
    procedure btEmptyClick(Sender: TObject);
    procedure btArhivClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure ListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure mnuProdModeClick(Sender: TObject);
  private
    FOnDataChanging: TDataChangingEvent;
  public
    Id: string;
    IdProd, IdCult, IdPostav: integer;
    Empty: boolean;
    procedure ClearData;
    procedure FetchData(idobj, objname: string);
    procedure SaveInfo;
  published
    property OnDataChanging: TDataChangingEvent read FOnDataChanging write FOnDataChanging;
  end;

implementation
uses ProdDataMod, hyperstr, ProdEdit, ProdArhPeriod, ProdArhPrint;



{$R *.DFM}

{ TfrmProd }

procedure TfrmProd.ClearData;
begin
  pnlProdName.Caption := '';
  pnlPostav.Caption := '';
  List.Items.Clear;
  Memo.Lines.Clear;
end;


procedure TfrmProd.FetchData(idobj, objname: string);
var
  s: string;
  i,j: integer;
begin
  if Memo.Modified then SaveInfo;

  pnlObjName.Caption := objname;
  id := idobj;

  if not proddm.qryProd.Database.Connected then begin
    ClearData;
    Memo.Lines.Add('Нет соединения с базой данных');
    pnlProdButtons.Enabled := false;
    exit;
  end;
  pnlProdButtons.Enabled := true;

  try
    proddm.qryProd.SQL.text :=
          'SELECT P.IDPROD, P.IDCULT, P.IDPOSTAV, C.NAME AS CULT_NAME, T.NAME AS POSTAV_NAME, P.INFO '+
          ' FROM PRODUCT P, CULTURA C, POSTAVSHIK T WHERE P.ARH=0 AND P.IDOBJ='#39 +
          idobj + #39' AND P.IDCULT=C.IDCULT AND P.IDPOSTAV=T.IDPOSTAV';

    proddm.qryProd.Transaction.StartTransaction;
    proddm.qryProd.ExecQuery;
    empty := proddm.qryProd.Eof;

    if empty then begin
      // пустой объект
      ClearData;
    end else begin
      // не пустой. извлечение данных
      IdProd := proddm.qryProd.FieldByName('IDPROD').AsInteger;
      IdCult := proddm.qryProd.FieldByName('IDCULT').AsInteger;
      IdPostav := proddm.qryProd.FieldByName('IDPOSTAV').AsInteger;
      pnlProdName.Caption := '  ' + proddm.qryProd.FieldByName('CULT_NAME').AsString;
      pnlPostav.Caption := '  ' + proddm.qryProd.FieldByName('POSTAV_NAME').AsString;

      // Разбор info-поля
      Memo.Lines.BeginUpdate;
      Memo.Lines.Text := proddm.qryProd.FieldByName('INFO').AsString;
      List.Items.Clear;

      i := 0;
      while (i<Memo.Lines.Count) do begin
        s := Memo.Lines.Strings[i] + ' ';
        if s[1]='#' then begin
           with List.Items.Add do begin
             j := 2;
             Caption := Parse(s, ';', j);      // дата
             SubItems.Add(Parse(s, ';', j));   // вес
             SubItems.Add(Parse(s, ';', j));   // влажн
             SubItems.Add(Parse(s, ';', j));   // клейк
             SubItems.Add(Parse(s, ';', j) + '/' + Parse(s, ';', j)); // сор
           end;
           Memo.Lines.Delete(i);
        end else
          inc(i);
      end;
      Memo.Lines.EndUpdate;

    end;
    proddm.qryProd.Transaction.Commit;
  finally
    proddm.qryProd.Transaction.Active := false;
    proddm.qryProd.Close;
  end;

  Label1.Visible := not Empty;
  Label2.Visible := not Empty;
  Memo.Visible := not Empty;
  List.Visible := not Empty;
  pnlProdName.Visible := not Empty;
  pnlPostav.Visible := not Empty;
  btAdd.Enabled := true;
  btDel.Enabled := not Empty;
  btEmpty.Enabled := not Empty;
  btArhiv.Enabled := true;

  Memo.Modified := false;

  // Пересоздание карточки (если кол-во записей в ней > 100)
  if List.Items.Count > 100 then
    if MessageDlg('Количество записей в карточке превышает допустимое (не более 100).'#13+
          'Создать новую карточку для "'+ pnlObjName.Caption + '"?', mtConfirmation,
          mbOKCancel, 0) = mrOk then
      try
        with List.Items[0] do s := '#' + Caption + ';' + Subitems[0] + ';' +
              SubItems[1] + ';' + SubItems[2] + ';' + Subitems[3] + #13#10;
        Translate(s, '/', ';');
        s := s + Memo.Lines.Text;
        
        proddm.qryProd.SQL.text := 'INSERT INTO PRODUCT (IDCULT, IDPOSTAV, IDOBJ, '+
              'DTLOAD, ARH, INFO) VALUES (' + IntToStr(IdCult) + ',' +
              IntToStr(IdPostav) + ','#39 + Id + #39','#39 +
              DateTimeToStr(now) + #39',0, '#39 + s + #39')';

        proddm.qryProd.Transaction.StartTransaction;
        proddm.qryProd.ExecQuery;
        proddm.qryProd.Transaction.Commit;
        btEmptyClick(nil);
      except
        proddm.qryProd.Transaction.Active := false;
      end;

end;

procedure TfrmProd.btAddClick(Sender: TObject);
var
  ProdEditForm: TProdEditForm;
begin
  if ((Empty) and ((Sender = pnlProdName) or (Sender = pnlPostav) or
        (Sender = List))) then exit;

  ProdEditForm := TProdEditForm.Create(self);

  if Sender = btAdd then
    ProdEditForm.ProductRecord(id, iif(empty, pemNewLoad, pemNewRec));

  if Sender = List then
    ProdEditForm.ProductRecord(id, pemEditRec);

  if (Sender = pnlProdName) or (Sender = pnlPostav)then
    ProdEditForm.ProductRecord(id, pemEditCP);

  if (Empty) or (Sender = pnlProdName) or (Sender = pnlPostav) then begin
    FetchData(id, pnlObjName.Caption);
  end;

  ProdEditForm.Free;
end;


procedure TfrmProd.SaveInfo;
var
  s: string;
  i: integer;
begin
  if proddm.dbProd.Connected then try
    s := '';
    for i:=0 to List.Items.Count-1 do
      with List.Items[i] do begin
        s := s + '#' + Caption + ';' + Subitems[0] + ';' + SubItems[1] + ';' +
              SubItems[2] + ';' + Subitems[3] + #13#10;
      end;
    Translate(s, '/', ';');

    s := s + Memo.Lines.Text;

    proddm.qryProd.SQL.text := 'UPDATE PRODUCT SET INFO='#39 + s + #39 +
          ' WHERE IDPROD=' + IntToStr(IdProd);
    proddm.qryProd.Transaction.StartTransaction;
    proddm.qryProd.ExecQuery;
    proddm.qryProd.Transaction.Commit;
  except
    proddm.qryProd.Transaction.Active := false;
  end;
end;


procedure TfrmProd.btDelClick(Sender: TObject);
begin
  if not ProdDM.UserAccessLevel then exit;

  if List.Selected = nil then exit;
  if MessageDlg('Удалить запись в карточке?', mtInformation, mbOKCancel, 0) <>
      mrOk then exit;
  try
    List.Selected.Delete;
    SaveInfo;
  except
  end;
end;

procedure TfrmProd.btEmptyClick(Sender: TObject);
begin
  if not ProdDM.UserAccessLevel then exit;

  if Sender <> nil then
    if MessageDlg('Установить в карточке отметку "Пустой"?', mtInformation,
          mbOKCancel, 0) <> mrOk then exit;
  proddm.qryProd.SQL.text := 'UPDATE PRODUCT SET ARH=1,'+
        'DTEMPTY='#39 + DateTimeToStr(now) + #39' WHERE IDPROD='+
        IntToStr(IdProd);
  try      
    proddm.qryProd.Transaction.StartTransaction;
    proddm.qryProd.ExecQuery;
    proddm.qryProd.Transaction.Commit;
  except
    proddm.qryProd.Transaction.Active := false;
  end;
  
  FetchData(id, pnlObjName.Caption);
end;


// ПЕЧАТЬ АРХИВА
procedure TfrmProd.btArhivClick(Sender: TObject);
var
  ProdArhPeriodForm: TProdArhPeriodForm;
  ProdArhPrintForm: TProdArhPrintForm;
  i: integer;
  dbeg, dend: TDateTime;
begin
  ProdArhPeriodForm := TProdArhPeriodForm.Create(self);
  i := ProdArhPeriodForm.ShowModal;
  dbeg := ProdArhPeriodForm.DateTimePicker1.Date;
  dend := ProdArhPeriodForm.DateTimePicker2.Date;
  ProdArhPeriodForm.Free;

  if i = mrOk then begin
    ProdArhPrintForm := TProdArhPrintForm.Create(self);
    ProdArhPrintForm.MakeReport(dbeg, dend, Id, pnlObjName.Caption);
    ProdArhPrintForm.ShowModal;
    ProdArhPrintForm.Free;
  end;
end;

procedure TfrmProd.BitBtn1Click(Sender: TObject);
begin
  PopupMenu.Popup( Mouse.CursorPos.x, Mouse.CursorPos.y );
end;

procedure TfrmProd.N1Click(Sender: TObject);
var
  ProdArhPrintForm: TProdArhPrintForm;
begin
  ProdArhPrintForm := TProdArhPrintForm.Create(self);
  ProdArhPrintForm.MakeCurReport;
  ProdArhPrintForm.ShowModal;
  ProdArhPrintForm.Free;
end;

procedure TfrmProd.ListCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  Compare := -1 * CompareText(Item1.Caption,Item2.Caption);
end;

procedure TfrmProd.mnuProdModeClick(Sender: TObject);
begin
  with sender as TMenuItem do
    if Checked then begin
      Checked := false;
      ProdMode_On := false;
    end else begin
      CheckProdMode;
      Checked := ProdMode_On;
    end;
end;

end.
