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.