Colocar os bitmaps na dll

Por vezes, quando iniciamos um projecto, temos uma preocupação: fazer uma aplicação pequena. Bem, a solução pode passar por colocar todos os bitmaps que vamos utilizar numa dll. Então vamos lá começar:

Deve usar o Image Editor, criar uma nova Resource File (.res), neste ficheiro vamos colocar os bitmaps e icons (ambos funcionam da mesma forma) que queremos na nossa aplicação, clique com a tecla direita do rato na nova resource file e crie um novo bitmap, depois desenhe ou cole do clipboard um bitmap, finalmente guarde o ficheiro com o nome images.res. Depois disto estar feito vá ao IDE do Delphi e no File menu clique New... e escolha DLL depois cole o código abaixo, não se esqueça de adicionar uma unit vazia ao projecto. Guarde o projecta da dll no mesmo directório do ficheiro image.res, finalmente faça o build da dll (não se esqueça, que não se pode correr (executar) uma dll!)

Código da Dll:

library ImageRes; {nome da dll}
uses DummyUnit; {DummyUnit é uma unit vazia, que é necessária}
{$R images.res} {nome da resource file, que deve estar no mesmo caminho da dll}
begin
end.
Código da DummyUnit:

unit DummyUnit;
interface
implementation
end.

Usar os bitmaps que estão na dll:
Estão aqui alguns exemplos como extrair os bitmaps da dll:

procedure TForm1.SpeedButton1Click(Sender:TObject);
var
      MyHandle :THandle; 
      Bmp : TBitmap; 
begin
      MyHandle := LoadLibrary('ImageRes.DLL'); {nome da dll construida acima} 
      Bmp := TBitmap.Create; 
      Bmp.Handle := LoadBitmap(MyHandle, 'BITMAP1'); {Bitmap1 é o nome do bitmap criado no ficheiro image.res} 
      SpeedButton1.Glyph.Handle := LoadBitmap(MyHandle,'BITMAP1'); {Carrega o Bitmap1 para o glyph do SpeedButton1} 
      Canvas.Draw(0,0,Bmp); {Desenha o bitmap no canvas da form} 
       Image1.picture.bitmap:=Bmp; {Carrega o bitmap para o componente Timage} 
       Bmp.Free; 

end;

Drag and Drop com ListView

Fonte: www.activedelphi.com.br

Primeiro inclua em seu formulário dois TListView e preencha a propriedades DragMode com o valor dmAutomatic nos dois. Para facilitar nossas vidas, vamos criar um método genérico para realizar o drag and drop, com o seguinte código
procedure realizarDragAndDrop(Sender: TObject; Source: TObject);
var
itemAdicionado : TListItem;
Item : string;
itAdd : TListItem;
begin
if Source <> Sender then
begin
with (Source as TListview) do
begin
Item := Items[ItemIndex].Caption;
Items.Delete(ItemIndex);
itAdd := items[ItemIndex];
end;
itemAdicionado := (Sender as TListView).Items.AddItem(itAdd, 1);
itemAdicionado.Caption := item;
end;
end;

Agora, vamos partir do ponto que nossos listView só aceitam drag and drop de componentes listView, para isso, no evento onDragOver de cada listView vamos colocar o seguinte código

Accept := (Source is TListView);

Para finalizar, vamos fazer a chamada do método que realiza o drag and drop efetivamente. No evento onDragDrop de cada listView, basta fazer a chamada do nosso método realizarDragAndDrop da seguinte maneira

realizarDragAndDrop(Sender, Source);

Vale ressaltar que os parâmetros Sender e Source são parâmetros de entrada do evento onDragDrop de um listView que definem a origem e o destino do item que está sendo manipulado com o drag and drop.

Técnicas para Agilizar o Desenvolvimento

Fonte: www.activedelphi.com.br

Nesse mini-artigo vou descrever algumas técnicas que considero importantes, no dia-a-dia para agilizar o nosso trabalho como desenvolvedores de software.
Utilizar atalhos: nada mais rápido e eficiente do que aproveitar dos recursos que o Delphi nos oferece para agilizar e facilitar nossa vida, um dos que utilizo com frequência: Detalhe importante, estou trabalhando com o Delphi XE. Galera do Delphi 7... vamos lá, vamos migrar para o XE2 nada melhor e mais produtivo!
> Ctrl + Shift + S = salvar, nunca é demais
> Ctrl + Shift + D = refactory para adicionar um field a classe
> Ctrl + Shift + V = declarar variáveis locais
> Ctrl + Alt + P = adicionar componentes
> Alt + F11 = use unit
> Ctrl + Shift + F11 = abrir o project options
> Ctrl + Shift + J = sync edit, poder editar vários objetos, propriedades etc ao mesmo tempo.

Utilizarmos as macros: tenho certeza que pouco utilizam, mas caso seja necessário remover parte de um código em várias linhas, no caso em que o Ctrl + Shift + J não pode nos ajudar, tentem usar as macros, com certeza é muito produtivo.

