Hay cientos de pequeñas cosas que tenemos que realizar en nuestros programas, aquí tenéis una pequeña colección de aquellas que he ido necesitando ... las he ido recopilando para lo que hagan falta:
Conocer el nombre de usuario del Login de Windows.
function GetLoginName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetUserName(buffer, size) then
Result := StrPas(buffer)
else
Result := StrPas('');
end;
Conocer el nombre de un ordenador en una Red Windows.
function GetComputerNetName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetComputerName(buffer, size) then
Result := StrPas(buffer)
else
Result := StrPas('');
end;
Determinar los directorios de Instalación, Sistema y Archivos de Programas de Windows.
uses SysUtils, Windows;
El directorio de instalación de Windows
function GetWindowsDir: TFileName;
var
WinDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, WinDir, GetWindowsDirectory(WinDir, MAX_PATH));
if Result = '' then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
El directorio de sistema de Windows
function GetSystemDir: TFileName;
var
SysDir: array [0..MAX_PATH-1] of char;
begin
SetString(Result, SysDir, GetSystemDirectory(SysDir, MAX_PATH));
if Result = '' then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
El directorio de los Archivos de Programa de Windows
function GetProgramFilesDir: TFileName;
begin
Result := GetRegistryData(HKEY_LOCAL_MACHINE, '\Software\Microsoft\Windows\CurrentVersion', 'ProgramFilesDir');
end;
Calcular la letra de un DNI (España)
function NIF(DNI: String): Char;
begin
Result := Copy('TRWAGMYFPDXBNJZSQVHLCKET',StrToInt(DNI) mod 23+1,1)[1];
end;
Calcular el dígito de control de un código EAN-13
function Calcula_digito_de_control_EAN13(CodS:string):integer;
var
i,r,rd: integer;
CodN: array[1..12] of integer;
b: boolean;
begin
// 1ª fase: calcula suma de digitos x 1 si impar, x 3 si par
b := false; r := 0;
for i := 1 to 12 do
begin
CodN[ i ] := 0;
b := Not b;
if b then
CodN[ i ] := StrToInt(Copy(CodS,i,1)) * 1
else
CodN[ i ] := StrToInt(Copy(CodS,i,1)) * 3;
r := r + CodN[ i ];
end;
rd := 0;
// 2ª fase encuentra decena superior
for i := r to r + 10 do
begin
if (i / 10) = Int(i / 10) then rd := i - r;
end;
if (rd = 10) then rd := 0;
result := rd;
end;
Usar un FONT sin tener que instalarlo en Windows
procedure TForm1.FormCreate(Sender: TObject);
begin
AddFontResource('C:\FONTS\FUENTE.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RemoveFontResource('C:\FONTS\FUENTE.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
Obtener el número de identificación de una tarjeta de red.
function GetNetworkID: string;
var
G: TGuid;
begin
OleCheck(CoCreateGuid(G));
Result := GuidToString(G);
Result := Copy(Result, Length(Result) - 12, 12);
end;
Ejecutar código antes de que mi aplicación sea minimizada.
type
TForm1 = class(TForm)
...
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
end;
...
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_MAXIMIZE) then MiCodigo;
DefaultHandler(Msg);
end;
Obtener la información VersionInfo de tu ejecutable.
function GetAppInfo(De:string):string;
{Se pueden pedir los siguientes datos:
CompanyName
FileDescription
FileVersion
InternalName
LegalCopyright
OriginalFilename
ProductName
ProductVersion
}
type
PaLeerBuffer = array [0..MAX_PATH] of char;
var
Size, Size2 : DWord;
Pt, Pt2 : Pointer;
Idioma : string;
begin
Result:='';
Size := GetFileVersionInfoSize(PChar (Application.Exename), Size2);
if Size > 0 then
begin
GetMem (Pt, Size);
GetFileVersionInfo (PChar (ParamStr (0)), 0, Size, Pt);
VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
Idioma:=IntToHex( DWord(Pt2^) ,8 );
Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+De),Pt2, Size2);
if Size2 > 0 then
begin
Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);
end else
raise Exception.Create( 'No existe esa informacion en este ejecutable');
FreeMem (Pt);
end else
raise exception.Create ( 'Lo siento, no hay VersionInfo disponible en este ejecutable.');
end;
Hacer ReadOnly una sola columna de un TDBGrid.
procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
if DBGrid1.SelectedField = MiCampoProtegido then
DBGrid1.Options := DBGrid1.Options - [dgEditing]
else
DBGrid1.Options := DBGrid1.Options + [dgEditing];
end;
Cómo saber el PATH de una Base de Datos sabiendo su Alias
uses BDE;
.....
procedure ShowDatabaseDesc(DBName: String);
const
DescStr = 'Driver Name: %s'#13#10'AliasName: %s'#13#10+Text: %s'#13#10'Physical Name/Path: %s';
var
dbDes: DBDesc;
begin
dbiGetDatabaseDesc(PChar(DBName), @dbDes);
with dbDes do
ShowMessage(Format(DescStr, [szDbType, szName, szText, szPhyName]));
end;
Cómo convertir TColor a HTML
Pon un TColorDialog (ColorDialog1), un TLabel (Label1) y un TButton (Button1) en tu form
Mete éste código en el OnClick de Button1:
procedure TForm1.Button1Click(Sender: TObject);
function ColorToHtml(DelphiColor:TColor):string;
var
tmpRGB : TColorRef;
begin
tmpRGB := ColorToRGB(DelphiColor);
Result:=Format( '#%.2x%.2x%.2x',[GetRValue(tmpRGB), GetGValue(tmpRGB), GetBValue(tmpRGB)]);
end;
begin
if ColorDialog1.Execute then
Label1.Caption:=ColorToHtml(ColorDialog1.Color);
end;
Comprobar si una URL es válida
uses WinInet;
...
Function CheckUrl(url:string):boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl( hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
Cómo saber el PATH correcto de mi aplicación
function TForm1.DirectorioAplicacion: string;
var
Buffer: array [0..255] of Char;
begin
GetModuleFileName(HInstance, Buffer, SizeOf(Buffer));
Result := ExtractFilePath(StrPas(Buffer));
end;
Cómo saber si un formulario se ha movido.
interface
...
type
TForm1 = class(TForm)
...
private
{ Private declarations }
procedure FormMove(var Msg: TWMMove); message WM_MOVE;
...
end;
...
implementation
...
procedure TForm1.FormMove(var Msg: TWMMove);
begin
inherited;
Label1.Caption := Format('(%d,%d)', [Left, Top]);
end;
...
Detectar y confirmar el cierre de Windows
interface
...
type
TForm1 = class(TForm)
...
private
{ Private declarations }
procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message WM_QueryEndSession;
...
end;
...
implementation
...
procedure TForm1.WMQueryEndSession(var Msg : TWMQueryEndSession);
begin
if MessageDlg('¿Desea cerrar Windows?', mtConfirmation, [mbYes,mbNo], 0) = mrNo then
Msg.Result := 0
else
Msg.Result := 1;
end;
...
Cómo ocultar o mostrar la Barra de tareas de Windows
procedure Ocultar_Barra;
begin
ShowWindow(FindWindow( 'Shell_TrayWnd',nil), SW_HIDE);
end;
procedure Mostrar_Barra;
begin
ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_SHOWNA);
end;
Cómo registrar un tipo de fichero y el ejecutable que lo abre en Windows
procedure TForm1.FileFormatAssociations;
var
reg: TRegistry;
FileExt : String;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_CLASSES_ROOT;
reg.LazyWrite := false;
FileExt := '.XYZ';
//Borrar la Clave - Esto es importante !!!
reg.OpenKey(FileExt, true);
reg.WriteString('', FileExt);
reg.CloseKey;
//Invocamos al programa pasando el nombre del fichero como primer parámetro
reg.OpenKey(FileExt + '\shell\open\command', true);
reg.WriteString('', Application.ExeName + ' "%1"');
reg.CloseKey;
//El icono mostrado será el primer icono del ejecutable del programa
reg.OpenKey(FileExt + '\DefaultIcon', true);
reg.WriteString('', Application.ExeName + ',0');
reg.CloseKey;
reg.free;
end;
Quitar el Beep de un TEdit al pulsar [INTRO].
Generar el manejador de eventos OnKeyPress y escribir:
if Key = #13 then Key := #0;
