Olá pessoal, tudo bom? No artigo de hoje iremos aprender diversas dicas na linguagem Delphi. Muitas delas são muito simples mas que muita gente não conhece e que vai ajudar bastante os desenvolvedores.
Colocando bitmaps num ComboBox
Ajuste a propriedade Style do ComboBox para csOwnerDrawVariable.
var
Form1: TForm1;
Bmp1, Bmp2, Bmp3: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\chip16.bmp');
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\zoom.bmp');
Bmp1:=TBitmap.Create;
Bmp.Loadfromfile('c:\disk.bmp');
ComboBox1.Items.AddObject('Chip',Bmp1);
ComboBox1.Items.AddObject('Zoom',Bmp2);
ComboBox1.Items.AddObject('Disk',Bmp3);
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOWnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect); Bitmap:= TBitmap(ComboBox1.Items.Objects[index]);
if Bitmap nil then begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
Offset: Bitmap.width + 8;
end;
TextOut(Rect.Left + Offset, Rect.Top, ComboBox1.Items[index]);
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
Height:=20;
end;
Colocar os bitmaps na DLL
Por vezes, quando iniciamos um projeto, temos uma preocupação: fazer uma aplicação pequena em delphi. 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 mouse 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 projeto. Guarde o projeto da dll no mesmo diretó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
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;Exemplos de como extrair os bitmaps da DLL
Colocar uma ProgressBar numa StatusBar
Coloque uma StatusBar no form e adicione dois painéis a ela (propriedade Panels). Ajuste as propriedades do primeiro painel comoStyle = psOwnerDraw e Width = 150. Coloque uma ProgressBar no form e mude sua propriedade Visible para false. No evento OnDrawPanel da StatusBar digite o código abaixo:
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
{ Se for o primeiro painel... }
if Panel.Index = 0 then begin
{ Ajusta a tamanho da ProgressBar de acordo com
o tamanho do painel }
ProgressBar1.Width := Rect.Right - Rect.Left +1;
ProgressBar1.Height := Rect.Bottom - Rect.Top +1;
{ Pinta a ProgressBar no DC (device-context) da StatusBar }
ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);
end;
end;
- ColoqueumButtonnoform
- DigitenoeventoOnClickdoButtonocódigoabaixo:
procedure TForm1.Button1Click(Sender: TObject); var I: integer; begin for I := ProgressBar1.Min to ProgressBar1.Max do begin { Atualiza a posição da ProgressBar } ProgressBar1.Position := I; { Repinta a StatusBar para forçar a atualização visual } StatusBar1.Repaint; { Aguarda 50 milisegundos } Sleep(50); end; { Aguarde 500 milisegundos } Sleep(500); { Reseta (zera) a ProgressBar } ProgressBar1.Position := ProgressBar1.Min; { Repinta a StatusBar para forçar a atualização visual } StatusBar1.Repaint; end; - Execute e clique no botão para ver o resultado.
Como converter decimal para romanos
function DecToRoman( Decimal: LongInt ): String;
{Converte um numero decimal em algarismos romanos}
const
Romans: Array[1..13] of String = ( 'I', 'IV', 'V', 'IX', 'X',
'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' );
Arabics: Array[1..13] of Integer =( 1, 4, 5, 9, 10, 40, 50, 90,
100, 400, 500, 900, 1000);
var
i: Integer;
scratch: String;
begin
scratch := '';
for i := 13 downto 1 do
while ( Decimal >= Arabics[i] ) do
begin
Decimal := Decimal - Arabics[i];
scratch := scratch + Romans[i];
end;
Result := scratch;
end;
Ativar a proteção de tela do Windows
{ Ativa a proteção de tela do Windows, se estiver configurada. }
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);Inclua na seção uses: Windows
Adicionar o evento OnClick do DBGrid
Problema: meu programa precisa processar algo quando o usuário clicar no DBGrid em um determinado form. O problema é que o DBGrid não possui o evento OnClick. É possível adicionar este evento no DBGrid? Solução: é possível sim. Afinal é muito simples. Siga os passos abaixo para resolver seu problema:
Monte seu form normalmente, colocando o DBGrid e demais componentes. Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
Pronto. Execute e teste.
Observações: O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.
Alterar as cores do título de um DBGrid em tempo execução
Procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
I : integer;
begin
for i:=0 to DBGrid1.Columns.count-1 do begin
DBGrid1.Columns[i].Title.Color := clBtnFace;
DBGrid1.Columns[i].Title.Font.Color := clBlack;
DBGrid1.Columns[i].Title.Font.Style := [];
end;
Column.Title.color := ClYellow;
Column.Title.Font.Style := [ fsBold, fsItalic];
Column.Title.Font.Color := clRed;
end;
Alterar o papel de parede (1)
program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath : String; bTile :
boolean );
var
reg : TRegIniFile;
begin
// Mudando o Registro HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',sWallpaperBMPPath );
if( bTile )then begin
WriteString( '', 'TileWallpaper', '1' );
end else begin
WriteString( '', 'TileWallpaper', '0' );
end;
end;
reg.Free;
// Mostrar que o parametro do sistema foi alterado
SystemParametersInfo( SPI_SETDESKWALLPAPER,0, Nil,
SPIF_SENDWININICHANGE );
end;
begin
SetWallpaper( 'c:\winnt\winnt.bmp', False );
end.
Alterar papel de parede (2)
procedure ChangeWallpaper(bitmap: string);
var
pBitmap : pchar;
begin
bitmap:=bitmap+#0; {bitmap contém um arquivo *.bmp}
pBitmap:=@bitmap[1];
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pBitmap,
SPIF_UPDATEINIFILE);
end;
Mudar o papel de parede (3)
Para testar o exemplo abaixo inclua no seu form um componente Button e no evento OnClick o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,
PChar('C:\windows\Arenito.bmp'),SPIF_SENDWININICHANGE);
end;
Alterar o ícone do botão iniciar do Windows
var
Form1: TForm1;
Iniciar : hWnd;
OldBitmap : THandle;
NewImage : TPicture;Variáveis globais do form
procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage:=TPicture.create;
NewImage.LoadFromFile('C:\Delphi3\Images\DEFAULT\OutOpen.BMP');
Iniciar :=
FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'Button',nil);
OldBitmap:=SendMessage(Iniciar,BM_SetImage,0,NewImage.Bitmap.Hand
le);
end;No Oncreate do Form
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(Iniciar,BM_SetImage,0,OldBitmap);
NewImage.Free;
end;No OnDestroy
Desabilitar o botão fechar o form
procedure TForm1.Button1Click(Sender: TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMENU;
begin
hwndHandle := FindWindow(nil, 'Sem título - Bloco de Notas');
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;
Desabilitar Teclas Ctrl+Alt+Del
Ai vai um código que peguei no site da Borland que trava as teclas Ctrl+Alt+Del, Alt+Tab e Ctrl+Esc.
var
OldValue : LongBool;
begin
{liga a trava}
SystemParametersInfo(97, Word(True), @OldValue, 0);
{desliga a trava}
SystemParametersInfo(97, Word(False), @OldValue, 0);
end;
Descobrindo se há impressora instalada
try
// Set printer so, for get information
JustTest := Printer.Orientation;
IsPrinterSetup := true;
except
on EPrinter do IsPrinterSetup := false;
end;
if not IsPrinterSetup then
begin
SayAboutIt;
ExitProgram;
End;
Desabilita o botão Fechar do Formulário
procedure TForm1.FormCreate(Sender: TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMenu;
begin
hwndHandle := Self.Handle;
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;
Mudar a cor da linha de um DBGrid
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; .....);
begin
if odd(field.DataSet.RecNo) then
DBGrid1.Canvas.Font.Color := clBlue
else DBGrid1.Canvas.Font.Color := clWhite;
DBGrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, state);
end;
Inicializar vários EDITs em um formulário
procedure TForm1.Button1Click(Sender: TObject);
var contador : integer;
begin
for contador := 0 to (Form1.ControlCount - 1) do
if Form1.Controls[contador].ClassName = 'TEdit' then
(Form1.Controls[contador] as TEdit).Text := '';
end;
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;
Function NextMonth(Date: TDateTime): TDateTime;
var
Year, Month, Day: word;
Begin
DecodeDate (Date, Year, Month, Day);
if MonthOf(Date)=12 then
Begin
Inc(Year);
Month := 1;
End
else
Inc(Month);
NextMonth := EncodeDate (Year, Month, Day);
End;
Obtendo data do primeiro dia útil do mês
Function FirstDayOfMonth (Data : TDateTime; lSabDom : Boolean) : TDateTime;
var
Ano, Mes, Dia : word;
DiaDaSemana : Integer;
begin
DecodeDate (Data, Ano, Mes, Dia);
Dia := 1;
if lSabDom Then begin
DiaDaSemana := DayOfWeek (Data);
if DiaDaSemana = 1 Then
Dia := 2
else
if DiaDaSemana = 7 Then
Dia := 3;
end;
FirstDayOfMonth := EncodeDate (Ano, Mes, Dia);
end;
Obtendo o extenso de uma data informada
Function DataExtenso (dData : TDateTime) : string;
var
Ano, Mes, Dia : word;
begin
DecodeDate(dData, Ano, Mes, Dia);
DataExtenso := StrZero(Dia,2,0) + ' de ' + MesExtenso(Mes) + ' de ' + IntToStr(Ano);
end;
Function MesExtenso (xMes : Variant) : string;
Var
Dia, Mes, Ano : Word;
begin
Mes := 0;
Case VarType (xMes) of
VarDate : DecodeDate (xMes, Ano, Mes, Dia);
VarString :
Try
Mes := StrToInt (xMes);
Except
End;
else
Try
Mes := Round (xMes);
Except
End;
end;
case Mes of
1: Result := 'Janeiro';
2: Result := 'Fevereiro';
3: Result := 'Março';
4: Result := 'Abril';
5: Result := 'Maio';
6: Result := 'Junho';
7: Result := 'Julho';
8: Result := 'Agosto';
9: Result := 'Setembro';
10: Result := 'Outubro';
11: Result := 'Novembro';
12: Result := 'Dezembro';
else
Result := '';
end;
end;
Exemplo de uso: Label1.caption:=DataExtenso(now);
Por hoje é só, espero que tenham gostado e até o próximo artigo.