Utilizar o Together, ou Model View: nada melhor que visualizarmos a hierarquia de nossas classes com ele. Ao visualizarmos apenas o código fonte fica complicado de identificar quem herda de quem e qual a relação entre as classes. Confesso que essa foi a ultima barreira que venci, pois não era acostumado a essa ferramenta, mas depois que passei a usar vejo que é muito útil.

Formatar Edit Estilo Moeda

Tenho observado que vários colegas tem problemas na formatação de campos no estilo moeda. Esta rotina mostra como o campo Edit funciona como nos caixas eletrônicos, ou seja, a digitação vem da direita para a esquerda.
Para isso, insira no seu form um edit e no evento OnKeyPress inclua o seguinte código:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
     if NOT (Key in ['0'..'9', #8, #9]) then
     key := #0;
     //Função para posicionar o cursor sempre na direita
     Edit1.selstart := Length(Edit1.text);
end;

No evento onChange insira o seguinte código

procedure TForm1.Edit1Change(Sender: TObject);
var
   s : string;
   v : double;
   I : integer;
begin
   //1º Passo : se o edit estiver vazio, nada pode ser feito.
   If (edit1.Text = emptystr) then
      Edit1.Text := '0,00';

   //2º Passo : obter o texto do edit, SEM a virgula e SEM o ponto decimal:
   s := '';
   for I := 1 to length(edit1.Text) do
   if (edit1.text[I] in ['0'..'9']) then
      s := s + edit1.text[I];

   //3º Passo : fazer com que o conteúdo do edit apresente 2 casas decimais:
   v := strtofloat(s);
   v := (v /100); // para criar 2 casa decimais

   //4º Passo : Formata o valor de (V) para aceitar valores do tipo 0,10.
   edit1.text := FormatFloat('###,##0.00',v); 
   edit1.SelStart := 0;

end;

Criando diretório

Para criar um diretório você precisa usar a função ForceDirectories, o exemplo a baixo testa se não existe um diretório e cria o diretório apartir de uma variável string testando se o diretório já existe

Unit

FileCtrl

procedure TForm1.Button1Click(Sender: TObject);
var
     Dir: string;
begin
     Dir := 'C:\APPS\SALES\LOCAL';

     if not DirectoryExists(Dir) then
     ForceDirectories(Dir);
     Label1.Caption := Dir + ' foi criado';
end;

Como passar parâmetros entre 2 forms

Suponha que você esteja no Form1 e precise chamar o Form2 passando dois parametros ("Aden" e "Rodrigues").
1. Crie as variáveis de instancia do Form2 que receberão os dois parâmetros.
2. Reescreva o Construtor desse form, de forma receber os parametros e atribui-los às suas variáveis de instância:
type
TForm2 = class(TForm)
private
Parametro1 : String;
Parametro2 : String;
public
constructor Create(AOwner : TComponent; pParm1, pParm2 : String);
end;

var
Form2: TForm2;

implementation

Constructor TForm2.Create(AOwner : TComponent; pParm1, pParm2 : String);
begin
inherited Create(AOwner);
Parametro1 := pParm1;
Parametro2 := pParm2;
end;

Agora no seu form1, abra o form2 com a seguinte sintaxe:

With TForm2.Create(self, 'Aden', 'Rodrigues') do
Begin
ShowModal;
Free;
End;

Obs: Não deixe o delphi criar automaticamente o formulário. Crie-o (e destrua-o) manualmente.

Definir o tamanho do papel em TPrinter

Esta procedure configura o tamanho do papel em Run-Time para ser utilizado com o objeto TPrinter; Esta procedure deve ser chamada antes de aplicar o método Printer.BeginDoc.

procedure TForm1.SetPrinterPage(Width, Height : LongInt);

var

   Device : array[0..255] of char;

   Driver : array[0..255] of char;

   Port   : array[0..255] of char;

   hDMode : THandle;

   PDMode : PDEVMODE;

begin

     Printer.GetPrinter(Device, Driver, Port, hDMode);

     If hDMode <> 0 then

     begin

          pDMode := GlobalLock( hDMode );

          If pDMode <> nil then

          begin

               pDMode^.dmPaperSize   := DMPAPER_USER;

               pDMode^.dmPaperWidth  := Width;

               pDMode^.dmPaperLength := Height;

               pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;

               GlobalUnlock( hDMode );

          end;

     end;

end;

Como descobrir o código de uma tecla pressionada?

Na maioria dos componentes existem eventos que ocorrem quando o teclado é acionado

Ex:

Num Form existe os eventos:

1º OnKeyDown => Quando a tecla é apertada.

2º OnKeyUp => Quando a tecla é solta

3º OnKeyPress => Quando a tecla e apertada.

Os três devolvem uma variável chamada Key;

Os dois primeiros Key é uma word, no terceiro Key é um char.

Para você saber o nº de um tecla é só colocar no evento

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:TShiftState);
Begin
ShowMessage('O nº da tecla: '+Char(ORD(Key))+' é => '+IntToStr(key));
End;

Assim você sabe o valor de cada tecla e pode testar se ela foi acionada.

O legal não é testar este valor e sim trabalhar com a Virtual Key Code

Exemplo:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
Begin
IF Key=VK_Return Then ShowMessage('Você apertou o enter');
End;


Esse VK_Return é da Virtual Key Code, você terá que pesquisar no Help, Segue abaixo as outras teclas:

VK_LBUTTON Left mouse button
VK_RBUTTON Right mouse button
VK_CANCEL Control+Break
VK_MBUTTON Middle mouse button
VK_BACK Backspace key
VK_TAB Tab key
VK_CLEAR Clear key
VK_RETURN Enter key
VK_SHIFT Shift key
VK_CONTROL Ctrl key
VK_MENU Alt key
VK_PAUSE Pause key
VK_CAPITAL Caps Lock key
VK_KANA Used with IME
VK_HANGUL Used with IME
VK_JUNJA Used with IME
VK_FINAL Used with IME
VK_HANJA Used with IME
VK_KANJI Used with IME
VK_CONVERT Used with IME
VK_NONCONVERT Used with IME
VK_ACCEPT Used with IME
VK_MODECHANGE Used with IME
VK_ESCAPE Esc key
VK_SPACE Space bar
VK_PRIOR Page Up key
VK_NEXT Page Down key
VK_END End key
VK_HOME Home key
VK_LEFT Left Arrow key
VK_UP Up Arrow key
VK_RIGHT Right Arrow key
VK_DOWN Down Arrow key
VK_SELECT Select key
VK_PRINT Print key (keyboard-specific)
VK_EXECUTE Execute key
VK_SNAPSHOT Print Screen key
VK_INSERT Insert key
VK_DELETE Delete key
VK_HELP Help key
VK_LWIN Left Windows key (Microsoft keyboard)
VK_RWIN Right Windows key (Microsoft keyboard)
VK_APPS Applications key (Microsoft keyboard)
VK_NUMPAD0 0 key (numeric keypad)
VK_NUMPAD1 1 key (numeric keypad)
VK_NUMPAD2 2 key (numeric keypad)
VK_NUMPAD3 3 key (numeric keypad)
VK_NUMPAD4 4 key (numeric keypad)
VK_NUMPAD5 5 key (numeric keypad)
VK_NUMPAD6 6 key (numeric keypad)
VK_NUMPAD7 7 key (numeric keypad)
VK_NUMPAD8 8 key (numeric keypad)
VK_NUMPAD9 9 key (numeric keypad)
VK_MULTIPLY Multiply key (numeric keypad)
VK_ADD Add key (numeric keypad)
VK_SEPARATOR Separator key (numeric keypad)
VK_SUBTRACT Subtract key (numeric keypad)
VK_DECIMAL Decimal key (numeric keypad)
VK_DIVIDE Divide key (numeric keypad)
VK_F1 F1 key
VK_F2 F2 key
VK_F3 F3 key
VK_F4 F4 key
VK_F5 F5 key
VK_F6 F6 key
VK_F7 F7 key
VK_F8 F8 key
VK_F9 F9 key
VK_F10 F10 key
VK_F11 F11 key
VK_F12 F12 key
VK_F13 F13 key
VK_F14 F14 key
VK_F15 F15 key
VK_F16 F16 key
VK_F17 F17 key
VK_F18 F18 key
VK_F19 F19 key
VK_F20 F20 key
VK_F21 F21 key
VK_F22 F22 key
VK_F23 F23 key
VK_F24 F24 key
VK_NUMLOCK Num Lock key
VK_SCROLL Scroll Lock key
VK_LSHIFT Left Shift key (only used with GetAsyncKeyState and GetKeyState)
VK_RSHIFT Right Shift key (only used with GetAsyncKeyState and GetKeyState)
VK_LCONTROL Left Ctrl key (only used with GetAsyncKeyState and GetKeyState)
VK_RCONTROL Right Ctrl key (only used with GetAsyncKeyState and GetKeyState)
VK_LMENU Left Alt key (only used with GetAsyncKeyState and GetKeyState)
VK_RMENU Right Alt key (only used with GetAsyncKeyState and GetKeyState)
VK_PROCESSKEY Process key
VK_ATTN Attn key
VK_CRSEL CrSel key
VK_EXSEL ExSel key
VK_EREOF Erase EOF key
VK_PLAY Play key
VK_ZOOM Zoom key
VK_NONAME Reserved for future use
VK_PA1 PA1 key
VK_OEM_CLEAR Clear key

Como incrementar a Barra de Status

No formulário principal coloque uma statusbar com 3 panels,1 time e aplicationeventos e digite as funções abaixo ->

function mostrahora:string;
begin
    mostrahora:=timetostr(time);
end;

function mostradata:string;
var
    dthoje:tdatetime;
    diasemana:integer;
    strdiasemana:string;
begin
    dthoje:=date;
    diasemana:=dayofweek(dthoje);
    case diasemana of
      1:strdiasemana:='Domingo';
      2:strdiasemana:='Segunda-feira';
      3:strdiasemana:='Terça-feira';
      4:strdiasemana:='Quarta-feira';
      5:strdiasemana:='Quinta-feira';
      6:strdiasemana:='Sexta-feira';
      7:strdiasemana:='Sábado';
end;
mostradata:=strdiasemana+' '+datetostr(dthoje);
end;

// Selecione o aplicationeventos e na guia eventos do objeto inspector depois clique no evento OnHint e digite o código ->

procedure TFnomedoform.ApplicationEvents1Hint(Sender: TObject);
Begin
StatusBar1.Panels[2].Text:=Application.Hint;
// todos os hints do seu projeto apareceram no statusbar
end;

// agora faça com que suas funções apareçam o resultado

procedure TFnomedoform.Timer1Timer(Sender: TObject);
var
    presente:tdatetime;
    ano,mes,dia:word;
begin
   presente:=now;
   decodedate(presente,ano,mes,dia);
   case mes of
     1:STATUSBAR1.PANELS[1].TEXT:=' JANEIRO '+inttostr(ano);
     2:STATUSBAR1.PANELS[1].TEXT:='FEVEREIRO'+inttostr(ano);
     3:STATUSBAR1.PANELS[1].TEXT:='MARÇO '+inttostr(ano);
     4:STATUSBAR1.PANELS[1].TEXT:='ABRIL '+inttostr(ano);
     5:STATUSBAR1.PANELS[1].TEXT:='MAIO '+inttostr(ano);
     6:STATUSBAR1.PANELS[1].TEXT:='JUNHO '+inttostr(ano);
     7:STATUSBAR1.PANELS[1].TEXT:='JULHO '+inttostr(ano);
     8:STATUSBAR1.PANELS[1].TEXT:='AGOSTO '+inttostr(ano);
     9:STATUSBAR1.PANELS[1].TEXT:='SETEMBRO '+inttostr(ano);
     10:STATUSBAR1.PANELS[1].TEXT:='OUTUBRO '+inttostr(ano);
     11:STATUSBAR1.PANELS[1].TEXT:='NOVEMBRO '+inttostr(ano);
     12:STATUSBAR1.PANELS[1].TEXT:='DEZEMBRO '+inttostr(ano);
   end;
STATUSBAR1.PANELS[0].TEXT:=mostrahora();
STATUSBAR1.PANELS[1].TEXT:=mostradata();
end;

// ***** Viu como é fácil enfeitar seu projeto ******

Obter a célula de um StringGrid que está sob o cursor do mouse

Inclua na seção uses: Windows

procedure MouseCell(Grid: TStringGrid;
var Coluna, Linha: integer);
var
Pt: TPoint;
begin
GetCursorPos(Pt);
Pt := Grid.ScreenToClient(Pt);
if PtInRect(Grid.ClientRect, Pt) then
Grid.MouseToCell(Pt.X, Pt.Y, Coluna, Linha)
else begin
Coluna := -1;
Linha := -1;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Coluna, Linha: integer;
begin
MouseCell(StringGrid1, Coluna, Linha);
if (Coluna >= 0) and (Linha >= 0) then
Caption := 'Coluna: ' + IntToStr(Coluna) + ' - ' +
'Linha: ' + IntToStr(Linha);
else
Caption := 'O mouse não está no StringGrid';
end;

Alternando Bitmaps no Fundo de um Form

Um leitor perguntou recentemente sobre imagens de fundo em Forms.... Apesar de já se ter escrito diversos artigos sobre este tópico, sua questão tinhas algumas novidades. Primeiramente, ele desejava que o fundo se alternasse periodicamente entre diferente

Essencialmente, a solução para isto seria a aplicação de outros artigos similares. Em primeiro lugar, para resolver a questão de se ter diversas imagens, os bitmaps devem ser carregados em um array quando o Form for criado. A mudança periódica da imagem s

Finalmente, para tratar do assunto "não leia as imagens do disco", recorremos aos resources. Um arquivo de resource é apenas um caminho para empacotar muito bem qualquer tipo de dados que será anexado ao executável durante o processo de Linkedição. Para o

BITMAP1 BITMAP IMAGE1.BMP

BITMAP2 BITMAP IMAGE2.BMP

BITMAP3 BITMAP IMAGE3.BMP

BITMAP4 BITMAP IMAGE4.BMP

BITMAP5 BITMAP IMAGE5.BMP

A primeira parte de cada linha é o identificador que você utilizará no código para capturar uma imagem em particular. A segunda parte é o tipo de resource (neste caso, bitmap). E a última parte é o nome do arquivo que deve ser utilizado para a imagem. Ist

{$R MYBMPS.RES}
Quando o executável está sendo linkeditado (um passo antes da compilação), o resource será automaticamente anexado ao executável. Para carregar as imagens do resource no array de bitmaps no programa, fiz simplesmente:

for a := 1 to NumBmps do
begin
Bmps[a] := TBitmap.Create;
Bmps[a].LoadFromResourceName(hInstance,'BITMAP'+IntToStr(a));
end;
É basicamente isto... A seguir a listagem da Unit principal:

unit Unit1a;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
const
NumBmps = 5;
type
TForm1 = class(TForm)
Timer1: TTimer;
Edit1: TEdit;
CheckBox1: TCheckBox;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
Bmps : Array[1..NumBmps] of TBitmap;
SelectedBmp : Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$R MYBMPS.RES}
procedure TForm1.FormCreate(Sender: TObject);
var
a : Integer;
begin
for a := 1 to NumBmps do
begin
Bmps[a] := TBitmap.Create;
Bmps[a].LoadFromResourceName(hInstance,'BITMAP'+IntToStr(a));
end;
SelectedBmp := 1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
a : Integer;
begin
for a := 1 to NumBmps do Bmps[a].Free;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
x,y,w,h : Integer;
begin
w := Bmps[SelectedBmp].Width;
h := Bmps[SelectedBmp].Height;
for x := 0 to (Width div w) do
for y := 0 to (Height div h) do
Canvas.Draw(x*w,y*h,Bmps[SelectedBmp]);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc(SelectedBmp);
if SelectedBmp > NumBmps then SelectedBmp := 1;
Paint;
end;
end.

