Super Dicas Delphi parte VII

 


Como criar um Form de Apresentação (Splash Form) como o do WORD?

Para você criar um pequeno Form de apresentação enquanto seu programa é carregado ou enquanto sua aplicação gera indices, etc. Crie seu Form de Apresentação (ApresForm) e depois no menu View opção Project Source, inclua o seguinte código: 

program Mastapp; 
uses
Forms, 

Apres in 'APRES.PAS' {ApresForm},
Aplicacao01 in 'APLIC01.PAS' {Aplic01Form},
Aplicacao02 in 'APLIC02.PAS' {Aplic02Form};
{$R *.RES}
begin
ApresForm := TApresForm.Create(Application);
ApresForm.Show;
ApresForm.Update;
Application.CreateForm(TAplic01Form, Aplic01Form);
Application.CreateForm(TAplic01Form, Aplic02Form);
ApresForm.Hide;
ApresForm.Free;
Application.Run;
end.


Verifica se o Form, já esta ativo, Delphi1, Delphi2 e Delphi3

procedure TForm1.Button1Click(Sender: TObject);
var Found,i : Integer;
begin
Found := -1;
for i := 0 to Screen.FormCount - 1 do
if Screen.Forms[i] is TForm2 then
Found := i;
if Found >= 0 then
Screen.Forms[Found].Show
else
begin
Form2 := TForm2.Create(Self);
Form2.Show;
end; 

end;


Converter a primeira letra de um Texto em maiúscula

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
with Sender as TEdit do
if (SelStart = 0) or (Text[SelStart] = ' ') then
if Key in ['a'..'z'] then
Key := UpCase(Key);
end;


Mostrar as fontes TrueType instaladas no Windows

Para testar o exemplo abaixo inclua em seu formulário um componente ListBox, um componente Label e um componente
ListBox. 

// Evento OnClick do componente LisBox 

procedure TForm1.ListBox1Click(Sender: TObject);
begin 

{ Atribui a propriedade Caption do componente Label o nome da fonte selecionada apenas para visualização} 

Label1.Caption := ListBox1.Items[ListBox1.ItemIndex]; 

{ Atribui ao componente Label1 na propriedade Name da propriedade Font o nome da fonte selecionada
para que o componente Label para utilizar a mesma fonte }
Label1.Font.Name := ListBox1.Items[ListBox1.ItemIndex]; 

end; 

// Evento OnClick do componente Button. 

procedure TForm1.Button1Click(Sender: TObject);
begin
{Carrega as fontes instaladas no Windows para o componente ListBox}
ListBox1.Items := Screen.Fonts;
end;


ShowMessage com quebra de linhas

procedure TForm1.Button1Click(Sender: TObject);
var
MSG : String;
begin
MSG := 'Mensagem da Primeira Linha'+#13+'Mensagem da Segunda Linha'+#13+'Mensagem da Terceira Linha';
ShowMessage(MSG);
end;
ATENÇÃO. A quebra foi possível através do codigo #13.


Como retornar informações do ambiente DOS

No exemplo abaixo deve ser incluído no form um componente Button, um componente StringGrid e um componente ListBox. 

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; 

var
Form1: TForm1; 

implementation 

{$R *.DFM} 

// Evento OnClick do componente Button
procedure TForm1.Button1Click(Sender: TObject); 

var
Env : PChar;
i : Integer;
S : String;
PosEq : Integer;
begin
Env := GetEnvironmentStrings;
With ListBox1,StringGrid1 do begin
While Env^ <> #0 do begin
Items.Add(StrPas(Env));
Inc(Env,StrLen(Env)+1);
end;
RowCount := Items.Count;
for i := 0 to Pred(Items.Count) do begin
PosEq := Pos('=',Items[i]);
Cells[0,i] := Copy(Items[i],1,PosEq-1);
Cells[1,i] :=
Copy(Items[i],PosEq+1,Length(Items[i]));
end;
end; 

end;


Como colocar um componente ComboBox em um componente StringGrid

