delphi es letra comprueba que un campo sea letra o numero

procedure TusuarioN.Button1Click(Sender: TObject);
var
aux, abc:string;
i: integer;
correcto: boolean;
begin


 //el usuario solo puede tener letras y/o numeros
 abc:='1234567890qwertyuiopasdfghjklzxcvbnm'+'QWERTYUIOPASDFGHJKLZXCVBNM';

  aux:=edit1.Text;
  correcto:=true;
  for i := 1 to Length(aux) do
  begin

    if AnsiPos(aux[i],abc)=0 then
    begin
      correcto:=false;
    end;

  end;

  if correcto=false then
  begin
    ShowMessage('Usuario solo puede contener letras y/o numeros');
    exit;
  end;




(...)

delphi evitar que mi aplicacion se abra 2 veces en el mismo pc

procedure TForm1.FormCreate(Sender: TObject);
begin

 //***** evita que se abra 2 veces el programa
 CreateMutex(nil, False, 'MyAppId');
 if GetLastError <> 0 then Halt;

end;





.
 

encriptar y desencriptar

uses Math

    function encriptar(dato:string):string;
    function desencriptar(dato:string):string;


//*********************************************
function TclientesN.encriptar(dato:string):string;
var
  myNum : Byte;
  i: integer;
  tam: integer;
  aux:string;
begin

 tam:=Length(dato);

 for i:=1 to Length(dato) do
 begin

   myNum := Ord(dato[i]);
   myNum:=myNum + 1;
   dato[i]:=Chr(myNum);
   aux:=aux+Chr(myNum)+ Chr(RandomRange(65,90))+ Chr(RandomRange(97,122));

 end;

 result:=aux;

end;


//*********************************************
function TclientesN.desencriptar(dato:string):string;
var
  myNum : Byte;
  i,j: integer;
  tam: integer;
  aux:string;
begin

 tam:=(Length(dato) div 3);

 j:=0;
 for i:=1 to Length(dato) do
 begin

    j:=j+1;

    if j=1 then
    begin
      myNum := Ord(dato[i]);
      myNum:=myNum - 1;
      dato[i]:=Chr(myNum);
      aux:=aux+Chr(myNum);
    end;

    if j=3 then
    begin
      j:=0;
    end;

 end;

 result:=aux;

end;

Delphi Hilos de ejecución ejemplo

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;



type
  TForm1 = class(TForm)
    BtnConHilo: TButton;
    ProgressBar1: TProgressBar;
    BtnSinHilo: TButton;
    procedure BtnConHiloClick(Sender: TObject);
    procedure BtnSinHiloClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses unit2;


{$R *.dfm}

//****************************************************************
procedure TForm1.BtnConHiloClick(Sender: TObject);
var
hilo: TProgreso;
begin

hilo:= TProgreso.Create(true);
hilo.FreeOnTerminate:=true;
hilo.Resume;

end;

//****************************************************************
procedure TForm1.BtnSinHiloClick(Sender: TObject);
begin
    ProgressBar1.Position:=0;

    repeat
      sleep(1000);
      ProgressBar1.Position:=ProgressBar1.Position +1;
    until
      ProgressBar1.Position = ProgressBar1.Max;
end;

end.



################################
unit2.pas
################################

unit Unit2;

interface
uses
 Classes, windows, unit1;

type
 TProgreso = class (TThread)
   protected
   procedure Execute; override;
 end;

implementation

//****************************************************************
procedure TProgreso.Execute;
begin

  inherited;

  with form1 do
  begin
    ProgressBar1.Position:=0;

    repeat
      sleep(1000);
      ProgressBar1.Position:=ProgressBar1.Position +1;
    until
      ProgressBar1.Position = ProgressBar1.Max;
  end;

end;

end.







.

delphi saber el dia de la semana

uses DateUtils

(...)

var
diaSemana: integer;
begin

diaSemana:=DayOfWeek(now);
showmessage(inttostr(diaSemana));


(...)






.

configurar Rave Report delphi informes

componente RvProject1
---------------------------
parametro Engine -> RvSystem1
parametro ProjectFile -> C:\bases\prueba.rav