Como usar a cláusula UNION em um Query

O uso do componente TQuery gera muitas vantagens e economiza muitas linhas de programação. Mas muitas vezes nos deparamos com situações que parecem não ser resolvidas com sentenças SQL. Vejamos um exemplo:

Você possui 2 tabelas (VendasExternas e VendasInternas) e deseja fazer um resumo de todas as vendas de um vendedor chamado Marcos. Se você usar a sentença

SELECT Nome, Valor FROM VendasExternas, VendasInternas
WHERE Nome = 'Marcos'
você vai obter como resultado uma query com 4 campos (Nome, Valor, Nome_1 e Valor_1) e um resultado bem confuso para ser manipulado.

Para resolver o problema, você poderá usar a sentença

SELECT Nome, Valor FROM VendasExternas
WHERE Nome = 'Marcos'
UNION ALL
SELECT Nome, Valor FROM VendasInternas
WHERE Nome = 'Marcos'
A sentença acima pede para que sejam identificados as vendas de Marcos na tabela VendasExternas, as vendas de Marcos na tabela VendasInternas e que o resultado da primeira seja unido com o resultado da segunda produzindo uma query com apenas 2 colunas.

Visualizar imagem no dbgrid

Para visualizar uma imagem em um DBGrid, você vai ter que criar um descendente dele que aceite essas figuras. O código está abaixo:

unit DBPicGrd;

interface

uses
DBGrids, DB, DBTables, Grids, WinTypes, Classes, Graphics;

type
TDBPicGrid = class (TDBGrid)
protected
procedure DrawDataCell(const Rect: TRect; Field: TField; State:
TGridDrawState); override;
public
constructor Create (AOwner : TComponent); override;
published
property DefaultDrawing default False;
end;

procedure Register;

implementation

constructor TDBPicGrid.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
DefaultDrawing := False;
end;

procedure TDBPicGrid.DrawDataCell (const Rect: TRect; Field: TField;
State: TGridDrawState);
var
bmp : TBitmap;
begin
with Canvas do
begin
FillRect(Rect);
if Field is TGraphicField then
try
bmp := TBitmap.Create;
bmp.Assign (Field);
Draw (Rect.Left, Rect.Top, bmp);
finally
bmp.Free;
end
else
TextOut (Rect.Left, Rect.Top, Field.Text);
end;
end;

procedure Register;
begin
RegisterComponents ('Custom', [TDBPicGrid]);
end;
end.

Consultar por mês de um campo data

Problema:

Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.

Preciso fazer uma consulta onde apareceão apenas os clientes que fazem aniversário em determinado mês. Como fazer?

Solução:Use uma Query como abaixo:

- Coloque no form os seguintes componentes:

* TQuery

* TDataSource

* TDBGrid

* TEdit

* TButton

- Altere as propriedades dos componentes como abaixo:

* Query1.DatabaseName = (alias do BDE)

* DataSource1.DataSet = Query1

* DBGrid1.DataSource = DataSource1

- Coloque o código abaixo no evento OnClick de Button1:

Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select * from dCli');
Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
- Execute. Digite um número de 1 a 12 no Edit e clique no botão.

Observações

Os números de 1 a 12 representam, respectivamente

Como pegar a posição do mouse na tela

Para obter os valores das coordenadas do mouse de qualquer parte da tela, basta que se utiliza a função da API do Windows GetCursorPos. Esta função é interessante pois oferece ao programador os valores (x,y) de qualquer ponto da tela e não somente da aplicação.

Para implementação, esta função pode ser utilizada da seguinte maneira:

procedure TForm1.Timer1Timer(Sender: TObject);
var
pt: TPoint;
begin
GetCursorPos(pt); // Pega a posição atual do mouse;
//Mostra os valores das coordenadas do mouse
label1.caption := IntToStr(pt.x) + ',' + IntToStr(pt.y);
end;

Esta é mais uma das milhares de funções da API do Windows.

Enviar um email pelo delphi

