terça-feira, 4 de julho de 2017
segunda-feira, 3 de julho de 2017
domingo, 2 de julho de 2017
Error loading MIDAS.DLL Delphi
Para resolver o erro Error loading MIDAS.DLL que ocorre no Delphi
adicionar no source do seu projeto no Uses
MIDASLIB,
Dessa forma ao compilar o executável ele não irá pedir mais a dll
MIDAS.DLL
e o problema será resolvido.
adicionar no source do seu projeto no Uses
MIDASLIB,
Dessa forma ao compilar o executável ele não irá pedir mais a dll
MIDAS.DLL
e o problema será resolvido.
Como Resolver Can't load package ACBR_TCP.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_openssl.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_NFSe.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_nfe.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_diversos.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_comum.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_capicom.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_boleto.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
NO video abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
Como Resolver Can't load package ACBR_Serial.bpl NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO no Delphi
No vídeo abaixo é demonstrado como resolver o erro ao carregar Package do ACBR ao tentar instalar o componente ACBR e apresentar o erro NÃO FOI POSSÍVEL ENCONTRAR O MÓDULO ESPECIFICADO.
sábado, 1 de julho de 2017
Como Ocultar cursor do mouse OnMouseMove
Coloque esse código em algum evento (de preferência "OnMouseMove"):
showcursor(false); //Pronto: Oculta o cursor do mouse!
showcursor(false); //Pronto: Oculta o cursor do mouse!
Código Delphi demonstrando como Mover objeto junto com o mouse OnMouseMove
1°: //Para mover o objeto junto com o mouse ('como se ele fosse o mouse'):
//Coloque no "OnMouseMove" for Form e de todos os objetos de do form (EXCETO DO QUE IRÁ SE MOVER!) o código:
Objeto1.Top:= y - 3;
Objeto1.Left:= x - 2;
//Se deseja ocultar o mouse do Windows, adicione o código:
showcursor(false);
//Os - 3 e - 2 são para tirar o Objeto um pouco de cima dos objetos do form, para executar o clique.
2°: //Para colocar o objeto onde está o mouse no momento de um clique:
//Coloque o no evento OnClique em algum objeto do form, o código:
Objeto2.Top:= Mouse.CursorPos.Y;
Objeto2.Left:= Mouse.CursorPos.X;
//Coloque no "OnMouseMove" for Form e de todos os objetos de do form (EXCETO DO QUE IRÁ SE MOVER!) o código:
Objeto1.Top:= y - 3;
Objeto1.Left:= x - 2;
//Se deseja ocultar o mouse do Windows, adicione o código:
showcursor(false);
//Os - 3 e - 2 são para tirar o Objeto um pouco de cima dos objetos do form, para executar o clique.
2°: //Para colocar o objeto onde está o mouse no momento de um clique:
//Coloque o no evento OnClique em algum objeto do form, o código:
Objeto2.Top:= Mouse.CursorPos.Y;
Objeto2.Left:= Mouse.CursorPos.X;
Como Apagar , Excluir arquivos e ou pastas no Delphi de modo simples
//Apagar arquivos:
Windows.DeleteFile('c:arquivo.txt');
//Apagar pastas:
Windows.RemoveDirectory('c:pasta');
Comando API Delphi para uso em Win7! - Desligar monitor no Windows 7
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
Dica Simples ShowMessage com Mensagem com várias linhas
//Basta colocar "#13" quando desejar mudar de linha!!
Exemplo.:
showmessage('Linha 1' + #13 + 'Linha 2' + #13 + 'Linha 3');
Exemplo.:
showmessage('Linha 1' + #13 + 'Linha 2' + #13 + 'Linha 3');
Transformar caracter digitado na DBGrid tudo maiuscula
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9',#8]) then
begin
Key := UpCase(Key);
end;
end;
begin
if not (Key in ['0'..'9',#8]) then
begin
Key := UpCase(Key);
end;
end;
INVERTER DATA P/ PESQUISA SQL
function invertedata(Data:String):String;
begin
if not(length(Data))in[8..10] then
begin
Showmessage('Data Invalida');
exit;
end;
result:=FormatDateTime('mm',strtodate(Data))+'/'+
FormatDateTime('dd',strtodate(Data))+'/'+
FormatDateTime('yyyy',strtoDate(Date));
end;
begin
if not(length(Data))in[8..10] then
begin
Showmessage('Data Invalida');
exit;
end;
result:=FormatDateTime('mm',strtodate(Data))+'/'+
FormatDateTime('dd',strtodate(Data))+'/'+
FormatDateTime('yyyy',strtoDate(Date));
end;
Importação de arquivo txt utilizando memo e MYSQL
{inicialmente teremos que ter;
01 memo,
03 buttons (Abrir, importar e sair,
01 label,
01 progress bar,
01 opendialog.}
{No evendo onclick do botão importar coloque os seguintes códigos.}
procedure TFormImportaProdAmb.BitBtn2Click(Sender: TObject);
var vCount,i:integer;
begin
Dm1.QryChekComp.Close;
Dm1.QryChekComp.ParamByName('BpaComp').AsString := Copy(Memo1.Lines.Strings[1],8,6);
Dm1.QryChekComp.ParamByName('EstabCod').AsString := Copy(Memo1.Lines.Strings[i],1,7);
Dm1.QryChekComp.Open;
If Dm1.QryChekComp.RecordCount>0 Then
Begin
ShowMessage('Competencia já importada, Selecione uma competencia valida');
LimpaForm;
Abort;
End
else
begin
Repaint;
vCount := Memo1.Lines.Count;
for i := 1 to Memo1.Lines.Count -1 do
Begin
If vCount <> 0 Then
Begin
Dm1.QryInsProdAmb.ParamByName('EstabCod').AsString := Copy(Memo1.Lines.Strings[i],1,7);
Dm1.QryInsProdAmb.ParamByName('ProcDtComp').AsString := Copy(Memo1.Lines.Strings[i],8,6);
Dm1.QryInsProdAmb.ParamByName('BpaComp').AsString := Copy(Memo1.Lines.Strings[i],8,6);
Dm1.QryInsProdAmb.ParamByName('BpaCns').AsString := Copy(Memo1.Lines.Strings[i],14,15);
Dm1.QryInsProdAmb.ParamByName('CboCod').AsString := Copy(Memo1.Lines.Strings[i],29,6);
Dm1.QryInsProdAmb.ParamByName('BpaDtBpi').AsString := Copy(Memo1.Lines.Strings[i],35,8);
Dm1.QryInsProdAmb.ParamByName('ProcCod').AsString := Copy(Memo1.Lines.Strings[i],48,10);
Dm1.QryInsProdAmb.ParamByName('BpaSexo').AsString := Copy(Memo1.Lines.Strings[i],73,1);
Dm1.QryInsProdAmb.ParamByName('BpaIdade').AsInteger := StrToInt( Copy(Memo1.Lines.Strings[i],84,3));
Dm1.QryInsProdAmb.ParamByName('BpaQtde').AsInteger := StrToInt(Copy(Memo1.Lines.Strings[i],87,6));
Dm1.QryInsProdAmb.ParamByName('BpaTipoAtm').AsString := Copy(Memo1.Lines.Strings[i],149,1);
Dm1.QryInsProdAmb.ExecSQL;
Label1.Caption :='Aguarde enquanto o sistema importa os dados : '+ IntToStr(i + 1);
Label1.Refresh;
ProgressBar1.Max :=vCount;
ProgressBar1.Position :=i;
Sleep(01);
end;
end;
ShowMessage('Foram Importados '+IntToStr(vCount)+' Procedimentos');
end;
end;
{No envento onclick do botão abrir digite os seguintes códigos.}
If OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
if(Memo1.Text<>'') then
Begin
BitBtn2.Enabled:=True;
BitBtn1.Enabled:=False;
end
else
Begin
BitBtn2.Enabled:=False;
BitBtn1.Enabled:=True;
End;
01 memo,
03 buttons (Abrir, importar e sair,
01 label,
01 progress bar,
01 opendialog.}
{No evendo onclick do botão importar coloque os seguintes códigos.}
procedure TFormImportaProdAmb.BitBtn2Click(Sender: TObject);
var vCount,i:integer;
begin
Dm1.QryChekComp.Close;
Dm1.QryChekComp.ParamByName('BpaComp').AsString := Copy(Memo1.Lines.Strings[1],8,6);
Dm1.QryChekComp.ParamByName('EstabCod').AsString := Copy(Memo1.Lines.Strings[i],1,7);
Dm1.QryChekComp.Open;
If Dm1.QryChekComp.RecordCount>0 Then
Begin
ShowMessage('Competencia já importada, Selecione uma competencia valida');
LimpaForm;
Abort;
End
else
begin
Repaint;
vCount := Memo1.Lines.Count;
for i := 1 to Memo1.Lines.Count -1 do
Begin
If vCount <> 0 Then
Begin
Dm1.QryInsProdAmb.ParamByName('EstabCod').AsString := Copy(Memo1.Lines.Strings[i],1,7);
Dm1.QryInsProdAmb.ParamByName('ProcDtComp').AsString := Copy(Memo1.Lines.Strings[i],8,6);
Dm1.QryInsProdAmb.ParamByName('BpaComp').AsString := Copy(Memo1.Lines.Strings[i],8,6);
Dm1.QryInsProdAmb.ParamByName('BpaCns').AsString := Copy(Memo1.Lines.Strings[i],14,15);
Dm1.QryInsProdAmb.ParamByName('CboCod').AsString := Copy(Memo1.Lines.Strings[i],29,6);
Dm1.QryInsProdAmb.ParamByName('BpaDtBpi').AsString := Copy(Memo1.Lines.Strings[i],35,8);
Dm1.QryInsProdAmb.ParamByName('ProcCod').AsString := Copy(Memo1.Lines.Strings[i],48,10);
Dm1.QryInsProdAmb.ParamByName('BpaSexo').AsString := Copy(Memo1.Lines.Strings[i],73,1);
Dm1.QryInsProdAmb.ParamByName('BpaIdade').AsInteger := StrToInt( Copy(Memo1.Lines.Strings[i],84,3));
Dm1.QryInsProdAmb.ParamByName('BpaQtde').AsInteger := StrToInt(Copy(Memo1.Lines.Strings[i],87,6));
Dm1.QryInsProdAmb.ParamByName('BpaTipoAtm').AsString := Copy(Memo1.Lines.Strings[i],149,1);
Dm1.QryInsProdAmb.ExecSQL;
Label1.Caption :='Aguarde enquanto o sistema importa os dados : '+ IntToStr(i + 1);
Label1.Refresh;
ProgressBar1.Max :=vCount;
ProgressBar1.Position :=i;
Sleep(01);
end;
end;
ShowMessage('Foram Importados '+IntToStr(vCount)+' Procedimentos');
end;
end;
{No envento onclick do botão abrir digite os seguintes códigos.}
If OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
if(Memo1.Text<>'') then
Begin
BitBtn2.Enabled:=True;
BitBtn1.Enabled:=False;
end
else
Begin
BitBtn2.Enabled:=False;
BitBtn1.Enabled:=True;
End;
Função para Criptografar e Descriptografar uma String
{Abaixo seguem 3 funcoes, a primeira retorna o código ASCII de cada caracter, a segunda Criptografa uma string
e a terceira descriptografa. Voce pode sempre mudar a chave como preferir.
Espero ter sido de ajuda - M C Zanetti}
//funcao que retorno o código ASCII dos caracteres
function AsciiToInt(Caracter: Char): Integer;
var
i: Integer;
begin
i := 32;
while i < 255 do begin
if Chr(i) = Caracter then
Break;
i := i + 1;
end;
Result := i;
end;
{ Esta funcao tem como objetivo criptografar uma string utilizando o código ASCII de cada caracter e
somando a esse código o valor da CHAVE}
Function Criptografa(texto:string;chave:integer):String;
var
cont:integer;
retorno:string;
begin
if (trim(texto)=EmptyStr) or (chave=0) then begin
result:=texto;
end else begin
retorno:='';
for cont:=1 to length(texto) do begin
retorno:=retorno+chr(asciitoint(texto[cont])+chave);
end;
result:=retorno;
end;
end;
{Esta funcao é semelhante a funcao de Criptografia mais com o objetivo de descriptografar a string }
Function DesCriptografa(texto:string;chave:integer):String;
var
cont:integer;
retorno:string;
begin
if (trim(texto)=EmptyStr) or (chave=0) then begin
result:=texto;
end else begin
retorno:='';
for cont:=1 to length(texto) do begin
retorno:=retorno+chr(asciitoint(texto[cont])-chave);
end;
result:=retorno;
end;
end;
{Exemplo de Utilização das funcoes}
data_inicio:=criptografa(strtran(datetostr(date),'/',''),108); //esta linha criptografa a data, somando ao codigo ASCII 108 posicoes
data_inicio:=DesCriptografa(inicio,108); //esta linha descriptografa a data, retirando as mesmas 108 posicoes
Dica: Em um mesmo campo ou string utilize sempre a mesma chave para criptografar e descriptografar.
e a terceira descriptografa. Voce pode sempre mudar a chave como preferir.
Espero ter sido de ajuda - M C Zanetti}
//funcao que retorno o código ASCII dos caracteres
function AsciiToInt(Caracter: Char): Integer;
var
i: Integer;
begin
i := 32;
while i < 255 do begin
if Chr(i) = Caracter then
Break;
i := i + 1;
end;
Result := i;
end;
{ Esta funcao tem como objetivo criptografar uma string utilizando o código ASCII de cada caracter e
somando a esse código o valor da CHAVE}
Function Criptografa(texto:string;chave:integer):String;
var
cont:integer;
retorno:string;
begin
if (trim(texto)=EmptyStr) or (chave=0) then begin
result:=texto;
end else begin
retorno:='';
for cont:=1 to length(texto) do begin
retorno:=retorno+chr(asciitoint(texto[cont])+chave);
end;
result:=retorno;
end;
end;
{Esta funcao é semelhante a funcao de Criptografia mais com o objetivo de descriptografar a string }
Function DesCriptografa(texto:string;chave:integer):String;
var
cont:integer;
retorno:string;
begin
if (trim(texto)=EmptyStr) or (chave=0) then begin
result:=texto;
end else begin
retorno:='';
for cont:=1 to length(texto) do begin
retorno:=retorno+chr(asciitoint(texto[cont])-chave);
end;
result:=retorno;
end;
end;
{Exemplo de Utilização das funcoes}
data_inicio:=criptografa(strtran(datetostr(date),'/',''),108); //esta linha criptografa a data, somando ao codigo ASCII 108 posicoes
data_inicio:=DesCriptografa(inicio,108); //esta linha descriptografa a data, retirando as mesmas 108 posicoes
Dica: Em um mesmo campo ou string utilize sempre a mesma chave para criptografar e descriptografar.
Exportar Dataset para arquivo html gerando tabela zebrada e com estilo
procedure Exportar(DataSet: TDataSet; Arq: string; Ext: string);
var
shtml : widestring;
htmlfile : TextFile;
i : integer;
AvailableFields: set of TFieldType;
bookmark : tbookmarkstr;
begin
bookmark := dataset.Bookmark;
DataSet.DisableControls;
DataSet.First;
AvailableFields:=[ftInteger, ftWideString, ftDate, ftBcd, ftmemo, ftstring];
// --> cria o código html da página
shtml:= '<html> <head>'+#13#10;
shtml:= shtml + '<title>'+dataset.Name+'</title></head>' + #13#10;
shtml:= shtml + '<body>' + #13#10;
shtml:= shtml + '<script>'+#13+'function cor_tabela(id){'+#13+
'var cor1="#dae5e3";'+#13+
'var cor2="#fff";'+#13+
'var x=document.getElementById(id).getElementsByTagName("tr");'+#13+
'for(i=0;i<x.length;i++)'+#13+
'x[i].style.backgroundColor=(i%2==0)?cor1:cor2;'+#13+
'}'+#13+
'</script>'+#13+#10;
shtml:= shtml + '<style>'+#13+
'table {'+#13+
'border:solid 1px #000;'+#13+
'font-family:Verdana, Geneva, sans-serif;'+#13+
'font-size:11px;'+#13+
'background:#930;'+#13+
'}'+#13+
'th {'+#13+
'color:#FFF;'+#13+
'background:#930;'+#13+
'height:25px;'+#13+
'vertical-align:middle;'+#13+
'}'+#13+
'</style>'+#13+#10;
//header da tabela
shtml:= shtml + '<table id="tb" cellspacing="1" width="100%">' + #13#10;
shtml:= shtml + '<tr>' + #13#10;
for i:=0 to DataSet.FieldCount-1 do
begin
if DataSet.Fields[i].DataType in AvailableFields then
begin
shtml:= shtml + '<th>';
shtml:= shtml +
'' +
DataSet.Fields.Fields[i].DisplayName +
'';
shtml:= shtml + '</th>' + #13#10;
end;
end;{for}
shtml:= shtml + '</tr>' + #13#10;
//corpo da tabela
while not DataSet.Eof do
begin
shtml:= shtml + '<tr>' + #13#10;
for i:=0 to DataSet.FieldCount-1 do
begin
if DataSet.Fields.Fields[i].DataType in AvailableFields then
begin
if DataSet.Fields.Fields[i].DataType = ftBcd then
begin
shtml:= shtml + '<td align="right">'+ formatfloat('R$ ###,##0.00', DataSet.Fields.Fields[i].AsCurrency);
end else
begin
shtml:= shtml + '<td>'+DataSet.Fields.Fields[i].AsString;
shtml:= shtml + '</td>' + #13#10;
end;
end;
end;{for}
shtml:= shtml + '</tr>' + #13#10;
DataSet.Next;
end;{while}
shtml:= shtml + '</table>' + #13#10;
//script para zebrar a tabela
shtml:= shtml + '<script>cor_tabela("tb");</script>'+#13+#10;
//finalizando a página
shtml:= shtml + '</body></html>';
// --> salva o arquivo html
AssignFile(htmlfile,ChangeFileExt(Arq,'.'+Ext));
Rewrite(htmlfile);
WriteLn(htmlfile, shtml);
CloseFile(htmlfile);
DataSet.Bookmark := bookmark;
DataSet.EnableControls;
end;
segunda-feira, 26 de junho de 2017
sábado, 24 de junho de 2017
sexta-feira, 23 de junho de 2017
quinta-feira, 22 de junho de 2017
quarta-feira, 21 de junho de 2017
terça-feira, 20 de junho de 2017
Colocando bitmaps num ComboBox Delphi csOwnerDrawVariable
Ajuste a propriedade Style do ComboBox para csOwnerDrawVariable.
var
Form1: TForm1;
Bmp1, Bmp2, Bmp3: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\chip16.bmp');
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\zoom.bmp');
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\disk.bmp');
ComboBox1.Items.AddObject('Chip',Bmp1);
ComboBox1.Items.AddObject('Zoom',Bmp2);
ComboBox1.Items.AddObject('Disk',Bmp3);
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOWnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect); Bitmap:= TBitmap(ComboBox1.Items.Objects[index]);
if Bitmap nil then begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
Offset: Bitmap.width + 8;
end;
TextOut(Rect.Left + Offset, Rect.Top, ComboBox1.Items[index]);
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
Height:=20;
end;
TOCAR MUSICA WAVE no Delphi (playsound)
VOCE DEVE COLOCAR UM ARQUIVO WAVE JUNDO NA PASTA QUE ESTIVER O PROJETO E VOCE VAI ABRIR O DELPHI E DIMINUIR O FORM E COLOCAR UM BOTÃO
ENTÃO VOCE VAI DAR UM DUPLO CLIQUE E VAI ABRIR UMA JANELA PEDINDO O CODIGO ABAIXO
playsound(pchar('NOME_ARQUIVO.wav'),0,snd_async);
ENTÃO VOCE VAI DAR UM DUPLO CLIQUE E VAI ABRIR UMA JANELA PEDINDO O CODIGO ABAIXO
playsound(pchar('NOME_ARQUIVO.wav'),0,snd_async);
Assinar:
Comentários (Atom)