Buscar por:

Alteração do formato da data nas configurações regionais do windows

Código

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    procedure ConfiguraDataHora;

    procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE;

    function RegistryManipula(Key, SubKey, Conteudo: String): Boolean;

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

uses Registry;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

  // independente de qualquer forma que esteja configurado dentro do

  // windows (configurações regionais) será alterado para o formato dd/mm/yyyy

  ConfiguraDataHora;

end;

procedure TForm1.ConfiguraDataHora;

const

  Chave = 'Control PanelInternational';

  SubChave = 'sShortDate';

  Conteudo = 'dd/mm/yyyy';

begin

  // não encontrei outra maneira de alterar o conteudo de sShortDate

  RegistryManipula(Chave, SubChave, Conteudo);

  // envia mensagem para atualização das variáveis TFormatSettings:

  SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0);

end;

procedure TForm1.WMWinIniChange(var Message: TMessage);

begin

  if (Message.Msg = WM_WININICHANGE) and Application.UpdateFormatSettings then

  begin

    // atualização das variáveis TFormatSettings

    GetFormatSettings;

  end;

end;

function TForm1.RegistryManipula(Key, SubKey, Conteudo: String): Boolean;

const

  cstMsg = 'Não foi possível "%s" a entrada "%s", '+

           'chave "%s" no registry desta máquina.';

var

  Registry: TRegistry;

begin

  Result := False;

  Registry := TRegistry.Create;

  try

    with Registry do

    begin

      Access  := KEY_ALL_ACCESS;

      RootKey := HKEY_CURRENT_USER;

      if not OpenKey(Key, True) then

        ShowMessage(Format(cstMsg,['ACESSAR',Key,SubKey]))

      else

      begin

        try

          WriteString(SubKey, Conteudo);

          CloseKey;

          Result := True;

        except

          ShowMessage(Format(cstMsg,['GRAVAR',Key,SubKey]));

        end;

      end;

    end;

  finally

    Registry.Free;

  end;

  if (Result=False) then

  begin

    Halt(0);

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

const

  cstMsg = 'Configuração regional Atual: [%s]';

begin

  ShowMessage(Format(cstMsg, [ShortDateFormat]));

end;

end.