Programa de gestión desde 0

[[José Luis Garcí]]

Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas

[[José Luis Garcí]]

Aquí la 1º parte del código del archivo pas 682 lineas

Código Delphi [-]
unit FConfi;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB,
  NewPanelDB, DBCtrls, Mask, MyDbIbMemo, GroupboxJL, TDbIbchkbox, DBCBEXT,
  ExtDlgs, SPBBC, IBDatabase, Clipbrd, ShellAPI, jpeg, DBColorComboBox;

//[ 1]----------------[ Para poder tener tabs del page control en color]--------
Type
  TTabSheet = class(ComCtrls.TTabSheet)
  private
    FColor: TColor;
    procedure SetColor(Value: TColor);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd);
      message WM_ERASEBKGND;
  public
    constructor Create(aOwner: TComponent); override;
    property Color: TColor read FColor write SetColor;
   end;
//[ 1]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

type
  TUConfi = class(TForm)
    PanelBotonera: TNewPanelDB;
    SBBarraStatus: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    PanelDatos: TNewPanelDB;
    PanelConfirmar: TNewPanelDB;
    DsPrincipal: TDataSource;
    SbNuevo: TSpeedButton;
    SbModificar: TSpeedButton;
    SbBorrar: TSpeedButton;
    SB_Salir: TSpeedButton;
    SBConfirmar: TSpeedButton;
    SBCancelar: TSpeedButton;
    Timer1: TTimer;
    PGC: TPageControl;
    Empresa: TTabSheet;
    Numeradores: TTabSheet;
    LOPD: TTabSheet;
    Label1: TLabel;
    DBEdit1: TDBEdit;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Label4: TLabel;
    DBEdit4: TDBEdit;
    Label5: TLabel;
    DBEdit5: TDBEdit;
    Label6: TLabel;
    DBEdit6: TDBEdit;
    Label7: TLabel;
    DBEdit7: TDBEdit;
    Label8: TLabel;
    DBImage1: TDBImage;
    Label9: TLabel;
    DBEdit8: TDBEdit;
    Label10: TLabel;
    DBEdit9: TDBEdit;
    Label11: TLabel;
    DBEdit10: TDBEdit;
    Label12: TLabel;
    DBEdit11: TDBEdit;
    Label13: TLabel;
    DBEdit12: TDBEdit;
    Label14: TLabel;
    DBEdit13: TDBEdit;
    Label15: TLabel;
    GroupBoxJL1: TGroupBoxJL;
    DBIBMemo1: TDBIBMemo;
    GroupBoxJL2: TGroupBoxJL;
    Label16: TLabel;
    DBEdit14: TDBEdit;
    Label17: TLabel;
    DBEdit15: TDBEdit;
    Label18: TLabel;
    DBEdit16: TDBEdit;
    Label19: TLabel;
    DBEdit17: TDBEdit;
    Label20: TLabel;
    DBEdit18: TDBEdit;
    Label21: TLabel;
    DBEdit19: TDBEdit;
    Label22: TLabel;
    DBEdit20: TDBEdit;
    Label23: TLabel;
    DBEdit21: TDBEdit;
    Label24: TLabel;
    DBEdit22: TDBEdit;
    Label25: TLabel;
    DBEdit23: TDBEdit;
    Label26: TLabel;
    DBEdit24: TDBEdit;
    Label27: TLabel;
    DBEdit25: TDBEdit;
    GroupBoxJL8: TGroupBoxJL;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    GroupBoxJL9: TGroupBoxJL;
    Label32: TLabel;
    DBEdit30: TDBEdit;
    Label33: TLabel;
    DBEdit31: TDBEdit;
    Label34: TLabel;
    DBEdit32: TDBEdit;
    DBIBMemo2: TDBIBMemo;
    DBIBMemo3: TDBIBMemo;
    DBIBMemo4: TDBIBMemo;
    GroupBoxJL5: TGroupBoxJL;
    Label53: TLabel;
    GroupBoxJL6: TGroupBoxJL;
    Label54: TLabel;
    DBEdit52: TDBEdit;
    DBIBCheckbox1: TDBIBCheckbox;
    DbComboBoxExt1: TDbComboBoxExt;
    Label35: TLabel;
    Label55: TLabel;
    Label56: TLabel;
    SpeedButtonBC1: TSpeedButtonBC;
    SpeedButtonBC2: TSpeedButtonBC;
    OpenDialog1: TOpenDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SpeedButtonBC3: TSpeedButtonBC;
    SpeedButtonBC4: TSpeedButtonBC;
    SpeedButtonBC5: TSpeedButtonBC;
    SpeedButtonBC6: TSpeedButtonBC;
    SpeedButtonBC7: TSpeedButtonBC;
    SpeedButtonBC8: TSpeedButtonBC;
    SpeedButtonBC9: TSpeedButtonBC;
    SpeedButtonBC10: TSpeedButtonBC;
    SpeedButtonBC11: TSpeedButtonBC;
    SpeedButtonBC12: TSpeedButtonBC;
    Panel3: TPanel;
    SpeedButtonBC15: TSpeedButtonBC;
    SpeedButtonBC16: TSpeedButtonBC;
    DBColorBox1: TDBColorBox;
    DBColorBox2: TDBColorBox;
    DBColorBox3: TDBColorBox;
    DBColorBox4: TDBColorBox;
    GroupBoxJL3: TGroupBoxJL;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    Label39: TLabel;
    Label40: TLabel;
    Label41: TLabel;
    Label42: TLabel;
    Label43: TLabel;
    Label44: TLabel;
    DBEdit26: TDBEdit;
    DBEdit27: TDBEdit;
    DBEdit28: TDBEdit;
    DBEdit29: TDBEdit;
    DBEdit33: TDBEdit;
    DBEdit34: TDBEdit;
    DBEdit35: TDBEdit;
    DBEdit36: TDBEdit;
    DBEdit37: TDBEdit;
    GroupBoxJL4: TGroupBoxJL;
    Label45: TLabel;
    Label46: TLabel;
    Label47: TLabel;
    Label48: TLabel;
    Label49: TLabel;
    Label50: TLabel;
    Label51: TLabel;
    Label52: TLabel;
    DBEdit38: TDBEdit;
    DBEdit39: TDBEdit;
    DBEdit40: TDBEdit;
    DBEdit41: TDBEdit;
    DBEdit42: TDBEdit;
    DBEdit43: TDBEdit;
    DBEdit44: TDBEdit;
    DBEdit45: TDBEdit;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure SbNuevoClick(Sender: TObject);
    procedure SbModificarClick(Sender: TObject);
    procedure SbBorrarClick(Sender: TObject);
    procedure SB_SalirClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SBCancelarClick(Sender: TObject);
    procedure SBConfirmarClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PGCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
    procedure SpeedButtonBC1Click(Sender: TObject);
    procedure SpeedButtonBC2Click(Sender: TObject);
    procedure SpeedButtonBC3Click(Sender: TObject);
    procedure SpeedButtonBC4Click(Sender: TObject);
    procedure SpeedButtonBC10Click(Sender: TObject);
    procedure SpeedButtonBC6Click(Sender: TObject);
    procedure SpeedButtonBC12Click(Sender: TObject);
    procedure SpeedButtonBC5Click(Sender: TObject);
    procedure SpeedButtonBC11Click(Sender: TObject);
    procedure SpeedButtonBC16Click(Sender: TObject);
    procedure SpeedButtonBC15Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  UConfi: TUConfi;
  IBT:TIBTransaction;