smtp.postmessage.toAddress := 'StringList (por ex uma listbox';
smtp.postmessage.FromAdreess := 'ex: meu_email@123.pt';
smtp.userid := 'ex: user@123.pt'
smtp.host := 'ex: smtp@123.pt'
smtp.postmessage.subject := 'Assunto'
smtp.postmessage.body := 'Texto da mensagem (stringlist)'

smtp.connect;
smtp.sendmail;
smtp.disconnect;

Contribuição:
O Anonymous.nick enviou um complemento explicando melhor o procedimento para enviar um e-mail usando o Delphi.

Fazer um aplicativo completo para manipulação de e-mails é um tanto trabalhoso e não é o assunto desta dica. Muitas vezes, porém, queremos apenas dar ao nosso software a capacidade de enviar simples e-mails. Isto é fácil, especialmente porque o Delphi5 nos oferece o componente TNMSMTP (paleta FastNet) que faz praticamente todo o trabalho para nós. Precisamos apenas alterar algumas propriedades e chamar alguns métodos para que a mensagem seja enviada. Vamos para a prática:

1. Coloque um componente TNMSMTP no form.

2. Coloque um botão e no evento OnClick deste botão escreva:

procedure TForm1.Button1Click(Sender: TObject);
begin

{ Seu servidor SMTP }
NMSMTP1.Host := 'smtp.servidor.com.br';

{ Porta SMTP, **NÃO MUDE ISTO** }
NMSMTP1.Port := 25;

{ Nome de login do usuário }
NMSMTP1.UserID := 'MeuLogin';

{ Conecta ao servidor }
NMSMTP1.Connect;

{ Se ocorrer algum erro durante a conexão com o servidor, avise! }
if not NMSMTP1.Connected then
raise Exception.Create('Erro de conexão');

with NMSMTP1.PostMessage do begin
{ Seu e-mail }
FromAddress := 'meuemail@meuserver.com.br';

{ Seu nome }
FromName := 'Meu Nome';

{ E-mail do destinatário }
ToAddress.Clear;
ToAddress.Add('destinatario@servidor.com.br');

{ Assunto da mensagem }
Subject := 'Assunto da mensagem';

{ Corpo da mensagem }
Body.Clear;
Body.Add('Primeira linha da mensagem');
Body.Add('Segunda linha da mensagem');
Body.Add(''); { Linha em branco }
Body.Add('Última linha da mensagem');

{ Anexar arquivos(Se não quiser anexar arquivos, apague as 3 linhas seguintes) }

Attachments.Clear;

{ Endereço do anexo }
Attachments.Add('c:\diretorio\arquivo.ext');

end;

{ Manda o e-mail }
NMSMTP1.SendMail;
{ Disconecta do servidor }
NMSMTP1.Disconnect;
end;

Pronto! É só fazer as adaptações necessárias e você terá envio de e-mails em sua aplicação.

Observações:
Para enviar o mesmo e-mail para vários destinatário de uma só vez basta adicionar os endereços de e-mails de todos os destinatários em NMSMTP1.PostMessage.ToAddress.

Manipulação de arquivos texto no delphi

Bem, vamos falar inicialmente da escrita de arquivos texto. Existem algumas palavras reservadas, das quais irei falar de apenas algumas delas, que serão abordadas neste artigo. Para conhecer todas as palavras reservadas, relacionadas a manipulação de arquivos, entrem no help do Delphi com o seguinte tema: "Input and output procedures and functions"

Palavra Reservada

Função

AssignFile

Associa o arquivo manipulado a uma variável do tipo File

Append

Abre um arquivo existente para inserção de novos dados

Eof

Verifica se a posição atual do cursor indica o fim do arquivo

Write / Rewrite

Escreve valores diversos no arquivo. O rewrite após a escrita posiciona o cursor na próxima linha do arquivo

Read / Readln

Lê diversos valores no arquivo. O readln após a leitura posiciona o cursor na próxima linha do arquivo

Bem, irei agora explicitar dois exemplos contendo a manipulação de arquivos textos. O primeiro deles, ilustrará a inserção de dados em um arquivo. O segundo irá ilustrar a leitura de dados.

function GravaArquivoLogTransacao(TipoTransacao: TTipoTransacao): Integer;

const