componente RvSystem1
---------------------------
DefaultDest -> rdPrinter
SystemPrinter -> Copies -> 1  // numero de copias
SystemPrinter -> Title -> Titulo de la impresion

SystemSetups -> ssAllowSetup -> false   // para imprimir directamente


componente RvNDRWriter1
---------------------------



uses (...), inifiles;

(...)

procedure TForm1.Button1Click(Sender: TObject);
var
ini: TIniFile;
nombreImpresora: string;
begin

  ini := TIniFile.Create('./parametros.ini');
  nombreImpresora:=ini.ReadString('parametros', 'impresora', '');
  ini.Free;

  if nombreImpresora='' then
  begin    ShowMessage('Error al leer el fichero PARAMETROS.INI');
    exit;
  end;

  RvProject1.Open;
  if RvNDRWriter1.SelectPrinter(nombreImpresora)=false then
  begin
    ShowMessage('No exite impresora');
  end
  else
  begin
    RvProject1.Execute;
    RvProject1.Close;
  end;


end;






.

delphi cambiar el order del tab de los componentes tabulador

Botón derecho en el formulario -> Tab Order





.

ficheros ini fichero archivo archivos

uses inifiles;


//********************************************
procedure Tinicio.FormCreate(Sender: TObject);
var
ini: TIniFile;

(...)

    ini := TIniFile.Create('./parametros.ini');
    aux:=ini.ReadString('parametros', 'avisoanyonuevo', 'si');
    ini.Free;


(...)


    ini := TIniFile.Create('./parametros.ini');
    ini.WriteString('parametros', 'avisoanyonuevo', 'si');
    ini.Free;




.

cambio horario saber dia de la semana saber numero del mes

uses DateUtils;

(...)

//******************************************
procedure TForm1.Button1Click(Sender: TObject);
var
diadelasemana: integer;
numerodemes: integer;
begin


diadelasemana:=DayOfWeek(now);
numerodemes:=MonthOfTheYear(now);


if ((diadelasemana=1)) then
begin

ShowMessage('domingo: ' + inttostr(numerodemes));

end;


end;




.

maximo valor de int maximo entero

var
  min, max : integer;
begin
  // Set the minimum and maximum values of this data type
  min := Low(integer);
  max := High(integer);
  ShowMessage('Min integer value = '+IntToStr(min));
  ShowMessage('Max integer value = '+IntToStr(max));
end;

delphi tamaño de un fichero tamaño de un archivo

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    function tamanioA(nom:String):integer;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//********************************************
function TForm1.tamanioA(nom:String):integer;
var
FHandle: integer;
begin
FHandle := FileOpen(nom, 0);
try
Result := (getfilesize(FHandle,nil));
finally
FileClose(FHandle);
end;
end;

//***********************************************
procedure TForm1.Button1Click(Sender: TObject);
var
aux: string;
i: integer;
begin

aux:='c:\sella5.pdf';

i:=((tamanioA(aux) div 1024) div 1024);


ShowMessage(aux + ' --> ' +inttostr(i) + ' Mb');


end;

end.





.

showmessage salto de linea intros

ShowMessage('TU VIDA'+ #13#10 + 'SERA' + #13#10 +
'UNA CANCION');










.

adoquery saber si es null

//************************************************************************
procedure TForm1.Button1Click(Sender: TObject);
var
SQLQuery, aux: string;
begin

  ADOQuery1.Active := false;
  ADOQuery1.SQL.Clear;

  SQLQuery:='select * from borrar limit 1';
  ADOQuery1.SQL.Add(SQLQuery);

  ADOQuery1.Active := true;

  if  ADOQuery1.RecordCount > 0 then
  begin

    if ADOQuery1.FieldByName('nombre').IsNull then
    begin
      ShowMessage('nombre es null');
    end
    else
    begin
      aux:=ADOQuery1.FieldByName('nombre').AsString;
      ShowMessage(aux);
    end;

  end;

  ADOQuery1.Active := false;

end;



.

Crear un informe con RAVE v2

Tienes que añadir un control de la clase RvSystem y enlazar la propiedad engine del RvProject con el.

