programa_cobranca/ufrmCobrancaCampanha.pas

unit ufrmCobrancaCampanha;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, umstMaster, Data.DB, System.ImageList,
  Vcl.ImgList, ZAbstractRODataset, ZAbstractDataset, ZDataset, Vcl.Grids,
  Vcl.DBGrids, Vcl.DBCtrls, Vcl.ComCtrls, rDBComponents, Vcl.StdCtrls, Vcl.Mask,
  Vcl.Buttons, Vcl.ExtCtrls, StrUtils;

  type THackDBNavigator = class(TDBNavigator);

type
  TfrmCobrancaCampanha = class(TmstMaster)
    pnl_info: TPanel;
    lbl_id: TLabel;
    lbl_nome: TLabel;
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    lbl_source: TLabel;
    lbl_participantes: TLabel;
    lbl_datacad: TLabel;
    dbedt_id: TDBEdit;
    dbedt_nome: TDBEdit;
    dbcb_ativa: TDBCheckBox;
    dbcb_concluida: TDBCheckBox;
    lb_source: TListBox;
    lb_destiny: TListBox;
    pb_campanha: TProgressBar;
    dbdtp_cad: TrDBDateTimePicker;
    pnl_gridcampanha: TPanel;
    navPrincipal: TDBNavigator;
    dbg_campanha: TDBGrid;
    pnl_griddevedores: TPanel;
    dbg_consultados: TDBGrid;
    dts_campanha: TDataSource;
    dtsCampanha_consulta: TDataSource;
    Query: TZQuery;
    ImageList1: TImageList;
    procedure IncAllBtnClick(Sender: TObject);
    procedure IncludeBtnClick(Sender: TObject);
    procedure dbcb_ativaClick(Sender: TObject);
    procedure dbcb_concluidaClick(Sender: TObject);
    procedure dbg_campanhaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure dts_campanhaDataChange(Sender: TObject; Field: TField);
    procedure dts_campanhaStateChange(Sender: TObject);
    procedure ExAllBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure navPrincipalBeforeAction(Sender: TObject; Button: TNavigateBtn);
  private
      procedure SetupHackedNavigator(const Navigator : TDBNavigator;
                                 const Glyphs : TImageList);
    { Private declarations }
  public
  campanha_hints : array of string;

  function GetFirstSelection(List: TCustomListBox): Integer;
  procedure MoveSelected(List: TCustomListBox; Items: TStrings);
  procedure SetItem(List: TListBox; Index: Integer);
  procedure SetButtons;
    { Public declarations }
  end;

var
  frmCobrancaCampanha: TfrmCobrancaCampanha;

implementation

{$R *.dfm}

uses udtmSystem, ucadCampanha, System.UITypes;

procedure TfrmCobrancaCampanha.IncAllBtnClick(Sender: TObject); //func pra adicionar todos os elementos
var                                                     //de um list box pro outro
  I: Integer;
begin
  for I := 0 to lb_source.Items.Count - 1 do
    lb_destiny.Items.AddObject(lb_source.Items[I],
      lb_source.Items.Objects[I]);
  lb_source.Items.Clear;
  SetItem(lb_source, 0);
end;

procedure TfrmCobrancaCampanha.IncludeBtnClick(Sender: TObject); //func pra adicionar um elemento
var                                                      //de um lsit box pro outro
  Index: Integer;
begin
  Index := GetFirstSelection(lb_source);
  MoveSelected(lb_source, lb_destiny.Items);
  SetItem(lb_source, Index);
end;

procedure TfrmCobrancaCampanha.dbcb_ativaClick(Sender: TObject);     //toggle do db de ativo
begin                                                        //e concluido
  inherited;
if dbcb_ativa.Checked then
begin
  dbcb_concluida.Checked := false;
end;
end;

procedure TfrmCobrancaCampanha.dbcb_concluidaClick(Sender: TObject); //toggle do db de ativo
begin                                                        //e concluido
  inherited;
if dbcb_concluida.Checked then
begin
  dbcb_ativa.Checked := false;
end;
end;

procedure TfrmCobrancaCampanha.dbg_campanhaMouseMove(Sender: TObject; //func pra exibir o hint
  Shift: TShiftState; X, Y: Integer);                         //correto de cada campanha
  var
  Cell: TGridCoord;
begin
  inherited;
  Cell := dbg_campanha.MouseCoord(X,Y);

  if (cell.Y > 0) then
  begin
    dbg_campanha.Hint := campanha_hints[cell.Y-1];
  end else
  begin
    dbg_campanha.Hint := '';
  end;

