You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

599 lines
17 KiB

unit ucadEmpresa;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Jpeg, Clipbrd, System.UITypes,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, umstCadastro, Data.DB, Vcl.ExtCtrls,
Vcl.DBCtrls, Vcl.StdCtrls, Vcl.Mask, Vcl.ComCtrls, Vcl.Buttons,
System.ImageList, Vcl.ImgList, Vcl.ExtDlgs, rImageZoom, rDBComponents,
Vcl.Menus, ACBrBase, ACBrMail, Vcl.Grids, Vcl.DBGrids;
// Tentando "Hackear" o TDBNavigator
type
THackDBNavigator = class(TDBNavigator);
type
TcadEmpresa = class(TmstCadastro)
lbl_cidade: TLabel;
lbl_bairro: TLabel;
lbl_tel: TLabel;
lbl_email: TLabel;
lbl_website: TLabel;
lbl_fantasia: TLabel;
lbl_cnpj: TLabel;
lbl_inscriest: TLabel;
lbl_inscrimuni: TLabel;
lbl_cep: TLabel;
lbl_end: TLabel;
lbl_num: TLabel;
lbl_compl: TLabel;
lbl_uf: TLabel;
dblucmbox_cidade: TDBLookupComboBox;
dbedt_bairro: TDBEdit;
dbedt_tel: TDBEdit;
dbedt_email: TDBEdit;
dbedt_website: TDBEdit;
dbedt_fantasia: TDBEdit;
dbedt_cnpj: TDBEdit;
dbedt_inscriest: TDBEdit;
dbedt_inscrimuni: TDBEdit;
dbedt_cep: TDBEdit;
dbedt_end: TDBEdit;
dbedt_num: TDBEdit;
dbedt_compl: TDBEdit;
dblucmbox_uf: TDBLookupComboBox;
tabLogo: TTabSheet;
spdbtn_clearimg: TSpeedButton;
spdbtn_loadimg: TSpeedButton;
lbl_carregarimg: TLabel;
lbl_limparimg: TLabel;
ImageList2: TImageList;
tabEmail: TTabSheet;
btn_testconex: TButton;
dtsUF: TDataSource;
dtsCidades: TDataSource;
tabJuros: TTabSheet;
lbl_debito: TLabel;
dbedt_debito: TDBEdit;
lbl_credvista: TLabel;
dbedt_credvista: TDBEdit;
lbl_cred3: TLabel;
dbedt_cred3: TDBEdit;
lbl_cred6: TLabel;
dbedt_cred6: TDBEdit;
lbl_cred12: TLabel;
dbedt_cred12: TDBEdit;
rdbimg_logo: TrDBImage;
opd_logo: TOpenPictureDialog;
lbl_financiamento: TLabel;
dbedt_financiamento: TDBEdit;
lbl_titulologo: TLabel;
dbedt_titulologo: TDBEdit;
PopupMenu1: TPopupMenu;
Copiar1: TMenuItem;
gb_taxacredor: TGroupBox;
gb_repassebanco: TGroupBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
dbedt_credvistabanco: TDBEdit;
dbedt_debitobanco: TDBEdit;
dbedt_cred3banco: TDBEdit;
dbedt_cred12banco: TDBEdit;
dbedt_cred6banco: TDBEdit;
ACBrMail: TACBrMail;
pnl_email: TPanel;
lbl_nomeemail: TLabel;
dbedt_nomeemail: TDBEdit;
lbl_useremail: TLabel;
dbedt_useremail: TDBEdit;
lbl_senhaemail: TLabel;
dbedt_senhaemail: TDBEdit;
Label1: TLabel;
DBEdit2: TDBEdit;
lbl_smtp: TLabel;
dbedt_smtp: TDBEdit;
lbl_portasmtp: TLabel;
dbedt_portasmtp: TDBEdit;
dbcb_tls: TDBCheckBox;
dbcb_ssl: TDBCheckBox;
Label7: TLabel;
DBEdit3: TDBEdit;
Label8: TLabel;
DBEdit4: TDBEdit;
dbgrdCartoes: TDBGrid;
dbnavCartoes: TDBNavigator;
procedure dtsDBDataChange(Sender: TObject; Field: TField);
procedure FormCreate(Sender: TObject);
procedure dtsUFDataChange(Sender: TObject; Field: TField);
procedure dtsCidadesDataChange(Sender: TObject; Field: TField);
procedure dtsDBStateChange(Sender: TObject);
procedure spdbtn_loadimgClick(Sender: TObject);
procedure spdbtn_clearimgClick(Sender: TObject);
procedure Copiar1Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure navPrincipalBeforeAction(Sender: TObject; Button: TNavigateBtn);
procedure btn_testconexClick(Sender: TObject);
private
procedure SetupHackedNavigator(const Navigator: TDBNavigator;
const Glyphs: TImageList);
function JpgToBmp(path: string): string;
function FindSubcontrolAtPos(AControl: TControl;
AScreenPos, AClientPos: TPoint): TControl;
function FindControlAtPos(AScreenPos: TPoint): TControl;
procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
{ Private declarations }
public
pos: TPoint;
primeiro_cad: boolean;
{ Public declarations }
end;
var
cadEmpresa: TcadEmpresa;
implementation
{$R *.dfm}
uses udtmSystem;
// praticamente tudo aqui é igual ao cadastro de beneficiários
// única coisa que muda é a adição do tratamento da logomarca que
// segue a mesma lógica dos componentes que usam o banco, mas não
// são componentes de database
procedure TcadEmpresa.btn_testconexClick(Sender: TObject);
begin
with ACBrMail do
begin
try
Clear;
IsHTML := true;
Subject := 'Teste de conexão';
From := dtmSystem.tblEmpresaTX_EMAIL.AsString;
FromName := dtmSystem.tblEmpresaTX_EMAILNOME.AsString;
Host := dtmSystem.tblEmpresaTX_SMTP.AsString;
Username := dtmSystem.tblEmpresaTX_USUARIO.AsString;
Password := dtmSystem.tblEmpresaTX_SENHA.AsString;
Port := dtmSystem.tblEmpresaTX_PORTA.AsString;
if dtmSystem.tblEmpresaTP_TLS.AsString = 'S' then
begin
SetTLS := true;
end
else
begin
SetTLS := false;
end;
if dtmSystem.tblEmpresaTP_SSL.AsString = 'S' then
begin
SetSSL := true;
end
else
begin
SetSSL := false;
end;
DefaultCharset := TMailCharset(0);
IDECharset := TMailCharset(0);
AddAddress('marcus@nexverse.com.br', 'Teste de conexão');
Body.Text := 'Teste de conexão';
Screen.Cursor := crHourGlass;
Send(false);
Application.ProcessMessages;
Screen.Cursor := crDefault;
Showmessage
('Email teste enviado com sucesso. Configuração de email correta!');
except
Screen.Cursor := crDefault;
Showmessage
('Falha ao enviar email de teste. Configuração de email incorreta!');
end;
end;
end;
procedure TcadEmpresa.Copiar1Click(Sender: TObject);
var
Control: TControl;
begin
// usa duas funções que achei na net pra pegar o controle na pos do mouse pra poder copiar o conteúdo dele mesmo desabilitado
Control := FindControlAtPos(pos);
if Control is TDBEdit then
begin
Clipboard.AsText := (Control as TDBEdit).Text;
end;
if Control is TDBLookupComboBox then
begin
Clipboard.AsText := (Control as TDBLookupComboBox).Text;
end;
if Control is TrDBDateTimePicker then
begin
Clipboard.AsText := formatdatetime('dd/mm/yyyy',
(Control as TrDBDateTimePicker).Date);
end;
if Control is TDBMemo then
begin
(Control as TDBMemo).SelectAll;
(Control as TDBMemo).CopyToClipboard;
end;
end;
procedure TcadEmpresa.dtsCidadesDataChange(Sender: TObject; Field: TField);
begin
inherited;
if (dtmSystem.tblEmpresaID_CIDADE.AsVariant >= 0) then
begin
dblucmbox_cidade.KeyValue := dtmSystem.tblEmpresaID_CIDADE.AsVariant;
end;
end;
procedure TcadEmpresa.dtsDBDataChange(Sender: TObject; Field: TField);
begin
inherited;
// tabLogo.Enabled := grpDescricao.Enabled;
end;
procedure TcadEmpresa.dtsDBStateChange(Sender: TObject);
begin
inherited;
tabLogo.Enabled := grpDescricao.Enabled;
pnl_email.Enabled := grpDescricao.Enabled;
tabJuros.Enabled := grpDescricao.Enabled;
end;
procedure TcadEmpresa.dtsUFDataChange(Sender: TObject; Field: TField);
begin
if (dtmSystem.tblEmpresaID_ESTADO.AsVariant >= 0) then
begin
dblucmbox_uf.KeyValue := dtmSystem.tblEmpresaID_ESTADO.AsVariant;
end;
if (dtmSystem.tblEmpresaID_CIDADE.AsVariant >= 0) then
begin
dblucmbox_cidade.KeyValue := dtmSystem.tblEmpresaID_CIDADE.AsVariant;
end;
end;
function TcadEmpresa.FindControlAtPos(AScreenPos: TPoint): TControl;
var
i: Integer;
f, m: TForm;
p: TPoint;
r: TRect;
begin
Result := nil;
for i := Screen.FormCount - 1 downto 0 do
begin
f := Screen.Forms[i];
if f.Visible and (f.Parent = nil) and (f.FormStyle <> fsMDIChild) and
TRect.Create(f.Left, f.Top, f.Left + f.Width, f.Top + f.Height)
.Contains(AScreenPos) then
Result := f;
end;
Result := FindSubcontrolAtPos(Result, AScreenPos, AScreenPos);
if (Result is TForm) and (TForm(Result).ClientHandle <> 0) then
begin
Winapi.Windows.GetWindowRect(TForm(Result).ClientHandle, r);
p := TPoint.Create(AScreenPos.X - r.Left, AScreenPos.Y - r.Top);
m := nil;
for i := TForm(Result).MDIChildCount - 1 downto 0 do
begin
f := TForm(Result).MDIChildren[i];
if TRect.Create(f.Left, f.Top, f.Left + f.Width, f.Top + f.Height)
.Contains(p) then
m := f;
end;
if m <> nil then
Result := FindSubcontrolAtPos(m, AScreenPos, p);
end;
end;
function TcadEmpresa.FindSubcontrolAtPos(AControl: TControl;
AScreenPos, AClientPos: TPoint): TControl;
var
i: Integer;
C: TControl;
begin
Result := nil;
C := AControl;
if (C = nil) or not C.Visible or not TRect.Create(C.Left, C.Top,
C.Left + C.Width, C.Top + C.Height).Contains(AClientPos) then
Exit;
Result := AControl;
if AControl is TWinControl then
for i := 0 to TWinControl(AControl).ControlCount - 1 do
begin
C := FindSubcontrolAtPos(TWinControl(AControl).Controls[i], AScreenPos,
AControl.ScreenToClient(AScreenPos));
if C <> nil then
Result := C;
end;
end;
procedure TcadEmpresa.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
with dtmSystem do
begin
tblEnderecos.Close;
tblCidades.Close;
tblEstados.Close;
tblEmpresa.Close;
end;
cadEmpresa := nil;
end;
procedure TcadEmpresa.FormCreate(Sender: TObject);
begin
inherited;
if not(dtsUF.DataSet.Active) then
begin
dtsUF.DataSet.Open;
end;
if not(dtsCidades.DataSet.Active) then
begin
dtsCidades.DataSet.Open;
end;
SetupHackedNavigator(navPrincipal, ImageList2);
SetupHackedNavigator(dbnavCartoes, ImageList2);
// navPrincipal.Enabled := dtmSystem.VerificarPermissao('EMPCBR.01');
primeiro_cad := false;
end;
procedure TcadEmpresa.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if Key = VK_ESCAPE then
begin
Key := 0;
Close;
end;
end;
procedure TcadEmpresa.FormShow(Sender: TObject);
begin
inherited;
if not(dtmSystem.tblEmpresa.Active) then
begin
dtmSystem.tblEmpresa.Open;
end;
if dtmSystem.tblEmpresa.IsEmpty then
begin
// navPrincipal.VisibleButtons := navPrincipal.VisibleButtons + [nbInsert];
dtsDB.DataSet.Append;
primeiro_cad := true;
end;
end;
function TcadEmpresa.JpgToBmp(path: string): string;
var
Bmp: TBitmap;
Jpeg: TJPEGImage;
novo_path: string;
begin
Result := '';
if FileExists(path) then
begin
novo_path := ChangeFileExt(path, '.bmp');
Bmp := TBitmap.Create;
Jpeg := TJPEGImage.Create;
Jpeg.LoadFromFile(path);
Bmp.Assign(Jpeg);
Bmp.SaveToFile(novo_path);
Result := novo_path;
Jpeg.Free;
Bmp.Free;
end;
end;
procedure TcadEmpresa.navPrincipalBeforeAction(Sender: TObject;
Button: TNavigateBtn);
begin
case Button of
nbPost:
begin
if DBEdit1.Text = '' then
begin
MessageDlg
('Por favor insira uma Razão Social antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_fantasia.Text = '' then
begin
MessageDlg
('Por favor insira um Nome Fantasia antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_debito.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de débito antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_credvista.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito a vista antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred3.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 3x antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred6.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 6x antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred12.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 12x antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_debitobanco.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de débito de repasse para banco antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_credvistabanco.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito a vista de repasse para banco antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred3banco.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 3x de repasse para banco antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred6banco.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 6x de repasse para banco antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
if dbedt_cred12banco.Text = '' then
begin
MessageDlg
('Por favor insira um valor para taxa de crédito em até 12x de repasse para banco antes de finalizar o cadastro da Empresa.',
mtWarning, [mbOK], 0);
Abort;
end;
primeiro_cad := false;
// navPrincipal.VisibleButtons := navPrincipal.VisibleButtons - [nbInsert];
end;
nbCancel:
begin
if primeiro_cad = true then
begin
MessageDlg('Por favor termine de cadastrar a Empresa.', mtWarning,
[mbOK], 0);
Abort;
end;
end;
end;
inherited;
end;
procedure TcadEmpresa.PopupMenu1Popup(Sender: TObject);
begin
pos := Mouse.CursorPos;
end;
procedure TcadEmpresa.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
for btn := Low(TNavigateBtn) to High(TNavigateBtn) do
if Navigator = navPrincipal then
begin
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;
end;
end
else
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;
end;
end;
procedure TcadEmpresa.spdbtn_clearimgClick(Sender: TObject);
begin
dtsDB.DataSet.FieldByName('IMG_LOGO').Clear;
end;
procedure TcadEmpresa.spdbtn_loadimgClick(Sender: TObject);
begin
if opd_logo.Execute then
begin
if (ExtractFileExt(opd_logo.FileName) = '.jpg') or
(ExtractFileExt(opd_logo.FileName) = '.jpeg') then
begin
rdbimg_logo.LoadFromFile(JpgToBmp(opd_logo.FileName));
end
else
begin
rdbimg_logo.LoadFromFile(opd_logo.FileName);
end;
end;
end;
procedure TcadEmpresa.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.