lazarus-ccr/examples/germesorders/uorder.pas

unit uOrder;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, rxdbgrid, sqlite3ds, db, ComCtrls, StdCtrls, uDbTypes, memds2,
  DbCtrls, rxdbcomb, rxlookup, dbdateedit, ufrmParent;

type

  { TfrmOrder }

  TfrmOrder = class(TfrmParent)
    btnOrderList: TButton;
    btnOrderList1: TButton;
    btnSave: TBitBtn;
    btnCancel: TBitBtn;
    cbxGroup: TComboBox;
    chkCache: TDBCheckBox;
    DBEdit1: TDBEdit;
    dsOrgs: TSqlite3Dataset;
    dsrcOrder: TDatasource;
    dsrcOrgs: TDatasource;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    lbxSubGroups: TListBox;
    Panel1: TPanel;
    Panel2: TPanel;
    cbxOrg: TRxDBLookupCombo;
    dsOrder: TSqlite3Dataset;
    Panel3: TPanel;
    procedure btnSaveClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOrderListClick(Sender: TObject);
    procedure cbxGroupChange(Sender: TObject);
    procedure cbxSubGroupChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FId_Order: TDbKeyType;
    { private declarations }
    GroupOpt, SubGroupOpt:TDbKeyType;
    GroupIndex, SubGroupIndex:Integer;

    procedure CloseAndFree;

    procedure OptionsLoad;
    procedure OptionsSubGroupLoad(const ParentID:string; const Id:string);
    procedure OptionsSave;

    function GroupChosen:string;
    function SubGroupChosen:string;

    procedure GroupIndexFind(D:TDataset);
    procedure SubGroupIndexFind(D:TDataset);

  public
    { public declarations }
    property Id_Order:TDbKeyType read FId_Order write FId_Order;
  end; 
  
var frmOrder:TfrmOrder;

implementation
uses uDebug, uBase, uOrderGoods, uUtils, uTestForm, uOptionConst;

{ TfrmOrder }

procedure TfrmOrder.btnCancelClick(Sender: TObject);
begin
  GlobalLogger.Log('Отмена изменений заказа %d', [Id_Order]);
  dsOrder.Cancel;

  CloseAndFree;
end;

procedure TfrmOrder.btnOrderListClick(Sender: TObject);
begin
  OptionsSave;

  GlobalLogger.Log('Открытие формы редактирования состава заказа');

  if frmOrderGoods = nil then
    frmOrderGoods:=TfrmOrderGoods.Create(Application);
  with frmOrderGoods do
  begin
    GoodShowType:=TGoodShowType( TComponent(Sender).Tag );
    Id_Order:=Self.Id_Order;
    Id_Org:=DBFieldAsDBKey(dsOrder, 'Org');
    {$IFDEF LCLwince}
    WindowResize;
    {$ENDIF}
    Show;
  end;

  {
  with TfrmTestForm.Create(self) do
  begin
    ShowModal;
    Free;
  end;
  }
  
  GlobalLogger.Log('Форма редактирования состава заказа успешно отработала');
end;

procedure TfrmOrder.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  CloseAction:=caHide;
end;

procedure TfrmOrder.FormCreate(Sender: TObject);
begin
  BaseConnect.ConnectToBase(dsOrder);
  dsOrder.TableName:='Orders';
  dsOrder.PrimaryKey:='ID';

  //workaround to prevent mask exception :(
  DBEdit1.EditMask:='';

  BaseConnect.ConnectToBase(dsOrgs);
  dsOrgs.SQL:='select ID, Name from Orgs order by Name';
  dsOrgs.Open;
end;

procedure TfrmOrder.FormShow(Sender: TObject);
var W:String;
begin
  GlobalLogger.Log('Переход на заказ с ID=%d', [Id_Order]);
  dsOrder.Open;
  if not dsOrder.Locate('ID', Id_Order, []) then
    begin
      GlobalLogger.Log('Заказ с ID=%d не найден', [Id_Order]);
      ShowMessage(Format('Заказ с ID=%d не найден', [Id_Order]));
      Exit;
    end;
  dsOrder.Edit;

  W:=BaseConnect.OptionUser[goOptWorkerCurrent];

  if W <> '' then
    DbFieldAssignAsDbKey(dsOrder, 'Creator', W);
  //cbxOrg.Update;
  
  OptionsLoad;
end;

procedure TfrmOrder.CloseAndFree;
begin
  dsOrder.Close;

  GlobalLogger.Log('Закрытие формы TfrmOrder');
  Close;
end;

procedure TfrmOrder.btnSaveClick(Sender: TObject);
var S:String;
begin
  GlobalLogger.Log('Сохранение заказа %d', [Id_Order]);
  dsOrder.Post;

  if dsOrder.UpdatesPending then
    begin
      GlobalLogger.Log('Применение изменений заказа %d', [Id_Order]);
      S:='Изменения заказа %d ' + Iif(dsOrder.ApplyUpdates, 'успешно применены', 'применить не удалось.');
      GlobalLogger.Log(S, [Id_Order]);
    end;
  CloseAndFree;
