{ =============================================================================== Copyright (©) 2001. Rodax Software. =============================================================================== Los contenidos de este fichero son propiedad de Rodax Software titular del copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado, en su totalidad o en parte, con el permiso escrito de Rodax Software, o de acuerdo con los términos y condiciones establecidas en el acuerdo/contrato bajo el que se suministra. ----------------------------------------------------------------------------- Web: www.rodax-software.com =============================================================================== Fecha primera versión: 01-10-2001 Versión actual: 1.0.1 Fecha versión actual: 30-04-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit RdxFrame; {$I ..\COMPILE.INC} interface uses Consts, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Tipos, RdxBarras; type TRdxFrame = class(TFrame) private FOnShow : TNotifyEvent; FFormulario : TForm; FBarraSeleccion : TRdxCustomBarra; FBarraSalir : TRdxCustomBarra; FBarraOperacion : TRdxCustomBarra; FBarraExtra : TRdxCustomBarra; procedure CMRelease(var Message: TMessage); message CM_RELEASE; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ActualizarTitulos(Objeto : TWinControl); procedure SetBarra (Index : Integer; Value : TRdxCustomBarra); procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; protected FEntidad : TRdxEntidad; FModo : TRdxModo; FContenido : TRdxFrame; FContenidoModal : TRdxFrame; procedure DoShow; dynamic; procedure VerModal; virtual; procedure SetEntidad (Value : TRdxEntidad); procedure SetModo (Value : TRdxModo); virtual; procedure SetContenido (NuevoFrame : TRdxFrame); virtual; procedure SetContenidoModal (NuevoFrame : TRdxFrame); virtual; procedure ActualizarEstado; virtual; procedure CambiarModo(ModoAnterior, Modo : TRdxModo); virtual; function CambiarEntidad(EntidadAnterior, Entidad : TRdxEntidad): Boolean; virtual; procedure ActualizarBarras; virtual; procedure CrearFormulario; procedure Loaded; override; procedure FreeContenido; virtual; procedure OnCloseForm(Sender: TObject; var Action: TCloseAction); procedure CloseFrameModal; virtual; public CaptionModal : string; HeightModal : integer; WidthModal : integer; ModoModal : TRdxModo; EntidadModal : TRdxEntidad; IsModal : Boolean; property Contenido : TRdxFrame read FContenido write SetContenido; property ContenidoModal : TRdxFrame read FContenidoModal write SetContenidoModal; function CloseFrame : Boolean; virtual; constructor Create(AOwner: TComponent); override; published property OnShow: TNotifyEvent read FOnShow write FOnShow; property Modo : TRdxModo read FModo write SetModo default Normal; property Entidad : TRdxEntidad read FEntidad write SetEntidad default entVacia; property BarraSeleccion : TRdxCustomBarra index 0 read FBarraSeleccion write SetBarra; property BarraSalir : TRdxCustomBarra index 1 read FBarraSalir write SetBarra; property BarraOperacion : TRdxCustomBarra index 2 read FBarraOperacion write SetBarra; property BarraExtra : TRdxCustomBarra index 3 read FBarraExtra write SetBarra; end; implementation {$R *.DFM} uses Entidades, Colores, RdxTitulos, RdxBotones {$IFDEF RDX_D6}, Variants{$ENDIF}; procedure TRdxFrame.VerModal; begin if FContenidoModal = NIL then Exit; FContenidoModal.Visible := True; FFormulario.ShowModal; end; constructor TRdxFrame.Create(AOwner: TComponent); begin FFormulario := NIL; Visible := False; inherited Create(AOwner); CaptionModal := ''; WidthModal := 850; HeightModal := 700; ModoModal := Seleccionar; EntidadModal := entVacia; end; procedure TRdxFrame.SetModo (Value : TRdxModo); var ModoAnterior : TRdxModo; begin if FModo <> Value then begin ModoAnterior := Modo; FModo := Value; CambiarModo(ModoAnterior, Modo); end; end; procedure TRdxFrame.SetEntidad(Value: TRdxEntidad); var EntidadAnterior : TRdxEntidad; begin if FEntidad <> Value then begin EntidadAnterior := FEntidad; FEntidad := Value; CambiarEntidad(EntidadAnterior, Entidad); end; end; procedure TRdxFrame.SetContenido (NuevoFrame : TRdxFrame); var Bloqueo : Boolean; begin if NuevoFrame = NIL then exit; if FContenido <> NIL then begin if FContenido.Name = NuevoFrame.ClassName then begin NuevoFrame.Free; Exit end else begin if (not FContenido.CloseFrame) then begin NuevoFrame.Free; Exit end else FContenido := NIL; end; end; Bloqueo := LockWindowUpdate(Application.MainForm.Handle); if FFormulario <> nil then begin FFormulario.Close; FFormulario := NIL; end; FContenido := NuevoFrame; FContenido.Name := NuevoFrame.ClassName; FContenido.Parent := Self; FContenido.IsModal := False; if FBarraSeleccion <> NIL then FBarraSeleccion.Visible := False; if FBarraSalir <> NIL then FBarraSalir.Visible := False; if FBarraOperacion <> NIL then FBarraOperacion.Visible := False; if Bloqueo then LockWindowUpdate(0); end; procedure TRdxFrame.CrearFormulario; begin FFormulario := TForm.Create(Self); with FFormulario do begin BorderStyle := bsSizeable; BorderIcons := []; ClientWidth := WidthModal; ClientHeight := HeightModal; Position := poOwnerFormCenter; Caption := CaptionModal; Color := RdxHueso; end; end; procedure TRdxFrame.SetContenidoModal (NuevoFrame : TRdxFrame); begin if NuevoFrame = nil then exit; if FContenidoModal <> nil then if (not FContenidoModal.CloseFrame) then begin NuevoFrame.Free; Exit end else FContenidoModal := NIL; if FFormulario <> nil then begin FFormulario.Close; FFormulario := NIL; end; CrearFormulario; FContenidoModal := NuevoFrame; FContenidoModal.Entidad := EntidadModal; FContenidoModal.Parent := FFormulario; FContenidoModal.IsModal := True; FFormulario.OnClose := FContenidoModal.OnCloseForm; FContenidoModal.Modo := ModoModal; VerModal; end; procedure TRdxFrame.FreeContenido; begin if FFormulario <> NIL then begin // Es un contenido modal FContenidoModal := NIL; FFormulario.OnClose := NIL; FFormulario.Close; FFormulario := NIL; CaptionModal := ''; WidthModal := 700; HeightModal := 580; ModoModal := Seleccionar; EntidadModal := entVacia; end else // Es un contenido normal FContenido := NIL; ActualizarBarras; end; function TRdxFrame.CloseFrame : Boolean; begin // Primero hay que mirar si el frame que queremos cerrar tiene algún // frame hijo. Si es así se intenta cerrar. El contenido modal no hace // falta mirarlo porque no se puede cerrar una ventana modal desde // fuera de la propia ventana. if FContenido <> NIL then if (not FContenido.CloseFrame) then begin Result := False; exit; end; Result := True; Visible := False; if (Parent is TRdxFrame) then (Parent as TRdxFrame).FreeContenido else CloseFrameModal; PostMessage(Handle, CM_RELEASE, 0, 0); end; procedure TRdxFrame.CloseFrameModal; begin // Modo ver modal Parent.Visible := False; Parent := NIL; if (Owner is TRdxFrame) then (Owner as TRdxFrame).FreeContenido; end; procedure TRdxFrame.ActualizarBarras; begin // Tratar barras case FModo of Normal : begin if FBarraSeleccion <> NIL then FBarraSeleccion.Visible := False; if FBarraSalir <> NIL then FBarraSalir.Visible := False; if FBarraOperacion <> NIL then FBarraOperacion.Visible := False; end; Consultar : begin if FBarraSeleccion <> NIL then FBarraSeleccion.Visible := False; if FBarraSalir <> NIL then FBarraSalir.Visible := True; if FBarraOperacion <> NIL then FBarraOperacion.Visible := False; end; Seleccionar : begin if FBarraSeleccion <> NIL then FBarraSeleccion.Visible := True; if FBarraSalir <> NIL then FBarraSalir.Visible := False; if FBarraOperacion <> NIL then FBarraOperacion.Visible := False; end; else begin if FBarraSeleccion <> NIL then FBarraSeleccion.Visible := False; if FBarraSalir <> NIL then FBarraSalir.Visible := False; if FBarraOperacion <> NIL then FBarraOperacion.Visible := True; end; end; end; procedure TRdxFrame.CambiarModo(ModoAnterior, Modo : TRdxModo); begin if (csLoading in ComponentState) then Exit; ActualizarEstado; end; function TRdxFrame.CambiarEntidad (EntidadAnterior, Entidad : TRdxEntidad): Boolean; begin Result := False; if (csLoading in ComponentState) then Exit; // Primero hay que mirar si el frame al que queremos cambiar de entidad // tiene algún frame hijo. Si es así se intenta cerrar. // El contenido modal no hace falta mirarlo porque no se puede // cerrar una ventana modal desde fuera de la propia ventana. if FContenido <> NIL then if not FContenido.CloseFrame then begin FEntidad := EntidadAnterior; Exit; end; ActualizarEstado; Result := True; end; procedure TRdxFrame.ActualizarTitulos(Objeto : TWinControl); var i : integer; PanelTituloOp : TRdxPanelTituloOperacion; begin for i := 0 to Objeto.ControlCount-1 do begin if csAcceptsControls in Objeto.Controls[i].ControlStyle then ActualizarTitulos(Objeto.Controls[i] as TWinControl) else begin if Objeto.Controls[i] is TRdxCustomTitlePanel then begin if Objeto.Controls[i] is TRdxPanelTituloOperacion then begin PanelTituloOp := (Objeto.Controls[i] as TRdxPanelTituloOperacion); {PanelTituloOp.Color := darColorClaro(FEntidad); PanelTituloOp.Font.Color := darColorOscuro(FEntidad);} PanelTituloOp.Caption := CaptionsModos[FModo] + ' ' + CaptionsEntidades[FEntidad]; end; end; end; end; end; procedure TRdxFrame.CMRelease; begin Free; end; procedure TRdxFrame.SetBarra (Index : Integer; Value : TRdxCustomBarra); begin case Index of 0 : FBarraSeleccion := Value; 1 : FBarraSalir := Value; 2 : FBarraOperacion := Value; 3 : FBarraExtra := Value; end; end; procedure TRdxFrame.Loaded; begin inherited Loaded; ActualizarEstado; end; procedure TRdxFrame.ActualizarEstado; begin ActualizarBarras; ActualizarTitulos(Self); end; procedure TRdxFrame.CMShowingChanged(var Message: TMessage); begin inherited; if Showing then begin try DoShow; except Application.HandleException(Self); end; end; end; procedure TRdxFrame.DoShow; begin if Assigned(FOnShow) then FOnShow(Self); end; procedure TRdxFrame.OnCloseForm(Sender: TObject; var Action: TCloseAction); begin CloseFrame; Action := caFree; end; procedure TRdxFrame.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; case Operation of opRemove: if AComponent is TRdxCustomBarra then begin if FBarraSeleccion = AComponent then FBarraSeleccion := NIL; if FBarraSalir = AComponent then FBarraSalir := NIL; if FBarraOperacion = AComponent then FBarraOperacion := NIL; if FBarraExtra = AComponent then FBarraExtra := NIL; end; end; end; end.