unit uconfLayouts; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, System.win.ComObj, System.StrUtils, System.MaskUtils, Vcl.Buttons, generics.collections, System.UITypes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, umstMaster, Vcl.ComCtrls, Vcl.Grids, Vcl.DBCtrls, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Menus, Vcl.Mask, Data.DB, System.ImageList, Vcl.ImgList; type THackDBNavigator = class(TDBNavigator); type TconfLayouts = class(TmstMaster) MainMenu1: TMainMenu; mnuArquivo: TMenuItem; mnuCarregar: TMenuItem; mnuSalvar: TMenuItem; gb_list: TGroupBox; navPrincipal: TDBNavigator; dblulb_layouts: TDBLookupListBox; sg_layout: TStringGrid; lbl_nome: TLabel; pg_campos: TPageControl; tabDevedores: TTabSheet; tabTitulos: TTabSheet; lbl_qnt: TLabel; dtsLayouts: TDataSource; od_layout: TOpenDialog; gb_campos: TGroupBox; mnuNovo: TMenuItem; cb_nome: TCheckBox; cbx_nome: TComboBox; cbx_cpfcnpj: TComboBox; cb_cpfcnpj: TCheckBox; cbx_tel1: TComboBox; cb_tel1: TCheckBox; cb_nomepai: TCheckBox; cbx_nomepai: TComboBox; cb_rg: TCheckBox; cbx_rg: TComboBox; cb_end: TCheckBox; cbx_end: TComboBox; cb_nomemae: TCheckBox; cbx_nomemae: TComboBox; cb_num: TCheckBox; cbx_num: TComboBox; cb_cidade: TCheckBox; cbx_cidade: TComboBox; cb_uf: TCheckBox; cbx_uf: TComboBox; cb_comp: TCheckBox; cbx_comp: TComboBox; cbx_bairro: TComboBox; cb_bairro: TCheckBox; cbx_cep: TComboBox; cb_cep: TCheckBox; Gerarxls1: TMenuItem; mnuGerar: TMenuItem; cbx_tel2: TComboBox; cb_tel2: TCheckBox; cbx_tel3: TComboBox; cb_tel3: TCheckBox; ImageList1: TImageList; cb_dtnasc: TCheckBox; cbx_dtnasc: TComboBox; btn_visualizar: TButton; cb_produto: TCheckBox; cbx_produto: TComboBox; cb_valor: TCheckBox; cbx_valor: TComboBox; cbx_dtvence: TComboBox; cb_dtvence: TCheckBox; cb_banco: TCheckBox; cbx_banco: TComboBox; cb_nrcheque: TCheckBox; cbx_nrcheque: TComboBox; cb_motivo: TCheckBox; cbx_motivo: TComboBox; cb_cheque: TCheckBox; cbx_cheque: TComboBox; cb_coddev: TCheckBox; cbx_coddev: TComboBox; cb_email: TCheckBox; cbx_email: TComboBox; dbedt_nomelayout: TDBEdit; dbedt_nrcampos: TDBEdit; cbx_ddd1: TComboBox; cbx_ddd2: TComboBox; cbx_ddd3: TComboBox; lblddd1: TLabel; lblddd2: TLabel; lblddd3: TLabel; cb_ddd1: TCheckBox; cb_ddd2: TCheckBox; cb_ddd3: TCheckBox; cb_obstit: TCheckBox; cbx_obstit: TComboBox; cb_obsdev: TCheckBox; cbx_obsdev: TComboBox; cb_codigodevedor: TCheckBox; cbx_codigodevedor: TComboBox; cb_dtpag: TCheckBox; cbx_dtpag: TComboBox; procedure FormCreate(Sender: TObject); procedure mnuNovoClick(Sender: TObject); procedure mnuSalvarClick(Sender: TObject); procedure dtsLayoutsDataChange(Sender: TObject; Field: TField); procedure cb_nomeClick(Sender: TObject); procedure cb_nomepaiClick(Sender: TObject); procedure cb_nomemaeClick(Sender: TObject); procedure cb_cpfcnpjClick(Sender: TObject); procedure cb_rgClick(Sender: TObject); procedure cb_coddevClick(Sender: TObject); procedure cb_tel1Clic(Sender: TObject); procedure cb_endClick(Sender: TObject); procedure cb_numClick(Sender: TObject); procedure cb_cidadeClick(Sender: TObject); procedure cb_ufClick(Sender: TObject); procedure cb_compClick(Sender: TObject); procedure cb_cepClick(Sender: TObject); procedure cb_bairroClick(Sender: TObject); procedure mnuCarregarClick(Sender: TObject); procedure cb_tel2Click(Sender: TObject); procedure cb_tel3Click(Sender: TObject); procedure mnuGerarClick(Sender: TObject); procedure navPrincipalBeforeAction(Sender: TObject; Button: TNavigateBtn); procedure cb_dtnascClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btn_visualizarClick(Sender: TObject); procedure cb_produtoClick(Sender: TObject); procedure cb_valorClick(Sender: TObject); procedure cb_dtvenceClick(Sender: TObject); procedure cbx_nomeExit(Sender: TObject); procedure cbx_nomepaiExit(Sender: TObject); procedure cbx_nomemaeExit(Sender: TObject); procedure cbx_cpfcnpjExit(Sender: TObject); procedure cbx_rgExit(Sender: TObject); procedure cbx_coddevExit(Sender: TObject); procedure cbx_dtnascExit(Sender: TObject); procedure cbx_endExit(Sender: TObject); procedure cbx_numExit(Sender: TObject); procedure cbx_compExit(Sender: TObject); procedure cbx_cepExit(Sender: TObject); procedure cbx_bairroExit(Sender: TObject); procedure cbx_tel1Exit(Sender: TObject); procedure cbx_tel2Exit(Sender: TObject); procedure cbx_tel3Exit(Sender: TObject); procedure cbx_cidadeExit(Sender: TObject); procedure cbx_ufExit(Sender: TObject); procedure cbx_produtoExit(Sender: TObject); procedure cbx_valorExit(Sender: TObject); procedure cbx_dtvenceExit(Sender: TObject); procedure cb_bancoClick(Sender: TObject); procedure cbx_bancoExit(Sender: TObject); procedure cb_nrchequeClick(Sender: TObject); procedure cbx_nrchequeChange(Sender: TObject); procedure cb_motivoClick(Sender: TObject); procedure cbx_motivoChange(Sender: TObject); procedure cb_chequeClick(Sender: TObject); procedure cbx_chequeExit(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure cb_emailClick(Sender: TObject); procedure cbx_emailExit(Sender: TObject); procedure dbedt_nrcamposChange(Sender: TObject); procedure cbx_ddd1Exit(Sender: TObject); procedure cbx_ddd2Exit(Sender: TObject); procedure cbx_ddd3Exit(Sender: TObject); procedure cb_obstitClick(Sender: TObject); procedure cbx_obstitExit(Sender: TObject); procedure cb_obsdevClic(Sender: TObject); procedure cb_codigodevedorClick(Sender: TObject); procedure cbx_codigodevedorExit(Sender: TObject); procedure cb_dtpagClick(Sender: TObject); procedure cbx_dtpagExit(Sender: TObject); private procedure Carregar; function CmtoPix(cm: double): integer; function PixtoCM(pix: integer): double; procedure PovoaCB(tbSheet: TTabSheet); function MontaString(box: TComboBox): string; function CheckIndex(box: TComboBox): Boolean; procedure SetupHackedNavigator(const Navigator: TDBNavigator; const Glyphs: TImageList; S: string); procedure WMMoving(var Msg: TWMMoving); message WM_MOVING; // function EscreveHeader(index: integer): string; { Private declarations } public itemList: TStringList; listBox: TObjectList; listCheck: TObjectList; recno_helper: integer; { Public declarations } end; var confLayouts: TconfLayouts; const // O layout é guardado como uma string que indica onde cada elemento se encontra nas colunas da tabela. { Nome; Nome do Pai; Nome da Mãe; CPF/CNPJ; RG; Email; Data de Nascimento; Endereço; Número; Complemento; Bairro; Cidade; Estado; CEP; Telefone1; Telefone2; Telefone3; Produto; Valor; Data de Vencimento; Código do Devedor; (agora é aqui); É cheque; Banco; Nrº do cheque; Motivo; DDD1; DDD2; DDD3; Obs de Título; Obs de Devedor; Código do Devedor; Data de Pagamento } Header: array [0 .. 31] of string = ('Nome', 'Nome do Pai', 'Nome da Mãe', 'CPF/CNPJ', 'RG', 'Email', 'Data de Nascimento', 'Endereço', 'Número', 'Complemento', 'Bairro', 'Cidade', 'Estado', 'CEP', 'Telefone (1)', 'Telefone (2)', 'Telefone (3)', 'Produto', 'Valor', 'Data de Vencimento', 'Código do Devedor', 'É Cheque', 'Banco', 'Nrº do Cheque', 'Motivo', 'DDD1', 'DDD2', 'DDD3', 'Obs Título', 'Obs Devedor', 'Código do Devedor', 'Data de Pagamento'); // sempre atualizar no dtmSystem o valor do tamanho deste vetor para que o fix automático funcione. implementation {$R *.dfm} uses udtmSystem; procedure TconfLayouts.btn_visualizarClick(Sender: TObject); var i: integer; begin for i := 0 to listBox.Count - 1 do begin if listCheck[i].Checked then begin if listBox[i].Text <> '' then begin sg_layout.Cells[strtoint(listBox[i].Text) - 1, 0] := Header[i]; end; end; end; end; procedure TconfLayouts.Carregar; var OpenOffice, OpenDesktop, OOCalc, OOExec, Planilha, LoadParams, Param, OORCCount: Variant; RCount, CCount, TotCell, Counter, ColWidth, RowHeight, PColwidth, PRowHeight: integer; pathFile: string; i, j, k, l: integer; begin // procedimento pra gerar um arquivo xls pelo Open Office if od_layout.Execute then begin pathFile := StringReplace(od_layout.FileName, '\', '/', [rfReplaceAll]); pathFile := 'file:///' + pathFile; Screen.Cursor := crHourGlass; if VarIsEmpty(OpenOffice) then begin OpenOffice := CreateOleObject('com.sun.star.ServiceManager'); // abre o gerenciador end; OpenDesktop := OpenOffice.CreateInstance('com.sun.star.frame.Desktop'); // abre o desktop LoadParams := VarArrayCreate([0, 0], varVariant); // cria uma array de variáveis vazia Param := OpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue'); // copia os parâmetros standard do open office Param.Name := 'Hidden'; // seta pra não aparecer a janela Param.Value := true; LoadParams[0] := Param; OOExec := OpenDesktop.LoadComponentFromURL(pathFile, '_blank', 0, LoadParams); // abre o tables do open office OOCalc := OOExec.Sheets; // abre a planilha Planilha := OOCalc.getbyIndex(0); OORCCount := Planilha.createCursor; OORCCount.gotoEndOfUsedArea(false); RCount := OORCCount.RangeAddress.EndRow; CCount := OORCCount.RangeAddress.EndColumn; Inc(RCount, 1); Inc(CCount, 1); TotCell := RCount * CCount; Counter := 0; itemList := TStringList.Create; with itemList do begin for k := 0 to CCount - 1 do begin Add(inttostr(k + 1)); end; end; for l := 0 to sg_layout.ColCount - 1 do begin sg_layout.Cols[l].Clear; end; sg_layout.RowCount := RCount; sg_layout.ColCount := CCount; RowHeight := 0; for j := 0 to RCount - 1 do begin ColWidth := 0; for i := 0 to CCount - 1 do begin PColwidth := CmtoPix(Planilha.getCellByPosition(i, j) .getColumns.getbyIndex(0).Width); if ColWidth < PColwidth then begin ColWidth := PColwidth; end; PRowHeight := CmtoPix(Planilha.getCellByPosition(i, j).getRows.Height); if RowHeight < PRowHeight then begin RowHeight := PRowHeight; end; sg_layout.ColWidths[i] := ColWidth; sg_layout.RowHeights[j] := RowHeight; sg_layout.Cells[i, j] := Planilha.getCellByPosition(i, j).getFormula; end; end; try OOExec.Close(false); finally OpenOffice := Unassigned; Screen.Cursor := crDefault; SetFocus; end; end; PovoaCB(tabDevedores); PovoaCB(tabTitulos); itemList.Clear; // ud_qnt.Position := CCount; end; procedure TconfLayouts.cb_nomemaeClick(Sender: TObject); begin cbx_nomemae.Enabled := cb_nomemae.Checked; end; procedure TconfLayouts.cbx_bairroExit(Sender: TObject); begin if CheckIndex(cbx_bairro) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_bancoExit(Sender: TObject); begin inherited; if CheckIndex(cbx_banco) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_cepExit(Sender: TObject); begin if CheckIndex(cbx_cep) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_chequeExit(Sender: TObject); begin inherited; if CheckIndex(cbx_cheque) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_cidadeExit(Sender: TObject); begin if CheckIndex(cbx_cidade) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_coddevExit(Sender: TObject); begin if CheckIndex(cbx_coddev) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_codigodevedorExit(Sender: TObject); begin inherited; if CheckIndex(cbx_codigodevedor) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_compExit(Sender: TObject); begin if CheckIndex(cbx_comp) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_cpfcnpjExit(Sender: TObject); begin if CheckIndex(cbx_cpfcnpj) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_ddd1Exit(Sender: TObject); begin if CheckIndex(cbx_ddd1) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_ddd2Exit(Sender: TObject); begin if CheckIndex(cbx_ddd2) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_ddd3Exit(Sender: TObject); begin if CheckIndex(cbx_ddd3) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_dtnascExit(Sender: TObject); begin if CheckIndex(cbx_dtnasc) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_dtpagExit(Sender: TObject); begin inherited; if CheckIndex(cbx_dtpag) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_dtvenceExit(Sender: TObject); begin if CheckIndex(cbx_dtvence) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_emailExit(Sender: TObject); begin if CheckIndex(cbx_email) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_endExit(Sender: TObject); begin if CheckIndex(cbx_end) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_motivoChange(Sender: TObject); begin inherited; if CheckIndex(cbx_motivo) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_nomeExit(Sender: TObject); begin if CheckIndex(cbx_nome) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_nomemaeExit(Sender: TObject); begin if CheckIndex(cbx_nomemae) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_nomepaiExit(Sender: TObject); begin if CheckIndex(cbx_nomepai) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_nrchequeChange(Sender: TObject); begin inherited; if CheckIndex(cbx_nrcheque) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_numExit(Sender: TObject); begin if CheckIndex(cbx_num) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_obstitExit(Sender: TObject); begin inherited; if CheckIndex(cbx_obstit) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_produtoExit(Sender: TObject); begin if CheckIndex(cbx_produto) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_rgExit(Sender: TObject); begin if CheckIndex(cbx_rg) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_tel1Exit(Sender: TObject); begin if CheckIndex(cbx_tel1) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_tel2Exit(Sender: TObject); begin if CheckIndex(cbx_tel2) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_tel3Exit(Sender: TObject); begin if CheckIndex(cbx_tel3) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_ufExit(Sender: TObject); begin if CheckIndex(cbx_uf) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cbx_valorExit(Sender: TObject); begin if CheckIndex(cbx_valor) then begin MessageDlg('Já existe um campo relacionado a essa coluna.', mtInformation, [mbOK], 0); end; end; procedure TconfLayouts.cb_bairroClick(Sender: TObject); begin cbx_bairro.Enabled := cb_bairro.Checked; end; procedure TconfLayouts.cb_bancoClick(Sender: TObject); begin inherited; cbx_banco.Enabled := cb_banco.Checked; end; procedure TconfLayouts.cb_cepClick(Sender: TObject); begin cbx_cep.Enabled := cb_cep.Checked; end; procedure TconfLayouts.cb_chequeClick(Sender: TObject); begin inherited; cb_banco.Enabled := cb_cheque.Checked; cb_nrcheque.Enabled := cb_cheque.Checked; cb_motivo.Enabled := cb_cheque.Checked; cbx_cheque.Enabled := cb_cheque.Checked; end; procedure TconfLayouts.cb_cidadeClick(Sender: TObject); begin cbx_cidade.Enabled := cb_cidade.Checked; end; procedure TconfLayouts.cb_coddevClick(Sender: TObject); begin cbx_coddev.Enabled := cb_coddev.Checked; end; procedure TconfLayouts.cb_codigodevedorClick(Sender: TObject); begin inherited; cbx_codigodevedor.Enabled := cb_codigodevedor.Checked; end; procedure TconfLayouts.cb_compClick(Sender: TObject); begin cbx_comp.Enabled := cb_comp.Checked; end; procedure TconfLayouts.cb_cpfcnpjClick(Sender: TObject); begin cbx_cpfcnpj.Enabled := cb_cpfcnpj.Checked; end; procedure TconfLayouts.cb_dtnascClick(Sender: TObject); begin cbx_dtnasc.Enabled := cb_dtnasc.Checked; end; procedure TconfLayouts.cb_dtpagClick(Sender: TObject); begin inherited; cbx_dtpag.Enabled := cb_dtpag.Checked; end; procedure TconfLayouts.cb_dtvenceClick(Sender: TObject); begin cbx_dtvence.Enabled := cb_dtvence.Checked; end; procedure TconfLayouts.cb_emailClick(Sender: TObject); begin inherited; cbx_email.Enabled := cb_email.Checked; end; procedure TconfLayouts.cb_endClick(Sender: TObject); begin cbx_end.Enabled := cb_end.Checked; if cb_end.Checked then begin cb_num.Enabled := true; cb_cidade.Enabled := true; cb_uf.Enabled := true; cb_comp.Enabled := true; cb_cep.Enabled := true; cb_bairro.Enabled := true; end else begin cb_num.Checked := false; cb_num.Enabled := false; cbx_num.Enabled := false; cb_cidade.Checked := false; cb_cidade.Enabled := false; cbx_cidade.Enabled := false; cb_uf.Checked := false; cb_uf.Enabled := false; cbx_uf.Enabled := false; cb_comp.Checked := false; cb_comp.Enabled := false; cbx_comp.Enabled := false; cb_cep.Checked := false; cb_cep.Enabled := false; cbx_cep.Enabled := false; cb_bairro.Checked := false; cb_bairro.Enabled := false; cbx_bairro.Enabled := false; end; end; procedure TconfLayouts.cb_motivoClick(Sender: TObject); begin inherited; cbx_motivo.Enabled := cb_motivo.Checked; end; procedure TconfLayouts.cb_nomeClick(Sender: TObject); begin cbx_nome.Enabled := cb_nome.Checked; end; procedure TconfLayouts.cb_nomepaiClick(Sender: TObject); begin cbx_nomepai.Enabled := cb_nomepai.Checked; end; procedure TconfLayouts.cb_nrchequeClick(Sender: TObject); begin inherited; cbx_nrcheque.Enabled := cb_nrcheque.Checked; end; procedure TconfLayouts.cb_numClick(Sender: TObject); begin cbx_num.Enabled := cb_num.Checked; end; procedure TconfLayouts.cb_produtoClick(Sender: TObject); begin cbx_produto.Enabled := cb_produto.Checked; end; procedure TconfLayouts.cb_rgClick(Sender: TObject); begin cbx_rg.Enabled := cb_rg.Checked; end; procedure TconfLayouts.cb_tel1Clic(Sender: TObject); begin cbx_tel1.Enabled := cb_tel1.Checked; cbx_ddd1.Enabled := cb_tel1.Checked; cb_ddd1.Checked := cb_tel1.Checked; end; procedure TconfLayouts.cb_tel2Click(Sender: TObject); begin cbx_tel2.Enabled := cb_tel2.Checked; cbx_ddd2.Enabled := cb_tel2.Checked; cb_ddd2.Checked := cb_tel2.Checked; end; procedure TconfLayouts.cb_tel3Click(Sender: TObject); begin cbx_tel3.Enabled := cb_tel3.Checked; cbx_ddd3.Enabled := cb_tel3.Checked; cb_ddd3.Checked := cb_tel3.Checked; end; procedure TconfLayouts.cb_ufClick(Sender: TObject); begin cbx_uf.Enabled := cb_uf.Checked; end; procedure TconfLayouts.cb_valorClick(Sender: TObject); begin cbx_valor.Enabled := cb_valor.Checked; end; procedure TconfLayouts.cb_obsdevClic(Sender: TObject); begin inherited; cbx_obsdev.Enabled := cb_obsdev.Checked; end; procedure TconfLayouts.cb_obstitClick(Sender: TObject); begin inherited; cbx_obstit.Enabled := cb_obstit.Checked; end; function TconfLayouts.CheckIndex(box: TComboBox): Boolean; var i: integer; begin for i := 0 to listBox.Count - 1 do begin if box.Text = '' then begin result := false; break; end; if listCheck[i].Checked then begin if box.Name <> listBox[i].Name then begin if box.Text = listBox[i].Text then begin box.ItemIndex := -1; result := true; break; end else begin result := false; end; end; end; end; end; function TconfLayouts.CmtoPix(cm: double): integer; var ppcm: double; begin ppcm := Screen.PixelsPerInch / 2540; result := Trunc(ppcm * cm); end; procedure TconfLayouts.dbedt_nrcamposChange(Sender: TObject); var k: integer; begin if dbedt_nrcampos.Text <> '' then begin sg_layout.ColCount := strtoint(dbedt_nrcampos.Text); end else begin sg_layout.ColCount := 0; end; itemList := TStringList.Create; try with itemList do begin if dbedt_nrcampos.Text <> '' then begin for k := 0 to strtoint(dbedt_nrcampos.Text) - 1 do begin Add(inttostr(k + 1)); end; end else begin for k := 0 to 1 - 1 do begin Add(inttostr(k + 1)); end; end; end; PovoaCB(tabDevedores); PovoaCB(tabTitulos); finally itemList.Clear; end; end; procedure TconfLayouts.dtsLayoutsDataChange(Sender: TObject; Field: TField); var lista: TStringList; i, k: integer; string_helper: string; begin gb_campos.Enabled := dtsLayouts.State in [dsEdit, dsInsert]; // ud_qnt.Enabled := dtsLayouts.State in [dsEdit, dsInsert]; // edt_nome.ReadOnly := dtsLayouts.State in [dsBrowse]; tabDevedores.Enabled := dtsLayouts.State in [dsEdit, dsInsert]; tabTitulos.Enabled := dtsLayouts.State in [dsEdit, dsInsert]; btn_visualizar.Enabled := dtsLayouts.State in [dsEdit, dsInsert]; string_helper := 'Quantidade total de entradas: ' + inttostr(dtsLayouts.DataSet.RecordCount) + '.';; stbStatus.Panels[0].Width := stbStatus.Canvas.TextWidth(string_helper) + 20; stbStatus.Panels[0].Text := string_helper; string_helper := 'Entrada atual: ' + inttostr(dtsLayouts.DataSet.RecNo) + '.'; stbStatus.Panels[1].Width := stbStatus.Canvas.TextWidth(string_helper) + 20; stbStatus.Panels[1].Text := string_helper; if not(dtsLayouts.DataSet.IsEmpty) then begin if dtsLayouts.State in [dsBrowse] then begin if recno_helper <> dtmSystem.tblLayouts.RecNo then begin itemList := TStringList.Create; try with itemList do begin for k := 0 to strtoint(dbedt_nrcampos.Text) - 1 do begin Add(inttostr(k + 1)); end; end; PovoaCB(tabDevedores); PovoaCB(tabTitulos); finally end; recno_helper := dtmSystem.tblLayouts.RecNo; if dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger > 0 then begin sg_layout.ColCount := dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger; // ud_qnt.Position := dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger; end; lista := TStringList.Create; try lista.Clear; lista.Delimiter := ';'; lista.DelimitedText := dtmSystem.tblLayoutsSTR_CAMPOS.AsString; finally end; for i := 0 to lista.Count - 2 do begin if strtoint(lista[i]) > 0 then begin sg_layout.Cells[strtoint(lista[i]) - 1, 0] := Header[i]; if Assigned(listBox) then begin listBox[i].Enabled := true; listBox[i].ItemIndex := strtoint(lista[i]) - 1; try listCheck[i].Checked := true; except end; end; end else begin // if i < sg_layout.ColCount then // begin // sg_layout.Cells[strtoint(lista[i]) - 1, 0] := ''; if Assigned(listBox) then begin listBox[i].Enabled := false; listBox[i].ItemIndex := -1; listBox[i].Text := ''; try listCheck[i].Checked := false; except end; end; // end; end; end; end; end; end; end; procedure TconfLayouts.FormClose(Sender: TObject; var Action: TCloseAction); begin dtsLayouts.DataSet.Close; Action := caFree; confLayouts := nil; end; procedure TconfLayouts.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin 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 TconfLayouts.FormCreate(Sender: TObject); var lista: TStringList; i, k: integer; begin recno_helper := -1; if not(dtsLayouts.DataSet.Active) then begin dtsLayouts.DataSet.Open; end; SetupHackedNavigator(navPrincipal, ImageList1, 's'); if dtsLayouts.DataSet.FieldByName('NR_QNTCAMPOS').AsString <> '' then begin sg_layout.ColCount := dtsLayouts.DataSet.FieldByName('NR_QNTCAMPOS') .AsInteger; // edt_qnt.Text := dtsLayouts.DataSet.FieldByName('NR_QNTCAMPOS').AsString; end else begin sg_layout.ColCount := 0; end; // ud_qnt.Position := dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger; listBox := TObjectList.Create; listBox.OwnsObjects := false; listBox.Add(cbx_nome); listBox.Add(cbx_nomepai); listBox.Add(cbx_nomemae); listBox.Add(cbx_cpfcnpj); listBox.Add(cbx_rg); listBox.Add(cbx_email); listBox.Add(cbx_dtnasc); listBox.Add(cbx_end); listBox.Add(cbx_num); listBox.Add(cbx_comp); listBox.Add(cbx_bairro); listBox.Add(cbx_cidade); listBox.Add(cbx_uf); listBox.Add(cbx_cep); listBox.Add(cbx_tel1); listBox.Add(cbx_tel2); listBox.Add(cbx_tel3); listBox.Add(cbx_produto); listBox.Add(cbx_valor); listBox.Add(cbx_dtvence); listBox.Add(cbx_coddev); // mudou pra cá listBox.Add(cbx_cheque); listBox.Add(cbx_banco); listBox.Add(cbx_nrcheque); listBox.Add(cbx_motivo); listBox.Add(cbx_ddd1); listBox.Add(cbx_ddd2); listBox.Add(cbx_ddd3); listBox.Add(cbx_obstit); listBox.Add(cbx_obsdev); listBox.Add(cbx_codigodevedor); listBox.Add(cbx_dtpag); listCheck := TObjectList.Create; listCheck.OwnsObjects := false; listCheck.Add(cb_nome); listCheck.Add(cb_nomepai); listCheck.Add(cb_nomemae); listCheck.Add(cb_cpfcnpj); listCheck.Add(cb_rg); listCheck.Add(cb_email); listCheck.Add(cb_dtnasc); listCheck.Add(cb_end); listCheck.Add(cb_num); listCheck.Add(cb_comp); listCheck.Add(cb_bairro); listCheck.Add(cb_cidade); listCheck.Add(cb_uf); listCheck.Add(cb_cep); listCheck.Add(cb_tel1); listCheck.Add(cb_tel2); listCheck.Add(cb_tel3); listCheck.Add(cb_produto); listCheck.Add(cb_valor); listCheck.Add(cb_dtvence); listCheck.Add(cb_coddev); // mudou pra cá listCheck.Add(cb_cheque); listCheck.Add(cb_banco); listCheck.Add(cb_nrcheque); listCheck.Add(cb_motivo); listCheck.Add(cb_ddd1); listCheck.Add(cb_ddd2); listCheck.Add(cb_ddd3); listCheck.Add(cb_obstit); listCheck.Add(cb_obsdev); listCheck.Add(cb_codigodevedor); listCheck.Add(cb_dtpag); // ud_qnt.Max := listBox.Count; pg_campos.ActivePageIndex := 0; lista := TStringList.Create; try lista.Clear; lista.Delimiter := ';'; lista.DelimitedText := dtmSystem.tblLayoutsSTR_CAMPOS.AsString; finally end; for i := 0 to lista.Count - 2 do begin if strtoint(lista[i]) > 0 then begin listBox[i].ItemIndex := strtoint(lista[i]) - 1; try listCheck[i].Checked := true; except end; end; end; end; procedure TconfLayouts.mnuCarregarClick(Sender: TObject); begin Carregar; end; procedure TconfLayouts.mnuGerarClick(Sender: TObject); var OpenOffice, OpenDesktop, OOCalc, OOExec, Planilha, LoadParams, Param, FilterParams, Param2: Variant; i: integer; lista: TStringList; pathFile, nome: string; begin Screen.Cursor := crHourGlass; if dtsLayouts.State in [dsEdit, dsInsert] then begin MessageDlg('Por favor salve ou cancele qualquer' + ' alterações no layout antes de gerar o arquivo .xls', mtWarning, [mbOK], 0); abort; end; // gera uma planilha conforme o string grid do layout 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); lista := TStringList.Create; try lista.Clear; lista.Delimiter := ';'; lista.DelimitedText := dtmSystem.tblLayoutsSTR_CAMPOS.AsString; finally end; for i := 0 to lista.Count - 2 do begin if lista[i] <> '0' then begin Planilha.getCellByPosition(strtoint(lista[i]) - 1, 0).string := UpperCase(Header[i]); Planilha.getCellByPosition(strtoint(lista[i]) - 1, 0).HoriJustify := 3; Planilha.getCellByPosition(strtoint(lista[i]) - 1, 0) .getText.createTextCursor.CharWeight := 150; Planilha.getCellByPosition(strtoint(lista[i]) - 1, 0) .getColumns.getbyIndex(0).Width := PixtoCM(sg_layout.ColWidths[strtoint(lista[i]) - 1]); Planilha.getCellByPosition(strtoint(lista[i]), 0).getColumns.getbyIndex(0) .OptimalWidth := true; end; 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.tblLayoutsTX_NOME.AsString; nome := StringReplace(nome, ' ', '_', [rfReplaceAll]); // pathFile := GetCurrentDir; // pathFile := 'file:///' + pathFile + '\Layouts\' + nome; // pathFile := StringReplace(pathFile, '\', '/', [rfReplaceAll]); pathFile := GetCurrentDir; pathFile := 'file:///' + dtmSystem.path_executavel + '\Layouts\' + nome; pathFile := StringReplace(pathFile, '\', '/', [rfReplaceAll]); try OOExec.StoreAsURL(pathFile + '.xls', FilterParams); OOExec.Close(false); finally OpenOffice := Unassigned; end; Screen.Cursor := crDefault; end; procedure TconfLayouts.mnuNovoClick(Sender: TObject); var i, j: integer; begin with dtmSystem do begin tblLayouts.Append; end; for i := 0 to listBox.Count - 1 do begin listBox[i].Enabled := false; listBox[i].ItemIndex := -1; listBox[i].Text := ''; end; for j := 0 to listCheck.Count - 1 do begin listCheck[j].Checked := false; end; end; procedure TconfLayouts.mnuSalvarClick(Sender: TObject); var string_helper: string; begin { Por ordem de leitura: 0 = não inclui; > 0 = inclui; Nome; Nome do Pai; Nome da Mãe; CPF/CNPJ; RG; Email; Data de Nascimento; Endereço; Número; Complemento; Bairro; Cidade; Estado; CEP; Telefone (1); Telefone (2); Telefone (3); Produto; Valor; Data de Vencimento; Código do Devedor; É cheque; Banco; Nrº do Cheque; Motivo ; Observação dos Títulos} string_helper := ''; string_helper := string_helper + MontaString(cbx_nome); string_helper := string_helper + MontaString(cbx_nomepai); string_helper := string_helper + MontaString(cbx_nomemae); string_helper := string_helper + MontaString(cbx_cpfcnpj); string_helper := string_helper + MontaString(cbx_rg); string_helper := string_helper + MontaString(cbx_email); string_helper := string_helper + MontaString(cbx_dtnasc); string_helper := string_helper + MontaString(cbx_end); string_helper := string_helper + MontaString(cbx_num); string_helper := string_helper + MontaString(cbx_comp); string_helper := string_helper + MontaString(cbx_bairro); string_helper := string_helper + MontaString(cbx_cidade); string_helper := string_helper + MontaString(cbx_uf); string_helper := string_helper + MontaString(cbx_cep); string_helper := string_helper + MontaString(cbx_tel1); string_helper := string_helper + MontaString(cbx_tel2); string_helper := string_helper + MontaString(cbx_tel3); string_helper := string_helper + MontaString(cbx_produto); string_helper := string_helper + MontaString(cbx_valor); string_helper := string_helper + MontaString(cbx_dtvence); string_helper := string_helper + MontaString(cbx_coddev); // agora é aqui string_helper := string_helper + MontaString(cbx_cheque); string_helper := string_helper + MontaString(cbx_banco); string_helper := string_helper + MontaString(cbx_nrcheque); string_helper := string_helper + MontaString(cbx_motivo); string_helper := string_helper + MontaString(cbx_ddd1); string_helper := string_helper + MontaString(cbx_ddd2); string_helper := string_helper + MontaString(cbx_ddd3); string_helper := string_helper + MontaString(cbx_obstit); string_helper := string_helper + MontaString(cbx_obsdev); string_helper := string_helper + MontaString(cbx_codigodevedor); if dtsLayouts.State in [dsEdit, dsInsert] then begin dtmSystem.tblLayoutsSTR_CAMPOS.AsWideString := string_helper; // dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger := strtoint(edt_qnt.Text); end; if dtsLayouts.State in [dsBrowse] then begin dtmSystem.tblLayouts.Edit; dtmSystem.tblLayoutsSTR_CAMPOS.AsString := string_helper; // dtmSystem.tblLayoutsNR_QNTCAMPOS.AsInteger := strtoint(edt_qnt.Text); end; if not(Sender is TDBNavigator) then begin dtmSystem.tblLayouts.Post; end; end; function TconfLayouts.MontaString(box: TComboBox): string; begin if (box.Text <> '') and (strtoint(box.Text) > 0) and box.Enabled then begin result := box.Text + ';'; end else begin result := '0;'; end; end; procedure TconfLayouts.navPrincipalBeforeAction(Sender: TObject; Button: TNavigateBtn); begin case Button of nbFirst, nbPrior, nbNext, nbLast, nbInsert, 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 else begin if Button = nbInsert then begin mnuNovo.OnClick(navPrincipal); abort; end; end; end; nbPost: begin mnuSalvar.OnClick(navPrincipal); SelectNext(ActiveControl as tWinControl, true, true); 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 abort; try dtsLayouts.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 = nbPost then begin mnuSalvar.OnClick(Self); abort; end; if Button = nbInsert then begin mnuNovo.OnClick(Self); abort; end; } end; function TconfLayouts.PixtoCM(pix: integer): double; var ppcm: double; begin ppcm := Screen.PixelsPerInch / 2540; result := pix / ppcm; end; procedure TconfLayouts.PovoaCB(tbSheet: TTabSheet); var i: integer; begin // povoa os combo boxes com os índices do número de colunas que se pode ter if tbSheet.ControlCount > 0 then begin for i := 0 to tbSheet.ControlCount - 1 do begin if tbSheet.Controls[i] is TComboBox then begin with tbSheet.Controls[i] as TComboBox do begin Items.BeginUpdate; try begin Items.Clear; Items.AddStrings(itemList); end; finally Items.EndUpdate; end; end; end; end; // itemList.Free; end; end; procedure TconfLayouts.SetupHackedNavigator(const Navigator: TDBNavigator; const Glyphs: TImageList; S: string); 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'); *) Hints: array [TNavigateBtn] of string = ('Primeiro', 'Anterior', 'Próximo', 'Último', 'Adicionar', 'Apagar', 'Modificar', 'Confirmar', 'Cancelar', 'Atualizar', 'Aplicar Atualizações', 'Cancelar Atualizãções'); 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 Hint := Hints[btn]; if S = 's' then begin Caption := Captions[btn]; end; // 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 TconfLayouts.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; end.