/*Prog*/ Delphi-Neftalí /*finProg*/

{:Pasa un item de menú a la derecha de la pantalla.
Pasa un item de menú y todos los que hay a su derecha a la parte "derecha" de
la barra de menús del formulario.}
procedure MenuItemAtRight (MainMenu:TMainMenu; Position:Integer);
var
   Handle:HMENU;
   MenuItemInfo:TMenuItemInfo;
   Buffer: array[0..79] of char;
begin
   // Coger el handle del menu principal
   Handle := MainMenu.Handle;
 
   // Rellenar estructura
   FillChar (MenuItemInfo, SizeOf(TMenuItemInfo), 0);
   MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);
   MenuItemInfo.fMask := MIIM_TYPE;
   MenuItemInfo.dwTypeData := Buffer;
   MenuItemInfo.cch := SizeOf(Buffer);
 
   // No se puede obtener la informacion del item del menú ?
   if not GetMenuItemInfo(Handle, Position, True, MenuItemInfo) then begin
    // salir
    Exit;
   end;
 
   // Modificar el tipo de menú para ponerlo a la derecha
   MenuItemInfo.fType := MenuItemInfo.fType or MF_RIGHTJUSTIFY;
 
   // No se puede establecer informacion del item de menú
   if not SetMenuItemInfo (Handle, Position, True, MenuItemInfo) then begin
     Exit;
   end;
end;

// Para poner el tercer eleento y los siguientes:
MenuItemAtRight(Self.MainMenu1, 3);
// Para poner el último elemento:
MenuItemAtRight(Self.MainMenu1,
Windows.GetMenuItemCount(Self.MainMenu1.Handle)-1);

// Metodo 1 (*)
// Segun el tipo de componente...
if (comp is TEdit) then
  Result := TEdit(comp).Left;
else if (comp is TLabel) then
  Result := TLabel(comp).Left;
else if (comp is TButton) then
  Result := TButton(comp).Left;

{:Obtener la información de una propiedad a partir de la clase y el nombre;
Ademas devuelve la lista de todas las porpiedades de ese control.}
function GetRTTIControlInfo(AControl: TPersistent;
         propList:TStrings;  AProperty: string): PPropInfo;
var
   i: integer;
   props: PPropList;
   tData: PTypeData;
begin
   // Inicial
   Result := nil;
   // No asignado el control ==> Salimos
   if (AControl = nil) or (AControl.ClassInfo = nil) then begin
      Exit;
   end;
   // Obtener la información
   tData := GetTypeData(AControl.ClassInfo);
   // Tipo desconocido o sin propiedades ==> Salimos
   if (tData = nil) or (tData^.PropCount = 0) then
   	Exit;
    GetMem(props, tData^.PropCount * SizeOf(Pointer));
    try
   	GetPropInfos(AControl.ClassInfo, props);
 	for i := 0 to tData^.PropCount - 1 do begin
   		propList.Add(Props^[i]^.Name);
   		with Props^[i]^ do begin
    		  if (Name = AProperty) then begin
		   	result := Props^[i];
	   	  end;
   	        end;
   	end;
   finally
      FreeMem(props);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  pInfo: PPropInfo;
  propList:TStrings;
  PStr:String;
begin
 // Crear la lista
 propList := TStringList.Create();
 // protección para liberar
 try
 
  // Acceder a la info de la propiedad
  pInfo := GetRTTIControlInfo(Button1, propList, 'Left');
  // La prop. encontrada es de tipo integer (debería ser, ya que es la
  // prop. Left)
  if (pInfo.PropType^^.Kind in [tkInteger]) then begin
    // Obtener
    PStr:= 'Left' + ' = ' + Format('%d', [GetOrdProp(Button1, pInfo)]);
    // Mostrar
    MessageDlg(PStr, mtInformation, [mbOK], 0);
  end;
  // Rellenar la lista de propiedades
  Memo1.Lines.Assign(propList);
 finally
    FreeAndNil(propList);
 end;
end;

var
   Catalog : _Catalog;
   Table : _Table;
   BaseName : String;
   DS : String;
   col : _Column;
   key : _Key;
begin
   // Nombre de la Base de Datos
   BaseName := 'C:\Temp\MiBaseDatos.mdb';
   // Create a Catalog Object
   Catalog := CreateCOMObject(StringToGUID('ADOX.Catalog')) 
                  as  _Catalog;
   // Set the Connection String
   DS := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+BaseName;
   // Check if we already have such a file and delete it
   if FileExists(BaseName) Then begin
      DeleteFile(BaseName);
   end;
   // Create new Access database
   Catalog.Create(DS);
   // Create a Table Object
   Table := CreateCOMObject(StringToGUID('ADOX.Table')) as _Table;
   // Set the name of a table
   Table.Name := 'MiTabla';
   // Append Table into the base
   Catalog.Tables.Append(Table);
   // Now add two columns (fields) into the table
   // Both are Text fields up to 128 characters
   Table.Columns.Append('Nombre', adVarWChar, 128);
   Table.Columns.Append('Apellido', adVarWChar, 128);
   // Creamos el objeto columna para el autoIncremental
   col := CoColumn.Create;
   // BD a la que pertenece
   col.ParentCatalog := Catalog;
   col.Name := 'Auntoincremental';
   // Tipo del campo
   col.Type_ := adInteger;
   // Asignamos que es un AutoIncremental
   col.Properties['AutoIncrement'].Value := True;
   // Añadimos la columna
   Table.Columns.Append(col, adInteger, col.DefinedSize);
   // Columna para la clave primaria
   col := CoColumn.Create;
   // BD a la que pertenece
   col.ParentCatalog := Catalog;
   col.Name := 'ClavePrimaria';
   col.Type_ := adInteger;
   // Añadirla
   Table.Columns.Append(col, adInteger, col.DefinedSize);
   // Creamos la clave primaria
   Key := CoKey.Create;
   Key.Name := 'ClavePrimaria';
   Key.Type_ := adKeyPrimary;
   // Columna que forma parte de la PK
   Key.Columns.Append('ClavePrimaria', adInteger, 0 );
   // Añadirla a la tabla
   Table.Keys.Append(Key, 0, EmptyParam, Unassigned, Unassigned);

{:Elimina los saltos de línea (caracteres #10 y #13; salto de linea y salto
de carro) de un TStrings.}
function QuitarSaltosLinea(Strs: TStrings;  
                          CharReplace:String=STR_EMPTY):String;
var
   Str:string;
begin
   Str := AnsiReplaceStr(Strs.Text, #10, CharReplace);
   Result := AnsiReplaceStr(Str, #13, CharReplace);
end

const
  DATABASENAME = 'c:\temp\BaseDatosNueva.mdb';
var
  Catalog: _Catalog;
  ConnectionString:String;
begin
  // Create a Catalog Object
  Catalog := CreateCOMObject(StringToGUID('ADOX.Catalog')) as _Catalog;
  // Set the Connection String
  ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
                              'Data Source=' + DATABASENAME;
  try
    // Create new Access database
    Catalog.Create(ConnectionString);
  except
    on E:EOLEException do begin
      // Levantamos la excepción
      MessageDlg('Error al crear la Base de Datos; Mensaje:' +
      E.Message, mtError, [mbOK], 0);
    end;
  end;