Formatar disquete.
{implementation section}
....
const SHFMT_ID_DEFAULT = $FFFF;
// Formating options
SHFMT_OPT_QUICKFORMAT = $0000;
SHFMT_OPT_FULL = $0001;
SHFMT_OPT_SYSONLY = $0002;
// Error codes
SHFMT_ERROR = $FFFFFFFF;
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;
function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'
procedure TForm1.btnFormatDiskClick(Sender: TObject);
var
retCode: LongInt;
begin
retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
if retCode < 0 then ShowMessage('Could not format drive');
end;
Como detectar as teclas de "seta".
Use os eventos KeyDown ou KeyUp e teste se Key = VK_LEFT ou VK_RIGHT, etc.
Caps Lock e Num Lock
procedure TMyForm.Button1Click(Sender: TObject);
Var KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1
else KeyState[VK_NUMLOCK] := 0;
SetKeyboardState(KeyState);
End;
Para a tecla Caps Lock basta trocar VK_NUMLOCK por VK_CAPITAL.
BDE em 1 disqiete
Depois que apanhei bastente do BDE, recorri a lista e ninguem consegui
me ajudar ... consegui resolver o problema. E como acredito que outras
pessoas tenham o mesmo problema, resolvi colocar essa dica na lista.
Por favor, se alguem tiver algo a acresentar ou mesmo corrigir,
sinta-se a vontade para compartilhar conosco.
Arquivos Exenciais para o BDE:
EUROPE.BLL
USA.BLL
IDR20009.DLL
IDAPI32.DLL
BLW32.DLL
IDAPI32.CFG <--- esse arquivo pode ter qualquer outro nome, desde que
seja configurado no registro.
Drivers de Banco de Dados:
IDPDX32.DLL <--- Driver Paradox
IDASCI32.DLL <--- Driver ASCII
IDDBAS32.DLL <--- Driver DBase
IDODBC32.DLL <--- Driver ODBC
O BDE precisa de pelo menos um Driver de Banco de Dados para funcionar.
Esses acima sao apenas alguns, existem varios outros.
O BDE 4.51 + Driver Paradox compactados com o Algoritimo ZIP, ocuparam
aproximadamente 650 Kb.
Entradas no Registro do Win95:
HKEY_LOCAL_MACHINE
SOFTWARE\Borland\Database Engine
DLLPATH -> localizacao do BDE (Unidade+Caminho Completo)
CONFIGFILE01 -> localizacao do arquivo de configuracao (Unidade+Caminho
Completo+Nome do Arquivo)
SOFTWARE\Borland\BLW32
BLAPIPATH -> localizacao do BDE (Unidade+Caminho Completo)
LOCALE_LIB1 -> localizacao do arquivo USA.BLL (Unidade+Caminho
Completo+USA.BLL)
LOCALE_LIB2 -> localizacao do arquivo EUROPE.BLL (Unidade+Caminho
Completo+EUROPE.BLL)
Segue um pequeno exemplo de como registrar o BDE no Registro do Win95:
begin
Registry.RootKey := HKEY_LOCAL_MACHINE;
Registry.CreateKey('SOFTWARE\Borland\Database Engine');
Registry.OpenKey('SOFTWARE\Borland\Database Engine', False);
Registry.WriteString('DLLPATH', 'C:\ARQUIVOS DE PROGRAMAS\BDE\');
Registry.WriteString('CONFIGFILE1', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\IDAPI32.CFG');
Registry.OpenKey('\', False);
Registry.CreateKey('SOFTWARE\Borland\BLW32');
Registry.OpenKey('SOFTWARE\Borland\BLW32', False);
Registry.WriteString('BLAPIPATH', 'C:\ARQUIVOS DE PROGRAMAS\BDE\');
Registry.WriteString('LOCALE_LIB1', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\USA.BLL');
Registry.WriteString('LOCALE_LIB2', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\EUROPE.BLL');
end;
Para compilar esse codigo, sera necessario declarar a Unit Registry.
Como eu disse, esse e um exemplo bem simples. Ele nem mesmo verifica se
o BDE ja esta registrado ou não.
Para criar o Alias atravez do seu instalador, voce pode usar a funcao
da api do BDE chamada DbiAddAlias.
Cor de fundo do hint
Veja as propriedades dp TApplication...
Application.HintColor := clAqua;
Application.HintPause := ...
Application.HintShortPause := ...
Margem para RichText
Se for um richedit e margens laterais(direita e esquerda) tenta
RichEdit1.Paragraph.FirstIndent -> Paragrafo
RichEdit1.Paragraph.LeftIndent -> margem esquerda
RichEdit1.Paragraph.RightIndent -> margem direita
Mudar de cor a linha do dbGrid
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if Table1.FieldByName('Pagou').Value = True then
DBGrid1.Canvas.Brush.Color := clGreen
else
DBGrid1.Canvas.Brush.Color := clRed;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.DefaultDrawDataCell(Rect,Field,State);
end;
Verificando atributo do arquivo
Crie uma var do tipo word, por ex., Attributes. Depois, atribua a esta var o
valor retornado por FileGetAttr. Ex.:
var
Attributes: Word;
begin
Attributes := FileGetAttr( 'nomedoarquivo' );
// Supondo 4 CheckBoxe's, 1 para cada atributo, Ok?
CheckBox1.Checked := (Attributes and faReadOnly) = faReadOnly;
CheckBox2.Checked := (Attributes and faArchive) = faArchive;
CheckBox3.Checked := (Attributes and faSysFile) = faSysFile;
CheckBox4.Checked := (Attributes and faHidden) = faHidden;
end;
Para compactar (remover fisicamente todos registros apagados) de uma tabela Paradox deve-se utilizar o seguinte código:
procedure ParadoxPack(Table : TTable);
var
TBDesc : CRTblDesc;
hDb: hDbiDb;
TablePath: array[0..dbiMaxPathLen] of char;
begin
FillChar(TBDesc,Sizeof(TBDesc),0);
with TBDesc do begin
StrPCopy(szTblName,Table.TableName);
StrPCopy(szTblType,szParadox);
bPack := True;
end;
hDb := nil;
Check(DbiGetDirectory(Table.DBHandle, True, TablePath));
Table.Close;
Check(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite,
dbiOpenExcl,nil,0, nil, nil, hDb));
Check(DbiSetDirectory(hDb, TablePath));
Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False));
Table.Open;
end;
unit Ext;
interface
function extenso (valor: real): string;
implementation
uses
SysUtils, Dialogs;
function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco',
'Seis', 'Sete', 'Oito', 'Nove');
Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze',
'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta',
'Cinquenta', 'Sessenta', 'Setenta',
'Oitenta', 'Noventa');
Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos',
'Quatrocentos', 'Quinhentos', 'Seiscentos',
'Setecentos', 'Oitocentos', 'Novecentos');
function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
if Expressao
then Result:=CasoVerdadeiro
else Result:=CasoFalso;
end;
function MiniExtenso (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:='';
Dezena:='';
Centena:='';
if (trio[2]='1') and (trio[3]<>'0') then
begin
Unidade:=Dez[strtoint(trio[3])];
Dezena:='';
end
else
begin
if trio[2]<>'0' then Dezena:=Dezenas[strtoint(trio[2])];
if trio[3]<>'0' then Unidade:=Unidades[strtoint(trio[3])];
end;
if (trio[1]='1') and (Unidade='') and (Dezena='')
then Centena:='cem'
else
if trio[1]<>'0'
then Centena:=Centenas[strtoint(trio[1])]
else Centena:='';
Result:= Centena + ifs((Centena<>'') and ((Dezena<>'') or (Unidade<>'')), ' e ', '')
+ Dezena + ifs((Dezena<>'') and (Unidade<>''),' e ', '') + Unidade;
end;
begin
if (valor>999999.99) or (valor<0) then
begin
msg:='O valor está fora do intervalo permitido.';
msg:=msg+'O número deve ser maior ou igual a zero e menor que 999.999,99.';
msg:=msg+' Se não for corrigido o número não será escrito por extenso.';
showmessage(msg);
Result:='';
exit;
end;
if valor=0 then
begin
Result:='';
Exit;
end;
Texto:=formatfloat('000000.00',valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso('0'+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>'' then
if copy(texto,4,3)='000' then
Result:=Result+' Mil Reais'
else
Result:=Result+' Mil, ';
if (((copy(texto,4,2)='00') and (Milhar<>'')
and (copy(texto,6,1)<>'0')) or (centavos=''))
and (Centena<>'') then Result:=Result+' e ';
if (Milhar+Centena <>'') then Result:=Result+Centena;
if (Milhar='') and (copy(texto,4,3)='001') then
Result:=Result+' Real'
else
if (copy(texto,4,3)<>'000') then Result:=Result+' Reais';
if Centavos='' then
begin
Result:=Result+'.';
Exit;
end
else
begin
if Milhar+Centena='' then
Result:=Centavos
else
Result:=Result+', e '+Centavos;
if (copy(texto,8,2)='01') and (Centavos<>'') then
Result:=Result+' Centavo.'
else
Result:=Result+' Centavos.';
end;
end;
end.
Form não seja redimensionado
Inclua o código abaixo em um Form.
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
message WM_INITMENUPOPUP;
procedure WMNCHitTest(var Msg: TWMNCHitTest);
message WM_NCHitTest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
with Msg.MinMaxInfo^ do
begin
ptMinTrackSize.x:= form1.width;
ptMaxTrackSize.x:= form1.width;
ptMinTrackSize.y:= form1.height;
ptMaxTrackSize.y:= form1.height;
end;
end;
procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
inherited;
if Msg.SystemMenu then
EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED)
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,HTBOTTOMLEFT, HTTOP,
HTTOPRIGHT, HTTOPLEFT] then
Result:= HTNOWHERE
end;
Mover um componente em Run-time
No exemplo abaixo deve ser incluído um componente Button. Para testar este exemplo mantenha a tecla CTRL pressionada clique com o mouse no componente Button. Feito isto, basta arrastar o componente Button para qualquer lado.
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Evento OnMouseDown do Form
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end;
// Evento OnMouseMove do Form
procedure TForm1.Button1MouseMove(Sender:
TObject; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
Button1.Left:= Button1.Left-(MouseDownSpot.x-x);
Button1.Top:= Button1.Top - (MouseDownSpot.-y);
end;
end;
// Evento OnMouseUp do Form
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x -x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
Verificar se a tecla TAB foi pressionada
Para testar o exemplo abaixo inclua alguns componentes Edit em seu form.
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure ProcessaMsg(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ProcessaMsg(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = WM_KEYDOWN then
begin
if Msg.wParam = VK_TAB then
Caption := 'Tecla Tab';
end;
end;
// Evento OnCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := ProcessaMsg;
end;
Executar um AVI no Form
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with MediaPlayer1 do
begin
FileName := 'c:\windows\help\scroll.avi';
Open;
Display := Form2;
Form2.Show;
Play;
end;
end;
Colocar zeros a esquerda de um valor digitado no componente Edit
procedure TForm1.Edit1Exit(Sender: TObject);
begin
Edit1.Text := FormatFloat('000000',StrToFloat(Edit1.Text));
end;