end;

procedure TfrmCobrancaCampanha.dts_campanhaDataChange(Sender: TObject; Field: TField);
begin
  inherited;
dbg_consultados.DataSource.DataSet := dtmSystem.tblCampanhaDevedores;     //seta o grid pra
end;                                                                      //pegar conteúdo
                                                                          //do db
procedure TfrmCobrancaCampanha.dts_campanhaStateChange(Sender: TObject);
begin
  inherited;
  pnl_info.Enabled := dts_campanha.State in [dsEdit, dsInsert];     //inherited do Cadastro
end;                                                                //que nao tinha pois janela nao veio do cad, mas funciona como uma

procedure TfrmCobrancaCampanha.ExAllBtnClick(Sender: TObject); //excluir todos os elementos do segundo
var                                                    //list box de volta pro primeiro
  I: Integer;
begin
  for I := 0 to lb_destiny.Items.Count - 1 do
    lb_source.Items.AddObject(lb_destiny.Items[I], lb_destiny.Items.Objects[I]);
  lb_destiny.Items.Clear;
  SetItem(lb_destiny, 0);
end;

procedure TfrmCobrancaCampanha.ExcludeBtnClick(Sender: TObject); //exclui um elemento do segundo
var                                                      //list box de volta pro primeiro
  Index: Integer;
begin
  Index := GetFirstSelection(lb_destiny);
  MoveSelected(lb_destiny, lb_source.Items);
  SetItem(lb_destiny, Index);
end;

procedure TfrmCobrancaCampanha.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
    if dts_campanha.DataSet <> nil then
  begin                                           //ver dts_campanhaStateChange

    dts_campanha.DataSet.Filtered := False;

    if dts_campanha.DataSet.State in [dsInsert, dsEdit] then
      dts_campanha.DataSet.Cancel;
  end;
Action := caFree;
end;

procedure TfrmCobrancaCampanha.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  inherited;                                //ver dts_campanhaStateChange
if navPrincipal.DataSource <> nil then
    if navPrincipal.DataSource.State in [dsInsert, dsEdit] then
    begin
      MessageDlg
        ('Existem alterações pendentes, clique em CONFIRMAR ou CANCELAR.',
        mtConfirmation, [mbOK], 0);
      CanClose := False;
    end;
end;

procedure TfrmCobrancaCampanha.FormCreate(Sender: TObject);
var
pos : integer;
begin
  inherited;
  pos := 0;
  setlength(campanha_hints,pos+1);

  SetupHackedNavigator(navPrincipal,ImageList1);


with dtmSystem do
begin

  tblCobCampanha.Open;
  tblCobCampanha.First;
  while not tblCobCampanha.Eof do
  begin
    campanha_hints[pos] := tblCobCampanhaTX_DESC.AsString;//vetor de hints pra campanha
    pos := pos +1;
    setlength(campanha_hints,pos+1);
    tblCobCampanha.Next;
  end;
  tblCobCampanha.First;

  tblUsuariosConsulta.Open;
  tblCampanhaCob.Open;
  tblUsuariosConsulta.First;
  while not tblUsuariosConsulta.Eof do
  begin
    if tblCampanhaCob.Locate('ID_COBRADOR',tblUsuariosConsultaID_USUARIO.AsString,[]) then
    begin
    lb_destiny.Items.Add(tblUsuariosConsultaTX_NOME.AsString);// adiciona as entradas pro list box
    end else
    lb_source.Items.Add(tblUsuariosConsultaTX_NOME.AsString);
    tblUsuariosConsulta.Next;
  end;

end;
end;

procedure TfrmCobrancaCampanha.FormShow(Sender: TObject);
begin
  inherited;
//dtmSystem.tblCobCampanha.Open;

end;


function TfrmCobrancaCampanha.GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do //pega primeiro item do list box
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;


procedure TfrmCobrancaCampanha.MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do //move o item selecionado
    if List.Selected[I] then
    begin
      Items.AddObject(List.Items[I], List.Items.Objects[I]);
      List.Items.Delete(I);
    end;
end;

procedure TfrmCobrancaCampanha.navPrincipalBeforeAction(Sender: TObject;
  Button: TNavigateBtn);
                           //primeiro blocao ver dts_campanhaStateChange
