quarta-feira, 1 de setembro de 2010

Obtendo a data do último dia do mês, ou último dia útil, de uma data informada

Function LastDayOfMonth (Data : TDateTime; lSabDom : Boolean) : TDateTime;
var
    Ano, Mes, Dia : word;
    AuxData : TDateTime;
    DiaDaSemana : Integer;
begin
    AuxData := FirstDayOfMonth (NextMonth (Data), False) - 1;
    if lSabDom Then begin
        DecodeDate (Auxdata, Ano, Mes, Dia);
        DiaDaSemana := DayOfWeek (AuxData);
        if DiaDaSemana = 1 Then
            Dia := Dia - 2
        else
        if DiaDaSemana = 7 Then
            Dec (Dia);
        AuxData := EnCodeDate (Ano, Mes, Dia);
    end;
    LastDayOfMonth := AuxData;
end;

Fazendo cálculo de horas

var
    hora1: TDateTime;
    hora2: TDateTime;
    total: TDateTime;
begin
    hora1 := StrToTime(Edit1.Text);
    hora2 := StrToTime(Edit2.Text);
    total := Hora2 - Hora1;
    Label1.Caption := FormatDateTime('hh:nn:ss',total);
end;

Descobrir se uma data é fim do mês

Esta função retorna true se a data passada como parâmetro é fim de mês. Retorna false caso contrário.

Inclua na seção uses: SysUtils

function tbFimDoMes(const Data: TDateTime): boolean;
var
  Ano, Mes, Dia: Word;
begin
  DecodeDate(Data +1, Ano, Mes, Dia);
  Result := Dia = 1;
end;

terça-feira, 31 de agosto de 2010

Definir data/hora de um arquivo

Inclua na seção uses: SysUtils

{ Esta função altera a data e hora de um arquivo. Se obter sucesso retorna true, caso contrário retorna false. }
function DefineDataHoraArq(NomeArq: string; DataHora: TDateTime): boolean;
var
  F: integer;
begin
  Result := false;
  F := FileOpen(NomeArq, fmOpenWrite or fmShareDenyNone);
  try
  if F > 0 then
  Result := FileSetDate(F, DateTimeToFileDate(DataHora)) = 0;
  finally
  FileClose(F);
  end;
end;
{ Exemplo de uso 1: Usa a data atual do sistema (Now) }

if DefineDataHoraArq('c:\teste\logo.bmp', Now) then
  ShowMessage('Data/Hora do arquivo definida com sucesso.')
else
  ShowMessage('Não foi possível definir data/hora do arquivo.');

{ Exemplo de uso 2: Usa uma data fixa }
var
  DataHora: TDateTime;
begin
  { Define a data para 5-Fev-1999 e a hora para 10:30 }
  DataHora := EncodeDate(1999, 2, 5) + EncodeTime(10, 30, 0, 0);
  if DefineDataHoraArq('c:\teste\logo.bmp', DataHora) then
  ShowMessage('Data/Hora do arquivo definida com sucesso.')
  else
  ShowMessage('Não foi possível definir data/hora do arquivo.');
end;

Converte hora (formato HH:MM) para minutos

Function HoraToMin(Hora: String): Integer;
begin
    Result := (StrToInt(Copy(Hora,1,2))*60) + StrToInt(Copy(Hora,4,2));
end;

Como saber se o ano é bisexto

function TForm1.AnoBiSexto(Ayear: Integer): Boolean;
begin
    Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or
    (AYear mod 400 = 0));
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
    if AnoBiSexto(1999) Then
        ShowMessage('Ano de 1999 é Bisexto')
    Else ShowMessage('Ano de 1999 não é Bisexto');
end;

Como saber quantos dias tem no mes

function TForm1.AnoBiSexto(Ayear: Integer): Boolean;
begin
    // Verifica se o ano é Bi-Sexto
    Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or
    (AYear mod 400 = 0));
end;
 
function TForm1.DiasPorMes(Ayear, AMonth: Integer): Integer;
const DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
    Result := DaysInMonth[AMonth];
    if (AMonth = 2) and AnoBiSexto(AYear) then
    Inc(Result);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
    Label1.Caption := IntToStr(DiasPorMes(1999, 10));
end;

Como formatar data para exibição por extenso

O Delphi permite formatar datas para apresentação por extenso de forma bastante simples. Vejamos os seguintes exemplos:

Para formatar a data 18/03/1999, podemos utilizar:

No create do form colocar

Shortdateformat:=

