Como executar um avi no form

Crie dois formulários e adicione o componente TmediaPlayer no seu form, depois coloque um botão e adicione o código abaixo no evento onclick do mesmo.

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

with MediaPlayer1 do

begin

   // coloque o path de um avi

   FileName := ' C:\Arquivos de programas\Borland\Delphi6\Demos\CoolStuf\speedis.avi';

   Open;

   Display := Form2;

   Form2.Show;

   Play;

end;

end;

Número de cores aceitas pelo monitor

O código abaixo apresenta a implementação de uma função que retorna o número de cores suportadas pelo monitor.

Esta função baseia-se na utilização de uma API do Windows, chamada GETDC.:

Function QtdeCores : integer;var h : HDC;

begin

Result := 0; try h := GetDC( 0 );

Result :=1 shl ( GetDeviceCaps( h, PLANES ) * GetDeviceCaps( h, BITSPIXEL ));

finally

ReleaseDC( 0, h );

end;

end;

Para executar esta função coloque um objeto edit e um objeto button, no evento onclick do botão insira o seguinte código:

edit1.text:= inttostr(Qtdecores);

Ao clicar no botão o objeto edit recebe a quantidade de cores que o monitor está suportando.

Como mudar a resolução do vídeo via programação

1º Coloque um listbox no form

Modifique o OnCreate do form assim:

 

procedure TForm1.FormCreate(Sender: TObject);

var

  i : Integer;

  DevMode : TDevMode;

begin

  i := 0;

  while EnumDisplaySettings(nil,i,Devmode) do begin

  with Devmode do

  ListBox1.Items.Add(Format('%dx%d %d Colors',

  [dmPelsWidth,dmPelsHeight, 1 shl dmBitsperPel]));

  Inc(i);

  end;

end;

- Coloque um botão no form

- Altere o evento OnClick do botão conforme abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

var

  DevMode : TDevMode;

begin

  EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);

  ChangeDisplaySettings(DevMode,0);

end;

Bloquear Mouse e Teclado

Para testar essa dica coloque um Timer sete o interval para 5000 e um Botão e coloque o código abaixo!

O código travará o mouse e teclado por 5 segundos!

Use com cuidado e responsabilidade... Não me venha travar o mouse sem programar uma ação para destravá-lo!

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

  Button1: TButton;

  Timer1: TTimer;

  procedure Button1Click(Sender: TObject);

  procedure Timer1Timer(Sender: TObject);

private

  { Private declarations }

public

  { Public declarations }

end;

procedure BlockInput(ABlockInput : boolean); stdcall; external 'USER32.DLL';

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

BlockInput(True);

Timer1.Enabled:=True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

BlockInput(false);

Timer1.Enabled:=false;

end;

end.

Sugestão para tratamento de erros no Delphi / Cliente-Servidor

Todas as vezes que são abertas as tabelas é colocado o comando StartTransaction antes da abertura das mesmas.

Quando acontece algum erro na abertura das tabelas, o Delphi dispara uma mensagem de erro. Este erro pode ter sido provocado por diversos motivos mas é certo que o erro foi de alteração de uma ou mais tabelas no Banco de Dados. é aconselhável que se coloque uma rotina de tratamento de erro listada abaixo: 

- Onde estão as tabelas, coloque as suas tabelas que serão abertas; 

- Onde será mostrada a mensagem coloque uma mensagem qualquer avisando sobre o erro 

try

   if F_Menu.DBSistema.IsSQLBased then 

      F_Menu.DBSistema.StartTransaction;

   Tabela1.Open;

   Tabela2.Open;

   Tabela3.Open;

   Tabela4.Open;

except

   on EDatabaseError do

     if MessageDlg(, mtError, [mbOK], 0) <> mrOK Then

       raise;

     end;

ShowModal;  

Sugestão  Delphi / Oracle  

      Criar uma função que irá verificar qual o código de erro enviado pela exceção e então emitir uma mensagem em português. Abaixo está uma idéia desta rotina que será inserida no formulário principal da sua aplicação.  

procedure TF_Menu.ErrorMsg(Sender : TObject; E: exception);

begin

if e is EDBengineError then

      TrataErro(E as edbEngineError)

else

    application.showException(E);

end;  

