unit uBaseForm; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Buttons, Vcl.Grids, Vcl.DBGrids, uDBGridHelper, Vcl.ComCtrls, uUIAutoScaler, Data.DB, System.Rtti, System.UITypes, System.TypInfo; type TDBGrid = class(Vcl.DBGrids.TDBGrid) private FLastSortColumn: string; FLastSortDirection: string; protected procedure ColWidthsChanged; override; procedure KeyPress(var Key: Char); override; procedure TitleClick(Column: TColumn); override; end; TfrmBase = class(TForm) pnlToolbar: TPanel; pnlHeader: TPanel; pnlMain: TPanel; pnlFooter: TPanel; pnlSideToolbar: TPanel; // Top Toolbar Buttons btnGuardar: TBitBtn; btnCancelar: TBitBtn; btnAnadir: TBitBtn; btnEliminar: TBitBtn; btnPrimero: TBitBtn; btnAnterior: TBitBtn; btnSiguiente: TBitBtn; btnUltimo: TBitBtn; btnModificar: TBitBtn; btnBuscar: TBitBtn; btnImprimir: TBitBtn; btnIA: TBitBtn; btnDuplicar: TBitBtn; btnRect: TBitBtn; btnAyuda: TBitBtn; btnSalir: TBitBtn; // Side Toolbar Buttons (Details) btnNuevoArticulo: TBitBtn; btnEliminaArticulo: TBitBtn; btnBuscarArticulo: TBitBtn; btnExcel: TBitBtn; // Main Components pgcDetails: TPageControl; tsDatosEnvio: TTabSheet; dbgItems: TDBGrid; TsListado: TTabSheet; procedure FormCreate(Sender: TObject); procedure btnAyudaClick(Sender: TObject); procedure btnImprimirClick(Sender: TObject); virtual; procedure FormResize(Sender: TObject); procedure btnSalirClick(Sender: TObject); procedure btnAnadirClick(Sender: TObject); procedure btnModificarClick(Sender: TObject); procedure btnEliminarClick(Sender: TObject); procedure btnPrimeroClick(Sender: TObject); procedure btnAnteriorClick(Sender: TObject); procedure btnSiguienteClick(Sender: TObject); procedure btnUltimoClick(Sender: TObject); protected procedure Loaded; override; procedure KeyPress(var Key: Char); override; procedure dbgItemsDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); procedure DoShow; override; function HasUnsavedChanges: Boolean; virtual; function IsNewRecord: Boolean; virtual; function GetHelpText: string; virtual; procedure UpdateActions; override; procedure UpdateActionButtonsState; virtual; procedure DoCancelar; virtual; procedure ResetChangeTracking; procedure ResetModifiedState; procedure ControlChanged(Sender: TObject); procedure DBComboBoxChanged(Sender: TObject); virtual; // Virtual actions procedure DoAnadir; virtual; procedure DoModificar; virtual; procedure DoEliminar; virtual; procedure DoPrimero; virtual; procedure DoAnterior; virtual; procedure DoSiguiente; virtual; procedure DoUltimo; virtual; procedure DoDuplicar; virtual; private FChildSaveClick: TNotifyEvent; FIsAutoSaving: Boolean; FInitialControlStates: TStringList; FSavedAnyChanges: Boolean; FLastSortColumn: string; FLastSortDirection: string; procedure btnGuardarClick(Sender: TObject); procedure btnCancelarClick(Sender: TObject); procedure btnDuplicarClick(Sender: TObject); procedure CaptureInitialStates; procedure dbgItemsTitleClick(Column: TColumn); procedure ApplyUpperCaseToEdits; public { Public declarations } procedure AdjustFormWidthToGrid(AGrid: TDBGrid); destructor Destroy; override; function CloseQuery: Boolean; override; end; var frmBase: TfrmBase; implementation uses System.IniFiles, uAppTheme, FireDAC.Comp.DataSet, frm_PrintOptions, Vcl.DBCtrls; type TCustomEditAccessor = class(TCustomEdit); TCustomComboBoxAccessor = class(TCustomComboBox); {$R *.dfm} { TDBGrid } procedure TDBGrid.ColWidthsChanged; var LForm: TCustomForm; begin inherited ColWidthsChanged; LForm := GetParentForm(Self); if Assigned(LForm) and (LForm is TfrmBase) then begin TfrmBase(LForm).AdjustFormWidthToGrid(Self); end; end; procedure TDBGrid.KeyPress(var Key: Char); begin if (Key = '.') and (FormatSettings.DecimalSeparator = ',') then begin if (SelectedField <> nil) and (SelectedField is TNumericField) then Key := ','; end else if (Key = ',') and (FormatSettings.DecimalSeparator = '.') then begin if (SelectedField <> nil) and (SelectedField is TNumericField) then Key := '.'; end; inherited KeyPress(Key); end; procedure TDBGrid.TitleClick(Column: TColumn); var LDataSet: TDataSet; Context: TRttiContext; RType: TRttiType; Prop: TRttiProperty; SortStr: string; begin inherited TitleClick(Column); // If a custom handler is assigned, we skip automatic sorting to avoid conflicts if Assigned(OnTitleClick) then Exit; if (DataSource = nil) or (DataSource.DataSet = nil) then Exit; LDataSet := DataSource.DataSet; if not LDataSet.Active then Exit; Context := TRttiContext.Create; try RType := Context.GetType(LDataSet.ClassType); Prop := RType.GetProperty('IndexFieldNames'); if Assigned(Prop) and (Prop.Visibility in [System.TypInfo.mvPublic, System.TypInfo.mvPublished]) then begin if FLastSortColumn = Column.FieldName then begin if FLastSortDirection = 'A' then FLastSortDirection := 'D' else FLastSortDirection := 'A'; end else begin FLastSortColumn := Column.FieldName; FLastSortDirection := 'A'; end; if FLastSortDirection = 'D' then SortStr := Column.FieldName + ':D' else SortStr := Column.FieldName + ':A'; Prop.SetValue(LDataSet, SortStr); end; finally Context.Free; end; end; procedure TfrmBase.AdjustFormWidthToGrid(AGrid: TDBGrid); var i: Integer; TotalColWidth: Integer; GridClientDiff: Integer; LNewWidth: Integer; begin if (AGrid = nil) or not AGrid.Visible or not Showing then Exit; TotalColWidth := 0; for i := 0 to AGrid.Columns.Count - 1 do begin if AGrid.Columns[i].Visible then TotalColWidth := TotalColWidth + AGrid.Columns[i].Width; end; if TotalColWidth < 150 then Exit; // Prevenir encogimiento si no hay columnas definidas if dgIndicator in AGrid.Options then TotalColWidth := TotalColWidth + 15; TotalColWidth := TotalColWidth + 25; // Extra padding for borders and scrollbars GridClientDiff := TotalColWidth - AGrid.ClientWidth; if GridClientDiff <> 0 then begin LNewWidth := Self.ClientWidth + GridClientDiff; if LNewWidth < 800 then LNewWidth := 800; // Enforce minimum width of 800px to prevent squishing if LNewWidth < Screen.WorkAreaWidth then Self.ClientWidth := LNewWidth else Self.ClientWidth := Screen.WorkAreaWidth - 50; end; end; procedure TfrmBase.FormCreate(Sender: TObject); begin // Standard initialization for ERP forms pgcDetails.ActivePageIndex := 0; FSavedAnyChanges := False; TUIAutoScaler.RegisterForm(Self); end; procedure TfrmBase.Loaded; begin inherited Loaded; KeyPreview := True; if Assigned(dbgItems) then begin if not Assigned(dbgItems.OnDrawColumnCell) then dbgItems.OnDrawColumnCell := dbgItemsDrawColumnCell; if not Assigned(dbgItems.OnTitleClick) then dbgItems.OnTitleClick := dbgItemsTitleClick; end; // Bind standard buttons to VCL virtual action wrappers if Assigned(btnAnadir) then btnAnadir.OnClick := btnAnadirClick; if Assigned(btnCancelar) then btnCancelar.OnClick := btnCancelarClick; if Assigned(btnModificar) then btnModificar.OnClick := btnModificarClick; if Assigned(btnEliminar) and not Assigned(btnEliminar.OnClick) then btnEliminar.OnClick := btnEliminarClick; if Assigned(btnPrimero) then btnPrimero.OnClick := btnPrimeroClick; if Assigned(btnAnterior) then btnAnterior.OnClick := btnAnteriorClick; if Assigned(btnSiguiente) then btnSiguiente.OnClick := btnSiguienteClick; if Assigned(btnUltimo) then btnUltimo.OnClick := btnUltimoClick; if Assigned(btnDuplicar) then btnDuplicar.OnClick := btnDuplicarClick; if Assigned(btnImprimir) then btnImprimir.OnClick := btnImprimirClick; end; procedure TfrmBase.dbgItemsDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var Checked: Boolean; DrawRect: TRect; DrawState: Cardinal; Grid: TDBGrid; IsOddRow: Boolean; LText: string; LFlags: Cardinal; begin Grid := TDBGrid(Sender); // Aplicar color de fondo alterno si la fila no está seleccionada if not (gdSelected in State) then begin if Assigned(Grid.DataSource) and Assigned(Grid.DataSource.DataSet) and Grid.DataSource.DataSet.Active then IsOddRow := Odd(Grid.DataSource.DataSet.RecNo) else IsOddRow := False; if IsOddRow then Grid.Canvas.Brush.Color := TAppTheme.COLOR_GRID_ROW_ODD else Grid.Canvas.Brush.Color := TAppTheme.COLOR_GRID_ROW_EVEN; end; if Assigned(Column.Field) and ((Column.Field is TBooleanField) or (Pos('activo', LowerCase(Column.Field.FieldName)) > 0) or (Pos('active', LowerCase(Column.Field.FieldName)) > 0) or (Pos('compartido', LowerCase(Column.Field.FieldName)) > 0) or (Pos('compartida', LowerCase(Column.Field.FieldName)) > 0) or (Pos('bloquear', LowerCase(Column.Field.FieldName)) > 0) or (Pos('bloqueado', LowerCase(Column.Field.FieldName)) > 0) or (Pos('asegurado', LowerCase(Column.Field.FieldName)) > 0) or (Pos('comprobado', LowerCase(Column.Field.FieldName)) > 0) or (Pos('consolidado', LowerCase(Column.Field.FieldName)) > 0) or (Pos('validado', LowerCase(Column.Field.FieldName)) > 0) or (Pos('puede_', LowerCase(Column.Field.FieldName)) > 0) or (Pos('permiso', LowerCase(Column.Field.FieldName)) > 0)) then begin Grid.Canvas.Font.Color := Grid.Canvas.Brush.Color; Grid.Canvas.FillRect(Rect); // Force boolean fields to have empty display values so they never render text if (Column.Field is TBooleanField) and (TBooleanField(Column.Field).DisplayValues <> ';') then TBooleanField(Column.Field).DisplayValues := ';'; if Column.Field is TBooleanField then Checked := Column.Field.AsBoolean else begin var LValInt: Integer; var LValStr := Trim(Column.Field.AsString); if TryStrToInt(LValStr, LValInt) then Checked := (LValInt <> 0) else Checked := SameText(LValStr, 'S') or SameText(LValStr, 'T') or SameText(LValStr, 'True') or SameText(LValStr, '1'); end; DrawRect := Rect; DrawRect.Left := Rect.Left + (Rect.Width - 14) div 2; DrawRect.Right := DrawRect.Left + 14; DrawRect.Top := Rect.Top + (Rect.Height - 14) div 2; DrawRect.Bottom := DrawRect.Top + 14; DrawState := DFCS_BUTTONCHECK; if Checked then DrawState := DrawState or DFCS_CHECKED; DrawFrameControl(Grid.Canvas.Handle, DrawRect, DFC_BUTTON, DrawState); end else if Assigned(Column.Field) and Column.Field.IsBlob then begin Grid.Canvas.FillRect(Rect); LText := Column.Field.AsString; DrawRect := Rect; InflateRect(DrawRect, -2, 0); LFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX; if Column.Alignment = taRightJustify then LFlags := LFlags or DT_RIGHT else if Column.Alignment = taCenter then LFlags := LFlags or DT_CENTER else LFlags := LFlags or DT_LEFT; DrawText(Grid.Canvas.Handle, PChar(LText), Length(LText), DrawRect, LFlags); end else begin Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State); end; end; procedure TfrmBase.KeyPress(var Key: Char); var LGrid: Vcl.DBGrids.TDBGrid; LField: TField; LControl: TControl; IsNumeric: Boolean; begin // Interceptar teclas de separador decimal para campos numéricos en DBGrid // (necesario cuando el inplace editor está activo ya que no propaga caracteres imprimibles al grid) if Assigned(ActiveControl) then begin LGrid := nil; if ActiveControl is Vcl.DBGrids.TDBGrid then LGrid := Vcl.DBGrids.TDBGrid(ActiveControl) else if (ActiveControl.Parent <> nil) and (ActiveControl.Parent is Vcl.DBGrids.TDBGrid) then LGrid := Vcl.DBGrids.TDBGrid(ActiveControl.Parent) else begin // Recorrer ascendentes por si hay anidamientos adicionales LControl := ActiveControl.Parent; while LControl <> nil do begin if LControl is Vcl.DBGrids.TDBGrid then begin LGrid := Vcl.DBGrids.TDBGrid(LControl); Break; end; LControl := LControl.Parent; end; end; if LGrid <> nil then begin LField := nil; if (LGrid.SelectedIndex >= 0) and (LGrid.SelectedIndex < LGrid.Columns.Count) then LField := LGrid.Columns[LGrid.SelectedIndex].Field; if LField = nil then LField := LGrid.SelectedField; if LField <> nil then begin IsNumeric := (LField is TNumericField) or (LField.DataType in [ftInteger, ftSmallint, ftWord, ftFloat, ftCurrency, ftBCD, ftAutoInc, ftLargeint, ftFMTBcd]); if IsNumeric then begin if (Key = '.') and (FormatSettings.DecimalSeparator = ',') then Key := ',' else if (Key = ',') and (FormatSettings.DecimalSeparator = '.') then Key := '.'; end; end; end; end; inherited KeyPress(Key); if Key = #13 then begin if Assigned(ActiveControl) then begin LGrid := nil; if ActiveControl is Vcl.DBGrids.TDBGrid then LGrid := Vcl.DBGrids.TDBGrid(ActiveControl) else if (ActiveControl.Parent <> nil) and (ActiveControl.Parent is Vcl.DBGrids.TDBGrid) then LGrid := Vcl.DBGrids.TDBGrid(ActiveControl.Parent) else begin LControl := ActiveControl.Parent; while LControl <> nil do begin if LControl is Vcl.DBGrids.TDBGrid then begin LGrid := Vcl.DBGrids.TDBGrid(LControl); Break; end; LControl := LControl.Parent; end; end; // Si estamos en un DBGrid o su editor inplace, pasar a la siguiente columna / grabar fila if LGrid <> nil then begin Key := #0; if LGrid.SelectedIndex < LGrid.Columns.Count - 1 then begin LGrid.SelectedIndex := LGrid.SelectedIndex + 1; end else begin if Assigned(LGrid.DataSource) and Assigned(LGrid.DataSource.DataSet) then begin if LGrid.DataSource.DataSet.State in [dsEdit, dsInsert] then LGrid.DataSource.DataSet.Post; end; LGrid.SelectedIndex := 0; end; Exit; end; // Exclude buttons, multi-line memos, and grids from Enter key navigation if (ActiveControl is TButton) or (ActiveControl is TBitBtn) or (ActiveControl is TCustomMemo) or (ActiveControl is TCustomGrid) then Exit; end; Key := #0; // Consume the key to prevent Windows warning beep Perform(WM_NEXTDLGCTL, 0, 0); // Advance focus to the next control in the tab order end; end; procedure TfrmBase.btnAyudaClick(Sender: TObject); begin ShowMessage(GetHelpText); end; function TfrmBase.GetHelpText: string; var LBaseDir, LIniPath, LNetworkPath, LHelpFilePath: string; LIni: TIniFile; LHelpLines: TStringList; I: Integer; const LocalSearchPaths: array[0..3] of string = ( 'help\', '..\help\', '..\..\help\', '..\..\..\help\' ); begin Result := ''; LBaseDir := ExtractFilePath(ParamStr(0)); LIniPath := LBaseDir + 'db_config.ini'; // 1. Intentar cargar desde el Servidor de Red Local (Prioridad Alta) if FileExists(LIniPath) then begin LIni := TIniFile.Create(LIniPath); try LNetworkPath := LIni.ReadString('Help', 'NetworkPath', ''); if LNetworkPath <> '' then begin LNetworkPath := IncludeTrailingPathDelimiter(LNetworkPath); LHelpFilePath := LNetworkPath + Self.ClassName + '.txt'; if DirectoryExists(LNetworkPath) and FileExists(LHelpFilePath) then begin LHelpLines := TStringList.Create; try LHelpLines.LoadFromFile(LHelpFilePath, TEncoding.UTF8); Result := LHelpLines.Text; Exit; finally LHelpLines.Free; end; end; end; finally LIni.Free; end; end; // 2. Fallback: Buscar en cascada en las carpetas locales (Prioridad Baja/Offline) for I := Low(LocalSearchPaths) to High(LocalSearchPaths) do begin LHelpFilePath := LBaseDir + LocalSearchPaths[I] + Self.ClassName + '.txt'; if FileExists(LHelpFilePath) then begin LHelpLines := TStringList.Create; try LHelpLines.LoadFromFile(LHelpFilePath, TEncoding.UTF8); Result := LHelpLines.Text; Exit; finally LHelpLines.Free; end; end; end; Result := 'Manual de ayuda para ' + Self.Caption + '.' + #13#10 + 'No se encontró un archivo de ayuda específico para ' + Self.ClassName + '.' + #13#10 + 'Por favor, póngase en contacto con soporte técnico si requiere asistencia.'; end; procedure TfrmBase.btnImprimirClick(Sender: TObject); begin TfrmPrintOptions.ShowOptions(Self, nil, dbgItems, Self.Caption); end; procedure TfrmBase.btnSalirClick(Sender: TObject); begin Close; end; procedure TfrmBase.FormResize(Sender: TObject); begin // No-op. Custom auto-scaling disabled to let native VCL DPI scaling handle form layout. end; { --- Button Action Wrappers --- } procedure TfrmBase.btnAnadirClick(Sender: TObject); begin DoAnadir; end; procedure TfrmBase.btnModificarClick(Sender: TObject); begin DoModificar; end; procedure TfrmBase.btnEliminarClick(Sender: TObject); begin DoEliminar; end; procedure TfrmBase.btnPrimeroClick(Sender: TObject); begin DoPrimero; ResetChangeTracking; end; procedure TfrmBase.btnAnteriorClick(Sender: TObject); begin DoAnterior; ResetChangeTracking; end; procedure TfrmBase.btnSiguienteClick(Sender: TObject); begin DoSiguiente; ResetChangeTracking; end; procedure TfrmBase.btnUltimoClick(Sender: TObject); begin DoUltimo; ResetChangeTracking; end; procedure TfrmBase.btnDuplicarClick(Sender: TObject); begin DoDuplicar; end; procedure TfrmBase.ResetChangeTracking; var I: Integer; begin // Limpiar flags de modificación en todos los TCustomEdit for I := 0 to ComponentCount - 1 do begin if Components[I] is TCustomEdit then TCustomEdit(Components[I]).Modified := False; end; // Recapturar estados baseline de checkboxes y comboboxes CaptureInitialStates; // Forzar refresco inmediato de botones UpdateActionButtonsState; end; { --- Default Virtual Implementations (Override in Children) --- } procedure TfrmBase.DoAnadir; begin // Handled by child classes end; procedure TfrmBase.DoModificar; begin // Handled by child classes end; procedure TfrmBase.DoEliminar; begin // Handled by child classes end; procedure TfrmBase.DoPrimero; begin // Handled by child classes end; procedure TfrmBase.DoAnterior; begin // Handled by child classes end; procedure TfrmBase.DoSiguiente; begin // Handled by child classes end; procedure TfrmBase.DoUltimo; begin // Handled by child classes end; procedure TfrmBase.DoDuplicar; begin // Handled by child classes end; destructor TfrmBase.Destroy; begin TUIAutoScaler.UnregisterForm(Self); if Assigned(FInitialControlStates) then FreeAndNil(FInitialControlStates); inherited Destroy; end; procedure TfrmBase.CaptureInitialStates; var I: Integer; begin if not Assigned(FInitialControlStates) then FInitialControlStates := TStringList.Create else FInitialControlStates.Clear; for I := 0 to ComponentCount - 1 do begin // Excluir controles marcados con Tag=999 (filtros auxiliares no editables) if (Components[I] is TControl) and (TControl(Components[I]).Tag = 999) then Continue; if Components[I] is TCheckBox then FInitialControlStates.Values[Components[I].Name] := BoolToStr(TCheckBox(Components[I]).Checked, True) else if Components[I] is TCustomComboBox then FInitialControlStates.Values[Components[I].Name] := IntToStr(TCustomComboBox(Components[I]).ItemIndex) else if Components[I] is TDBLookupComboBox then FInitialControlStates.Values[Components[I].Name] := VarToStr(TDBLookupComboBox(Components[I]).KeyValue) else if Components[I] is TDateTimePicker then FInitialControlStates.Values[Components[I].Name] := FloatToStr(TDateTimePicker(Components[I]).Date); end; end; procedure TfrmBase.ResetModifiedState; var I: Integer; begin FSavedAnyChanges := True; // 1. Reset all Edit and Memo controls' Modified flag to False for I := 0 to ComponentCount - 1 do begin if Components[I] is TCustomEdit then TCustomEdit(Components[I]).Modified := False; end; // 2. Recapture baseline states for checkboxes and comboboxes CaptureInitialStates; end; procedure TfrmBase.DoShow; var LSaveEvent: TNotifyEvent; I: Integer; begin TUIAutoScaler.ScaleForm(Self); inherited DoShow; // Forzar mayúsculas automáticamente en campos de texto editables (excepto campos especiales) ApplyUpperCaseToEdits; // Hook btnGuardar.OnClick assigned in child's FormShow if Assigned(btnGuardar.OnClick) then begin LSaveEvent := Self.btnGuardarClick; if TMethod(btnGuardar.OnClick).Code <> TMethod(LSaveEvent).Code then begin FChildSaveClick := btnGuardar.OnClick; btnGuardar.OnClick := btnGuardarClick; end; end; // Reset Modified flag on all TCustomEdit controls after child's FormShow/LoadData have executed! for I := 0 to ComponentCount - 1 do begin if Components[I] is TCustomEdit then TCustomEdit(Components[I]).Modified := False; end; // Reset the saved changes flag for this session FSavedAnyChanges := False; // Capture baseline loaded states of checkboxes and comboboxes CaptureInitialStates; // Enlazar dinámicamente eventos de cambio para actualizar estado en tiempo real for I := 0 to ComponentCount - 1 do begin // Excluir controles marcados con Tag=999 (filtros auxiliares no editables) if (Components[I] is TControl) and (TControl(Components[I]).Tag = 999) then Continue; if Components[I] is TDBComboBox then begin if not Assigned(TDBComboBox(Components[I]).OnChange) then TDBComboBox(Components[I]).OnChange := DBComboBoxChanged; end else if Components[I] is TCustomComboBox then begin if not Assigned(TCustomComboBoxAccessor(Components[I]).OnChange) then TCustomComboBoxAccessor(Components[I]).OnChange := ControlChanged; end else if Components[I] is TDBLookupComboBox then begin if not Assigned(TDBLookupComboBox(Components[I]).OnClick) then TDBLookupComboBox(Components[I]).OnClick := ControlChanged; if not Assigned(TDBLookupComboBox(Components[I]).OnCloseUp) then TDBLookupComboBox(Components[I]).OnCloseUp := ControlChanged; end else if Components[I] is TCheckBox then begin if not Assigned(TCheckBox(Components[I]).OnClick) then TCheckBox(Components[I]).OnClick := ControlChanged; end else if Components[I] is TCustomEdit then begin if not Assigned(TCustomEditAccessor(Components[I]).OnChange) then TCustomEditAccessor(Components[I]).OnChange := ControlChanged; end else if Components[I] is TDateTimePicker then begin if not Assigned(TDateTimePicker(Components[I]).OnChange) then TDateTimePicker(Components[I]).OnChange := ControlChanged; end else if Components[I] is Vcl.DBGrids.TDBGrid then begin Vcl.DBGrids.TDBGrid(Components[I]).Options := Vcl.DBGrids.TDBGrid(Components[I]).Options + [dgTitleClick, dgTitleHotTrack]; if not Assigned(Vcl.DBGrids.TDBGrid(Components[I]).OnTitleClick) then Vcl.DBGrids.TDBGrid(Components[I]).OnTitleClick := dbgItemsTitleClick; end; end; // Ocultar botones auxiliares si el formulario hijo no les ha asignado evento OnClick if Assigned(btnIA) and not Assigned(btnIA.OnClick) then btnIA.Visible := False; if Assigned(btnRect) and not Assigned(btnRect.OnClick) then btnRect.Visible := False; if Assigned(btnExcel) and not Assigned(btnExcel.OnClick) then btnExcel.Visible := False; if Assigned(btnBuscar) and not Assigned(btnBuscar.OnClick) then btnBuscar.Visible := False; end; procedure TfrmBase.DBComboBoxChanged(Sender: TObject); var LCombo: TDBComboBox; begin if (Sender is TDBComboBox) and TDBComboBox(Sender).Focused then begin LCombo := TDBComboBox(Sender); if (LCombo.Field <> nil) and (LCombo.DataSource <> nil) and (LCombo.DataSource.DataSet <> nil) and LCombo.DataSource.DataSet.Active then begin if LCombo.DataSource.DataSet.CanModify and (LCombo.Field.AsString <> LCombo.Text) then begin LCombo.DataSource.DataSet.Edit; LCombo.Field.AsString := LCombo.Text; end; end; end; ControlChanged(Sender); end; procedure TfrmBase.ControlChanged(Sender: TObject); begin UpdateActionButtonsState; end; procedure TfrmBase.ApplyUpperCaseToEdits; begin TAppTheme.ApplyUpperCaseToEdits(Self); end; procedure TfrmBase.btnGuardarClick(Sender: TObject); begin if not FIsAutoSaving and not IsNewRecord then begin if MessageDlg('¿Está seguro de que desea guardar las modificaciones de este registro?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit; end; if Assigned(FChildSaveClick) then FChildSaveClick(Sender); // If the child set ModalResult := mrOk, we intercept it, reset it to mrNone, // and mark that we saved changes! if Self.ModalResult = mrOk then begin ResetModifiedState; if not FIsAutoSaving then Self.ModalResult := mrNone; end; end; function TfrmBase.CloseQuery: Boolean; var LPromptResult: Integer; LSaveHandler: TNotifyEvent; begin Result := inherited CloseQuery; if not Result then Exit; // Force an up-to-date evaluation of unsaved changes before deciding UpdateActionButtonsState; // Auto-save with prompt if there are unsaved changes and user is closing the form (ModalResult <> mrOk) if (ModalResult <> mrOk) and HasUnsavedChanges then begin LPromptResult := MessageDlg('Se han detectado modificaciones sin guardar. ¿Desea guardar los cambios antes de salir?', mtConfirmation, [mbYes, mbNo, mbCancel], 0); if LPromptResult = mrYes then begin LSaveHandler := btnGuardar.OnClick; if Assigned(LSaveHandler) then begin // Ensure the button is enabled so the save handler can execute btnGuardar.Enabled := True; FIsAutoSaving := True; try // Call the OnClick handler directly instead of btnGuardar.Click // to bypass the Enabled check and guarantee the save executes LSaveHandler(btnGuardar); // If the save was successful, children set ModalResult := mrOk. // If it failed or was aborted, ModalResult is not mrOk, so prevent close. if ModalResult <> mrOk then Result := False; finally FIsAutoSaving := False; end; end; end else if LPromptResult = mrNo then begin // Let the form close without saving (discard changes) Result := True; end else begin // mrCancel: Keep the form open (abort close) Result := False; end; end; // If the form is closing successfully (Result is True) and we have saved changes at some point, // ensure the ModalResult is mrOk so the parent list is refreshed! if Result and FSavedAnyChanges then ModalResult := mrOk; end; function TfrmBase.HasUnsavedChanges: Boolean; var I: Integer; StoredVal, CurrentVal: string; begin Result := False; // 1. Scan all TDataSource components to check if any linked DataSet is being edited/inserted for I := 0 to ComponentCount - 1 do begin if (Components[I] is TDataSource) and Assigned(TDataSource(Components[I]).DataSet) then begin if TDataSource(Components[I]).DataSet.Active then begin if (TDataSource(Components[I]).DataSet.State = dsInsert) or ((TDataSource(Components[I]).DataSet.State = dsEdit) and TDataSource(Components[I]).DataSet.Modified) then begin Result := True; Exit; end; end; end; end; // 1b. Scan ALL TFDDataSet components on the form for pending cached updates // (covers datasets that may not be directly linked to dbgItems) for I := 0 to ComponentCount - 1 do begin if (Components[I] is TFDDataSet) and TFDDataSet(Components[I]).Active and TFDDataSet(Components[I]).CachedUpdates and TFDDataSet(Components[I]).UpdatesPending then begin Result := True; Exit; end; end; // 2. Check all Edit and Memo controls on the form to see if any are modified for I := 0 to ComponentCount - 1 do begin // Excluir controles marcados con Tag=999 (filtros auxiliares no editables) if (Components[I] is TControl) and (TControl(Components[I]).Tag = 999) then Continue; if Components[I] is TCustomEdit then begin // Exclude data-aware TDBEdit and TDBMemo controls since their changes // are already tracked at the DataSet/DataSource level. if not (Components[I] is TDBEdit) and not (Components[I] is TDBMemo) then begin if TCustomEdit(Components[I]).Modified then begin Result := True; Exit; end; end; end; end; // 3. Check CheckBoxes and ComboBoxes against their initial captured states if Assigned(FInitialControlStates) then begin for I := 0 to ComponentCount - 1 do begin // Excluir controles marcados con Tag=999 (filtros auxiliares no editables) if (Components[I] is TControl) and (TControl(Components[I]).Tag = 999) then Continue; if Components[I] is TCheckBox then begin StoredVal := FInitialControlStates.Values[Components[I].Name]; CurrentVal := BoolToStr(TCheckBox(Components[I]).Checked, True); if (StoredVal <> '') and (StoredVal <> CurrentVal) then begin Result := True; Exit; end; end else if Components[I] is TCustomComboBox then begin StoredVal := FInitialControlStates.Values[Components[I].Name]; CurrentVal := IntToStr(TCustomComboBox(Components[I]).ItemIndex); if (StoredVal <> '') and (StoredVal <> CurrentVal) then begin Result := True; Exit; end; end else if Components[I] is TDBLookupComboBox then begin StoredVal := FInitialControlStates.Values[Components[I].Name]; CurrentVal := VarToStr(TDBLookupComboBox(Components[I]).KeyValue); if (StoredVal <> '') and (StoredVal <> CurrentVal) then begin Result := True; Exit; end; end else if Components[I] is TDateTimePicker then begin StoredVal := FInitialControlStates.Values[Components[I].Name]; CurrentVal := FloatToStr(TDateTimePicker(Components[I]).Date); if (StoredVal <> '') and (StoredVal <> CurrentVal) then begin Result := True; Exit; end; end; end; end; end; function TfrmBase.IsNewRecord: Boolean; function IsValueAssigned(const AValue: TValue): Boolean; begin Result := False; if AValue.IsEmpty then Exit; case AValue.Kind of tkInteger, tkEnumeration: Result := AValue.AsInteger <> 0; tkInt64: Result := AValue.AsInt64 <> 0; tkFloat: Result := AValue.AsExtended <> 0.0; tkString, tkLString, tkWString, tkUString: Result := AValue.AsString <> ''; tkVariant: Result := not VarIsEmpty(AValue.AsVariant) and (VarToStr(AValue.AsVariant) <> '') and (VarToStr(AValue.AsVariant) <> '0'); end; end; var Context: TRttiContext; RType: TRttiType; Prop: TRttiProperty; Field: TRttiField; begin Result := True; // Default to new record Context := TRttiContext.Create; try RType := Context.GetType(Self.ClassType); if Assigned(RType) then begin // Look for a property ending with 'Id' (e.g. FamiliaId, MateriaPrimaId) for Prop in RType.GetProperties do begin if SameText(Copy(Prop.Name, Length(Prop.Name) - 1, 2), 'Id') then begin if IsValueAssigned(Prop.GetValue(Self)) then begin Result := False; Exit; end; end; end; // If no such property or it was empty, check fields starting with 'F' and ending with 'Id' for Field in RType.GetFields do begin if SameText(Copy(Field.Name, 1, 1), 'F') and SameText(Copy(Field.Name, Length(Field.Name) - 1, 2), 'Id') then begin if IsValueAssigned(Field.GetValue(Self)) then begin Result := False; Exit; end; end; end; end; finally Context.Free; end; end; procedure TfrmBase.UpdateActions; begin inherited UpdateActions; UpdateActionButtonsState; end; procedure TfrmBase.UpdateActionButtonsState; var LEditing: Boolean; begin LEditing := IsNewRecord or HasUnsavedChanges; if Assigned(btnGuardar) then btnGuardar.Enabled := LEditing; if Assigned(btnCancelar) then btnCancelar.Enabled := LEditing; if Assigned(btnAnadir) then btnAnadir.Enabled := not LEditing; if Assigned(btnModificar) then btnModificar.Enabled := not LEditing; if Assigned(btnEliminar) then btnEliminar.Enabled := not LEditing; if Assigned(btnPrimero) then btnPrimero.Enabled := not LEditing; if Assigned(btnAnterior) then btnAnterior.Enabled := not LEditing; if Assigned(btnSiguiente) then btnSiguiente.Enabled := not LEditing; if Assigned(btnUltimo) then btnUltimo.Enabled := not LEditing; if Assigned(btnBuscar) then btnBuscar.Enabled := not LEditing; if Assigned(btnImprimir) then btnImprimir.Enabled := not LEditing; if Assigned(btnDuplicar) then btnDuplicar.Enabled := not LEditing; if Assigned(btnSalir) then btnSalir.Enabled := not LEditing; end; procedure TfrmBase.btnCancelarClick(Sender: TObject); begin DoCancelar; end; procedure TfrmBase.DoCancelar; var I: Integer; Context: TRttiContext; RType: TRttiType; Method: TRttiMethod; begin for I := 0 to ComponentCount - 1 do begin if (Components[I] is TDataSource) and Assigned(TDataSource(Components[I]).DataSet) then begin if TDataSource(Components[I]).DataSet.Active and (TDataSource(Components[I]).DataSet.State in [dsEdit, dsInsert]) then TDataSource(Components[I]).DataSet.Cancel; end; end; if Assigned(dbgItems) and Assigned(dbgItems.DataSource) and Assigned(dbgItems.DataSource.DataSet) then begin if dbgItems.DataSource.DataSet.State in [dsEdit, dsInsert] then dbgItems.DataSource.DataSet.Cancel; end; if IsNewRecord then begin ModalResult := mrCancel; Close; end else begin // Llamar dinámicamente a LoadData del hijo si existe para recargar el registro Context := TRttiContext.Create; try RType := Context.GetType(Self.ClassType); if Assigned(RType) then begin Method := RType.GetMethod('LoadData'); if Assigned(Method) then Method.Invoke(Self, []); end; finally Context.Free; end; ResetModifiedState; UpdateActionButtonsState; end; end; procedure TfrmBase.dbgItemsTitleClick(Column: TColumn); var LGrid: Vcl.DBGrids.TDBGrid; LDataSet: TDataSet; Context: TRttiContext; RType: TRttiType; Prop: TRttiProperty; SortStr: string; CurrentIndex: string; begin if (Column = nil) or (Column.Grid = nil) or not (Column.Grid is Vcl.DBGrids.TDBGrid) then Exit; LGrid := Vcl.DBGrids.TDBGrid(Column.Grid); if (LGrid.DataSource = nil) or (LGrid.DataSource.DataSet = nil) then Exit; LDataSet := LGrid.DataSource.DataSet; if not LDataSet.Active then Exit; Context := TRttiContext.Create; try RType := Context.GetType(LDataSet.ClassType); Prop := RType.GetProperty('IndexFieldNames'); if Assigned(Prop) and (Prop.Visibility in [System.TypInfo.mvPublic, System.TypInfo.mvPublished]) then begin CurrentIndex := Prop.GetValue(LDataSet).AsString; if SameText(CurrentIndex, Column.FieldName) or SameText(CurrentIndex, Column.FieldName + ':A') then SortStr := Column.FieldName + ':D' else SortStr := Column.FieldName + ':A'; Prop.SetValue(LDataSet, SortStr); end; finally Context.Free; end; end; end.