begin

  case Button of
    nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbRefresh:
      if navPrincipal.DataSource.State in [dsInsert, dsEdit] then
      begin
        MessageDlg('Existem alterações pendentes, clique em CONFIRMAR ou CANCELAR.', mtConfirmation, [mbOK], 0);
        Abort;
      end;

    nbPost: SelectNext(ActiveControl as tWinControl, True, True);

    nbDelete:
    begin
      if navPrincipal.DataSource.State in [dsInsert, dsEdit] then
      begin
        MessageDlg('Existem alterações pendentes, clique em CONFIRMAR ou CANCELAR.', mtConfirmation, [mbOK], 0);
        Abort;
      end;

      if MessageDlg('Deseja apagar este registro?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then Abort;

      try
        dts_campanha.DataSet.Delete;
      except
        ShowMessage('Este registro está sendo utilizado pelo sistema ou contém dependências e não pode ser apagado');
      end;

      Abort;
    end;

    nbCancel: if MessageDlg('Deseja cancelar as modificações?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then Abort;
  end;

  if button = nbInsert then
  begin
    with TcadCampanha.Create(self) do   //abre janela de criar campanha
    begin
      showmodal;
      if ModalResult <> mrOk then
      begin
        navPrincipal.DataSource.DataSet.Cancel;
        pnl_info.Enabled := false;
      end;
      if ModalResult = mrOk then
      begin
//        navPrincipal.DataSource.DataSet.Append;
        Query.Open;
        pnl_info.Enabled := true;
      end;
      abort;
    end;
  end;

  if button = nbEdit then
  begin
    pnl_info.Enabled := true;
  end;

  if button = nbCancel then
  begin
    pnl_info.Enabled := false;
  end;
  if button = nbPost then
  begin
  dtmSystem.tblCampanhaDevedores.Open;
    Query.First;
    while not Query.Eof do
    begin
      dtmSystem.tblCampanhaDevedores.Append;
      dtmSystem.tblCampanhaDevedoresID_CAMPANHA.AsInteger := dtmSystem.tblCobCampanhaID_CAMPANHA.AsInteger;
      dtmSystem.tblCampanhaDevedoresID_DEVEDOR.AsInteger := Query.FieldByName('ID_DEVEDOR').AsInteger;
      Query.Next;
    end;
    Query.First;
  end;

end;

procedure TfrmCobrancaCampanha.SetButtons; //seta o estado dos botões
var
  SrcEmpty, DstEmpty: Boolean;
begin
  SrcEmpty := lb_source.Items.Count = 0;
  DstEmpty := lb_destiny.Items.Count = 0;
  IncludeBtn.Enabled := not SrcEmpty;
  IncAllBtn.Enabled := not SrcEmpty;
  ExcludeBtn.Enabled := not DstEmpty;
  ExAllBtn.Enabled := not DstEmpty;
end;

procedure TfrmCobrancaCampanha.SetItem(List: TListBox; Index: Integer);
var
  MaxIndex: Integer;                      //seta os itens
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then Index := 0
    else if Index > MaxIndex then Index := MaxIndex;
    if Index >= 0 then Selected[Index] := True;
  end;
  SetButtons;
end;

procedure TfrmCobrancaCampanha.SetupHackedNavigator(const Navigator : TDBNavigator;
const Glyphs : TImageList);
const
  Captions : array[TNavigateBtn] of string =
      ('Primeiro', 'Anterior', 'Próximo', 'Último', 'Adicionar',
       'Apagar', 'Modificar', 'Confirmar', 'Cancelar', 'Atualizar',
       'Aplicar Atualizações','Cancelar Atualizãções');
(*Captions : array[TNavigateBtn] of string =
      ('First', 'Prior', 'Next', 'Last', 'Insert',
       'Delete', 'Edit', 'Post', 'Cancel', 'Refresh');*)
var
  btn : TNavigateBtn;
begin
//função propriamente dita para "hackear" o navigator
  for btn := Low(TNavigateBtn) to High(TNavigateBtn) do
    with THackDBNavigator(Navigator).Buttons[btn] do
    begin
      //from the Captions const array
      Caption := Captions[btn];

      //the number of images in the Glyph property
      NumGlyphs := 1;
      // Remove the old glyph.
      Glyph := nil;
      // Assign the custom one
      Glyphs.GetBitmap(Integer(btn),Glyph);
      // gylph above text
      Layout := blGlyphTop;

      Font.Style := Font.Style - [fsbold];
    end;

end;

end.