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;
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;
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
public
end;
var
UConfi: TUConfi;
IBT:TIBTransaction;
implementation
{$R *.dfm}
uses UDM, Fun_Errores, UMENU, Fun;
constructor TTabSheet.Create(aOwner: TComponent);
begin
inherited;
FColor := clBtnFace;
end;
procedure TTabSheet.SetColor(Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Invalidate;
end;
end;
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
if FColor = clBtnFace then
inherited
else
begin
Brush.Color := FColor;
Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);
Msg.Result := 1;
end;
end;
procedure TUConfi.FormActivate(Sender: TObject);
begin
if Timer1.Enabled=false then Timer1.Enabled:=True;
PanelBotonera.ColorNotActive:=COLORPANELACT;
PanelBotonera.ActiveColor:=COLORPANELNOACT;
PanelDatos.ActiveColor:=COLORPANELACT;
PanelDatos.ColorNotActive:=COLORPANELNOACT;
PanelConfirmar.ActiveColor:=COLORPANELACT;
PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
DbComboBoxExt1.ColorA:=COLOR1GRID;
DbComboBoxExt1.ColorB:=COLOR2GRID;
end;
procedure TUConfi.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Timer1.Enabled=true then Timer1.Enabled:=False;
end;
procedure TUConfi.FormCreate(Sender: TObject);
begin
Empresa.Color:=clMoneyGreen; Numeradores.Color:=clSkyBlue; LOPD.Color:=clInfoBk; PGC.ActivePageIndex:=0;
end;
procedure TUConfi.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key = #13) then
if (ActiveControl is TEdit)
or (ActiveControl is TDBEdit)
or (ActiveControl is TDBComboBox) then
begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0);
end
end;
procedure TUConfi.FormPaint(Sender: TObject);
begin
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);
var
AText: string;
APoint: TPoint;
begin
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;
end;
procedure TUConfi.SbBorrarClick(Sender: TObject);
var VarINumRegistros:Integer;
begin 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);
begin
DSPrincipal.DataSet.Cancel;
end;
procedure TUConfi.SBConfirmarClick(Sender: TObject);
begin
try
DSPrincipal.DataSet.Post;
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);
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);
begin
DSPrincipal.DataSet.Insert;
DBIBMemo1.Lines.Clear;
DBIBMemo2.Lines.Clear;
DBIBMemo3.Lines.Clear;
DBIBMemo4.Lines.Clear;
DBEdit1.SetFocus;
end;
procedure TUConfi.SB_SalirClick(Sender: TObject);
begin
UConfi.Close;
end;