programa_cobranca/ufrmCampanha.pas

unit ufrmCampanha;

interface

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

type
  THackDBNavigator = class(TDBNavigator);

type
  TfrmCampanha = class(TmstMaster)
    pnl_info: TPanel;
    lbl_id: TLabel;
    lbl_nome: TLabel;
    dbedt_id: TDBEdit;
    dbedt_nome: TDBEdit;
    lbl_datacad: TLabel;
    dbcb_ativa: TDBCheckBox;
    dbcb_concluida: TDBCheckBox;
    IncludeBtn: TSpeedButton;
    IncAllBtn: TSpeedButton;
    ExcludeBtn: TSpeedButton;
    ExAllBtn: TSpeedButton;
    lb_source: TListBox;
    lb_destiny: TListBox;
    lbl_source: TLabel;
    lbl_participantes: TLabel;
    pnl_gridcampanha: TPanel;
    pb_campanha: TProgressBar;
    pnl_griddevedores: TPanel;
    dbg_consultados: TDBGrid;
    navPrincipal: TDBNavigator;
    dtsCampanha: TDataSource;
    ImageList1: TImageList;
    Query: TZQuery;
    dtsCampanha_consulta: TDataSource;
    dbdtp_cad: TrDBDateTimePicker;
    dbg_campanha: TDBGrid;
    qtdCobrados: TZReadOnlyQuery;
    ppmnu_exports: TPopupMenu;
    ppmnu_nomedoc: TMenuItem;
    dbmem_desc: TDBMemo;
    mnuFichaDev: TMenuItem;
    N1: TMenuItem;
    procedure IncludeBtnClick(Sender: TObject);
    procedure ExcludeBtnClick(Sender: TObject);
    procedure IncAllBtnClick(Sender: TObject);
    procedure ExAllBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure dbg_campanhaMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure navPrincipalBeforeAction(Sender: TObject; Button: TNavigateBtn);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure dtsCampanhaStateChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbcb_ativaClick(Sender: TObject);
    procedure dbcb_concluidaClick(Sender: TObject);
    procedure dtsCampanhaDataChange(Sender: TObject; Field: TField);
    procedure dtsCampanha_consultaDataChange(Sender: TObject; Field: TField);
    procedure dbg_consultadosDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ppmnu_nomedocClick(Sender: TObject);
    procedure mnuFichaDevClick(Sender: TObject);
  private
    cob_index: Integer;
    procedure SetupHackedNavigator(const Navigator: TDBNavigator;
      const Glyphs: TImageList);
    // procedure ProgressBarStepIt(const Progressbar: TProgressBar; n: Integer);
    procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
    { 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
  frmCampanha: TfrmCampanha;

implementation

{$R *.dfm}

uses udtmSystem, ucadCampanha, ucadDevedores;

procedure TfrmCampanha.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
  begin
    lb_destiny.Items.AddObject(lb_source.Items[I], lb_source.Items.Objects[I]);
  end;
  lb_source.Items.Clear;
  SetItem(lb_source, 0);

end;

procedure TfrmCampanha.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 TfrmCampanha.mnuFichaDevClick(Sender: TObject);
begin
  if not dtmSystem.tblDevedores.Active then
  begin
    dtmSystem.tblDevedores.Open;
  end
  else
  begin
    dtmSystem.tblDevedores.Refresh;
  end;
  if dtmSystem.tblDevedores.Locate('ID_DEVEDOR',
    dtmSystem.tblCampanhaDevedoresID_DEVEDOR.AsInteger, []) then
  begin
    cadDevedores := TcadDevedores.Create(Self);
    cadDevedores.ShowModal;
  end;
end;

procedure TfrmCampanha.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 TfrmCampanha.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 TfrmCampanha.dbg_campanhaMouseMove(Sender: TObject;
  // func pra exibir o hint
  Shift: TShiftState; X, Y: Integer); // correto de cada campanha
var
  Cell: TGridCoord;
  // content : string;
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 TfrmCampanha.dbg_consultadosDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  case AnsiIndexStr(dtsCampanha_consulta.DataSet.FieldByName('TP_ESTADO')
    .AsString, ['A', 'B']) of
    0:
      dbg_consultados.Canvas.Brush.Color := clWhite;
    1:
      dbg_consultados.Canvas.Brush.Color := $FACE87;
  end;
  // end;
  dbg_consultados.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

procedure TfrmCampanha.dtsCampanhaDataChange(Sender: TObject; Field: TField);
begin
  inherited;
  // seta o grid pra
  // adiciona as entradas pro list box
  // pegar conteúdo do db
  if (dtsCampanha.State in [dsBrowse]) then
  begin
    if cob_index <> dtsCampanha.DataSet.RecNo then
    begin
      cob_index := dtsCampanha.DataSet.RecNo;

      Screen.Cursor := crHourGlass;
      with dtmSystem do
      begin
        if not tblCampanhaDevedores.Active then
        begin
          tblCampanhaDevedores.Open;
        end;
        if not tblUsuariosConsulta.Active then
        begin
          tblUsuariosConsulta.Open;
        end;
        if not tblCampanhaCob.Active then
        begin
          tblCampanhaCob.Open;
        end;
        tblUsuariosConsulta.First;
        lb_source.Items.Clear;
        lb_destiny.Items.Clear;
        while not tblUsuariosConsulta.Eof do
        begin
          if tblCampanhaCob.Locate('ID_COBRADOR',
            tblUsuariosConsultaID_USUARIO.AsString, []) then
          begin
            lb_destiny.Items.Add(tblUsuariosConsultaTX_NOME.AsString);
          end
          else
          begin
            lb_source.Items.Add(tblUsuariosConsultaTX_NOME.AsString);
          end;
          tblUsuariosConsulta.Next;
        end;
        // tblCampanhaDevedores.DisableControls;
        // tblCampanhaDevedores.First;
        pb_campanha.Position := 0;
        pb_campanha.Max := tblCampanhaDevedores.RecordCount * 10;
        if qtdCobrados.Connection = nil then
        begin
          qtdCobrados.Connection := dtmSystem.ZConnection;
        end;
        if not dtsCampanha.DataSet.IsEmpty then
        begin
          qtdCobrados.SQL.Text :=
          'select * from chg_campanhas_devedores where id_campanha = ' +
          dtsCampanha.DataSet.FieldByName('ID_CAMPANHA').AsString +
          ' and TP_ESTADO = ' + QuotedStr('B');
          qtdCobrados.Open;
          pb_campanha.Position := 10 * qtdCobrados.RecordCount;
          pb_campanha.Position := pb_campanha.Position - 1;
          pb_campanha.Position := pb_campanha.Position + 1;
        end;
        // tblCampanhaDevedores.First;
        // tblCampanhaDevedores.EnableControls;
        SetButtons;
      end;
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TfrmCampanha.dtsCampanhaStateChange(Sender: TObject);
begin
  inherited;
  pnl_info.Enabled := dtsCampanha.State in [dsEdit, dsInsert];
  // inherited do Cadastro
end;

procedure TfrmCampanha.dtsCampanha_consultaDataChange(Sender: TObject;
  Field: TField);
begin
end;

// que nao tinha pois janela nao veio do cad, mas funciona como uma

procedure TfrmCampanha.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
  begin
    lb_source.Items.AddObject(lb_destiny.Items[I], lb_destiny.Items.Objects[I]);
  end;
  lb_destiny.Items.Clear;
  SetItem(lb_destiny, 0);
end;

procedure TfrmCampanha.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 TfrmCampanha.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  if dtsCampanha.DataSet <> nil then
  begin // ver dts_campanhaStateChange
    dtsCampanha.DataSet.Filtered := false;
    if dtsCampanha.DataSet.State in [dsInsert, dsEdit] then
    begin
      dtsCampanha.DataSet.Cancel;
    end;
  end;

  with dtmSystem do
  begin
    tblCampanhaDevedores.close;
    tblUsuariosConsulta.close;
    tblCampanhaCob.close;
    tblCobCampanha.close;
  end;
  // frmCampanha := nil;
  // Action := caFree;
end;

procedure TfrmCampanha.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  inherited; // ver dts_campanhaStateChange
  if navPrincipal.DataSource <> nil then
  begin
    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;
end;

procedure TfrmCampanha.FormCreate(Sender: TObject);
var
  pos: Integer;
begin
  inherited;
  pos := 0;
  setlength(campanha_hints, pos + 1);
  cob_index := -1;
  with dtmSystem do
  begin
    if not(tblCobCampanha.Active) then
    begin
      tblCobCampanha.Open;
    end;
    if not(tblCampanhaDevedores.Active) then
    begin
      tblCampanhaDevedores.Open;
    end;
    if not(tblUsuariosConsulta.Active) then
    begin
      tblUsuariosConsulta.Open;
      tblUsuariosConsulta.First;
    end;
    if not(tblCampanhaCob.Active) then
    begin
      tblCampanhaCob.Open;
    end;
    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
      begin
        lb_source.Items.Add(tblUsuariosConsultaTX_NOME.AsString);
      end;
      tblUsuariosConsulta.Next;
    end;
    { if tblCobCampanha.RecordCount > 0 then
      begin
      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;
      end; }
  end;

  SetupHackedNavigator(navPrincipal, ImageList1);
  dtmSystem.tblCampanhaDevedores.Filtered := false;
  if dtmSystem.VerificarPermissao('CBR.04') then
  begin

  end;

end;

procedure TfrmCampanha.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_ESCAPE then
  begin
    Key := 0;
    close;
  end;
end;

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

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

procedure TfrmCampanha.navPrincipalBeforeAction(Sender: TObject;
  Button: TNavigateBtn);
var
  I, escolha: Integer;
  str_helper: string; // primeiro blocao ver dts_campanhaStateChange
begin

  case Button of
    nbFirst, nbPrior, nbNext, nbLast, nbRefresh:
      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;
      end;

    nbPost:
      begin
        // SelectNext(ActiveControl as tWinControl, True, True);
        escolha := mrYes;
        if lb_destiny.Items.Count < 1 then
        begin
          escolha :=
            MessageDlg('Você está prestes a criar uma campanha sem cobradores.'
            + ' Deseja continuar?', mtInformation, mbYesNo, 0);
        end;

        if escolha = mrYes then
        begin
          if lb_destiny.Items.Count > 0 then
          begin
            dtmSystem.tblUsuariosConsulta.Open;
            dtmSystem.tblCampanhaCob.Open;
            dtmSystem.tblCampanhaCob.Filtered := false;
            dtmSystem.tblCampanhaCob.Filter := 'ID_CAMPANHA = ' +
              dtmSystem.tblCobCampanhaID_CAMPANHA.AsString;
            dtmSystem.tblCampanhaCob.Filtered := True;
            dtmSystem.tblCampanhaCob.First;
            while dtmSystem.tblCampanhaCob.RecordCount > 0 do
            begin
              dtmSystem.tblCampanhaCob.Delete;
            end;
            for I := 0 to lb_destiny.Items.Count - 1 do
            begin
              str_helper := lb_destiny.Items[I];
              dtmSystem.tblUsuariosConsulta.Locate('TX_NOME', str_helper,
                [loCaseInsensitive, loPartialKey]);
              if not(dtmSystem.tblCampanhaCob.Locate('ID_COBRADOR',
                dtmSystem.tblUsuariosConsultaID_USUARIO.AsInteger, [])) then
              begin
                dtmSystem.tblCampanhaCob.append;
                // monta tabela de relação campanha - cobrador
                dtmSystem.tblCampanhaCobID_CAMPANHA.AsInteger :=
                  dtmSystem.tblCobCampanhaID_CAMPANHA.AsInteger;
                dtmSystem.tblCampanhaCobID_COBRADOR.AsInteger :=
                  dtmSystem.tblUsuariosConsultaID_USUARIO.AsInteger;
                dtmSystem.tblCampanhaCobID_ULTIMO_USUARIO.AsInteger :=
                  dtmSystem.id_usuario;
                dtmSystem.tblCampanhaCobDT_HORA_ULTIMA_ATT.AsDateTime := Now;
                dtmSystem.tblCampanhaCob.post;
              end;
              /// /////////////////
            end;
          end;
          dtmSystem.tblCampanhaCob.Filtered := false;
        end
        else
        begin
          Abort;
        end;
      end;

    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
        begin
          Abort;
        end;

        try
          dtsCampanha.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:
      begin
        if MessageDlg('Deseja cancelar as modificações?', mtConfirmation,
          [mbYes, mbNo], 0) = mrNo then
        begin
          Abort;
        end
        else
        begin
          if not(dtmSystem.tblUsuariosConsulta.Active) then
          begin
            dtmSystem.tblUsuariosConsulta.Open;
          end;
          dtmSystem.tblUsuariosConsulta.First;
          lb_destiny.Items.Clear;
          lb_source.Items.Clear;
          while not dtmSystem.tblUsuariosConsulta.Eof do
          begin
            if dtmSystem.tblCampanhaCob.Locate('ID_COBRADOR',
              dtmSystem.tblUsuariosConsultaID_USUARIO.AsString, []) then
            begin
              lb_destiny.Items.Add
                (dtmSystem.tblUsuariosConsultaTX_NOME.AsString);
              // adiciona as entradas pro list box
            end
            else
            begin
              lb_source.Items.Add
                (dtmSystem.tblUsuariosConsultaTX_NOME.AsString);
            end;
            dtmSystem.tblUsuariosConsulta.Next;
          end;
        end;
      end;
    nbInsert:
      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 not dtmSystem.tblDevedores.Active then
        begin
          dtmSystem.tblDevedores.Open;
        end;
        if dtmSystem.tblDevedores.RecordCount = 0 then
        begin
          MessageDlg
            ('Não há devedores cadastrados para que uma campanha possa ser montada.',
            mtWarning, [mbOK], 0);
          Abort;
        end;
        cadCampanha := TcadCampanha.Create(Self);
        with cadCampanha do // abre janela de criar campanha
        begin
          ShowModal;
          if ModalResult <> mrOk then
          begin
            navPrincipal.DataSource.DataSet.Cancel;
            cadCampanha := nil;
          end
          else if ModalResult = mrOk then
          begin
            navPrincipal.DataSource.DataSet.Refresh;
            dtsCampanha_consulta.DataSet.Refresh;
            cadCampanha := nil;
          end;
          Abort;
        end;
      end;
  end;

end;

procedure TfrmCampanha.ppmnu_nomedocClick(Sender: TObject);
var
  OpenOffice, OpenDesktop, OOCalc, OOExec, Planilha, LoadParams, Param,
    FilterParams, Param2: Variant;
  I: Integer;
  pathFile, nome: string;
begin
  if dtsCampanha_consulta.DataSet.IsEmpty then
  begin
    Abort;
  end;

  Screen.Cursor := crHourGlass;
  // dtsCampanha_consulta.DataSet.DisableControls;
  dtsCampanha_consulta.DataSet.First;
  if VarIsEmpty(OpenOffice) then
  begin
    OpenOffice := CreateOleObject('com.sun.star.ServiceManager');
  end;
  OpenDesktop := OpenOffice.CreateInstance('com.sun.star.frame.Desktop');

  LoadParams := VarArrayCreate([0, 0], varVariant);
  Param := OpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
  Param.Name := 'Hidden';
  Param.Value := True;
  LoadParams[0] := Param;

  OOExec := OpenDesktop.LoadComponentFromURL('private:factory/scalc', '_blank',
    0, LoadParams);
  OOCalc := OOExec.Sheets;
  Planilha := OOCalc.getbyIndex(0);
  I := 1;
  Planilha.getCellByPosition(0, 0).string := 'Nome';
  Planilha.getCellByPosition(1, 0).string := 'Documento';

  while not dtsCampanha_consulta.DataSet.Eof do
  begin
    Planilha.getCellByPosition(0, I).string :=
      dtsCampanha_consulta.DataSet.FieldByName('TX_NOME').AsString;
    Planilha.getCellByPosition(1, I).string :=
      dtsCampanha_consulta.DataSet.FieldByName('TX_DOCUMENTO').AsString;
    Planilha.getCellByPosition(0, I).getColumns.getbyIndex(0)
      .OptimalWidth := True;
    Planilha.getCellByPosition(1, I).getColumns.getbyIndex(0)
      .OptimalWidth := True;
    Inc(I, 1);
    dtsCampanha_consulta.DataSet.Next;
  end;

  FilterParams := VarArrayCreate([0, 1], varVariant);

  Param2 := OpenDesktop.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
  Param2.Name := 'FilterName';
  Param2.Value := 'MS Excel 97';
  FilterParams[0] := Param2;
  Param2.Name := 'Overwrite';
  Param2.Value := True;
  FilterParams[1] := Param2;

  nome := dtmSystem.tblCobCampanhaTX_NOME.AsString;
  nome := StringReplace(nome, ' ', '_', [rfReplaceAll]);

  // pathFile := GetCurrentDir;
  // pathFile := 'file:///' + pathFile + '\' + nome;
  // pathFile := StringReplace(pathFile, '\', '/', [rfReplaceAll]);

  pathFile := dtmSystem.path_executavel;
  pathFile := 'file:///' + pathFile + '\' + nome;
  pathFile := StringReplace(pathFile, '\', '/', [rfReplaceAll]);

  try
    OOExec.StoreAsURL(pathFile + '.xls', FilterParams);
    OOExec.close(false);
  finally
    OpenOffice := Unassigned;
  end;

  dtsCampanha_consulta.DataSet.First;
  // dtsCampanha_consulta.DataSet.EnableControls;

  Screen.Cursor := crDefault;
end;

procedure TfrmCampanha.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 TfrmCampanha.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
    begin
      Index := 0
    end
    else if Index > MaxIndex then
    begin
      Index := MaxIndex;
    end;
    if Index >= 0 then
    begin
      Selected[Index] := True;
    end;
  end;
  SetButtons;
end;

procedure TfrmCampanha.SetupHackedNavigator(const Navigator: TDBNavigator;
  const Glyphs: TImageList);
const
  Captions: array [TNavigateBtn] of string = ('Primeiro', 'Anterior', 'Próximo',
    'Último', 'Adicionar', 'Excluir', 'Alterar', '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;

procedure TfrmCampanha.WMMoving(var Msg: TWMMoving);
var
  workArea: TRect;
begin
  workArea := Screen.WorkareaRect;

  with Msg.DragRect^ do
  begin
    if left < workArea.left then
      OffsetRect(Msg.DragRect^, workArea.left - left, 0);

    if top < workArea.top then
      OffsetRect(Msg.DragRect^, 0, workArea.top - top);

    if Right > workArea.Right then
      OffsetRect(Msg.DragRect^, workArea.Right - Right, 0);

    if Bottom > workArea.Bottom then
      OffsetRect(Msg.DragRect^, 0, workArea.Bottom - Bottom);
  end;

end;

// procedure TfrmCampanha.ProgressBarStepIt(const Progressbar: TProgressBar;
// n: Integer);
// begin
// Progressbar.StepBy(n);
// Progressbar.Update;
// Progressbar.StepBy(n - 1);
// Progressbar.Update;
// Progressbar.StepBy(1);
// Progressbar.Update;
// Application.ProcessMessages;
//
// // same as
// (*
// ProgressBar1.Position := 1 + ProgressBar1.Position;
// ProgressBar1.Position := -1 + ProgressBar1.Position;
// ProgressBar1.Position := 1 + ProgressBar1.Position;
// *)
// end;

end.