unit CalendarioMontajes2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, RdxFrame, RdxBotones, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxLookupEdit, cxDBLookupEdit, cxDBLookupComboBox, ExtCtrls, RdxPaneles, RdxBarras, Menus, cxStyles, cxGraphics, cxScheduler, cxSchedulerStorage, cxSchedulerCustomControls, cxSchedulerCustomResourceView, cxSchedulerDayView, cxSchedulerDateNavigator, cxSchedulerWeekView, cxSchedulerDBStorage, cxCheckListBox, ActnList, IBQuery, DB, IBCustomDataSet, IBDatabase, IBTable, ComCtrls, ImgList, dxPSGlbl, dxPSUtl, dxPSEngn, dxPrnPg, dxBkgnd, dxWrap, dxPrnDev, dxPSCompsProvider, dxPSFillPatterns, dxPSEdgePatterns, dxPSCore, dxPSContainerLnk, dxPrnDlg, dxPgsDlg; type TfrCalendarioMontajes = class(TRdxFrame) BarraAgenda: TRdxBarraSuperior; imgSombra: TImage; pnlExtra: TRdxBarraSuperior; eUsuario: TPanel; cbxUsuarios: TcxLookupComboBox; bRefrescar: TRdxBoton; cxScheduler: TcxScheduler; Panel1: TPanel; cxResources: TcxCheckListBox; cxSchedulerDBStorage1: TcxSchedulerDBStorage; Panel2: TPanel; Panel3: TPanel; bAnadir: TRdxBoton; bEliminar: TRdxBoton; RdxBoton1: TRdxBoton; RdxBoton2: TRdxBoton; ActionList1: TActionList; actDia: TAction; actSemana: TAction; actMes: TAction; RdxBoton3: TRdxBoton; bSeparador1: TShape; bConsultar: TRdxBotonSuperior; RdxBotonSuperior1: TRdxBotonSuperior; RdxBotonSuperior2: TRdxBotonSuperior; dsCitas: TDataSource; tCitas: TIBTable; IBTransaction1: TIBTransaction; IBDatabase1: TIBDatabase; dsInstaladores: TDataSource; tInstaladores: TIBTable; actVerTodos: TAction; tInstaladoresCODIGO: TIntegerField; tInstaladoresNOMBRE: TIBStringField; ImageList1: TImageList; actAnadir: TAction; actModificar: TAction; actEliminar: TAction; RdxBotonSuperior3: TRdxBotonSuperior; procedure actDiaExecute(Sender: TObject); procedure actSemanaExecute(Sender: TObject); procedure actMesExecute(Sender: TObject); procedure tCitasNewRecord(DataSet: TDataSet); procedure cxResourcesEditValueChanged(Sender: TObject); procedure actVerTodosExecute(Sender: TObject); procedure bRefrescarClick(Sender: TObject); procedure tCitasAfterPost(DataSet: TDataSet); procedure actAnadirExecute(Sender: TObject); procedure actModificarExecute(Sender: TObject); procedure actModificarUpdate(Sender: TObject); procedure actEliminarExecute(Sender: TObject); procedure actEliminarUpdate(Sender: TObject); procedure cxSchedulerGetEventDisplayText(Sender: TObject; AEvent: TcxSchedulerControlEvent; var AText: String); procedure cxSchedulerGetEventHintText(Sender: TObject; AEvent: TcxSchedulerControlEvent; var AText: String); procedure cxSchedulerCustomDrawEvent(Sender: TObject; ACanvas: TcxCanvas; AViewInfo: TcxSchedulerEventCellViewInfo; var ADone: Boolean); private procedure CargarListaInstaladores; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; end; procedure FillGradientRect(ACanvas: TcxCanvas; const ARect: TRect; AColor1, AColor2: TColor; AHorizontal: Boolean); var frCalendarioMontajes: TfrCalendarioMontajes; implementation {$R *.dfm} { TfrCalendarioMontajes } uses Entidades, Configuracion, ResourcesEditor, cxSchedulerDialogs, dxOffice11; var W1, H1, C1, C2: Integer; ABitmap: TBitmap; procedure FillGradientRect(ACanvas: TcxCanvas; const ARect: TRect; AColor1, AColor2: TColor; AHorizontal: Boolean); begin with ARect do begin W1 := Right - Left; H1 := Bottom - Top; if (W1 < 1) or (H1 < 1) then Exit; if (ABitmap.Height <> H1) or (ABitmap.Width <> W1) or (AColor1 <> C1) or (AColor2 <> C2) then begin C1 := AColor1; C2 := AColor2; ABitmap.Free; ABitmap := TBitmap.Create; ABitmap.PixelFormat := pf32Bit; ABitmap.Height := H1; ABitmap.Width := W1; FillTubeGradientRect(ABitmap.Canvas.Handle, Rect(0, 0, W1, H1), AColor1, AColor2, AHorizontal); end; BitBlt(ACanvas.Handle, Left, Top, W1, H1, ABitmap.Canvas.Handle, 0, 0, srcCopy); end; end; constructor TfrCalendarioMontajes.Create(AOwner: TComponent); begin inherited Create(AOwner); Entidad := entAgenda; ConfigurarFrame(Self, Self.Entidad); CargarListaInstaladores; ABitmap := TBitmap.Create; ABitmap.PixelFormat := pf32bit; end; destructor TfrCalendarioMontajes.Destroy; begin ABitmap.Free; inherited; end; procedure TfrCalendarioMontajes.actDiaExecute(Sender: TObject); begin cxScheduler.GoToDate(cxScheduler.SelStart, vmDay); end; procedure TfrCalendarioMontajes.actSemanaExecute(Sender: TObject); begin cxScheduler.GoToDate(cxScheduler.SelStart, vmWeek); end; procedure TfrCalendarioMontajes.actMesExecute(Sender: TObject); begin cxScheduler.GoToDate(cxScheduler.SelStart, vmMonth); end; procedure TfrCalendarioMontajes.tCitasNewRecord(DataSet: TDataSet); begin Randomize; DataSet.FieldByName('ID').AsInteger := Random(1000); end; procedure TfrCalendarioMontajes.CargarListaInstaladores; var I: Integer; begin cxResources.Items.BeginUpdate; try cxResources.Items.Clear; for I := 0 to cxScheduler.Storage.ResourceCount - 1 do begin with cxResources.Items.Add do begin ImageIndex := 0; Text := cxScheduler.Storage.ResourceNames[I]; Checked := cxScheduler.Storage.Resources.ResourceItems[I].Visible; ItemObject := cxScheduler.Storage.Resources.ResourceItems[I]; end; end; finally cxResources.Items.EndUpdate; end; end; procedure TfrCalendarioMontajes.cxResourcesEditValueChanged( Sender: TObject); var AIndex: Integer; begin AIndex := cxResources.ItemIndex; if AIndex < 0 then Exit; with cxResources.Items[AIndex] do TcxSchedulerStorageResourceItem(ItemObject).Visible := Checked; if cxScheduler.Storage.Resources.ResourceItems.VisibleResourceCount = 0 then begin cxResources.Items[AIndex].Checked := True; Exit; end; end; procedure TfrCalendarioMontajes.actVerTodosExecute(Sender: TObject); var I: Integer; begin cxResources.Items.BeginUpdate; try for I := 0 to cxResources.Items.Count - 1 do begin cxResources.Items[I].Checked := True; TcxSchedulerStorageResourceItem(cxResources.Items[I].ItemObject).Visible := True; end; finally cxResources.Items.EndUpdate; end; end; procedure TfrCalendarioMontajes.bRefrescarClick(Sender: TObject); var AEditor: TfmResourcesLayoutEditor3; begin if not ((cxScheduler.Storage <> nil) and cxScheduler.Storage.IsActive) or (cxScheduler.Storage.ResourceCount = 0) then Exit; AEditor := TfmResourcesLayoutEditor3.Create(nil); try //cxSetLookAndFeel(AEditor, cxScheduler.LookAndFeel); AEditor.Storage := cxScheduler.Storage; AEditor.ShowModal; finally AEditor.Release; end; end; procedure TfrCalendarioMontajes.tCitasAfterPost(DataSet: TDataSet); begin inherited; IBTransaction1.CommitRetaining; end; procedure TfrCalendarioMontajes.actAnadirExecute(Sender: TObject); begin inherited; cxScheduler.CreateEventUsingDialog(); end; procedure TfrCalendarioMontajes.actModificarExecute(Sender: TObject); begin if (cxScheduler.SelectedEventCount = 1) then cxScheduler.EditEventUsingDialog(cxScheduler.SelectedEvents[0]); end; procedure TfrCalendarioMontajes.actModificarUpdate(Sender: TObject); begin (Sender as TAction).Enabled := (cxScheduler.SelectedEventCount = 1); end; procedure TfrCalendarioMontajes.actEliminarExecute(Sender: TObject); begin if (cxScheduler.SelectedEventCount > 0) then cxScheduler.DeleteSelectedEvents(); end; procedure TfrCalendarioMontajes.actEliminarUpdate(Sender: TObject); begin (Sender as TAction).Enabled := (cxScheduler.SelectedEventCount > 0); end; procedure TfrCalendarioMontajes.cxSchedulerGetEventDisplayText( Sender: TObject; AEvent: TcxSchedulerControlEvent; var AText: String); begin if not VarIsNull(AEvent.GetCustomFieldValueByName('TIPOTAREA')) then AText := AText + ' (' + VarToStr(AEvent.GetCustomFieldValueByName('TIPOTAREA')) + ')'; end; procedure TfrCalendarioMontajes.cxSchedulerGetEventHintText( Sender: TObject; AEvent: TcxSchedulerControlEvent; var AText: String); begin if not VarIsNull(AEvent.GetCustomFieldValueByName('TIPOTAREA')) then AText := AText + #13#10 + VarToStr(AEvent.GetCustomFieldValueByName('TIPOTAREA')); end; procedure TfrCalendarioMontajes.cxSchedulerCustomDrawEvent(Sender: TObject; ACanvas: TcxCanvas; AViewInfo: TcxSchedulerEventCellViewInfo; var ADone: Boolean); var APrevRegion, ARegion: TcxRegion; AMessageRect: TRect; begin if not AViewInfo.Selected then begin AViewInfo.Transparent := True; FillGradientRect(ACanvas, AViewInfo.Bounds, clWhite, AViewInfo.Color, False); end; ADone := False; end; end.