NomArquivo: String = "LogTransacao.txt";

var

Path: String;

Arquivo: TextFile;

begin

        Path := ExtractFilePath(Application.ExeName);

        if not DirectoryExists(Path) then begin

                CreateDir(Path);

        end;

        if not FileExists(Path + NomArquivo) then begin

                FileCreate(Path + NomArquivo);

        end;

        Try

        AssignFile(Arquivo, Path + NomArquivo);

        Append(Arquivo);

        Write(Arquivo, FormatFloat("000000", Transacao.TransactionID) + " / " + FormatFloat("000000", Transacao.GlobalID));

        case TipoTransacao of

        ttBeginTran: WriteLn(Arquivo, " - BeginTran: " + DateToStr(Date) + " " + TimeToStr(Time) + " por usuário: " + IntToStr(UserID));

        ttCommit: WriteLn(Arquivo, " - Commit: " + DateToStr(Date) + " " + TimeToStr(Time) + " por usuário: " + IntToStr(UserID));

        ttRollBack: WriteLn(Arquivo, " - RollBack: " + DateToStr(Date) + " " + TimeToStr(Time) + " por usuário: " + IntToStr(UserID));

end;

CloseFile(Arquivo);

Result := 1;

Except

Result := -1;

End;

end;

Na função acima, ilustro a geração de um log de transações de uma aplicação. Observe que as palavras que realizam a "escrita" no arquivo estão destacadas.

procedure LeArquivoLogTransacao(NomeArquivo: String);

var

strFile: TextFile;

strLine: String;

begin

        AssignFile(strFile, NomeArquivo);

        Reset(strFile);

        Readln(strFile, strLine);

        while not Eof(strFile) do begin

                ShowMessage(strLine);

                Readln(strFile, strLine);

        end;

end;

Já na função acima, realizamos a leitura do arquivo e lançamos uma mensagem contato o conteúdo lido a cada linha.

Como calcular preço de venda [passo-a-passo]

O Brasil tem um mercado informal  muito aberto e, muitas vezes, os trabalhadores autônomos se perdem ao calcular o preço de seus produtos de forma a pagar todas as suas despesas e ainda tirar um lucro legal. Existem alguns cursos voltados para este fim, com dicas de criação, formação de preço e gerenciamento do seu negócio (o SEBRAE é um excelente exemplo disso). Mas para uma pergunta simples, existe também respostas simples. Para facilitar a vida desses pequenos negócios, o Formigueiros também é cultura e explica passo-a-passo como se calcula o preço de venda de um produto. Para calcular é preciso ter as informações conforme exemplo abaixo:

1) Custo unitário do produto: R$ 12,50;

2) Percentual de despesas variáveis*: 9% (sendo 4% do simples nacional + 5% da comissão de vendas);

3) Percentual de despesas fixas**: 25% (esse percentual é medido pelo total das despesas fixas sobre o faturamento. Neste exemplo, utiliza-se o faturamento total de R$ 144.000,00 e despesas fixas de R$ 36.000,00, ou seja, 36.000/144.000,00 = 0,25 *100 = 25%);

4) Defina sua margem de lucro líquido: 12% (aqui você irá definir quanto você quer ter de lucro com o produto vendido já deduzidas todas as despesas);

5) Deduza de 100% as despesas acima citadas (fixas, variáveis e licro líquido): 100% – 46% = 54% (este é o percentual que deve ser aplicado sobre o preço unitário de compra do produto para definir qual o seu preço de venda);

6) Divida o custo unitário (de compra) por 54 (e multiplique por 100): R$ 12,50/54 * 100 = R$ 23,15

NOTA: Despesas fixas são as despesas permanentes da empresa como água, luz, telefone, aluguel, etc. Já as despesas variáveis são, como o próprio nome diz, despesas eventuais ou sem valor permanente como encargos, aquisição de bens ou produtos, etc.

Pronto, este é o valor de venda do seu produto. A dica é do blog do Élcio. Boas vendas e sucesso nos seus negócios.

Cálculo ICMS CST 00

Como prometido, vamos iniciar a explicação para o calculo da CST de ICMS 00, e suas possíveis variações.

ICMS CST 00 quer dizer, Tributada Integralmente. Para calcular este ICMS é simples, basta multiplicar a base de calculo(veja como aqui obter a base de calculo) pelo aliquota estabelecida.

Mais ou menos assim:

Base = 100,00

Alíquota = 17%

Valor ICMS = 100,00 x 17% = 17,00

Simples né? Então vamos começar a complicar

Embora a operação seja tributada integralmente, ela pode possuir Alíquota de ICMS reduzida.

A alíquota de ICMS também muda de acordo com o estado de origem x destino da mercadoria.

Algumas regras básicas:

1 – Venda para consumidor final, não contribuinte do ICMS, residente em UF diversa do emitente da nota fiscal, aplica-se a alíquota interna da UF do emissor da nota fiscal.

