coger la hora de internet

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

fecha a MySql formatear fecha

uses DateUtils

var
  myDate : TDateTime;

begin
  // Set up our TDateTime variable with a full date and time :
  // 5th of June 2000 at 01:02:03.004  (.004 milli-seconds)
  myDate := EncodeDateTime(2000, 6, 5, 1, 2, 3, 4);

  // Date only - numeric values with no leading zeroes (except year)
  ShowMessage('              d/m/y = '+
              FormatDateTime('d/m/y', myDate));

  // Date only - numeric values with leading zeroes
  ShowMessage('           dd/mm/yy = '+
              FormatDateTime('dd/mm/yy', myDate));

  // Use short names for the day, month, and add freeform text ('of')
  ShowMessage('  ddd d of mmm yyyy = '+
              FormatDateTime('ddd d of mmm yyyy', myDate));

  // Use long names for the day and month
  ShowMessage('dddd d of mmmm yyyy = '+
              FormatDateTime('dddd d of mmmm yyyy', myDate));

  // Use the ShortDateFormat settings only
  ShowMessage('              ddddd = '+
              FormatDateTime('ddddd', myDate));

  // Use the LongDateFormat settings only
  ShowMessage('             dddddd = '+
              FormatDateTime('dddddd', myDate));

  // Use the ShortDateFormat + LongTimeFormat settings
  ShowMessage('                  c = '+
              FormatDateTime('c', myDate));
end;


o por ejemplo en una QUERY


  SQLQuery:='SELECT sum(CAST(metros AS UNSIGNED)) as metros FROM records ';
  SQLQuery:= SQLQuery +'where ';
  SQLQuery:= SQLQuery +'localizadorid="'+localizadores[i]+'" ';
  SQLQuery:= SQLQuery +'and contacto="1" ';
  SQLQuery:= SQLQuery +'and fecha="'+FormatDateTime('yyyy-mm-dd', now-1)+'" ';



// now-1   es el dia de ayer para anteayer seria now-2

.

delphi listar archivos y directorios

 function TForm1.ListaDirectorios(directorioPadre: string) : TStringList;
  var
    sr: TSearchRec;
  begin
    Result := TStringList.Create;
    if FindFirst(directorioPadre + '*', faDirectory, sr) = 0 then
    repeat
      if (sr.Attr = faDirectory) then
        Result.Add(directorioPadre + sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
 
  function TForm1.ListaArchivos(directorioPadre: string) : TStringList;
  var
    sr: TSearchRec;
  begin
    Result := TStringList.Create;
    if FindFirst(directorioPadre + '*', faAnyFile, sr) = 0 then
      repeat
        if (sr.Attr and faDirectory = 0) or (sr.Name <> '.')
          and (sr.Name <> '..') then
            Result.Add(directorioPadre + sr.Name);
      until FindNext(sr) <> 0;
    FindClose(sr);
  end;
 
    
     // Llamando a las funciones anteriores
 procedure TForm1.Button1Click(Sender: TObject);
  begin
    ListBox1.Items := ListaDirectorios('C:\');
    ListBox2.Items := ListaArchivos('C:\');
  end;

delphi borrar fichero

procedure TForm1.Button1Click(Sender: TObject);
begin

  if FileExists('c:\borrar.txt') then
    DeleteFile('c:\borrar.txt');

end;

delphi tamaño de un fichero

procedure TForm1.Button1Click(Sender: TObject);
var
  F: File of byte;
begin
  AssignFile( F, 'c:\ftp2.bat' );
  Reset( F );
  ShowMessage( IntToStr( FileSize( F ) ) + ' bytes' );
  CloseFile( F );

end;







.

delphi try catch global en el form

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 FormCreate(Sender: TObject);
    procedure GlobalExceptionHandler(Sender: TObject; E: Exception);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }


  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  j:=0;
  i:=10 div j;

end;

//***********************************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := GlobalExceptionHandler;
end;

//***********************************************************************
procedure TForm1.GlobalExceptionHandler(Sender: TObject; E: Exception);
var
fic: textfile;
begin

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

  writeln(fic,datetostr(now()) + ' ' + timetostr(now()));
  writeln(fic,'-------------------------------------------------------------------');
  writeln(fic,'Exception class name = '+E.ClassName);
  writeln(fic,'Exception message = '+E.Message);
  writeln(fic,'');  CloseFile (fic);

end;

end.

delphi try catch

var
fic: textfile;


(...)
 
try
  j:=0;
  i:=1 div j;

  except
  on E : Exception do
  begin

  AssignFile (fic,'logerrores.txt');

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

  writeln(fic,datetostr(now()) + ' ' + timetostr(now()));
  writeln(fic,'-------------------------------------------------------------------');
  writeln(fic,'Exception class name = '+E.ClassName);
  writeln(fic,'Exception message = '+E.Message);
  writeln(fic,'');
  CloseFile (fic);
  end;


.

espera a que termine shellexecute

procedure ExecuteAndWait(const aCommando: string);


 (...)


//*****************
procedure TForm1.ExecuteAndWait(const aCommando: string);
var
  tmpStartupInfo: TStartupInfo;
  tmpProcessInformation: TProcessInformation;
  tmpProgram: String;
begin
  tmpProgram := trim(aCommando);
  FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0);
  with tmpStartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    wShowWindow := SW_HIDE;
  end;

  if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW,
    nil, nil, tmpStartupInfo, tmpProcessInformation) then
  begin
    // loop every 10 ms
    while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do
    begin
      Application.ProcessMessages;
    end;
    CloseHandle(tmpProcessInformation.hProcess);
    CloseHandle(tmpProcessInformation.hThread);
  end
  else
  begin
    RaiseLastOSError;
  end;
end;

(...)

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

aux:='C:\Users\Pau\Desktop\blat.exe -server smtp.1und1.de -port 587 -f "root@mgflotas.com" -to "informaticoalicante@gmail.com" -subject "AVISO MGFLOTAS " -body "PAU" -u root@mgflotas.com -pw 91919191aA -html';
ExecuteAndWait(aux);

end;

tamaño de una carpeta de windows

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;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);



  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