La Clase RVSystem tiene una propiedad SystemSetups donde puedes configurar las opciones de destinos (Impresora, preview, file..) si solo dejas opciones de impresión y ssAllowsetup a false, la impresión sale directa.

Si solo dejas opciones de Preview te saldra directamente la pantalla de previsualización y podras imprimir desde ella.

Saludos.

 

 

 

 

delphi copia portapapeles

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  anterior: string;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
fic: textfile;
nuevo: boolean;
begin

timer1.Enabled:=false;

nuevo:=false;


if memo1.Text='' then
begin
  memo1.Clear;
  memo1.PasteFromClipboard;
 anterior:=memo1.Text;
 nuevo:=true;
end
else
begin

  memo1.Clear;
  memo1.PasteFromClipboard;

  if anterior<>memo1.Text then
  begin
    anterior:=memo1.Text;
    nuevo:=true;
  end;
end;

if nuevo=true then
begin

AssignFile (fic,'fondo.txt');
  if FileExists('fondo.txt')=false then
  begin
    ReWrite(fic);
  end
  else
  begin
    Append(fic);
  end;

Append(fic);
writeln(fic,memo1.Text);
CloseFile (fic);

end;


timer1.Enabled:=true;

end;

end.





.

fechas delphi dia mes año

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
diadelasemana: integer;
wAnyo, wMes, wDia: Word;
begin

  DecodeDate( now(), wAnyo, wMes, wDia );

  diadelasemana:=DayOfWeek(now);

 // if ((diadelasemana=7) or (diadelasemana=1)) then



 ShowMessage(datetostr(EndOfTheMonth(now())));


  if (wMes=10) then
  begin

    if (wDia>=25) then
    begin
      ShowMessage(inttostr(wDia));
      ShowMessage(inttostr(wMes));
      ShowMessage(inttostr(wAnyo));
    end;

  end;


end;

end.



//*********
procedure TForm1.Button1Click(Sender: TObject);
var
wHor, wMin, wSeg, wMSeg, wAnyo, wMes, wDia: Word;
begin

DecodeDate( now(), wAnyo, wMes, wDia );
DecodeTime( now(), wHor, wMin, wSeg, wMSeg);

ShowMessage(inttostr(wHor)+inttostr(wMin)+inttostr(wSeg)+inttostr(wMSeg));

end;
 


.
 

saber si esta dentro de una zona GPS

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, strutils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  rectas: array[1..4] of string;

  puntosX: array[1..4] of integer;
  puntosY: array[1..4] of integer;

implementation

{$R *.dfm}


//********************************************************
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
pX, pY: real;

desde, hasta: integer;

puntoOrdenado1, puntoOrdenado2: real;
denominador1, denominador2: real;
numerador, total: real;

corta: integer;

begin

  pX:=4;
  pY:=38.5596881;

  corta:=0;    // las veces que corta por arriba un punto dado
  desde:=1;    // los segmentos de la zona el primero
  hasta:=4;    // los segmentos de la zona el ultimo (en este ej.)
  //***
  for i := desde to hasta do
  begin

    if i<>4 then
    begin

        puntoOrdenado1:=puntosX[i];
        puntoOrdenado2:=puntosX[i+1];
       
        if (puntoOrdenado1>puntosX[i+1]) then
        begin
          puntoOrdenado1:=puntosX[i+1];
          puntoOrdenado2:=puntosX[i];
        end;

        if ((puntoOrdenado1<=pX) and (puntoOrdenado2>=pX)) then
        begin
          



    // ecuaciones de la recta  ((X - Xa) / (Xb - Xa)) = ((Y - Ya) / (Yb - Ya))


          numerador:=pX - puntosX[i+1];

          denominador1:= puntosX[i+1] - puntosX[i];
          denominador2:= puntosY[i+1] - puntosY[i];

          total:= (numerador * denominador2 / denominador1) +  puntosY[i+1];

          if total >= pY then
          begin
            corta:=corta+1;
          end;

          //showmessage(floattostr(total));

        end;

    end
    else
    begin

        puntoOrdenado1:=puntosX[desde];
        puntoOrdenado2:=puntosX[hasta];

        if (puntoOrdenado1>puntosX[hasta]) then
        begin
          puntoOrdenado1:=puntosX[hasta];
          puntoOrdenado2:=puntosX[desde];
        end;

        if ((puntoOrdenado1<=pX) and (puntoOrdenado2>=pX)) then
        begin

          numerador:=pX - puntosX[hasta];

          denominador1:= puntosX[hasta] - puntosX[desde];
          denominador2:= puntosY[hasta] - puntosY[desde];

          total:= (numerador * denominador2 / denominador1) +  puntosY[hasta];

          if total >= pY then
          begin
            corta:=corta+1;
          end;

          //showmessage(floattostr(total));

        end;

    end;

  end;