procedure TF_Menu.TrataErro(E: eDBEngineError);

var

nSQLError   : integer;

cSQLMessage : string;

cTable      : string;

x           : integer;

begin

    nSQLError := 0;

    cSQLMessage := '';

    for x:=0 to e.ErrorCount -1 do

       if e.errors[x].NativeError <> 0 then

       begin

          nSQLError   := e.errors[x].NativeError;

          cSQLMessage := e.errors[x].message;

       end;

       if nSQLError <> 0 then

       begin

          cTable := '';

          x      := pos('table"',cSQLMessage);

          if x > 0 then

          begin

             cTable := copy(cSQLMessage,x+7,20);

             x      := pos('"',cTable);

             if x > 0 then cTable := copy(cTable,1,x-1);

          end;

       case nSQLError of

               1  : showmessage('Este registro já está cadastrado.');

          2292 : showmessage('Este resgistro não pode ser excluído porque'+#10+

                     'existem outros que dependem dele e que não foram excluídos');

        12203 : showmessage('Base de Dados está fora do ar. Favor entrar'+#10+

                     'em contato com o responsável pela rede na '+#10+

                     'localidade selecionada ou tente mais tarde.');

       else

          showmessage(IntToStr(nSQLError)+' '+cSQLMessage);

       end;

    end

else

    showmessage('Algo errado aconteceu!');

end;

 

procedure TF_Menu.FormCreate(Sender: TObject);

begin

  Application.OnException := ErrorMsg;

end;

Tradução de Mensagens Delphi

Depois de algum tempo pesquisando uma forma de fazer aparecer as mensagens em português, consegui uma solução muito fácil de implementar no ambiente de programação do Delphi 3.
 
CHEGA DE YES/NO !!!
 
messagedlg('Confirma ? mtConfirmation, [mbYes, mbNo], 0);
 
Aí vai:
 
1 - No diretório DELPHI3\LIB, copie o arquivo consts.dcu para consts.old;
2 - Inicie o Delphi e crie um nova Unit;
3 - Insira nesta, o arquivo consts.int do diretório DELPHI3\DOC E faça as devidas alterações nas mensagens que desejares alterar e nas partes duplicadas da Unit como "implement" e etc, também deixe o
cabeçalho como Unit Consts.
4 - Salve esta nova Unit no diretório DELPHI\LIB e pronto todas as mensagens alteradas por você estarão aplicadas nos seus próximos programas sem uma linha de programa e da forma que você quiser.

Linkar um OBJ ao executável

Primeiro você deve "linkar" o OBJ ao seu executável.  No Delphi , isto é feito com a diretriz de compilação $L.  Fica, na sua unit principal, assim:

{$L MyOBject.OBJ}  

Incluindo as chaves.

Logo depois, você deve declarar a função contida em MyObject.OBJ da forma usual.  Você precisara conhecer os parâmetros usados pela mesma, bem como o tipo e a ordem em que sao passados.   Voce deve incluir tambem a diretriz PASCAL ou CDECL.  Sugiro tentar primeiro com PASCAL.  Ficaria assim (na

secao implementation:

function (Parametro1 : TipoDoParametro1, Parametro2 : TipoDoParametro2):

TipoDoRetorno; pascal;

se nao der certo, tente:

function (Parametro1 : TipoDoParametro1, Parametro2 : TipoDoParametro2):

TipoDoRetorno; cdecl;

caso nao seja uma funcao e sim uma procedure, tente

procedure (Parametro1 : TipoDoParametro1, Parametro2 : TipoDoParametro2);

pascal;

ou

procedure (Parametro1 : TipoDoParametro1, Parametro2 : TipoDoParametro2);

cdecl;

Se voce nao sabe quais os parametros usados pela funcao/procedure, uma solucao seria linkar o seu OBJ num programa qualquer e disassembla-lo.  Ai pelo menos voce sabera a quantidade e o tipo de cada parametro. De qualquer forma, para saber para que serve cada um, tera que ser na tentativa e erro...a nao ser que voce tambem tenha paciencia para analisar o codigo disassemblado.

OBS:  Se o seu OBJ nao estiver num formato reconhecivel pelo LINK do Delphi (um formato similar ao COFF), voce pode tentar outros Linkers, e criar uma dll.  Existem varios linkers gratuitos, que reconhecem varios formatos (exemplos, sao lcclnk, djlnk, walk2lnk e o proprio linker da microsoft...tambem gratuito).

Traduzir captions e botões da MESSAGEDLG

Para traduzir algumas as mensagens do Delphi que aparecem nos botões e nas caixas de avisos da função MessageDlg, você necessita dos arquivos de recursos do Delphi (*.RC).

Possuo o Delphi 2 - Developers, que vem acompanhado de alguns destes arquivos de recursos.  No meu caso, eles estão gravados em C:\DELPHI2\SOURCE\VCL.

Os arquivos *.RC são arquivos "só texto", e contêm diversas mensagens utilizadas nos programas compilados no Delphi.  O exemplo que se segue realiza alterações nos arquivos CONSTS.RC e DBCONSTS.RC.  A alteração de outros arquivos "RC" pode ser feita de modo similar.   Para maiores detalhes, envie-me um e-mail (paulosd@dglnet.com.br), ou, melhor ainda, consulte o livro "Dominando o Delphi" (edição para o Delphi 1), de Marcos Cantù, ed. Makron Books.   O assunto "Usando recursos de tabelas de strings" está no capítulo 21, página 876.  Não sei se a edição para o Delphi 2 cobre este assunto.

a) Faça uma cópia dos arquivos CONSTS.RC e DBCONSTS.RC em um diretório seguro, para o caso de algo sair errado.

b) Pelo mesmo motivo, faça uma cópia dos arquivos CONSTS.RES e DBCONSTS.RES, que estão no diretório LIB do Delphi.   No meu caso, o diretório destes arquivos é C:\DELPHI2\LIB.

