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.