Bueno aquí mi pantalla de configuración, por desgracia no soy muy bueno haciendo las pantallas vistosas
Aquí el código del archivo pas 682 lineas
[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;
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.TabIndex<PGC.PageCount then 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.clubdelph...ead.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.[/DELPHI]
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
[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.[/DELPHI]