end;

function IdExtract(const S:string):string;
var i:Integer;
begin
  i:=Pos('|', S);
  if i = 0 then raise Exception.Create('Не найден id');
  Result:=Copy(S, 1,i-1);
end;

procedure TfrmOrder.OptionsLoad;
var S, SubGr:String;
begin
  GlobalLogger.Log('Загрузка опций');

  GlobalLogger.Log('Заполнение выпадающего списка групп');

  S:=BaseConnect.OptionUser[goOptGroupCurrent];
  if S = '' then
    begin
      BaseConnect.StringsFill('select ID, Name from Goods where ID<0 and ID > -10000000 order by Name', '%ID%| %Name%', cbxGroup.Items, nil);
      cbxGroup.ItemIndex:=0;
    end
    else
    begin
      GroupOpt:=StrToDBKey(S);
      BaseConnect.StringsFill('select ID, Name from Goods where ID<0 and ID > -10000000 order by Name', '%ID%| %Name%', cbxGroup.Items, @GroupIndexFind);
      cbxGroup.ItemIndex:=GroupIndex-1;
    end;
  GlobalLogger.Log('Заполнение выпадающего списка групп успешно завершено');

  SubGr:=BaseConnect.OptionUser[goOptSubGroupCurrent];
  OptionsSubGroupLoad(GroupChosen, SubGr );
end;

procedure TfrmOrder.OptionsSubGroupLoad(const ParentID:string; const Id:string);
var SGList:TStrings;
    SGCnt:TListBox;
begin
  GlobalLogger.Log('Заполнение выпадающего списка подгрупп');
  
  SGCnt:=lbxSubGroups;
  SGList:=SGCnt.Items;
  
  SGList.BeginUpdate;
  try
    SGList.Clear;
    SGList.Add('0| Не выбрана');
    if ParentID = '' then
      begin
        //cbxSubGroup.Items.Clear;
        exit;
      end
      else
      if (ID = '') or (ID = '0') then
      begin
        BaseConnect.StringsFill('select g.ID, g.Name from Goods g '+
                            'join HierGoods h on g.ID=h.Good and ParentID=' + ParentID + ' ' +
                            'order by Name', '%ID%| %Name%',
                            SGList, nil, false);
        SGCnt.ItemIndex:=0;
      end
      else
      begin
        SubGroupOpt:=StrToDBKey(ID);
        BaseConnect.StringsFill('select g.ID, g.Name from Goods g '+
                            'join HierGoods h on g.ID=h.Good and ParentID=' + ParentID + ' ' +
                            'order by Name', '%ID%| %Name%',
                            SGList, @SubGroupIndexFind, false);
        //cbxSubGroup.ItemIndex:=SubGroupIndex-1;
        SGCnt.ItemIndex:=SubGroupIndex;
      end;
  finally
    SGList.EndUpdate;
  end;
  GlobalLogger.Log('Заполнение выпадающего списка подгрупп успешно завершено');
end;

procedure TfrmOrder.cbxGroupChange(Sender: TObject);
begin
  //btnAcceptOptions.Enabled:=True;
  OptionsSubGroupLoad( GroupChosen, '' );
end;

procedure TfrmOrder.cbxSubGroupChange(Sender: TObject);
begin
  //btnAcceptOptions.Enabled:=True;
end;

procedure TfrmOrder.OptionsSave;
begin
  BaseConnect.OptionUser[goOptGroupCurrent]:=GroupChosen;
  BaseConnect.OptionUser[goOptSubGroupCurrent]:=SubGroupChosen;
end;

function TfrmOrder.GroupChosen: string;
begin
  if (cbxGroup.Items.Count <= 0) or
     (cbxGroup.ItemIndex < 0) or
     (cbxGroup.ItemIndex >= cbxGroup.Items.Count)
    then
    begin
      Result:='';
      exit;
    end;

  Result:=IdExtract( cbxGroup.Items[cbxGroup.ItemIndex] );
end;

function TfrmOrder.SubGroupChosen: string;
begin
  if (lbxSubGroups.Items.Count <= 0) or
     (lbxSubGroups.ItemIndex < 0) or
     (lbxSubGroups.ItemIndex >= lbxSubGroups.Items.Count)
    then
    begin
      Result:='';
      exit;
    end;

  Result:=IdExtract( lbxSubGroups.Items[lbxSubGroups.ItemIndex] );
end;

procedure TfrmOrder.GroupIndexFind(D: TDataset);
begin
  if GroupOpt = D.FieldByName('ID').AsInteger then
    GroupIndex:=D.RecNo;
end;

procedure TfrmOrder.SubGroupIndexFind(D: TDataset);
begin
  if SubGroupOpt = D.FieldByName('ID').AsInteger then
    SubGroupIndex:=D.RecNo;
end;



initialization
  {$I uordergoods.lrs}

end.