c) Use o Bloco de Notas para abrir e alterar os arquivos CONSTS.RC e DBCONSTS.RC. (O Edit também serviria;  entretanto, para acentuação correta no Windows, o Bloco de Notas é melhor).

Você só deve alterar as strings que estão entre aspas. Não altere o nome das constantes, que estão no início de cada linha.

Por exemplo, localize o seguinte bloco, em CONSTS.RC:

SCancelButton, "Cancel"

SYesButton, "&Yes"

SNoButton, "&No"

Altere para:

SCancelButton, "Cancelar"

SYesButton, "&Sim"

SNoButton, "&Não"

Não é necessário alterar todas as mensagens.  Se desejar, altere apenas aquelas que você utiliza em seus sistemas.  Lembre-se de salvar as alterações efetuadas.

d) Acione o prompt do DOS, e execute do seguinte modo o compilador de recursos do Delphi 2 (BRC32.EXE), que está no diretório BIN do Delphi (no meu caso, C:\DELPHI2\BIN):

C:\DELPHI2\BIN\BRC32 -R CONSTS.RC

C:\DELPHI2\BIN\BRC32 -R DBCONSTS.RC

(No Delphi 1, o compilador tem o seguinte nome:   BRC.EXE).

e) Os dois comandos anteriores irão gerar os arquivos CONSTS.RES e DBCONSTS.RES.  Copie os dois "*.RES" para o diretório LIB do DELPHI (no meu caso C:\DELPHI2\LIB)

f) Crie uma aplicação no Delphi que utilize a função MessageDlg, e botões "BitBtn".  Ao rodar o seu programa, as mensagens já devem aparecer traduzidas.

Desativando o menu de contexto padrão (em TCustomEdits)

Quando nós damos um click com o botão direito em um componente Edit (ou qualquer outro componente que permite editar como MaskEdit, Memo, DbEdit, etc.), por padrão o menu de contexto do sistema aparece com as opções para desfazer, copia, colar, etc.

Se por qualquer razão nós não queremos que este menu apareça, um modo é simplesmente pôr um Componente TPopupMenu no form e nomeia este na propriedade PopupMenu dos componentes que queremos que o menu de contexto não apareça.

Aqui está um procedimento que usa a RTI e desabilita o popup de todos os controles em um containe.

Uses TypInfo;

procedure DisablePopUp(AControl: TWinControl);

var

i : integer;

pm : TPopupMenu;

begin

pm := TPopupMenu.Create(AControl);

for i:=0 to AControl.ControlCount-1 do

if IsPublishedProp(

AControl.Controls[i],

'PopupMenu'

) then