implementation

{$R *.dfm}

uses UDM,  //Modulo de Datos       ç
     Fun_Errores, //Libreria paramshform errores
     UMENU,     //Menu del programa y donde se encuentran las variables principales
     Fun;  //Librería de funciones varias  *


//[ 2]----------------[ Para poder tener tabs del page control en color]--------
constructor TTabSheet.Create(aOwner: TComponent);
//------------------------------------------------------------------------------
//*************************************[ Crear nueva propiedad tabsheet ]*******
//------------------------------------------------------------------------------
begin
  inherited;
  FColor := clBtnFace;
end;
//[ 2]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

//[ 3]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.SetColor(Value: TColor);
//------------------------------------------------------------------------------
//**************************************************[ Seleción de color ]*******
//------------------------------------------------------------------------------
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Invalidate;
  end;
end;
//[ 3]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

//[ 4]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
//------------------------------------------------------------------------------
//******************************************[ Dibujar en el pagecontrol ]*******
//------------------------------------------------------------------------------
begin
  if FColor = clBtnFace then
    inherited
  else
  begin
    Brush.Color := FColor;
    Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);
    Msg.Result := 1;
  end;
end;
//[ 4]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------

procedure TUConfi.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
    if Timer1.Enabled=false then Timer1.Enabled:=True;
    //Ponemos el Juego de colores de mis  NewPanelDB
    PanelBotonera.ColorNotActive:=COLORPANELACT;
    PanelBotonera.ActiveColor:=COLORPANELNOACT;
    PanelDatos.ActiveColor:=COLORPANELACT;
    PanelDatos.ColorNotActive:=COLORPANELNOACT;
    PanelConfirmar.ActiveColor:=COLORPANELACT;
    PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
    //Ponemos el Juego de colores de mi  DbComboBoxExt
    DbComboBoxExt1.ColorA:=COLOR1GRID;
    DbComboBoxExt1.ColorB:=COLOR2GRID;
