Apuntes sobre Delphi


Descargar (poner a cero) un objeto de tipo TPicture.-

a) Definir un variable de tipo TPicture: Var Imagen: TPicture;
b) Crear un objeto del mismo tipo: Imagen:= TPicture.Create;
c) Asignar al objeto a descargar dicho objeto: CGrafico.Picture:=Imagen;
d) Liberar la memoria: Imagen.Free;

Procedimiento para limpiar el Canvas de un objeto.-  (ver también BorrarCanvas)

procedure TFicha1.BorrarLienzo(Color:Integer);
begin
      Self.Canvas.Brush.Color:=Color;
      Self.Canvas.Rectangle(0,0,ClientWidth,ClientHeight);
end;

Debemos declarar en la parte Interface el procedimiento:  BorrarLienzo(Color:Integer);

Procedimiento para controlar la entrada de datos en un control EDIT.-

    El código   8 corresponde al borrado de caracteres hacia atrás.
    El código 13 corresponde a la tecla Enter.
            "        27 a la tecla ESC.
     
procedure TForm1.EClaveKeyPress(Sender: TObject; var Key: Char);
 begin
        If key in ['0'..'9','A'..'Z','a'..'z',#8] then Key:=Key Else Key:=Chr(0);
 end;

Procedimiento para controlar el nombre de un fichero.-

Var nombre,C: String[8];
       i              : Byte;
       Letra       : String[1];
begin
 Registro.Obs:='';Registro.Clave:='';
 nombre:='';i:=0;Letra:='';C:='';
 nombre:=InputBox('Escriba el nombre del archivo:','','');
 For i:=1 to 8 do Begin
                   Letra:=Copy(nombre,i,1);
                   If (Letra='/') Or
                      (Letra='\') Or
                      (Letra=':') Or
                      (Letra='*') Or
                      (Letra='') Or
                      (Letra='?') Or
                      (Letra='"') Or
                      (Letra='<') Or
                      (Letra='>') Or
                      (Letra='|')
                    Then Letra:='#';
                   C:=C + Letra;
                  End;
 nombre:=C;

Procedimiento para controlar la entrada de números enteros.-

CadL:=InputBox('Longitud de la linea','Introducir:','');
 For i:=1 to Length(CadL)
  do begin
      Letra:=Copy(CadL,i,1);
      If (Letra='0') Or
         (Letra='1') Or
         (Letra='2') Or
         (Letra='3') Or
         (Letra='4') Or
         (Letra='5') Or
         (Letra='6') Or
         (Letra='7') Or
         (Letra='8') Or
         (Letra='9')
       Then C:=C + Letra;
      end;
 If C<>'' then CadL:=C else CadL:='100';
 Longitud:=StrToInt(CadL);

Función que permite obtener  una cadena (string) de un nmero real.-

function RealToStr(numero: Real;NumD: Byte): String;

var  ParteE, ParteD: String;
       Dig, n, L          : Integer;

begin
 ParteE:=IntToStr(Trunc(numero));
 if (numero> -1) and (numero < 0) then ParteE:='-'+ParteE;
 Case NumD of
            0: Dig:=0;
            1: Dig:=Abs(Trunc(10*Frac(numero)));
            2: Dig:=Abs(Trunc(100*Frac(numero)));
            3: Dig:=Abs(Trunc(1000*Frac(numero)));
           end;
 L:=Length(IntToStr(Dig));
 if (NumD>0) and (NumD-L>0) then for n:=1 to (NumD-L) do ParteD:=ParteD+'0';
 if (NumD>0) then ParteD:=ParteD+IntToStr(Dig) else ParteD:='';
 if ParteD<>'' then Result:=ParteE+'.'+ParteD else Result:=ParteE;
end;

Procedimiento que permite limpiar el Canvas de una ficha.-

procedure BorrarCanvas(Ficha: TForm;Color: Integer);
begin
 Ficha.Canvas.Brush.Color:=Color;
 Ficha.Canvas.Rectangle(0,0,Ficha.ClientWidth,Ficha.ClientHeight);
end;

Procedimiento para ordenar una lista (selección del mínimo) .-

var i, j, posicion: Integer;
     MinLinea      : String;

begin
 for i:=0 to Listas.Items.Count - 2
  do begin
      MinLinea:=Listas.Items[i];
      posicion:=i;
      for j:=i+1 to Listas.Items.Count - 1
       do begin
           if MinLinea>Listas.Items[j] then begin
                                           MinLinea:=Listas.Items[j];
                                           posicion:=j;
                                          end;
           end;
      Listas.Items[posicion]:=Listas.Items[i];
      Listas.Items[i]:=MinLinea;
     end;
end;

Convertir bitmap a jpeg (TI de Borland) .-

uses
  JPEG;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyJPEG : TJPEGImage;
  MyBMP  : TBitmap;
begin
  { Convierte BMP en JPEG }
  MyBMP := TBitmap.Create;
  with MyBMP do
    try
      LoadFromFile('MiImagenBitmap.BMP');
      MyJPEG := TJPEGImage.Create;
      with MyJPEG do begin
        Assign(MyBMP);
        SaveToFile('ImagenConvertida.JPEG');
        Free;
      end;
    finally
      Free;
    end;
end;


Convertir jpeg a bitmap (TI de Borland).-

uses
  JPEG;


procedure TForm1.Button1Click(Sender: TObject);
var
  MyJPEG : TJPEGImage;
  MyBMP  : TBitmap;
begin
  { Convierte JPEG en BMP }
  MyJPEG := TJPEGImage.Create;
  with MyJPEG do begin
    LoadFromFile('MiImagenJpeg.JPEG');
    MyBMP := TBitmap.Create;
    with MyBMP do begin
      Width := MyJPEG.Width;
      Height := MyJPEG.Height;
      Canvas.Draw(0,0,MyJPEG);
      SaveToFile('ImagenConvertida.BMP');
      Free;
    end;
    Free;
  end;
end;

¿Cómo puedo apagar el ordenador o hacer un reset desde mi programa?

if ExitWindowsEx (0,0) = 0 then showmessage ('No puedo reiniciar Windows); ??

    Más bien devuelve un valor True o False!!!!

if ExitWindowsEx (1,0) = 0 then showmessage ('No puedo cerrar el ordenador');

if ExitWindowsEx (2,0) = 0 then showmessage ('No puedo reiniciar el ordenador');

procedimiento para saber la posición del cursor en un Tmemo.-

var Lpos,Cpos,LineLength:integer;

begin
 Lpos := SendMessage(memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
 Cpos := SendMessage(memo1.Handle,EM_LINEINDEX,Lpos,0);
 LineLength := SendMessage(memo1.handle, EM_LINELENGTH, Cpos, 0);
 CPos := Memo1.SelStart-CPos;

 Label1.Caption:=IntToStr(Lpos); //Linea
 Label2.Caption:=IntToStr(Cpos); //Columna
 Label3.Caption:=IntToStr(LineLength) //Longitud de la linea

end;

Imprimir un BitMap.-

procedure TForm1.Button1Click(Sender: TObject);

 var ScaleX, ScaleY: Integer;
       R: TRect;

 begin
 Printer.BeginDoc;
  with Printer do
   try
   ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
   ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
   R := Rect(0, 0, Image1.Picture.Width * ScaleX, Image1.Picture.Height * ScaleY); 
  Canvas.StretchDraw(R, Image1.Picture.Graphic);
 finally
 EndDoc;
 end;
 end;

Procedimiento para leer la información sobre la memoria.-

procedure TMemory.GetInfo;
var
  SI :TSystemInfo;
  MS :TMemoryStatus;
begin
  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  GlobalMemoryStatus(MS);
  MemoryLoad:=MS.dwMemoryLoad;
  PhysicalTotal:=MS.dwTotalPhys;
  PhysicalFree:=MS.dwAvailPhys;
  VirtualTotal:=MS.dwTotalVirtual;
  VirtualFree:=MS.dwAvailVirtual;
  PageFileTotal:=MS.dwTotalPageFile;
  PageFileFree:=MS.dwAvailPageFile;
  ZeroMemory(@SI,SizeOf(SI));
  GetSystemInfo(SI);
  AllocGranularity:=SI.dwAllocationGranularity;
  MaxAppAddress:=DWORD(SI.lpMaximumApplicationAddress);
  MinAppAddress:=DWORD(SI.lpMinimumApplicationAddress);
  PageSize:=DWORD(SI.dwPageSize);
end;


Procedimiento para ejecutar o lanzar una aplicación.-

procedure TForm1.SBLanzarClick(Sender: TObject);

var CadNomP: String;
      NomP   : Array[0..1023] of Char;

begin
 CadNomP:=LELanzar.Text;
 StrPCopy(NomP, CadNomP);
 try
  WinExec(NomP, 1);
 except on E:Exception do ShowMessage('Error: '+E.message);
 end;
end;

Procedimiento para controlar la entrada de números en un control TEdit.-

 KeyPreview debe estar en true

procedure TForm2.EExpedienteKeyPress(Sender: TObject; var Key: Char);
begin
 if key in ['0'..'9','E','-', '+', #46, #8] then key:=key else key:=chr(0);
end;

volver