SetObjectProp(

AControl.Controls[i],

'PopupMenu',

pm);

end;

Use assim:

DisablePopUp(Form1);

ou

DisablePopUp(Panel1);

Menus Popup No PageControl

Saiba como exibir menus popup quando o usuário clicar com o botão direito do mouse sobre as abas de um componente PageControl. Esta técnica, agrega uma funcionalidade a mais ao componente, permitindo que cada aba tenha o seu próprio menu.

Siga os passos abaixo para implementar o procedimento responsável pela exibição dos menus no PageControl:

1) Abra uma nova aplicação e insira os seguintes componentes: 1 PageControl (paleta Win32) e 2 PopupMenu (paleta Standard);

2)  Só para exemplificar, adicione duas páginas (abas) ao PageControl com os respectivos nomes "Clientes" e "Fornecedores". Ajuste os componentes de forma que fique com a aparência abaixo. Caso deseje, você pode incluir alguns componentes no interior de cada uma das abas. Isto só não foi feito aqui porque o objetivo desta dica é explorar outras características do PageControl:

3) Insira alguns itens de menu para cada componente PopupMenu, sendo que PopupMenu1 terá correspondência com a aba "Clientes" e PopupMenu2 com a aba "Fornecedores";

4) Adicione a unit CommCtrl na seção Uses da unidade e declare, na seção public, uma procedure com o nome de TabMenuPopup, da seguinte forma:

procedure TabMenuPopup(APageControl: TPageControl; X, Y: Integer);

5)  Implemente o código da procedure, desta maneira:

procedure TForm1.TabMenuPopup(APageControl: TPageControl; X, Y: Integer);

var

  hi: TTCHitTestInfo;

  TabIndex: Integer;

  p: TPoint;

begin

  hi.pt.x := X;

  hi.pt.y := Y;

  hi.flags := 0;

  TabIndex := APageControl.Perform(TCM_HITTEST, 0, longint(@hi));

  p.x := APageControl.Left + X;

  p.y := APageControl.Top + y;

  p := ClientToScreen(p);

  // Permite o uso de diferentes menus para cada aba do PageControl...

  case TabIndex of

     0: {Primeira aba...}

        PopupMenu1.Popup(P.x, P.Y);

     1: {Segunda aba...}

     PopupMenu2.Popup(P.x, P.Y);

  end;

end;

6) No evento OnMouseDown do PageControl, digite o seguinte:

procedure TForm1.PageControl1MouseDown(Sender: TObject;

        Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

   if Button = mbRight then

      begin

          TabMenuPopup(PageControl1, X, Y);

      end;

   end;

Sobre o Dblookupcombobox

O componente DBLookupComboBox é utilizado para selecionar registros de uma tabela e gravar em outra tabela.

As propriedades necessárias para a utilização são:

DataSource - Ligar a DataSource da Tabela ao qual vai receber o valor do registro selecionado;

DataField - Ligar o campo de ligação entre as duas tabelas, ao qual vai receber o valor do registro selecionado;

ListSource - Ligar a DataSource da Tabela ao qual vai Ter o registro selecionado;

ListField - Ligar o campo que será listado quando o usuário abrir a janela para seleção do registro;

KeyField - Ligar o campo de ligação entre as duas tabelas, ao qual terá o seu valor enviado para gravação.

O campo de ligação entre as duas tabelas pode ser um campo código, pois é este campo que manterá os valores iguais entre as duas tabelas.

Como mudar a cor de fundo em linhas diferentes de texto em um TListBox

Depois de inserir um TListBox em seu form, você deve muda a propriedade Style do TListBox para lbOwnerDrawFixed. Se você não muda a propriedade Style, o evento OnDrawItem nunca vai ser chamado. Inclua o seguinte código no Evento OnDrawItem de seu TListBox:

procedure TForm1.ListBox1DrawItem

(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

myColor: TColor;

myBrush: TBrush;

begin

myBrush := TBrush.Create;

with (Control as TListBox).Canvas do

begin

if not Odd(Index) then

myColor := clSilver

else

myColor := clYellow;

myBrush.Style := bsSolid;

myBrush.Color := myColor;

Windows.FillRect(handle, Rect, myBrush.Handle);

Brush.Style := bsClear;

TextOut(Rect.Left, Rect.Top,

(Control as TListBox).Items[Index]);

MyBrush.Free;

end;

end;

Corrigindo um pequeno bug em TLabel.AutoSize

Se você mudar de fontes pequenas para fontes grandes, os tamanhos de seus rótulos não serão mudados. AutoSize só funcionará quando você mudar o caption do rótulo ou quando você acessar a propriedade AutoSize.

O seguinte código pode ser executado no evento FormCreate para corrigir os tamanhos.

for I := 0 to ComponentCount -1 do

if Components[I] is TLabel then

With TLabel(Components[I]) do

if AutoSize = True then

begin

AutoSize := False;

AutoSize := True;

end;

Efeito HotTrack em componentes Label e CheckBox

Neste exemplo, vamos aprender como criar um efeito HotTrack para componentes TLabel e TCheckBox. Este efeito está presente em muitos componentes do Delphi, em um dos caso no componente TPageControl. Ele é responsável por colorir as "guias" do PageControl quando o mouse "pousa" sobre a TabSheet.

Você deve estar se perguntando:

- Não seria o caso de criarmos um evento onMouseMove e colorirmos o mesmo através deste evento?

A resposta é sim, mas teríamos que fazer isso para todos os componentes do Form. Então para simplificarmos, vamos usar um outro método, mais genérico.

Nós vamos enviar uma mensagem ao Form fazendo com que seja disparado uma procedure que contém o algoritimo que será usado para mudar a cor da fonte dos componentes; O algoritimo é a procedure a seguir:

procedure TForm1.ChangeColor(Sender : TObject; MSG : Integer);

begin

If Sender is TLabel Then begin

   If (Msg = CM_MOUSELEAVE) Then

     (Sender as TLabel).Font.Color:=clWindowText;

   If (Msg = CM_MOUSEENTER) Then

     (Sender as TLabel).Font.Color:=clBlue;

end;

If Sender is TCheckBox then begin

   If (Msg = CM_MOUSELEAVE) Then

     (Sender as TCheckBox).Font.Color:=clWindowText;

   If (Msg = CM_MOUSEENTER) Then

     (Sender as TCheckBox).Font.Color:=clBlue;

end;

end;

E para dispara-lo vamos usar a procedure:

procedure TForm1.WndProc(Var Msg : TMessage);

var I : Integer;

begin

For I := 0 to ComponentCount -1 do

   If MSG.LParam = Longint(Components[I]) Then ChangeColor(Components[i],Msg.Msg);

inherited WndProc(Msg);

end;

Que é herdada do próprio Delphi, veja "inherited WndProc(Msg);".

Para exemplificar:

1- Abra o Delphi e no form vazio que se abre coloque alguns CheckBoxes e Labels.

2- Declare as procedures como a seguir na área private do formulário.

...

private

{ Private declarations }

   procedure ChangeColor(Sender : TObject; MSG : Integer);

   procedure WndProc(Var Msg : TMessage);override;

public

{ Public declarations }

end;

...

3- Digite seus respectivos algoritimos:

procedure TForm1.ChangeColor(Sender : TObject; MSG : Integer);

begin

If Sender is TLabel Then begin

   If (Msg = CM_MOUSELEAVE) Then

     (Sender as TLabel).Font.Color:=clWindowText;

   If (Msg = CM_MOUSEENTER) Then

     (Sender as TLabel).Font.Color:=clBlue;

end;

If Sender is TCheckBox then begin

   If (Msg = CM_MOUSELEAVE) Then

     (Sender as TCheckBox).Font.Color:=clWindowText;

   If (Msg = CM_MOUSEENTER) Then

     (Sender as TCheckBox).Font.Color:=clBlue;

end;

end;

procedure TForm1.WndProc(Var Msg : TMessage);

var I : Integer;

begin

For I := 0 to ComponentCount -1 do

   If MSG.LParam = Longint(Components[I]) Then ChangeColor(Components[i],Msg.Msg);

inherited WndProc(Msg);

end;

Pronto, agora basta compilar e ver o resultado.

Note as verificações necessárias para mudar os labels e checkboxes, isso significa que podemos fazer para outros objetos no Delphi;

If Sender is TLabel Then begin

If Sender is TCheckBox then begin