Criando caixas de diálogo em tempo de execução

{Inclua na seção uses: Forms, StdCtrls, Buttons A função abaixo demonstra a criação de uma caixa de diálogo que permite entrada de dados.}

{ Esta função retorna true se for pressionado OK e false em caso contrário. Se for OK, o texto digitado pelo usuário será copiado para a variável Nome }
function ObterNome(var Nome: string): boolean;
var
Form: TForm; { Variável para o Form }
Edt: TEdit; { Variável para o Edit }
begin
Result := false; { Por padrão retorna false }
{ Cria o form }
Form := TForm.Create(Application);
try
{ Altera algumas propriedades do Form }
Form.BorderStyle := bsDialog;
Form.Caption := 'Atenção';
Form.Position := poScreenCenter;
Form.Width := 200;
Form.Height := 150;
{ Coloca um Label }
with TLabel.Create(Form) do begin
Parent := Form;
Caption := 'Digite seu nome:';
Left := 10;
Top := 10;
end;
{ Coloca o Edit }
Edt := TEdit.Create(Form);
with Edt do begin
Parent := Form;
Left := 10;
Top := 25;
{ Ajusta o comprimento do Edit de acordo com a largura do form }
Width := Form.ClientWidth - 20;
end;
{ Coloca o botão OK }
with TBitBtn.Create(Form) do begin
Parent := Form;
{ Posiciona de acordo com a largura do form }
Left := Form.ClientWidth - (Width * 2) - 20;
Top := 80;
Kind := bkOK; { Botão Ok }
end;
{ Coloca o botão Cancel }
with TBitBtn.Create(Form) do begin
Parent := Form;
Left := Form.ClientWidth - Width - 10;
Top := 80;
Kind := bkCancel; { Botão Cancel }
end;
{ Exibe o form e aguarda a ação do usuário. Se for OK... }
if Form.ShowModal = mrOK then begin
Nome := Edt.Text;
Result := true;
end;
finally
Form.Free;
end;
end;

//Para chamar esta função siga o exemplo abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
if ObterNome(S) then
Edit1.Text := S;
end;

{Os componentes Label, Edit (var Edt) e BitBtn's (botões) não são destruídos explicitamente (Componente.Free). Isto não é necessário, pois ao criá-los informei como proprietário o Form (ex: TLabel.Create(Form)). Neste caso, estes componentes são destruídos automaticamente ao destruir o Form (Form.Free).}

Criando um atalho no desktop

//Coloque essas units na seção implementation :
uses ShlObj, ActiveX,ComObj, Registry; //Por último, crie uma procedure que faça o trabalho:

procedure CreateShortcut (FileName, Parameters, InitialDir, ShortcutName, ShortcutFolder : String);
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetArguments(Parameters);
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(InitialDir));
end;
MyReg := TRegIniFile.Create('SoftwareMicroSoftWindowsCurrentVersionExplorer');
Directory := MyReg.ReadString ('Shell Folders','Desktop','');
WFileName := Directory + '' + ShortcutName + '.lnk';
MyPFile.Save (PWChar (WFileName), False);
MyReg.Free;
end;

Criando uma rotina para pegar todos os erros do programa

Procedure MostraErro;
Begin
ShowMessage('Ocorreu algum erro!');
end;

TForm1.Create;
Begin
Application.OnException:=MostraErro;
end;

Criando uma base de dados ms access pelo delphi