2 – Venda para consumidor final, contribuinte do ICMS, residente em UF diversa do emitente da nota fiscal, aplica-se a alíquota interestadual entre as UF’s.

3 – Venda para contribuinte do ICMS que não seja consumidor final, aplica-se a alíquota interestadual.

Obs: Como já citei anteriormente, a alíquota do ICMS é uma característica do ITEM da nota, então dentro de uma nota, pode ter vários itens tributados integralmente, mas cada um com alíquota de ICMS diferente. E isso em operações internas(dentro do estado)

Precisa prestar atenção a tabela de alíquota entre UF’s (Confira a tabela aqui)

Lembrando, essas regras são aplicadas para a operações tributadas integralmente, ou seja, CST 00.

Evitar que a aplicação trave ao executar um processo grande

Já devemos ter precisado executar um comando muito grande e, para ficar mais amigável ao usuário, colocar uma barrinha de progresso, para avisá-lo em que estágio de processamento está.

Porém, nos deparamos com um pequeno problema: Nossa aplicação fica travada enquanto executa o comando!! Como resolver isto?

Existe um método chamado Application.ProcessMessages;   que força a aplicação processas as mensagens do sistema operacional, como por exemplo a exibição correta do form. Com isto, não só o form é visualizado corretamente, mas também nossa barrinha de progresso funciona perfeitamente. :D

Vejamos um exemplo simples:

Digamos que tenhamos um ADOTable com vários registros abertos e vamos percorrer um a um:

ADOTable1.First;
  while not (ADOTable1.Eof) do
  begin
      lblStatus.Caption := 'Processando registro...'; // exibimos alguma mensagem
      Application.ProcessMessages; // chamados o método que força o SO a desenha a janela
      ADOTable1.Next; // pula para o próximo registro da tabela
  end;

Pronto. Agora é só você implementar uma barra de progresso e colocar mais algumas perfumarias (objetos que deixam a cara do formulário mais amigável para o usuário) caso seja necessário :)

Detectando o Numero Serial do HD

Function SerialNum(FDrive:String) :String;
Var
    Serial:   DWord;
    DirLen,Flags: DWord;
    DLabel : Array[0..11] of Char;
begin
     Try GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
            Result := IntToHex(Serial,8);
       Except Result :='';
end;
end;

Recuperar a Velocidade da CPU

Esta interessante função recupera a velocidade de processamento aproximada da CPU:

const
ID_BIT=$200000; // EFLAGS ID bit
 
function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
 
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
 
Sleep(10);
asm
dw 310Fh // rdtsc
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh // rdtsc
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
 
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
 
Result := TimerLo / (1000.0 * DelayTime);
except end;
end;
No evento OnClick, basta atribuir a saída da função a uma string:

procedure TForm1.Button1Click(Sender: TObject);
var cpuspeed:string;
begin
cpuspeed:=Format('%f MHz', [GetCPUSpeed]);
edit1.text := cpuspeed;
end;

Verificando o tipo de Drive

Verificando o tipo de Drive

O código abaixo implementa uma função para testar qual o tipo de drive da unidade especificada.

Para isto, é necessário utilizar uma função de API do windows chamada GetTypeDrive.

Esta função retorna valores default que indicam o tipo de drive selecionado.(Drive_Removable,Drive_Fixed,Drive_Remote,Drive_CdRom,Drive_RamDisk)

Código Completo:

Function Tipo_Drive(Drive:Char):String;
Const
Drive_Removable = 2;
Drive_Fixed = 3;
Drive_Remote = 4;
Drive_CdRom = 5;
Drive_RamDisk = 6;
var
Tipo: byte;
begin
Tipo := GetDriveType(PChar(Drive + ':\'));
Case Tipo of
0: Result := 'Indeterminado';
1: Result := 'Inexistente ';
2: Result := 'Removível';
3: Result := 'Fixo';
4: Result := 'Rede';
5: Result := 'CD-ROM';
6: Result := 'RAM Disk';
else Result := ' Erro';
End;
end;

Consultar por mês de um campo data

Problema:

Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.

Preciso fazer uma consulta onde apareceão apenas os clientes que fazem aniversário em determinado mês. Como fazer?

Solução:

Use uma Query como abaixo:

- Coloque no form os seguintes componentes:

  * TQuery

  * TDataSource

  * TDBGrid

  * TEdit

  * TButton

- Altere as propriedades dos componentes como abaixo:

  * Query1.DatabaseName = (alias do BDE)

  * DataSource1.DataSet = Query1

  * DBGrid1.DataSource = DataSource1

 - Coloque o código abaixo no evento OnClick de Button1:

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from dCli');
  Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
  Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
  Query1.Open;
- Execute. Digite um número de 1 a 12 no Edit e clique no botão.

Observações

Os números de 1 a 12 representam, respectivamente, os meses de Janeiro a Dezembro. Este exemplo foi testado com Delphi4, BDE5 e tabela Paradox7.