//  ShowMessage(inttostr(corta));

  if (corta mod 2 <> 0)  then
  begin
    ShowMessage('Dentro');
  end
  else
  begin
    ShowMessage('Fuera');
  end;


//  ShowMessage(floattostr(corta mod 2));


end;





//********************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin

// vertices de la zona  (-5,3)   (6,9)   (3,5)   (9,-3)


puntosX[1]:=-5;
puntosX[2]:=6;
puntosX[3]:=3;
puntosX[4]:=9;


puntosY[1]:=3;
puntosY[2]:=9;
puntosY[3]:=5;
puntosY[4]:=-3;

end;




end.









http://es.onlinemschool.com/math/assistance/cartesian_coordinate/p_to_line/
http://fooplot.com



.

unir variable concatenar variable

cont:=listagrupos.Items.Count; // lineas de un lisbox


for i:=0 to listbox1.Items.Count-1 do
begin

if(listbox1.Selected[i]) then
begin
showmessage(inttostr(i));
end;
end;






sincronizar 4 listbox
/******************

procedure TForm1.ListBox1Click(Sender: TObject);
var
n:byte;
begin
for n:=2 to 4 do
begin
(FindComponent('ListBox'+IntToStr(n))as TListBox).ItemIndex:=
(Sender as TListBox).ItemIndex;
end;
end;


/****************



sincronizar 2 listbox
/******************

procedure TForm1.ListBox1Click(Sender: TObject);
var
n:byte;
begin
for n:=1 to 2 do
begin
(FindComponent('ListBox'+IntToStr(n))as TListBox).ItemIndex:=
(Sender as TListBox).ItemIndex;
end;
end;


/****************

base de datos select adoquery dinamico

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Data.DB, Data.Win.ADODB;

type
  TForm1 = class(TForm)
    ADOQuery1: TADOQuery;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//*************************************************
// aqui usa un componente ADOQUERY arrastrandolo
procedure TForm1.Button1Click(Sender: TObject);
var
SQLQuery: string;
begin


  ADOQuery1.Active := false;
  ADOQuery1.SQL.Clear;

  SQLQuery:='select id from localizadores limit 10';
  ADOQuery1.SQL.Add(SQLQuery);

  ADOQuery1.Active := true;

  if  ADOQuery1.RecordCount > 0 then
  begin
    showmessage('ok');
  end;

   ADOQuery1.Active := false;

end;

//*************************************************
// aqui crea un componente ADOQUERY dinamicamente
procedure TForm1.Button2Click(Sender: TObject);
var
ADOQuery2: TADOQuery;
SQLQuery: string;
i: integer;
begin

  ADOQuery2:= TADOQuery.Create(Self);
  ADOQuery2.ConnectionString:='Provider=MSDASQL.1;Persist Security Info=False;Data Source=elpauGPS';

  ADOQuery2.Active := false;
  ADOQuery2.SQL.Clear;

  SQLQuery:='select id from localizadores limit 10';
  ADOQuery2.SQL.Add(SQLQuery);


  ADOQuery2.Active := true;

  ShowMessage(inttostr(ADOQuery2.RecordCount));

  ADOQuery2.Active := false;

  ADOQuery2.Destroy;


end;

end.










// fin

coger la hora de internet

IdSNTP1.Host := 'time.windows.com';
label1.Caption := 'Fecha y hora: '+Datetimetostr(IdSNTP1.DateTime);