{Aprenda como criar uma base de dados MS Access sem o MS Access. Cria a base, as tabelas, índices, enfim, tudo utilizando puro código Pascal. INTRODUÇÃO

Quando se cria um sistema para ambientes desktop sempre surge a dúvida de qual base de dados usar. Geralmente são usados bancos DBase, Paradox ou MS Access. Destes, a base mais robusta e confiável é, sem dúvida, MS Access. Mas existe um grande problema para se criar a base de dados MS Access, pois faz-se necessário o uso do ambiente MS Access.

Algumas pessoas não têm este aplicativo instalado em sua máquina e então torna-se inviável o uso desta base de dados, impedindo, desta forma, um crescimento tecnológico do programador que fica preso a ferramentas obsoletas.

Neste tutorial você irá aprender como criar uma base de dados MS Access a partir do nada, usando puro código Delphi e a Tecnologia ADO Extensions que é distribuída pela Microsoft.

ADOX, faz parte dos componentes ADO, quer dizer, é uma extensão do ADO. O ADOX fornece ferramentas de acesso a estrutura, segurança, definições de tabelas e muitos outros.

Como dito anteriormente, ADOX é uma library distribuída pela Microsoft, o arquivo chama-se "Msadox.dll", sua definição é "Microsoft ADO Ext. 2.x for DDL and Security" e é este arquivo que iremos importar para nossa IDE no Delphi.

INSTALANDO

Para usar este objetos no Delphi basta seguir os seguintes passos:

1- Selecione PROJECT > IMPORT TYPE LIBRARY

2- Procure pela descrição: "Microsoft ADO Ext. 2.x for DDL and Security (Version 2.x)"

2- Em CLASS NAMES, altere o nome dos objetos acrescentando ADOX após a letra T, exemplo: TTable mude para TADOXTable, TColumm mude para TADOXColumn. Repita este procedimento para todos objetos nesta lista.

3- Em PALETTE PAGE selecione ou digite um novo nome para a paleta onde os componentes ficarão, exemplo: ADOX.

4- Pressione INSTALL, logo depois pressione Ok confirmando o início da instalação.

5- Pressione YES confirmando que você quer instalar os componentes.

6- Pressione Ok na tela que indica os objetos instalados.

7- Selecione FILE > CLOSE ALL e pressione YES para salvar este package criado.

O motivo da troca do nome dos objetos é muito óbvio, estes nomes de classe como Ttable já existem, então iria gerar conflitos na compilação, por isso bastou trocar o nome da classe.

Pronto, os objetos estão instalados, agora sempre que você utilizar estes objetos será inserido na clausula USES a Unit ADOX_TLB pois este é o nome da unit criada a partir da importação da DLL.

Agora, mãos à obra.

DEFININDO A BASE DE DADOS E OBJETOS A SEREM USADOS

Vamos criar uma base onde serão armazenados informaçõe sobre animais de estimação (para sair um pouco da rotina de CLIENTES/PRODUTOS/PEDIDOS).

Para esta base serão criadas as seguintes tabelas:

> PROPRIETARIO

> PRO_ID

> PRO_NOME

>ANIMAL

> ANI_ID

> ANI_PROPRIETARIO

> ANI_NOME

> ANI_NASCIMENTO

Onde um proprietario pode ter mais de um animal formando assim um relacionamento UM PARA MUITOS.

No Delphi, crie uma nova aplicação. Será criado um novo Form, a este insira os seguintes componentes:

> 3 TButtons

Para lançar os procedimentos de criação da base de dados e das tabelas.

Altere as seguintes propriedades para cada TButtons respectivamente:

Caption: Criar base

Name: btnBase

Caption: Criar tabelas

Name: btnTabelas

Caption: Navegar

Name: btnNavegar

> 1 TEdit

Para armazenar o path da base de dados a ser criada.

Altere as seguintes propriedades:

Name: edtPath

Text: (deixe em branco)

> 1 TSaveDialog

Para navegar no disco e informar o path da base de dados.

Altere as seguintes propriedades:

Filter: Base MS Access|*.mdb

Title: Salvar como...

DefaultExt: .mdb

> 1 TADOConnection

Para fazer a conexão com a base criada.

Altere as seguintes propriedades:

Login prompt: False

> 1 TADOCommand

Para fazer a ligação e criação das tabelas.

Altere as seguintes propriedades:

Connection: Selecione o ADOConnection1

> 1 TADOXCatalog

Para criar a base de dados.

CRIANDO A BASE DE DADOS

Agora vamos ao código. Clique duas vezes no objeto btnNavegar e digite:}


procedure TForm1.btnNavegarClick(Sender: TObject);
begin
if SaveDialog1.Execute then
edtPath.Text := SaveDialog1.FileName;
end; Com isso informamos o nome que a base terá.

Clique duas vezes no objeto btnBase e digite o seguinte procedimento:


procedure TForm1.btnBaseClick(Sender: TObject);
var
Base: String;
begin
if edtPath.Text = '' then
begin
ShowMessage('Nome da base de dados não informada.');
exit;
end;
Base := 'Provider=Microsoft.Jet.OLEDB.4.0'+
';Data Source=' + edtPath.Text +
';Jet OLEDB:Engine Type=4';
ADOXCatalog1.Create1(Base);
end; {Primeiro verificamos se há algum texto no objeto TEdit, em seguida atribuímos a string de conexão à variável BASE informando vários parâmetros, mas atente para a seguinte linha: "...Engine Type=4...", isto quer dizer que iremos criar uma base Access 97, para Access 2000 informe 5.

Em seguida é efetivamente criado a base de dados através do método Create1 do objeto ADOXCatalog, passando para este a string da BASE. Observe que o método é Create1 e não simplesmente Create, pois o método Create já existe e é da classe.

Pronto, criamos uma base de dados vazia, não existe nada nela, mas já é um arquivo comum ao MS Access e pode ser aberto normalmente.

CRIANDO TABELAS

Vamos começar a criar as tabelas, seus índices e integridade referencial. Para isso clique duas vezes no objeto btnTabelas e digite:}


procedure TForm1.btnTabelasClick(Sender: TObject);
var
base, comando: string;
begin
{ definindo a base de dados }
base := 'Provider=Microsoft.Jet.OLEDB.4.0' +
';Data Source=' + edtPath.Text +
';Persist Security Info=False';
ADOConnection1.ConnectionString := base;
{ Criando as tabelas... }
{>>> PROPRIETARIO <<<}
comando := 'CREATE TABLE PROPRIETARIO (' +
'PRO_ID INT,' +
'PRO_NOME TEXT(50))';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
{ ADICIONANDO INDICES }
comando := 'CREATE INDEX IDX_PRO_ID ' +
'ON PROPRIETARIO (PRO_ID) WITH PRIMARY';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
{>>> ANIMAL <<<}
comando := 'CREATE TABLE ANIMAL (' +
'ANI_ID INT,' +
'ANI_PROPRIETARIO INT ' +
'CONSTRAINT IDX_PRO_ID ' +
'REFERENCES PROPRIETARIO (PRO_ID),' +
'ANI_NOME TEXT (50),' +
'ANI_NASCIMENTO DATETIME)';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
end; {CONCLUÍNDO

Pronto, tudo muito fácil e simples. Agora rode o programa e faça os testes. Clique em navegar, selecione um diretório e digite o nome que sua base terá, então clique em CRIAR BASE e veja que o programa criará a base, logo após isto clique em CRIAR TABELAS então as tabelas serão criadas.

Agora ficou fácil criar sistemas desktops usando uma base mais robusta sem a necessidade de se ter o MS Access instalado em sua máquina. É possível criar e acessar todos os recursos de tabelas da base de dados MS Access usando os objetos ADOX, aqui foi mostrado como criar utilizando linguagem DDL, ou seja, escrevemos diretamente para que o comando fosse executado, mas é possível ter acesso à estes recursos diretamente com os componentes distribuídos por esta library, mas este assunto ficará para outra ocasião.

Se você tiver o MS Access instalado em sua máquina pode abri-lo e verificar nossa base de dados, caso contrário (como é o meu caso) crie uma simples aplicação com dois DBGrids para exibir os campos das tabelas, assim como inserir dados.}

Criando uma barra de status completa

{Para testar o exemplo abaixo inclua um componente StatusBar, um componente Timer. No componente StatusBar vá até a propriedade Panels e adicione 3 panels.

Na propriedade Interval do componente Timer informe o valor 500.}


unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1Timer(Self);
end;
// Evento OnTimer do componente Timer
procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[0].Text := TimeToStr(Time);
if GetKeyState(VK_NUMLOCK) = 1 then
StatusBar1.Panels[1].Text := 'Num lock: ON'
else
StatusBar1.Panels[1].Text := 'Num lock: OFF';
if GetKeyState(VK_CAPITAL) = 1 then
StatusBar1.Panels[2].Text := 'Caps lock: ON'
else
StatusBar1.Panels[2].Text := 'Caps lock: OFF';
end;
// Evento OnKeyPress do Form
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
Timer1Timer(Self);
end;
// Evento OnKeyDown do Form
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Timer1Timer(Self);
end;

Criando uma barra de status