Inclua no seu Form um componente ComboBox e um componente StringGrid. 

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox1Exit(Sender: TObject);
procedure StringGrid1SelectCell
(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
{ Ajusta a altura do ComboBox com a altura da linha do StringGrid}
StringGrid1.DefaultRowHeight := ComboBox1.Height;
{Esconde o ComboBox}
ComboBox1.Visible := False;
end;
// Evento OnChange do componente ComboBox
procedure TForm1.ComboBox1Change
(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row]
:= ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
// Evento OnExit do componente ComboBox
procedure TForm1.ComboBox1Exit
(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row]
:= ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
// Evento OnSelectCell do componente StringGrid
procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
var
R: TRect;
begin
if ((Col = 3) AND
(Row <> 0)) then begin
R := StringGrid1.CellRect(Col, Row);
R.Left := R.Left + StringGrid1.Left;
R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;
R.Bottom := R.Bottom + StringGrid1.Top;
ComboBox1.Left := R.Left + 1;
ComboBox1.Top := R.Top + 1;
ComboBox1.Width := (R.Right + 1) - R.Left;
ComboBox1.Height := (R.Bottom + 1) - R.Top;
ComboBox1.Visible := True;
ComboBox1.SetFocus;
end;
CanSelect := True; 

end;


Retornar a coluna ativa do DBGrid

unit Unit1;
interface 

use
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
Db, DBTables, Grids, DBGrids;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure DBGrid1ColEnter(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM} 

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
Caption := DBGrid1.SelectedField.FieldName;
end;


Contador de página para um relatório desenvolvido no QuickReport 2.0

var
Form1: TForm1;
i : integer;
implementation
{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject);
begin
i := 0 ;
QuickRep1.Prepare;
QrLabel2.Caption := IntToStr(i);
QuickRep1.Preview;
end; 

procedure TForm1.QuickRep1StartPage(Sender: TQuickRep);
begin
i := i + 1;
Form2.Label1.caption := IntToStr(i);
end;


Alterar a data e hora do sistema

procedure TForm1.Button1Click(Sender: TObject);
begin
SetNewTime(1998,2,10,18,07);
end; 

function SetNewTime(Ano, Mes, Dia, hour, minutes: word): Boolean; 

var
st:TSYSTEMTIME;
begin
GetLocalTime(st);
st.wYear := Ano;
st.wMonth := Mes;
st.wDay := Dia;
st.wHour := hour;
st.wMinute := minutes;
if not SetLocalTime(st) then
Result := False
else
Result := True;
end;


Incluir o evento onClick no DBgrid

unit Unit1; 

interface 

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, DB, DBTables; 

type
thack = class(tcontrol);
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject);
begin
THack(dbgrid1).controlstyle := THack(dbgrid1).controlstyle + [csClickEvents];
THack(dbgrid1).OnClick := Form1.OnClick;
end; 

procedure TForm1.FormClick(Sender: TObject);
begin
ShowMessage('Teste');
application.processmessages;
end; 

end.


Colocar uma imagem direto para um campo da tabela

procedure TForm1.Button1Click(Sender: TObject);
var
BMP: TBitMap;
begin
BMP := TBitMap.Create;
if OpenPictureDialog1.Execute then
begin
if Table1.State in [dsInsert, dsEdit] then
begin
BMP.LoadFromFile(OpenPictureDialog1.FileName);
Table1Graphic.Assign( BMP );
end;
end
end; 


Como rodar aplicativos Windows 

como: Calculadora, Bloco de Notas, Write, Word 97, Excel 97, PaintBrush, etc com o Delphi?

Você poderá executar a ShellExecute da API do Windows. Se quiser um meio mais fácil, pega essa procedure.

Procedure ExecuteProgram(Nome,Parametros:String);
Var Comando : Array[0..1024] of Char;
Parms : Array[0..1024] of Char;
Begin
StrPCopy(Comando,Nome);
StrPCopy(Parms,Parametros);
ShellExecute(0,nil,Comando,Parms,nil,sw_showmaximized);
End;

Para usá-la, coloque no evento onclick a chamada ao programa que deseja executar, tipo:

ExecuteProgram('WINWORD.EXE,'');
ou
ExecuteProgram('C:\MSOFFICE\EXCEL\EXCEL.EXE',
'CONTAS.XLS');


Criar um nova tabela a partir de uma estrutura de outra tabela

O exemplo abaixo mostra como você pode a partir de uma tabela que já está sendo utilizada pelo seu sistema, criar uma nova tabela com a mesma estrutura já vazia.
implementation
uses DB,DBTables;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
TabOrigem, TabDestino: TTable;
begin
TabOrigem := TTable.create(self);
with TabOrigem do
begin
DatabaseName := 'ViewFarma';
TableName := 'Bairros.db';
open;
end;
TabDestino := TTable.create(self);
with TabDestino do
begin
DatabaseName := 'ViewFarma';
TableName := 'Bairros2.db';
FieldDefs.Assign(TabOrigem.FieldDefs);
IndexDefs.Assign(TabOrigem.IndexDefs);
CreateTable;
end;
TabOrigem.close;
end;


DBGrid - Verifica os registros selecionados

O exemplo abaixo mostra como você pode verificar quais os registros que estão selecionados no componente DBGrid. Para selecionar vários registros você deve primeiro alterar a sub-propriedade dgMultiSelect que faz parte da propriedade Options para True. 
var
Form1: TForm1;
implementation
{$R *.DFM}
// Evento OnClick do componente BitBtn
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Table1.First;
While not Table1.Eof do
begin
if DBGrid1.SelectedRows.IndexOf(Table1.BookMark) >= 0 then
ShowMessage('Registro selecionado');
Table1.Next;
end;
end;