end;

procedure TUConfi.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*************************************************[ Al Cerrarse El Form ]******
// Cerramos todos los procesos para que no consuman memoria y posibles errores
//------------------------------------------------------------------------------
begin
   if Timer1.Enabled=true then  Timer1.Enabled:=False;
end;

procedure TUConfi.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
    {Cosas que queremos que haga según se inicie el Form}
//[ 5]----------------------------[ Tabs de page control en color ]-------------

    Empresa.Color:=clMoneyGreen;      //verde pastel
    Numeradores.Color:=clSkyBlue;     //Azul Pastel
    LOPD.Color:=clInfoBk;            //Amarillo pastel
//[ 5]--FIN SECCIÓN---------------[ Tabs de page control en color ]-------------
    PGC.ActivePageIndex:=0;
end;

procedure TUConfi.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[  Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
    if (Key = #13) then {Si se ha pulsado enter }
    if (ActiveControl is TEdit)
    or (ActiveControl is TDBEdit)
    or (ActiveControl is TDBComboBox) then
    begin
      Key := #0; { anula la puulsación }
      Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
    end
end;

procedure TUConfi.FormPaint(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ Paint ]****
//  Para arregar un fallo en la fase de diseño
//------------------------------------------------------------------------------
begin
    //Me aseguro de que coja el color de l fondo, no se porque se desactiva en el componente,
    //Tambien podria igualarlo por el color directamente
    GroupBoxJL1.ParentBackground:=True;
    GroupBoxJL2.ParentBackground:=True;
    GroupBoxJL3.ParentBackground:=True;
    GroupBoxJL4.ParentBackground:=True;
    GroupBoxJL5.ParentBackground:=True;
    GroupBoxJL6.ParentBackground:=True;
    GroupBoxJL8.ParentBackground:=True;
    GroupBoxJL9.ParentBackground:=True;
end;

procedure TUConfi.PGCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
  const Rect: TRect; Active: Boolean);
//------------------------------------------------------------------------------
//************************************************[ COLORES PAGECONTROL ]*******
//------------------------------------------------------------------------------
var
//[ 6]----------------[ Para poder tener tabs del page control en color]--------
  AText: string;
  APoint: TPoint;
//[ 6]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
begin

//[ 7]----------------[ Para poder tener tabs del page control en color]--------
  with (Control as TPageControl).Canvas do
  begin
    Brush.Color := ClGreen;
    FillRect(Rect);
    AText := TPageControl(Control).Pages[TabIndex].Caption;
    with Control.Canvas do
    begin
      APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
      APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
      TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
    end;
  end;
//[ 7]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
end;

procedure TUConfi.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
var VarINumRegistros:Integer;
begin                                //Cambiar por el mensaje elegido
   if not DsPrincipal.DataSet.IsEmpty then
   begin
      VarINumRegistros:=DsPrincipal.DataSet.RecordCount;
      if VarINumRegistros>1 then
      begin
         if (MessageBox(0, '¿Esta seguro  de eliminar el registro actual?', 'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
         else begin
           DSPrincipal.DataSet.Delete;
           ShowMessage('El registro ha sido eliminado');
           IBT.CommitRetaining;
         end;
      end else
      begin
         if (MessageBox(0, 'sólo existe el registro actual de configuración, ¿esta seguro de querer eliminarlo?', 'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
         else begin
             DSPrincipal.DataSet.Delete;
             ShowMessage('El registro ha sido eliminado');
             IBT.CommitRetaining;
         end;
      end;
   end else ShowMessage('No hay registros que poder borrar');
end;

procedure TUConfi.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Cancel;
end;

procedure TUConfi.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
  try
    DSPrincipal.DataSet.Post;
    //Ajuastamos los colores de las variables
    COLOR1GRID:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORA').AsString);
    COLOR2GRID:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORB').AsString);
    COLORPANELACT:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORACTIVO').AsString);
    COLORPANELNOACT:=StringToColor(DsPrincipal.DataSet.FieldByName('COLORNOACTIVO').AsString);
  except
    on E: Exception do
    begin
        MessageBeep(1000);
        ShowMessage('Se ha producido un error y el proceso no se ha podido terminar   Unidad:[ FConfi ]   Modulo:[ Grabar ]' + Chr(13) + Chr(13)
                  + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                  + 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
                  + '    '+Chr(13) + Chr(13)
                  + 'El proceso ha quedado interrumpido');
        DSPrincipal.DataSet.Cancel;
    end;
  end;
end;

procedure TUConfi.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
   if DsPrincipal.DataSet.IsEmpty<>true then
   begin
      DSPrincipal.DataSet.Edit;
      DBEdit1.SetFocus;
   end else ShowMessage('No hay tregistros disponibles para editar')

end;

procedure TUConfi.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
  DSPrincipal.DataSet.Insert;
  //Nos aseguramos de que los DBIMEMOS esten vacios
  DBIBMemo1.Lines.Clear;
  DBIBMemo2.Lines.Clear;
  DBIBMemo3.Lines.Clear;
  DBIBMemo4.Lines.Clear;
  DBEdit1.SetFocus;
end;

procedure TUConfi.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
   UConfi.Close;
end;

[[José Luis Garcí]]

Aquí la 2º parte del código del archivo pas 682 lineas


Aquí el código del archivo pas 682 lineas

Código Delphi [-]

procedure TUConfi.SpeedButtonBC10Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo4.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;


procedure TUConfi.SpeedButtonBC11Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD3').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC12Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo2.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC15Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************[ Page Control pestaña anterior ]****
//------------------------------------------------------------------------------
begin
  if PGC.TabIndex>0 then PGC.TabIndex:=PGC.TabIndex-1;
end;

procedure TUConfi.SpeedButtonBC16Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************[ Page Control siguiente pestaña ]****
//------------------------------------------------------------------------------
begin
  if PGC.TabIndexthen PGC.TabIndex:=PGC.TabIndex+1;
end;

procedure TUConfi.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  if OpenPictureDialog1.Execute then
  begin
     DBImage1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Botón pegar ]******
//  código bajado de http://www.clubdelphi.com/foros/showthread.php?t=57360
//  Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit   Clipbrd, jpeg, ShellAPI
//------------------------------------------------------------------------------
var
  f    : TFileStream;
  Jpg  : TJpegImage;
  Hand : THandle;
  Buffer    : Array [0..MAX_PATH] of Char;
  numFiles  : Integer;
  File_Name : String;
  Jpg_Bmp   : String;
  BitMap    : TBitMap;
  ImageAux  : TImage;

begin

  ImageAux := TImage.Create(Self);

  if Clipboard.HasFormat(CF_HDROP) then begin

    Clipboard.Open;
    try
      Hand := Clipboard.GetAsHandle(CF_HDROP);
      If Hand <> 0 then begin
        numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ;       //Unit ShellApi
        if numFiles > 1 then begin
          Clipboard.Close;
          ImageAux.Free;
          Errorx('Pegar-1','Ingredientes','Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
          Exit;
        end;
        Buffer[0] := #0;
        DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
        File_Name := buffer;
      end;
    finally
      Clipboard.close;
    end;

    f      := TFileStream.Create(File_Name, fmOpenRead);
    Jpg    := TJpegImage.Create;
    Bitmap := TBitmap.Create;

    // Check if Jpg File
    try
      Jpg.LoadFromStream(f);
      ImageAux.Picture.Assign(Jpg);
      Jpg_Bmp := 'JPG';
    except
      f.seek(0,soFromBeginning);
      Jpg_Bmp := '';
    end;

    if Jpg_Bmp = '' then begin
      try
        Bitmap.LoadFromStream(f);
        Jpg.Assign(Bitmap);
        ImageAux.Picture.Assign(Jpg);
        Jpg_Bmp := 'BMP';
      except
        Jpg_Bmp := '';
      end;
    end;

    Jpg.Free;
    Bitmap.Free;
    f.Free;

    if Jpg_Bmp = '' then begin
      ImageAux.Free;
      Errorx('Pegar-2','Ingredientes','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
      Exit;
    end;

  end
  else if Clipboard.HasFormat(CF_BITMAP) then
    ImageAux.Picture.Assign(Clipboard)
  else begin
    ImageAux.Free;
    Errorx('Pegar-3','Ingredientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Exit;
  end;

  Jpg := TJpegImage.Create;
  try
    Jpg.Assign(ImageAux.Picture.Graphic);
  except
    ImageAux.Free;
    Errorx('Pegar-4','Ingredientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
    Jpg.Free;
    Exit;
  end;
  Jpg.Free;
  DBImage1.Picture.Assign(ImageAux.Picture);
end;

procedure TUConfi.SpeedButtonBC3Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD1').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC4Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo1.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.SpeedButtonBC5Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pegar Texto ]****
// Pegamos del clipboard el texto
//------------------------------------------------------------------------------
begin
  DsPrincipal.DataSet.FieldByName('XLDPD2').Value:=Clipboard.AsText;
end;

procedure TUConfi.SpeedButtonBC6Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga texto ]****
//------------------------------------------------------------------------------
begin
  if OpenDialog1.Execute then
  begin
     DBIBMemo3.Lines.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TUConfi.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ El evento del Timer ]******
//------------------------------------------------------------------------------
begin
  SBBarraStatus.Panels[2].Text:=TimeToStr(now);
  if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;

end.

[[José Luis Garcí]]

y por último los componente usados.

He usado componentes estándar excepto , NewPAnelDb, SpeedButtonBC, GroupBoxJL, DbComboBoxExt, DBIBCheckbox, DBIBMemo que ya los he subido al club en su momento y que son gratuitos, pro último esta el DBColorBox que lo he creado esta tarde y que pongo su código a continuación

Componente DBColorBox

Código Delphi [-]
unit DBColorComboBox;

interface

uses
    WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, DbTables, DB, ExtCtrls, DBCtrls;

type
  TDBColorBox = class(TColorBox)
  private
    FDataLink : TFieldDataLink;
    procedure AutoInitialize;
    procedure AutoDestroy;
    function GetDataField : String;
    procedure SetDataField(Value : String);
    function GetDataSource : TDataSource;
    procedure SetDataSource(Value : TDataSource);
    procedure ActiveChange(Sender : TObject);
    procedure DataChange(Sender : TObject);
    procedure EditingChange(Sender : TObject);
    procedure UpdateData(Sender : TObject);
  protected
    procedure Change; override;
    procedure Click; override;
    procedure KeyPress(var Key : Char); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property DataField :     String     read GetDataField         write SetDataField;
    property DataSource : TDataSource read GetDataSource         write SetDataSource;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [TDBColorBox]);
end;


procedure TDBColorBox.ActiveChange(Sender: TObject);
const IntFieldTypes = [ftSmallInt, ftInteger, ftWord];
begin
     if DataField = '' then Exit;
     if FDataLink <> nil then
        if FDataLink.Dataset <> nil then
           if FDataLink.Dataset.Active then  TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString);
end;

procedure TDBColorBox.AutoDestroy;
begin
     FDataLink.Free;
end;

procedure TDBColorBox.AutoInitialize;
begin
     FDataLink := TFieldDataLink.Create;
     with FDataLink do
     begin
          OnDataChange := DataChange;
          OnUpdateData := UpdateData;
          OnEditingChange := EditingChange;
          OnActiveChange := ActiveChange;
     end;
end; { of AutoInitialize }

procedure TDBColorBox.Change;
begin
     inherited Change;
end;

procedure TDBColorBox.Click;
begin
     if DataField = '' then Exit;
     if FDataLink <> nil then
        if FDataLink.Dataset <> nil then
           if FDataLink.Dataset.Active then
              if FDataLink.Dataset.State in [dsEdit,dsInsert] then
              FDataLink.Dataset.FieldByName(DataField).Value:=ColorToString(TColorBox(Self).Selected);
     inherited Click;
end;

constructor TDBColorBox.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     AutoInitialize;
end;

procedure TDBColorBox.DataChange(Sender: TObject);
begin
     if FDataLink.Field = nil then
     begin
        { No field assigned }
     end else
     begin
         if FDataLink.Dataset.FieldByName(DataField).AsString <> '' then  TColorBox(Self).Selected:=StringToColor(FDataLink.Dataset.FieldByName(DataField).AsString)
                                                                   else  TColorBox(Self).Selected:=clBlack;
     end
end;

destructor TDBColorBox.Destroy;
begin
     AutoDestroy;
     inherited Destroy;
end;

procedure TDBColorBox.EditingChange(Sender: TObject);
begin
      {...}
end;

function TDBColorBox.GetDataField: String;
begin
     Result := FDataLink.FieldName;
end;

function TDBColorBox.GetDataSource: TDataSource;
begin
      Result := FDataLink.DataSource;
end;

procedure TDBColorBox.KeyPress(var Key: Char);
const  TabKey = Char(VK_TAB);
       EnterKey = Char(VK_RETURN);
begin
     inherited KeyPress(Key);
end;

procedure TDBColorBox.Loaded;
begin
     inherited Loaded;
end;

procedure TDBColorBox.SetDataField(Value: String);
begin
      FDataLink.FieldName := Value;
end;

procedure TDBColorBox.SetDataSource(Value: TDataSource);
begin
      FDataLink.DataSource := Value;
end;

procedure TDBColorBox.UpdateData(Sender: TObject);
begin
//    FDataLink.Dataset.FieldByName(DataField).Value:=ColorToString(TColorBox(Self).Selected);
end;

end.

[mamcx]

Serie bueno que este tipo de cosas las pongan en un repositorio de codigo fuente. Un foro no es muy bueno pa mostar mas que unas cuantas lineas de codigo.

Te recomiendo github (git), bitbucket (git, mercurial) google (git, mercurial, subversion). Los 2 primeros son mas populares y mejores caracteristicas. Ademas, gratis.

Si no te interesa porque mucha vuelta usar git o mercurial, usa :

https://gist.github.com/

Que puedes postear multiples archivos en un solo gist, y es solo copiar y pegar el contenido. Ej:

https://gist.github.com/mamcx/3777791

P.D: No retrae de actualizar el foro, pero ftp y codigo esparcido es taan siglo XX

[[José Luis Garcí]]

Gracias mamcx, vere los enlaces que de dices.

[Casimiro Notevi]

Empezado por José Luis Garcí

Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas

A mi me parecen bien, y a quien no le guste, que la cambie

[mamcx]

Eso es una queja constante entre programadores (no ser bueno en diseño). Pero ahora es mas facil que nunca dotar de una interface atractiva los programas. Una forma es usando un GUI Pack:

http://graphicriver.net/search?utf8=...&term=gui+pack

Y seguir las guis de buen diseño de apps, como la interface humana de Apple - que igual es aplicable a otras plataformas-.

Tambien se pueden copiar ideas de frameworks como http://twitter.github.io/bootstrap/. Con el nuevo estilo de "apps planas" que es la forma mas barata y directa de hacer un diseño "facil" no es complicado:

http://dribbble.com/search?q=flat+gui

Y con un conjunto de iconos decente (hay muchos iconos gratis como http://www.webappers.com/category/design/icons/ y de pago (estos los compre) http://www.iconshock.com) estamos casi listos.

[Casimiro Notevi]

Pero esas cosas no sirven para delphi, ¿no?

[mamcx]

Y porque no van a servir? Son solo graficos (pngs por ejemplo) e ideas para inspirarse. No es muy dificil de lograr una pantalla atractiva si se piensa en capas y se ajustan las cosas.

[PepeLolo]

Para la interface es cuestión de mirar aplicaciones y ver las partes que estéticamente quedan bien. Colores, agrupaciones, estilos, etc, cuestión de fisgar mucho.
Un ejercicio muy bueno es dibujar en papel lo que se quiere. No es necesario toda la interface de golpe sino lo repetitivo, ejemplo:
- Como voy a distribuir los botones de navegación y de acciones y donde colocarlos. Pues se pintan estos en un papel, se recortan y se reservan.
- Datos grupales, ejemplo "Dirección", los Pinto, los recorto y se reservan.
- Asi con cada grupo de botones, elementos, etc.

Cuando ya tienes un grupo de elementos habituales de la interface, sólo es cuestión de colocarlos sobre una superficie lisa y empezar a moverlos para ver como quedan mejor y seguir esa línea de trabajo.

Los recordables hacen mucho bien cuando no eres un manitas con el diseño.

[[José Luis Garcí]]

Primero disculparme por el retraso, pero debido a un problema en el apartado de configuración de un programa y a los dos componentes que ya he puesto aquí, no he podido seguir adecuadamente con el programa, en primer lugar un cambio en Data Module, quedando el código al final de la siguiente manera;

Código Delphi [-]
 //Primero añadimos las llamadas

    procedure conectar;
    procedure DataModuleCreate(Sender: TObject);

//y luego el código

implementation

{$R *.dfm}

procedure TDM.conectar;
//------------------------------------------------------------------------------
//**************************************************************[ Conectar ]****
//Nos permite conectar las tablas, querrys + IBDatabase + IBTransaction
//------------------------------------------------------------------------------
begin
   IBDatabase1.Connected:=True;            //La base de datos
  IBTransaction1.Active:=True;  //Las Tansacciones
   IBDCLIEN.Active:=True;        //La tabla Clientes
   IBDirecciones.Active:=True;   //La tabla Direcciones
   IBDPC.Active:=True;           //La tabla Personas de Contacto
   IBDContacto.Active:=True;     //La Tabla de datos de contacto
   IBDBcos.Active:=True;         //La tabla de Bancos
   IBDCONFI.Active:=True;        //La tabla de Configuración
   IBDUSUA.Active:=True;         //La tabla de usuarios (permisos de acceso)
end;

procedure TDM.DataModuleCreate(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************************[ Al crearse ]****
// 1º Debemos irnoa l menú de Delphi a  Project > View Source y arir el proyecto
// 2º Según tengamos la carga del proyecto ponemos el modulo de datos el primero
// Con esto conseguimos la carga de la base de datos este ok
//------------------------------------------------------------------------------
begin
   VarBPrimeraConeccion:=False;        //Para sólo la primera conección con la base de datos
   IBDatabase1BeforeConnect(Sender);
end;

procedure TDM.IBDatabase1BeforeConnect(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Antes de conectar ]****
// Cogemos la ruta del Ejecutable
//------------------------------------------------------------------------------
var Ruta:string;
    VarBPaso:Boolean;
begin
    VarBPaso:=false;
    if VarBPrimeraConeccion=False then
    begin
      Ruta:=ExtractFilePath(Application.ExeName);    //Sacamos la ruta
      if FileExists(Ruta+ 'PGF2.FDB') then
      begin
         IBDatabase1.DatabaseName:=ruta + 'PGF2.FDB';
         VarBPaso:=True;
      end else
      begin
         if FileExists(ruta+'bd\'+'PGF2.FDB') then
         begin
           IBDatabase1.DatabaseName:=Ruta+'bd\' + 'PGF2.FDB';
           VarBPaso:=True;
         end else Showmessage('Lo sentimos pero no encontramos el archivo PGF.FDB, donde se encuentra el ejecutable, o en la capeta BD de la ubicación del Ejecutable'+#13+#10+'La Aplicación se cerrara');
      end;
   //   ShowMessage(IBDatabase1.DatabaseName);
      VarBPrimeraConeccion:=True;
      if VarBPaso then conectar                 //si encontro la B.D. Activa el conjunto
                  else Application.Terminate;   //Si no la encontro sale del programa
   end;
end;
end.

Ahora las tablas (las dejo como estaban pues supone cambiar todo el código, las que tenga que hacer nuevas ya aplicare los sabios concejos de los compañeros)

CREATE TABLE CLIENTES (
ID INTEGER NOT NULL,
NOMMODULO T20 /* T20 = VARCHAR(20) */, //Nombre del módulo*
CODIGO T20 /* T20 = VARCHAR(20) */, //Código asignado en este Módulo
NOMBRE T80 /* T80 = VARCHAR(80) */, //Nombre del cliente
FORMAPAGO T40 /* T40 = VARCHAR(40) */, //Forma de pago
FECHAALTA DATE, //Fecha de alta
DTO NUMERIC(15,4), //Dto máximo a aplicar (1)
NOTAS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */, //Campo memo para notas (se podría poner en una tabla independiente)
IMG IMG /* IMG = BLOB SUB_TYPE 0 SEGMENT SIZE 80 */, //Campo Imagen (se podría poner en una tabla independiente)
IMPUESTOS LOG /* LOG = CHAR(1) */, //Aplicar impuestos en nuestro caso sería S o N
TIPOIMP INTEGER, //Tipo de impuesto vinculado a La tabla de configuración
CIF T20 /* T20 = VARCHAR(20) */, //C.I.F., N.I.F. etc. (no ponemos comprobador, para que funcione con otros tipos de documentos)
RET LOG /* LOG = CHAR(1) */, //Usar la retenciones en nuestro caso sería S o N
PORRET POR /* POR = NUMERIC(15,4) */, //Porcentaje de retenciones vinculado a La tabla de configuración
TARIFA T20 /* T20 = VARCHAR(20) */, //Que tarifa de precios aplicaremos de la tabla artículos
USARRAPEL LOG /* LOG = CHAR(1) */, //Usar Rapel, si el cliente usa albaranes, sumaremos los artículos del código y se aplica el precio según el rapel
DIASPRESENT T20 /* T20 = VARCHAR(20) */, //Días de presentación de la factura/s
DIASDECOBRO T20 /* T20 = VARCHAR(20) */, //Días de cobro de la factura/s
AVISOS MEMO /* MEMO = BLOB SUB_TYPE 1 SEGMENT SIZE 80 */, //Campo memo para avisos (se podría poner en una tabla independiente) a la hora de facturar
LIMITECREDITO POR /* POR = NUMERIC(15,4) */, // Limite de crédito que asignamos, si lo sobrepasa nos avisa
PENDIENTEPAGO POR /* POR = NUMERIC(15,4) */, //El pendiente actual de crédito que tiene dispuesto
SECTOR T20 /* T20 = VARCHAR(20) */, //Sector que tipo de sector de trabaja (Hostelería, Automoción, etc)
CODAGENTE T20 /* T20 = VARCHAR(20) */ //Código del Agente (Comercial) asignado
);