{Para criar uma barra de status realmente útil, primeiramente coloque um componente TStatusBar (que está na paleta Win32) no seu form. Clique com o botão direito no StatusBar1 e escolha Panels Editor. Clique Add e pronto (se quiser colocar mais divisões - para colocar um relógio, por exemplo, é só clicar Add mais vezes). Primeiramente altere a propriedade ShowHint para True. Depois digite o que vai aparecer no seguinte formato:

Texto que vai aparecer junto ao mouse|Texto que vai aparecer no StatusBar (onde | é Shift + ).

* No texto que aparecer junto ao mouse, coloque uma frase pequena (ex: Imprimir). No texto que vai aparecer no StatusBar, coloque um texto mais explicativo (ex: Imprimir o relatório de vendas do mês atual).

* Caso você queira que não apareça nenhum texto junto ao mouse (ou seja, só no StatusBar), cuide para que o primeiro caracter de Hint seja o caracter "|" (sem aspas).

No evento OnCreate do form, coloque o seguinte comando:}


Application.OnHint := ShowHint; {Crie uma procedure na seção private do form a procedure ShowHint. Na seção implementation, coloque:}


procedure TForm1.ShowHint(Sender: TObject);
begin
StatusBar1.Panels[0].Text := GetLongHint (Application.Hint);
end;

Criando um componente skin

{Aqui iremos tratar da criação de um componente SKIN como os do WINAMP. Para montar os SKINS devemos utilizar um Bitmap e deixar as bordas do formulários transparentes (ocultas). A solução é bem simples, utilizando o componente Timage, dê uma olhado no fonte:}


unit SkinImage;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
ExtCtrls;

type
TSkinImage = class(TImage)
private

protected
{ Protected declarations }
function BitmapToRegion(bmp: TBitmap) : dword;
procedure OwnerShow(Sender : TObject);
public
constructor Create(AOwner : TComponent); override;
published
{ Published declarations }
end;

procedure Register;

var
Ready : Boolean;

implementation

procedure Register;
begin
RegisterComponents('CLINICA DELPHI', [TSkinImage]);
end;

{ TSkinImage }

constructor TSkinImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if NOT (csDesigning in ComponentState) then
with TForm(AOwner) do
begin
BorderStyle := bsNone;
Self.Top := 0;
Self.Left := 0;
OnShow := OwnerShow;
end;
end;

function TSkinImage.BitmapToRegion(bmp: TBitmap) : dword;
var ix,iy : integer; // loop nas variáveis
tc : TColor; // transparentColor
b1 : boolean; // está olhando o "real"
pixels (no transparent pixels)
c1 : cardinal; // ajusta a variável na região
i1 : integer; // primeira posição real em pixel
begin
Result := 0;
i1 := 0;
// memória do transparent color
tc := bmp.transparentColor and $FFFFFF;
with bmp.canvas do
// enquadrilhe por todas as linhas
for iy := 0 to bmp.height - 1 do
begin
b1 := False;
// esquadrinhe por todo o pixels nesta linha
for ix:=0 to bmp.Width - 1 do
// feito nós acharmos o começo/final seguidos em pixel
if (pixels[ix, iy] and $FFFFFF <> tc) <> b1 then begin
// sim, e foi o último pixel,
// so nós podemos somar uma região de estilo de linha. . .
if b1 then begin
c1:=CreateRectRgn(i1,iy,ix,iy+1);
if result<>0 then
begin
// Esta não é a primeira região
CombineRgn(Result, Result, c1, RGN_OR);
DeleteObject(c1);
// Esta é a primeira região
end
else
Result := c1;
end else i1 := ix;
// mude o modo e procura o primeiro ou último pixel?
b1:=not b1;
end;
// o último pixel nesta fila era um pixel real?
if b1 then begin
c1:=CreateRectRgn(i1, iy, bmp.width-1, iy+1);
if (Result <> 0) then
begin
CombineRgn(Result, Result, c1, RGN_OR);
DeleteObject(c1);
end
else
Result := c1;
end;
end;
end;

procedure TSkinImage.OwnerShow(Sender: TObject);
var
Region : HRGN;
begin
if NOT Ready then
begin
Ready := True;
Region := BitmapToRegion(Picture.Bitmap);
SetWindowRgn(TForm(Owner).Handle, Region, True);
DeleteObject(Region);
end;
end;

initialization
Ready := False;
end. {" Digamos a primeira linha de nosso bitmap se parece:

000XXXXX00XXXXX000000XXXX000

0 -> Pixel Trasparente; X -> Pixel Colorido

Agora minha função passa por esta linha e cria uma região de janela para cada fila de pixels. No exemplo, nós adquiriríamos 3 regiões (4-8, 11-15, 22-25).

Nós fizemos o mesmo para todas as outras linhas no Bitmap, e todas essas regiões.}