dddd, dd/mm/yyyy = Quinta, 18/03/1999
dd/mmm/yyyy = 18/Mar/1999
dddd, dd" de "mmmm" de "yyyy = Quinta, 18 de Março de 1999
dd" de "mmmm" de "yyyy, dddd = 18 de Março de 1999, Quinta

segunda-feira, 30 de agosto de 2010

Enviando combinação de teclas para o buffer do teclado

Exemplo : PostKeyEx32(Ord('A'), [ssCtrl], false); Envia Ctrl+A para o controle que tiver o foco. Key : virtual keycode da tecla a enviar. Para caracteres imprimíveis informe o código ANSI (Ord(CHARACTER)). Shift : estado das teclas modificadoras. Shift, Control, Alt, Mouse Buttons.  SpecialKey: normalmente deve ser False. Informe True se a tecla desejada for, por exemplo, do teclado numérico.  

procedure PostKeyEx32(Key: Word; const Shift: TShiftState; SpecialKey: boolean);
type
    TShiftKeyInfo = Record
    shift: Byte;
    vkey : Byte;
End;
    byteset = Set of 0..7;
    const
    ShiftKeys: array [1..3] of TShiftKeyInfo =
    ((shift: Ord(ssCtrl); vkey: VK_CONTROL ),
    (shift: Ord(ssShift); vkey: VK_SHIFT ),
    (shift: Ord(ssAlt); vkey: VK_MENU ));
    var
    Flag: DWORD;
    bShift: ByteSet absolute shift;
    i: Integer;
begin
    for i := 1 to 3 do begin
        if shiftkeys[i].shift in bShift then
            Keybd_Event(ShiftKeys[i].vkey,
        MapVirtualKey(ShiftKeys[i].vkey, 0), 0, 0);
    end; // for
    if SpecialKey Then
        Flag := KEYEVENTF_EXTENDEDKEY
    else
        Flag := 0;
    Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
    Flag := Flag or KEYEVENTF_KEYUP;
    Keybd_Event(Key, MapvirtualKey(Key, 0), Flag, 0);
    for i := 3 DownTo 1 do begin
        if ShiftKeys[i].shift in bShift then
            Keybd_Event(shiftkeys[i].vkey,
        MapVirtualKey(ShiftKeys[i].vkey, 0),
        KEYEVENTF_KEYUP, 0);
    end; // for
end; // PostKeyEx32 

Virtual keys

vk_LButton = $01;
vk_RButton = $02;
vk_Cancel = $03;
vk_MButton = $04; { NOT contiguous with L & RBUTTON }
vk_Back = $08;
vk_Tab = $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior = $21;
vk_Next = $22;
vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up = $26;
vk_Right = $27;
vk_Down = $28;
vk_Select = $29;
vk_Print = $2A;
vk_Execute = $2B;
vk_SnapShot = $2C;
vk_Copy = $2C {not used by keyboards }
vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
{vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' }
{ vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' }
vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract = $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;
vk_F6 = $75;
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;

Colocando funções em uma DLL

Edite diretamente no DPR, e depois salve como Funcoes.dpr:

Library Funcoes;

Uses SysUtils,WinTypes,WinProcs;
{ Uma função que tira os espaços no início e no final de uma string }

Function Trim(J:String):String; Export;
Begin
While J[Length(J)]=#32 do Dec(J[0]);
If Length(J)>1 then
While (J[1]=' ') do
Begin
Delete(J,1,1);
If Length(J)<=1 then J:='';
end;
Result:=J;
end;
Exports { Torna visivel para os programas }
Trim;
Begin
End.
Para usar num programa:

Unit Unit1;
Interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Var
Form1: TForm1;
Implementation
{ Declara a funcao }
Function Trim(J:String):String; External 'funcoes.dll';
{$R *.DFM}
Procedure TForm1.FormClick(Sender: TObject);
begin
Caption:=Trim(' Visite sempre o Delphi Club '); { Note os espacos }
end;
 
As vantagens de colocar as funções em DLL são:

1. O programa exigirá menos memória

2. Você poderá reaproveitar as funções

3. Em alguns casos pode-se atualizar apenas as dll para um upgrade

Como atribuir um valor inicial para uma variável global

No Delphi, pode-se atribuir um valor inicial para uma variável global enquanto a declara. É possível escrever, por exemplo:

var
  Value: Integer = 10;
  Correct: Boolean = True;

Esta técnica de inicialização funciona apenas para variáveis globais, não para variáveis declaradas no escopo de um procedimento ou método.