//**********************************************************************
procedure BuscarArchivos(const directorio, mascara: string;
  atributos: Integer; var listado: TStrings);

  // Procedimiento anidado
  //
  procedure Buscar(const subdirectorio: string);
  var
    regBusqueda: TSearchRec;
  begin
    // Buscar en el directorio
    if FindFirst(subdirectorio + mascara,atributos,regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if (regBusqueda.Attr and faDirectory = 0)
            or (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
              begin
                //listado.Add(subdirectorio + (regBusqueda.Name)+ ' --> '+ inttostr(regBusqueda.Size));
                listado.Add(inttostr(regBusqueda.Size));
              end;
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;

    // Buscar en los subdirectorios
    if FindFirst(subdirectorio + '*', atributos
      or faDirectory, regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if ((regBusqueda.Attr and faDirectory) <> 0)
            and (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
                Buscar(subdirectorio + regBusqueda.Name + '\');
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;
  end;
   //
  // Fin del procedimiento anidado:
 // Comienza "BuscarArchivos(...)"
//
begin
  Buscar(IncludeTrailingPathDelimiter(directorio));
end;



procedure TForm1.Button1Click(Sender: TObject);
var
  lista: TStrings;
  total,  aux: real;
  i: integer;
  nombre: string;

begin
  lista := TStringList.Create;
  BuscarArchivos('C:\mgflo\video\', '*.*', faAnyFile, lista);

  memo1.clear;

  total:=0;

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

    nombre:=  lista[i];
    aux:=(strtofloat(nombre) / 1024 / 1024);
    total:=total+aux;

    memo1.Lines.Add(floattostr(aux));
 end;

     memo1.Lines.Add('---------------------------');
     memo1.Lines.Add(floattostr(total / 1024));

//  FormatFloat ('0.00', total).


  lista.Free;
end;

end.






.

delphi funcion pasar por valor

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;
function porvalor(var dato: string):bool;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//************************************
procedure TForm1.Button1Click(Sender: TObject);
var
a: string;
begin

porvalor(a);
ShowMessage(a);

end;

//************************************
function TForm1.porvalor(var dato: string):bool;
begin

dato:='hola';

end;


end.

sumar o restar horas

hora1:= now();

// resta una hora
ShowMessage(timetostr(hora1 - 60 / 1440));


// suma 40 minutos
ShowMessage(timetostr(hora1 + 40 / 1440));







.

Cerrar una ventana por su titulo con Delphi (cerrar un programa)

procedure TForm1.Button2Click(Sender: TObject);
var
  aHWnd : HWND;
begin
  aHWnd := FindWindow(nil, 'Google - Mozilla Firefox');

  if (aHWnd <> 0) then
    PostMessage(aHWnd, WM_QUIT, 0, 0);
    // or ...
    //PostMessage(aHWnd, WM_CLOSE, 0, 0);
end;

Abrir un programa desde Delphi

 uses ShellApi;

 ...

 ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL) ; 

delphi como funciona un dblookupcombobox combobox con dos tablas

necesitamos rellenar los siguientes campos:


ListField // lo que muestra en el combo
KeyField // el valor que coge el combo
ListSource // de donde maman estos dos campos de arriba


DataField // lo que modifica el combo (esta relacionado con el KeyField)
DataSource // donde mama el campo DataField


.

delphi dia de la semana

procedure TForm1.Button1Click(Sender: TObject);
var
diaSemana: string;
begin
diaSemana := FormatDateTime('dddd', Date);

showmessage(diaSemana);
end;

operaciones con string en delphi

Concat function
Concatenates two or more strings into a single string.
CompareStr function
Compares two strings.
CompareText function
Compares two strings without case sensitivity.
Copy function
Returns a substring of a string or a segment of a dynamic array.
Delete procedure
Removes a substring from a string.
DupeString function
Returns a string repeated a specified number of times.
ExtractStrings function
Fills a string list with substrings parsed from a delimited list.
Insert procedure
Inserts a substring into a string at a given position.
IsDelimiter function
Returns True if a specified character in a string matches one of a set of delimiters starting from some position.
LastDelimiter function
Returns the index of the last occurence in a string of the characters cpecified.
LeftStr function
Returns a string containing a specified number of characters from the left side of a string.
Length function
Returns an integer containing the number of characters in a string or the number of elements in an array.
LowerCase function
Returns a string that has been converted to lowercase.
Pos function
Returns an integer specifying the position of the first occurrence of one string within another.
PosEx function
Returns an integer specifying the position of the first occurrence of one string within another, where the search starts at a specified position.
QuotedStr function
Returns the quoted version of a string.
ReverseString function
Returns a string in which the character order of a specified string is reversed.
RightStr function
Returns a string containing a specified number of characters from the right side of a string.
SetLenght procedure
Changes the size of a dynamic array or a string.
SetString procedure
Sets the lenght and contents of a given string.
Str procedure
Formats a string from an integer or floating point variable.
StringOfChar function
Returns a string containing a repeating character string of the length specified.
StringReplace function
Returns a string in which a specified substring has been replaced with another substring.
Trim function
Returns a string containing a copy of a specified string without both leading and trailing spaces and control characters.
TrimLeft function
Returns a string containing a copy of a specified string without leading spaces and control characters.
TrimRight function
Returns a string containing a copy of a specified string without trailing spaces and control characters.
UpperCase function
Returns a string that has been converted to uppercase.
Val procedure
Converts a string to a numeric value.
WrapText function
Returns a string broken into multiple lines.

Borrar ficheros del disco con dephi

procedure Tfrm.BorrarFichero(fichero: String);

begin
if FileExists(fichero) then
 DeleteFile(fichero);
end;

arreglar Key Violation en clave primaria tabla Paradox

Si al insertar un nuevo regristro en una tabla Paradox que tiene un campo autonumérico te da error haz lo siguiente:

1) abrir DataBase Desktop





2) Abrir la tabla en cuestion




3) Pincha en el boton RESTRUCTURE y dentro ve a la columna TYPE del campo que falla (el autoincrement) y cambia el + por I guarda la tabla, cambialo como estaba (el I por el +) y guarda la tabla de nuevo.

Filtrar una tabla sin una query

procedure TForm1.Button1Click(Sender: TObject);
begin

table1.Filter:='cocheid >= 15 and cocheid <=20 or cochematricula = ' + QuotedStr('0755-DXR');
table1.Filtered:=true;

end;

ojo !! si se quiere filtrar con un LIKE sería así:

//*** asi no va
clientes.Filter:='ClientesNomApellidos like ' + QuotedStr('%'+edit1.text+'%');

//*** asi SI (ojo en Paradox solo funciona para los campos en que les pasemos como comienzan, no va ni con terminan, ni contienen)
clientes.Filter:='ClientesNomApellidos= '+QuotedStr(Edit1.text+'*');
clientes.Filtered:=true;

poner entre comillas un string

procedure TForm1.Button1Click(Sender: TObject);
var
dato: string;
begin

dato:='hola';

// sin comillas
showmessage(dato);

// con comillas
showmessage(QuotedStr(dato));


end;

Word to char

//*** Key es de tipo CHAR
//*** VK_MENUes de tipo WORD


if Key=Chr(VK_MENU) then
begin
// lo q sea
end;


.

tecla ALT tecla ENTER y mas teclas

//***********************
if Key=Chr(VK_MENU) then
begin
showmessage('tecla ALT pulsada');
end;


//***********************
if Key=#13 then
begin
showmessage('tecla ENTER pulsada');
end;


//******************************************************************
VK_LBUTTON 01 Left mouse button
VK_RBUTTON 02 Right mouse button
VK_CANCEL 03 Control-break processing
VK_MBUTTON 04 Middle mouse button (three-button mouse)
VK_BACK 08 BACKSPACE key
VK_TAB 09 TAB key
VK_CLEAR 0C CLEAR key
VK_RETURN 0D ENTER key
VK_SHIFT 10 SHIFT key
VK_CONTROL 11 CTRL key
VK_MENU 12 ALT key
VK_PAUSE 13 PAUSE key
VK_CAPITAL 14 CAPS LOCK key
VK_ESCAPE 1B ESC key
VK_SPACE 20 SPACEBAR
VK_PRIOR 21 PAGE UP key
VK_NEXT 22 PAGE DOWN key
VK_END 23 END key
VK_HOME 24 HOME key
VK_LEFT 25 LEFT ARROW key
VK_UP 26 UP ARROW key
VK_RIGHT 27 RIGHT ARROW key
VK_DOWN 28 DOWN ARROW key
VK_SELECT 29 SELECT key
VK_PRINT 2A PRINT key
VK_EXECUTE 2B EXECUTE key
VK_SNAPSHOT 2C PRINT SCREEN key
VK_INSERT 2D INS key
VK_DELETE 2E DEL key
VK_HELP 2F HELP key
30 0 key
31 1 key
32 2 key
33 3 key
34 4 key
35 5 key
36 6 key
37 7 key
38 8 key
39 9 key
41 A key
42 B key
43 C key
44 D key
45 E key
46 F key
47 G key
48 H key
49 I key
4A J key
4B K key
4C L key
4D M key
4E N key
4F O key
50 P key
51 Q key
52 R key
53 S key
54 T key
55 U key
56 V key
57 W key
58 X key
59 Y key
5A Z key
VK_NUMPAD0 60 Numeric keypad 0 key
VK_NUMPAD1 61 Numeric keypad 1 key
VK_NUMPAD2 62 Numeric keypad 2 key
VK_NUMPAD3 63 Numeric keypad 3 key
VK_NUMPAD4 64 Numeric keypad 4 key
VK_NUMPAD5 65 Numeric keypad 5 key
VK_NUMPAD6 66 Numeric keypad 6 key
VK_NUMPAD7 67 Numeric keypad 7 key
VK_NUMPAD8 68 Numeric keypad 8 key
VK_NUMPAD9 69 Numeric keypad 9 key
VK_SEPARATOR 6C Separator key
VK_SUBTRACT 6D Subtract key
VK_DECIMAL 6E Decimal key
VK_DIVIDE 6F Divide key
VK_F1 70 F1 key
VK_F2 71 F2 key
VK_F3 72 F3 key
VK_F4 73 F4 key
VK_F5 74 F5 key
VK_F6 75 F6 key
VK_F7 76 F7 key
VK_F8 77 F8 key
VK_F9 78 F9 key
VK_F10 79 F10 key
VK_F11 7A F11 key
VK_F12 7B F12 key
VK_F13 7C F13 key
VK_F14 7D F14 key
VK_F15 7E F15 key
VK_F16 7F F16 key
VK_F17 80H F17 key
VK_F18 81H F18 key
VK_F19 82H F19 key
VK_F20 83H F20 key
VK_F21 84H F21 key
VK_F22 85H F22 key
VK_F23 86H F23 key
VK_F24 87H F24 key
VK_NUMLOCK 90 NUM LOCK key
VK_SCROLL 91 SCROLL LOCK key
VK_LSHIFT A0 Left SHIFT key
VK_RSHIFT A1 Right SHIFT key
VK_LCONTROL A2 Left CONTROL key
VK_RCONTROL A3 Right CONTROL key
VK_LMENU A4 Left MENU key
VK_RMENU A5 Right MENU key
VK_PLAY FA Play key
VK_ZOOM FB Zoom key


.

comprobar que un textbox sea numero isnum

function IsStrANumber(NumStr : string) : bool;


//***********************
function IsStrANumber(NumStr : string) : bool;
begin
result := true;

try
StrToInt(NumStr);
except
result := false;
end;

end;
//****



if IsStrANumber(edit2.Text)=false then
begin
showmessage('El campo UNIDADES debe de ser un número.');
exit;
end;

.

crear un TDBText dinamico dinamicamente

var
fechaSalida: TDBText;

(...)

fechaSalida:= TDBText.Create(Self);
fechaSalida.DataField:='fechaSalida';
fechaSalida.DataSource:=DataSource3;

sumar tiempo sumar horas en SQL Paradox 7

(...)

var
resumen: Tform1;
function sumahoras(hora1: ttime; hora2: ttime): string;

implementation

{$R *.dfm}

(...)


//

---

function sumahoras(hora1: ttime; hora2: ttime): string;
var
h1,h2,m1,m2,s1,s2: integer;
h,m,s: integer;
aux, horaFinal: string;
begin


//**** hora 1
aux:= timetostr(hora1);

if (length(timetostr(hora1))=7) then
begin
aux:='0';
aux:=aux + timetostr(hora1);
end;

h1:= strtoint(aux[1]+aux[2]);
m1:= strtoint(aux[4]+aux[5]);
s1:= strtoint(aux[7]+aux[8]);

//**** hora 2
aux:= timetostr(hora2);

if (length(timetostr(hora2))=7) then
begin
aux:='0';
aux:=aux + timetostr(hora2);
end;


h2:= strtoint(aux[1]+aux[2]);
m2:= strtoint(aux[4]+aux[5]);
s2:= strtoint(aux[7]+aux[8]);

//

---

if ((s1+s2) > 59) then
begin
m1:=m1+1;
s:= (s1+s2) - 60;
end
else
begin
s:= (s1+s2);
end;


//

---

if ((m1+m2) > 59) then
begin
h1:=h1+1;
m:= (m1+m2) - 60;
end
else
begin
m:= (m1+m2);
end;

//

---

h:=h1+h2;


horaFinal:='00:00:00';
aux:=inttostr(s);

if (length(aux)<2) then
begin
horaFinal[7]:='0';
horaFinal[8]:=aux[1];
end
else
begin
horaFinal[7]:=aux[1];
horaFinal[8]:=aux[2];
end;

aux:=inttostr(m);

if (length(aux)<2) then
begin
horaFinal[4]:='0';
horaFinal[5]:=aux[1];
end
else
begin
horaFinal[4]:=aux[1];
horaFinal[5]:=aux[2];
end;


aux:=inttostr(h);

if (length(aux)<2) then
begin
horaFinal[1]:='0';
horaFinal[2]:=aux[1];
end
else
begin
horaFinal[1]:=aux[1];
horaFinal[2]:=aux[2];
end;

sumahoras:= horaFinal;

end;


//

---

//** ejemplo de llamada en una QUERY
//

---

(...)

aux:='select * from almuerzos where almuerzoFechaEntrada is not null and almuerzoFechaSalida >= :fechaD and almuerzoFechaSalida<= :fechaH and almuerzoEmpleado = ' + empleadoID ;

qAlmuerzos.close;
qAlmuerzos.SQL.Clear;
qAlmuerzos.SQL.add(aux);

qAlmuerzos.ParamByName('fechaD').DataType:= ftDate;
qAlmuerzos.ParamByName('fechaD').Value:= DateTimePicker1.Date;

qAlmuerzos.ParamByName('fechaH').DataType:= ftDate;
qAlmuerzos.ParamByName('fechaH').Value:= DateTimePicker2.Date;

qAlmuerzos.Active:=true;

qAlmuerzos.First;
totalTiempoAlmuerzo:= '00:00:00';
for i:=0 to qAlmuerzos.RecordCount-1 do
begin
totalTiempoAlmuerzo:= (sumahoras(strtotime(totalTiempoAlmuerzo), qAlmuerzos.Fieldvalues['almuerzoTotalTiempo']));
qAlmuerzos.next;
end;

(...)

Mensaje YES NO por defecto el NO

if Application.MessageBox(PChar(‘¿Te vas a casa?’), PChar(‘Confirmar’), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = IDNO then
begin
// lo que sea
end;

SQL con parametros

query1.close;
query1.SQL.Clear;
query1.SQL.add('insert into query1 (fecha, importeT, importeE, concepto, empleado, total) values (:fecha, :importeT, :importeE, :concepto, :empleado, :total)');
query1.ParamByName('fecha').Value:=Date;
query1.ParamByName('importeE').Value:=strtofloat(StringGrid1.Cells[2,i]);
query1.ParamByName('importeT').Value:=strtofloat('0');
query1.ParamByName('concepto').Value:=StringGrid1.Cells[0,i];
query1.ParamByName('empleado').Value:=StringGrid1.Cells[1,i];
query1.ParamByName('total').Value:=strtofloat(StringGrid1.Cells[2,i]);
query1.ExecSQL;

Crear un informe con RAVE

Primero colocamos los siguientes componentes en el Formulario



Modificamos las propiedades del componente Query1
(poniendo en la propiedad SQL la sql p.e. select * from cobros)










y dentro del boton que llama al iforme




pinchamos dos veces en el componente RV Rave y se abre el rave
una vez dentro para modificar las propiedades de la hoja vamos aqui



Añadimos una region




depues añadimos una banda estatica (para datos que siempre son iguales)
o una banda dinamica (donde pinta las filas del QUERY1)





Hacemos que traiga los campos de la query1 al report












aqui se muestran los campos que hay (ojo no los podemos arrastras al report)
OJO: si se usa la banda dinamica hay que ponerle la propiedad DATAVIEW el que corresponda de la QUERY




Para ponerlo en el reporte ponemos un componente de datos tipo texto




y en las propiedades lo asociamos




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

si queremos pasarle parámetros desde la aplicacion de un textbox por ejemplo al informe entonces haremos: (EN EL CODIGO DEL PROGRAMA)


RvProject1.SetParam(‘fechaD’, datetostr(DateTimePicker1.Date));

y en el informe haremos:

- poner un datatext
- pulsar los puntos suspensivos de su datafield
- en el campo de abajo (data text) pondremos p.e.
'Desde ' & Param.fechaD







FIN :D





.

Mesanej personalizado con YES o NO

if MessageDlg('¿Desea borrar la fila?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
// lo que sea
end;

borrar una fila de un stringgrid

//*****
ponemos un stringgrid y un boton en el formulario

y usaremos una variable global que se llama FILA para saber que fila se tiene que borrar cuando pulse el boton



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


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

//****** variable global
fila: integer;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin

fila:=-1;

with StringGrid1 do
begin
// Título de las columnas
Cells[1, 0] := 'NOMBRE';
Cells[2, 0] := 'APELLIDO1';
Cells[3, 0] := 'APELLIDO2';
Cells[4, 0] := 'NIF';
Cells[5, 0] := 'IMPORTE PTE.';

// Datos
Cells[1, 1] := 'PABLO';
Cells[2, 1] := 'GARCIA';
Cells[3, 1] := 'MARTINEZ';
Cells[4,1] := '67348321D';
Cells[5,1] := '1500,36';

// Datos
Cells[1, 2] := 'MARIA';
Cells[2, 2] := 'SANCHEZ';
Cells[3, 2] := 'PALAZON';
Cells[4, 2] := '44878234A';
Cells[5, 2] := '635,21';

// Datos
Cells[1, 3] := 'CARMEN';
Cells[2, 3] := 'PEREZ';
Cells[3, 3] := 'GUILLEN';
Cells[4, 3] := '76892693L';
Cells[5, 3] := '211,66';
end;


end;

procedure GridDeleteRow(RowNumber: Integer; Grid: TstringGrid);
var
i: Integer;
begin



Grid.Row := RowNumber;

for i := RowNumber to Grid.RowCount - 1 do
Grid.Rows[i] := Grid.Rows[i + 1];

Grid.RowCount := Grid.RowCount - 1;


end;

procedure TForm1.Button1Click(Sender: TObject);
begin

if (fila<>-1) then
begin

GridDeleteRow(fila, stringGrid1);
fila:=-1;
end;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin

fila:= ARow;

end;

end.







.

SQL delete

query1.Close;
query1.SQL.Clear;
query1.SQL.Add('delete from historico where id='+inttostr(id)+' and fecha='+#39+Getfecha+#39);
query1.ExecSQL;

SQL insert

query1.Close;
query1.SQL.Clear;
query1.SQL.Add('insert into historico (proveedor,fecha,articulo,talla,pcoste,pvp) values ('+#39+proveedor+#39+','+#39+Getfecha+#39+','+#39+edit1.text+#39+','+#39+edit2.text+#39+','+#39+floattostr(pcoste)+#39+','+#39+floattostr(pvp)+#39+')');
query1.ExecSQL;

DATETIMEPICKER otras funciones posiblemente interesantes

uses
ComCtrls;

const
DTM_SETFORMAT = $1005;

procedure TForm1.Button1Click(Sender: TObject);
var
sFormat: string;
begin
DateTimePicker1.kind := dtkTime;

// Don't show the seconds, Sekunden nicht anzeigen
SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, Longint(PChar('hh:mm')));

// To show AM/PM
SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, Longint(PChar('hh:mm tt')));

// 24-hour clock: Be sure to set Kind to dtkTime
DateTime_SetFormat(DateTimePickerTest.Handle, pChar('H:mm:ss'));

// To show Date and Time, Datum und Zeit anzeigen
// Note that you can only edit the date or the time depending
// on the Kind (dtkTime or dtkDate).
SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, Longint(PChar('dd/MM/yyyy hh:ss')));

// You could also use the DateTime_SetFormat macro:
DateTime_SetFormat(DateTimePicker1.Handle, PChar('M/d/yyy'));

// Instead of using the DateTime_SetFormat function, you can
// send a message to the control directly:
sFormat := 'dd-MMMM-yyyy';
DateTimePicker1.Perform(DTM_SETFORMAT, 0, DWORD(sFormat));
end;

// Show the Week Number in a TDateTimePicker

procedure DateToWeek(dtDate: TDateTime; var AWeek, AYear: Word);
const
FIRST_WEEKDAY: Integer = 2;
FIRST_WEEKDATE: Integer = 4;
var
wMonth, wDay: Word;
begin
dtDate := dtDate - ((DayOfWeek(dtDate) - FIRST_WEEKDAY + 7) mod 7) + 7 - FIRST_WEEKDATE;
DecodeDate(dtDate, AYear, wMonth, wDay);
AWeek := (Trunc(dtDate - EncodeDate(AYear, 1, 1)) div 7) + 1;
end;

procedure TForm1.DateTimePicker1Change(Sender: TObject);
var
sFormat: string;
wWeek, wYear: Word;
begin
DateToWeek(DateTimePicker1.date, wWeek, wYear);
sFormat := 'dd/MM/yy Week:' + IntToStr(wWeek) + '';
DateTimePicker1.Perform(DTM_SETFORMAT, 0, DWORD(sFormat));
end;

procedure TForm1.FormShow(Sender: TObject);
begin
DateTimePicker1Change(Self);
end;

Pasar de tipo WORD a tipo STRING

procedure TForm1.Button1Click(Sender: TObject);
var
mes, dia, ano :Word;
begin
decodedate(datetimepicker1.date , ano, mes, dia);
datetimepicker1.date := encodeDate(ano, mes, DaysInAMonth(ano, mes));

showmessage(inttostr(ano)); // aqui esta la solucion
end;

DATETIMEPICKER funciones utiles

uses // esto hay que meterlo en el uses
dateutils


//********************** numero del mes de un datetimepicker
monthof(datetimepicker1.date);

showmessage(IntToStr(Integer(monthof(datetimepicker1.date))));




//********************** numero del año de un datetimepicker
yearof(datetimepicker1.date);

showmessage(IntToStr(Integer(yearof(datetimepicker1.date))));





//********************** numero del dia de un datetimepicker
dayof(datetimepicker1.date);

showmessage(IntToStr(Integer(dayof(datetimepicker1.date))));



//################################################################################
inicializar un datetimepicker al dia 1 del mes

procedure TForm1.Button1Click(Sender: TObject);
var
mes, dia, ano :word;

begin
decodedate(datetimepicker1.date, ano, mes, dia);
datetimepicker1.date := encodeDate(ano,mes,1);

end;


// inicializarlo al ultimo dia del mes

procedure TForm1.Button1Click(Sender: TObject);
var
mes, dia, ano :Word;
begin
decodedate(datetimepicker1.date , ano, mes, dia);
datetimepicker1.date := encodeDate(ano, mes, DaysInAMonth(ano, mes));
end;



//###############################################################################
con dos datetimepicker poner 1 a dia 1 de un mes y el otro a ultimo dia de ese mes

DateTimePicker1.Date:=Now-DayOf(now)+1;
DateTimePicker2.Date:=Now+(DaysInMonth(now)-DayOf(now));

poner un string entre QUOTES

showmessage(QuotedStr('hola')); // casaria 'hola'


o tambien


showmessage(#39+'hola'+#39);

Como instalar los componentes SOCKET en delphi 7

Solution:
You will need to add the dclsockets package to the IDE.
To do this go to Component | Install Packages | Add (/bin/dclsockets70.bpl).


Pestaña Internet :)

by elpau

SQL entre fechas

query1.Close;
query1.SQL.clear;

dato:='SELECT * from venta where fecha between :f1 and :f2';
query1.SQL.add(dato);

query1.ParamByName('f1').DataType:=ftdate;
query1.ParamByName('f1').Value:=strtodate('11/04/2007');
query1.ParamByName('f2').DataType:=ftdate;
query1.ParamByName('f2').Value:=strtodate('15/04/2007');


query1.Active:=true;

stringgrid

//******************************************************
procedure TForm11.Button2Click(Sender: TObject);
begin

stringgrid1.rowcount:=30; // numero de filas del grid
//stringgrid1.Row:=10;


//stringgrid1.ColWidths[1]:=10;

stringgrid1.Cells[1,0]:='holaaaaaaaaaaaaaa';
stringgrid1.Cells[1,1]:='holaaaaaaaaaaaaaaaaaaaaaaaaaaaaa';
stringgrid1.Cells[2,2]:='holaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa';
stringgrid1.Cells[3,3]:='hola';
stringgrid1.Cells[4,4]:='hola';
stringgrid1.Cells[5,5]:='hola';
stringgrid1.Cells[6,6]:='hola';
stringgrid1.Cells[7,7]:='holaaaaaaaaaaaaaaaaaaa';
stringgrid1.Cells[8,8]:='hola';


end;



//********

stringgrid1.Visible:=true;
stringgrid1.rowcount:=a;

stringgrid1.Cells[1,0]:='ID';
stringgrid1.Cells[2,0]:='Nombre';
stringgrid1.Cells[3,0]:='Apellido';
stringgrid1.Cells[4,0]:='Turno';


// tamaño de columna
stringgrid1.ColWidths[1]:=10;




//***********
para q no deje editar una celda y las demas si

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin



if (acol = 2) and (arow = 1) then
StringGrid1.Options :=StringGrid1.Options-[goediting]
else
StringGrid1.Options :=StringGrid1.Options+[goediting];

end;

Redondear un float

uses math
---------------------------------------


// truncar

function Redondear(Valor: Real; Redondeo: Integer):Real;
begin
Redondear := Trunc(Valor * Power(10, Redondeo)) / Power(10,Redondeo);
end;

// redondear

function Redondear(Valor: Real; Redondeo: Integer):Real;
begin
Redondear := Round(Valor * Power(10, Redondeo)) / Power(10,Redondeo);
end;

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

var
numero,aux: real;
dato: string;
begin


dato:='12,4556';

numero:=strtofloat(dato);

aux:=Redondear(numero; 2);
numero:=aux;

dato:=floattostr(numero);

showmessage(dato);

end;

MessageDlg, (mensaje de dialogo)

procedure TFormPrincipal.SalirClick(Sender: TObject);
var
boton:integer;
begin
boton:=MessageDlg('¿Desea guardar las modificaciones en la Base de Datos?',mtConfirmation,mbYesNoCancel,0);
if boton=6 then
begin
//GUARDA VALORES EN LA BD
Cerrar(Liga);
close;
end
else
if boton=7 then
close;
end;

--------------------


mtWarning A message box containing a yellow exclamation point symbol.
mtError A message box containing a red stop sign.
mtInformation A message box containing a blue "i".
mtConfirmation A message box containing a green question mark.
mtCustom A message box containing no bitmap. The caption of the message box is the name of the application's executable file.

-------------------

mbYes A button with 'Yes' on its face.
mbNo A button the text 'No' on its face.
mbOK A button the text 'OK' on its face.
mbCancel A button with the text 'Cancel' on its face.
mbHelp A button with the text 'Help' on its face
mbAbort A button with the text 'Abort' on its face
mbRetry A button with the text 'Retry' on its face
mbIgnore A button with the text 'Ignore' on its face
mbAll A button with the text 'All' on its face

---------------------

MB_ABORTRETRYIGNORE La ventana contiene tres botones:
Abortar, Reintentar e Ignorar.
MB_ICONEXCLAMATION Aparece un icono de exclamación en la ventana.
MB_ICONINFORMATION Se trata de un icono con una 'i' en un bocadillo.
MB_ICONQUESTION Es un icono con una interrogación.
MB_ICONSTOP Se trata de un icono con un signo de STOP.
MB_OK La ventana contiene un botón de Aceptar.
MB_OKCANCEL La ventana contiene dos botones: Aceptar y Cancelar.
MB_RETRYCANCEL La ventana contiene dos botones: Reintentar
y Cancelar.
MB_YESNO La ventana contiene dos botones: Sí y No.
MB_YESNOCANCEL La ventana contiene tres botones:
Sí, No, y Cancelar.

Si, por ejemplo, queremos una vetana con un icono de exclamación y los botones correspondientes a la constante MB_YESNOCANCEL, pondremos en el parámetro Tipo de la función lo siguiente:


MB_ICONEXCLAMATION + MB_YESNOCANCEL

MessageBeep

The MessageBeep function plays a waveform sound. The waveform sound for each sound type is identified by an entry in the [sounds] section of the registry.

BOOL MessageBeep(

UINT uType // sound type
);


Parameters

uType

Specifies the sound type, as identified by an entry in the [sounds] section of the registry. This parameter can be one of the following values:

Value Sound
0xFFFFFFFF Standard beep using the computer speaker
MB_ICONASTERISK SystemAsterisk
MB_ICONEXCLAMATION SystemExclamation
MB_ICONHAND SystemHand
MB_ICONQUESTION SystemQuestion
MB_OK SystemDefault


Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

Remarks

After queuing the sound, the MessageBeep function returns control to the calling function and plays the sound asynchronously.
If it cannot play the specified alert sound, MessageBeep attempts to play the system default sound. If it cannot play the system default sound, the function produces a standard beep sound through the computer speaker.
The user can disable the warning beep by using the Control Panel Sound application.

See Also

FlashWindow, MessageBox

Listbox y Findcomponent

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;


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

Listar un directorio

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}


procedure TForm1.Button1Click(Sender: TObject);

procedure RastreaDir(Dir: string);
var
FileSearch: TSearchRec;
begin
chDir (Dir);
FindFirst ('*.*', faDirectory, FileSearch);

while FindNext(FileSearch)=0 do
begin
if (FileSearch.Attr = faDirectory) then
begin
if (FileSearch.Name<>'..') then RastreaDir(Dir+FileSearch.Name+'\');
end else
{Pon aqui lo que quieras hacer con los ficheros encontrados}
{Put here anything to make with the find files}
form1.memo1.lines.add(Dir+FileSearch.Name);
end;
FindClose(FileSearch);
end;

begin
RastreaDir('f:\mp3\viejo\');
end;



end.

ficheros en Delphi

LEER:
~~~~~~~~~~~~~~~~

AssignFile (fic,'hojas.txt');
Reset (fic);
Readln(fic,dato);
CloseFile (fic);



ESCRIBIR:
~~~~~~~~~~~~~~~~

AssignFile (fic,'tac.txt');
Rewrite (fic);
writeln(fic,'fin');
CloseFile (fic);


LEE HASTA FINAL DE FICHERO:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


AssignFile (fic,edit3.text);
Reset (fic);
Readln(fic,dato);


while not EOF(fic) do
begin

showmessage(dato);
Readln(fic,dato);


end;

Fecha y hora del sistema

var

function GetFecha: String;




//************************* fecha y hora
function GetLocalT: String;
var
stSystemTime : TSystemTime;
begin
Windows.GetLocalTime( stSystemTime );
Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) );
end;
//*************************


//************************* fecha
function GetFecha: String;
var
stSystemTime : TSystemTime;
aux,fecha: string;

begin
Windows.GetLocalTime( stSystemTime );
aux:=DateTimeToStr( SystemTimeToDateTime( stSystemTime ));

fecha:= aux[1]+aux[2]+aux[3]+aux[4]+aux[5]+aux[6]+aux[7]+aux[8]+aux[9]+aux[10];

Result:= fecha;
end;
//*************************

es numero INT un STR ???

function IsStrANumber(NumStr : string) : bool;


//********* comprueba si un combo es numero
function IsStrANumber(NumStr : string) : bool;
begin
result := true;

try
StrToInt(NumStr);
except
result := false;
end;

end;
//****



if IsStrANumber(edit2.Text)=false then
begin
showmessage('El campo UNIDADES debe de ser un número.');
exit;
end;

Imprimir con CANVAS printer

///***************** para hacer lineas

Printer.Canvas.MoveTo(0,0); // punto 1
Printer.Canvas.LineTo(9900,14000); // punto 2


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





{
a la hora de imprimir q solo haya trabajado una vez ese dia !!!!!!!!!!
}


unit Unit15;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, DBCtrls, Db, DBTables, ComCtrls, Printers;

type
TForm15 = class(TForm)
Button1: TButton;
Database1: TDatabase;
DataSource1: TDataSource;
Table1: TTable;
DataSource2: TDataSource;
Table2: TTable;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
DBText1: TDBText;
DBText2: TDBText;
DBText3: TDBText;
DBText4: TDBText;
ComboBox1: TComboBox;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
Label4: TLabel;
Label5: TLabel;
Button2: TButton;
DBNavigator1: TDBNavigator;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form15: TForm15;
function GetFecha: String;

implementation

uses Unit1;

{$R *.DFM}

//*******************************************************************
procedure TForm15.FormCreate(Sender: TObject);
var
i: integer;
a,b,c,d: integer;
begin

i:=2;
a:=screen.Width;
b:=screen.Height;

form15.left:= (a div i) - form15.width div i;
form15.top:= (b div i) - form15.Height div i;
end;

//**************************************************************
procedure TForm15.Button1Click(Sender: TObject);
begin
form15.hide;
form1.enabled:=true;
form1.show;
end;
//********************************************************
procedure TForm15.FormActivate(Sender: TObject);
var
i: integer;
begin

combobox1.clear;

table1.close;
table1.open;
table1.first;

for i:=0 to Table1.RecordCount-1 do
begin

if table1.Fieldvalues['borrado'] = false then
begin

combobox1.items.add(table1.Fieldvalues['id']);

end; // if

table1.next;

end;

table1.first;

datetimepicker1.date:= strtodate(GetFecha());
datetimepicker2.date:= strtodate(GetFecha());



end;


//*****************************************************************************
procedure TForm15.ComboBox1Change(Sender: TObject);
var
i: integer;
begin

table1.open;
table1.first;


for i:=0 to Table1.RecordCount-1 do
begin

if table1.Fieldvalues['id'] = combobox1.text then
begin
exit;
end; // if

table1.next;

end;

end;


//*************************************************************** fecha
function GetFecha: String;
var
stSystemTime : TSystemTime;
aux,fecha: string;

begin
Windows.GetLocalTime( stSystemTime );
aux:=DateTimeToStr( SystemTimeToDateTime( stSystemTime ));

fecha:= aux[1]+aux[2]+aux[3]+aux[4]+aux[5]+aux[6]+aux[7]+aux[8]+aux[9]+aux[10];

Result:= fecha;
end;
//*************************



//****************************************************************
procedure TForm15.Button2Click(Sender: TObject);
var
aux: string;
veces,x,y,salto,i: integer;
aux2,turno,fechaS,horaE,horaS,llamadas, entrantes, salientes, minutos: string;
begin

veces:=0;
table2.close;
table2.open;
table2.first;

for i:=0 to Table2.RecordCount-1 do
begin

if table2.Fieldvalues['trabajador'] = dbtext1.Field.AsString then
begin

aux2:= datetostr(datetimepicker2.date);

if strtodate(aux2) = table2.Fieldvalues['fechaS'] then
begin

horaE:=table2.Fieldvalues['horaE'];
horaS:=table2.Fieldvalues['horaS'];
fechaS:=table2.Fieldvalues['fechaS'];
llamadas:=table2.Fieldvalues['llamadas'];
entrantes:=table2.Fieldvalues['entrantes'];
salientes:=table2.Fieldvalues['salientes'];
minutos:=table2.Fieldvalues['minutos'];
turno:=table2.Fieldvalues['turno'];
veces:=veces+1;

end;

end;

table2.next;

end;

if (veces=0) then
begin
showmessage('Este empleado no ha trabajado ese día.');
exit;
end;

//showmessage('Imprimiendo ...');


Printer.BeginDoc; // INICIO UN NUEVO DOCUMENTO
With Printer.canvas do //CON EL OBJETO PRINTER.CANVAS HAGO LO SIGUIENTE
Begin
//TITULO QUE APARECE EN LA COLA DE IMPRESION

Printer.Title := 'Impresión de Dia de Trabajo';
Font.Color := ClBlack; //LE ASIGNO UN COLOR A LA LETRA
Pen.Color := ClBlack; //COLOR DE LA LINE DE LOS RECUADROS
Font.Size := 12; //TAMAÑO DE LA LETRA
Font.Name := 'Times New Roman';





aux:= 'Alicante ' + datetostr(datetimepicker1.date);
Printer.Canvas.TextOut(1000,1000,aux);

x:=1500;
y:=2000;

aux:= 'Resumen de Día de Trabajo:';
Printer.Canvas.TextOut(x,y,aux);

x:=1500;
y:=y+800;

aux:= '- ID: ' + dbtext1.Field.AsString;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- NOMBRE: ' + dbtext2.Field.AsString;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- APELLIDOS: ' + dbtext3.Field.AsString + ' ' + dbtext4.Field.AsString;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- DIA: ' + datetostr(datetimepicker2.date);
Printer.Canvas.TextOut(x,y,aux);


y:=y+800;
aux:= '- TURNO: ' + turno;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- HORA ENTRADA: ' + horaE;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- HORA SALIDA: ' + horaS;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- NUM. LLAMADAS: ' + llamadas;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- NUM. LLAMADAS ENTRANTES: ' + entrantes;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- NUM. LLAMADAS SALIENTES: ' + salientes;
Printer.Canvas.TextOut(x,y,aux);

y:=y+300;
aux:= '- NUM. MINUTOS: ' + minutos;
Printer.Canvas.TextOut(x,y,aux);



y:=y+5000;
aux:= 'FIRMA CONFORME:';
Printer.Canvas.TextOut(x,y,aux);

end;

Printer.EndDoc;


end; // fin procedure

end.

crear un UNIT con las funciones globales de todos los formularios

// FORM1

unit Unit1;

interface

uses
(...), unit2; // unit2 es el unit de funciones

(...)

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
a: funciones; // 'a' es el objeto que creamos de la clase funciones

(...)


//**************************************************************
procedure TForm1.Button1Click(Sender: TObject);
begin
a.saludar('pablo'); // funcion de la clase funciones
end;


=========================================================================================================
=========================================================================================================
=========================================================================================================


unit Unit2;

interface


uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, CPort;

type

funciones = class

private
{ Private declarations }
public

procedure saludar(string dato);
procedure timer();
procedure RelojTimer(Sender: TObject);


end;

var
texto: string; // variable global en unit2
Reloj: ttimer;

implementation

//***************************************************************
procedure funciones.saludar(string dato);
begin
showmessage('hola'+dato);
end;

//***************************************************************
procedure funciones.timer();
begin

Reloj := TTimer.Create(Reloj);
Reloj.Interval:=2000; // cada 2 segundos
Reloj.Enabled:=true; // activo el Reloj
Reloj.OnTimer:= RelojTimer; // donde ira cuando pase el tiempo

end;

//***************************************************************
procedure funciones.RelojTimer(Sender: TObject);
begin
showmessage('esto es del reloj');
end;

crear dinamicamente un componente BOTON o TIMER

// boton y timer dinamico


(...)

procedure ClickBoton(Sender: TObject);
procedure RelojTimer(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Boton: TButton;
Reloj: TTimer;

(...)




//*************************************************
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
Boton := TButton.Create(Self);
Boton.Parent := Self;
Boton.Left := 100;
Boton.Top := 100;
Boton.Caption:='Pulsame';
Boton.Name := 'Boton';
Boton.OnClick:=ClickBoton;


Reloj := TTimer.Create(Self);
Reloj.Interval:=1000;
Reloj.Enabled:=true;
Reloj.OnTimer:= RelojTimer;
end;


//*************************************************
procedure TForm1.ClickBoton(Sender: TObject);
begin
showmessage('boton pulsado hola');
end;


//*************************************************
procedure TForm1.RelojTimer(Sender: TObject);
begin
showmessage('Reloj');
end;

Caracteres especiales control+Z

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (chr(Key) in ['Z', 'z']) then
ShowMessage('Ctrl-Z');
end;


//********** para mandar Control-Z en un socket seria
socket.send('hola'+^z)

Combobox

combobox1.Items.Clear; // vacia el combobox

combobox1.items.Add('hola'); // añade una linea al combo

combobox1.items.Count; // numero de lineas en el combo



para que el combo no se pueda editar a mano:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
poner la propiedad STYLE del combo a: opDownList

Apagar el ordenador

//***********
function MyExitWindows(RebootParam: Longword): Boolean;

//********** funcion que apagar el pc
function tform1.MyExitWindows(RebootParam: Longword): Boolean;
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
tpResult := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd);
if tpResult then
begin
tpResult := LookupPrivilegeValue(nil,
SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid);
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg);
pcbtpPreviousRequired := 0;
if tpResult then
Windows.AdjustTokenPrivileges(TTokenHd,
False,
TTokenPvg,
cbtpPrevious,
rTTokenPvg,
pcbtpPreviousRequired);
end;
end;
Result := ExitWindowsEx(RebootParam, 0);
end;


//***********************************
procedure TForm1.Button1Click(Sender: TObject);
begin
MyExitWindows(EWX_POWEROFF or EWX_FORCE);
end;