home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / DBCTRLS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-17  |  101KB  |  3,151 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit DBCtrls;
  11.  
  12.  
  13. Interface
  14.  
  15. {$R DBCtrls}
  16.  
  17. Uses SysUtils,Classes,Forms,Grids,DBBase,Buttons,StdCtrls,Dialogs,ExtCtrls,Mask;
  18.  
  19. Type
  20.     {$M+}
  21.     TDBGridOptions = Set Of
  22.       (dgBorder,dgRowResize,dgColumnResize,dgEditing,dgAlwaysShowEditor,
  23.        dgShowSelection,dgAlwaysShowSelection,dgConfirmDelete,
  24.        dgCancelOnExit,dgIndicator,dgTitles,dgMouseSelect,dgLineNumbers,
  25.        dgEnableMaskEdit);
  26.     {$M-}
  27.  
  28.     TDBGrid=Class;
  29.     TDBGridColumn=Class;
  30.     TDBGridColumns=Class;
  31.  
  32.     TDBColumnTitle=Class
  33.        Private
  34.          FCaption:^String;
  35.          FAlignment:TAlignment;
  36.          FFont:TFont;
  37.          FColor:TColor;
  38.          FGrid:TDBGrid;
  39.          FColumn:TDBGridColumn;
  40.          FPenColor:TColor;
  41.        Private
  42.          Function GetFont:TFont;
  43.          Procedure SetFont(NewFont:TFont);
  44.          Procedure SetColor(NewColor:TColor);
  45.          Procedure SetPenColor(NewColor:TColor);
  46.          Procedure SetAlignment(NewValue:TAlignment);
  47.          Function GetCaption:String;
  48.          Procedure SetCaption(Const NewValue:String);
  49.        Public
  50.          Constructor Create(DBGrid:TDBGrid;Column:TDBGridColumn);
  51.          Destructor Destroy;Override;
  52.        Public
  53.          Property Font:TFont Read GetFont Write SetFont;
  54.          Property Color:TColor Read FColor Write SetColor;
  55.          Property PenColor:TColor Read FPenColor Write SetPenColor;
  56.          Property Alignment:TAlignment Read FAlignment Write SetAlignment;
  57.          Property Caption:String Read GetCaption Write SetCaption;
  58.     End;
  59.  
  60.     TDBGridColumn=Class
  61.        Private
  62.          FFieldName:^String;
  63.          FTitle:TDBColumnTitle;
  64.          FColor:TColor;
  65.          FGrid:TDBGrid;
  66.          FColumns:TDBGridColumns;
  67.          FWidth:LongInt;
  68.          FAlignment:TAlignment;
  69.          FReadOnly:Boolean;
  70.          FFont:TFont;
  71.          FPenColor:TColor;
  72.        Private
  73.          Function GetFieldName:String;
  74.          Procedure SetFieldName(Const NewValue:String);
  75.          Procedure SetTitle(NewTitle:TDBColumnTitle);
  76.          Procedure SetColor(NewColor:TColor);
  77.          Procedure SetPenColor(NewColor:TColor);
  78.          Function GetWidth:LongInt;
  79.          Procedure SetWidth(NewWidth:LongInt);
  80.          Procedure SetAlignment(NewValue:TAlignment);
  81.          Function GetFont:TFont;
  82.          Procedure SetFont(NewFont:TFont);
  83.        Public
  84.          Constructor Create(DBGrid:TDBGrid;Columns:TDBGridColumns);
  85.          Destructor Destroy;Override;
  86.        Public
  87.          Property FieldName:String Read GetFieldName Write SetFieldName;
  88.          Property Title:TDBColumnTitle Read FTitle Write SetTitle;
  89.          Property Color:TColor Read FColor Write SetColor;
  90.          Property PenColor:TColor Read FPenColor Write SetPenColor;
  91.          Property Width:LongInt Read GetWidth Write SetWidth;
  92.          Property Alignment:TAlignment Read FAlignment Write SetAlignment;
  93.          Property ReadOnly:Boolean Read FReadOnly Write FReadOnly;
  94.          Property Font:TFont Read GetFont Write SetFont;
  95.     End;
  96.  
  97.     {$HINTS OFF}
  98.     TDBGridColumns=Class(TList)
  99.         Private
  100.          FAutoCreated:Boolean;
  101.          FGrid:TDBGrid;
  102.          FUpdateLocked:Boolean;
  103.         Private
  104.          Function GetColumn(Index:LongInt):TDBGridColumn;
  105.          Procedure SetColumn(Index:LongInt;Column:TDBGridColumn);
  106.        Protected
  107.          Procedure FreeItem(Item:Pointer);Override;
  108.         Public
  109.          Constructor Create(DBGrid:TDBGrid);
  110.          Destructor Destroy;Override;
  111.          Function Add:TDBGridColumn;
  112.          Procedure Delete(Index:LongInt);
  113.          Procedure BeginUpdate;
  114.          Procedure EndUpdate;
  115.         Public
  116.          Property AutoCreated:Boolean Read FAutoCreated;
  117.          Property Items[Index:LongInt]:TDBGridColumn Read GetColumn Write SetColumn;Default;
  118.          Property Grid:TDBGrid Read FGrid;
  119.     End;
  120.     {$HINTS ON}
  121.  
  122.     TDBGrid=Class(TStringGrid)
  123.       Private
  124.          FDataLink:TTableDataLink;
  125.          FGridOptions:TDBGridOptions;
  126.          FColumns:TDBGridColumns;
  127.          Procedure SetDataSource(NewValue:TDataSource);
  128.          Function GetDataSource:TDataSource;
  129.          Procedure SetGridOptions(NewValue:TDBGridOptions);
  130.          Procedure SetColumns(NewColumns:TDBGridColumns);
  131.       Protected
  132.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  133.          Procedure SetFont(NewFont:TFont);Override;
  134.          Procedure Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
  135.          Procedure SetupComponent;Override;
  136.          Function GetCell(Col,Row:LongInt):String;Override;
  137.          Procedure SetCell(Col,Row:LongInt;Const NewContent:String);Override;
  138.          Function SelectCell(Col,Row:LongInt):Boolean;Override;
  139.          Procedure SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
  140.                                     Var Alignment:TAlignment;Var DrawFont:TFont);Override;
  141.          Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Override;
  142.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  143.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  144.          Procedure RowHeightChanged(Row:LongInt);Override;
  145.          Procedure ColWidthChanged(Col:LongInt);Override;
  146.          Function ShowEditor(Col,Row:LongInt):TInplaceEditClass;Override;
  147.       Protected
  148.          Property FixedCols;
  149.          Property FixedRows;
  150.          Property ColCount;
  151.          Property RowCount;
  152.          Property Options;
  153.       Public
  154.          Destructor Destroy;Override;
  155.          Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
  156.       Published
  157.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  158.          Property GridOptions:TDBGridOptions Read FGridOptions Write SetGridOptions;
  159.          Property Columns:TDBGridColumns Read FColumns Write SetColumns;
  160.     End;
  161.  
  162.     TDBEdit=Class(TEdit)
  163.       Private
  164.          FDataLink:TFieldDataLink;
  165.          Procedure SetDataSource(NewValue:TDataSource);
  166.          Function GetDataSource:TDataSource;
  167.          Procedure SetDataField(NewValue:String);
  168.          Function GetDataField:String;
  169.          Procedure WriteBack;
  170.       Protected
  171.          Procedure SetupComponent;Override;
  172.          Procedure SetupShow;Override;
  173.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  174.          Procedure KillFocus;Override;
  175.          Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
  176.       Public
  177.          Destructor Destroy;Override;
  178.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  179.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  180.       Published
  181.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  182.          Property DataField:String Read GetDataField Write SetDataField;
  183.     End;
  184.  
  185.     TDBText=Class(TLabel)
  186.       Private
  187.          FDataLink:TFieldDataLink;
  188.          Procedure SetDataSource(NewValue:TDataSource);
  189.          Function GetDataSource:TDataSource;
  190.          Procedure SetDataField(NewValue:String);
  191.          Function GetDataField:String;
  192.       Protected
  193.          Procedure SetupComponent;Override;
  194.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  195.          Procedure SetupShow;Override;
  196.       Public
  197.          Destructor Destroy;Override;
  198.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  199.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  200.       Published
  201.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  202.          Property DataField:String Read GetDataField Write SetDataField;
  203.     End;
  204.  
  205.     TDBCheckBox=Class(TCheckBox)
  206.       Private
  207.          FDataLink:TFieldDataLink;
  208.          FValueChecked:PString;
  209.          FValueUnchecked:PString;
  210.          Procedure SetDataSource(NewValue:TDataSource);
  211.          Function GetDataSource:TDataSource;
  212.          Procedure SetDataField(NewValue:String);
  213.          Function GetDataField:String;
  214.          Procedure SetValueChecked(NewValue:String);
  215.          Function GetValueChecked:String;
  216.          Procedure SetValueUnchecked(NewValue:String);
  217.          Function GetValueUnchecked:String;
  218.          Procedure WriteBack;
  219.       Protected
  220.          Procedure SetupComponent;Override;
  221.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  222.          Procedure SetupShow;Override;
  223.          Procedure Click;Override;
  224.       Public
  225.          Destructor Destroy;Override;
  226.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  227.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  228.       Published
  229.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  230.          Property ValueChecked:String Read GetValueChecked Write SetValueChecked;
  231.          Property ValueUnchecked:String Read GetValueUnchecked Write SetValueUnchecked;
  232.          Property DataField:String Read GetDataField Write SetDataField;
  233.     End;
  234.  
  235.  
  236.     TDBImage=Class(TImage)
  237.       Private
  238.          FDataLink:TFieldDataLink;
  239.          FChangeLock:Boolean;
  240.          Procedure SetDataSource(NewValue:TDataSource);
  241.          Function GetDataSource:TDataSource;
  242.          Procedure SetDataField(NewValue:String);
  243.          Function GetDataField:String;
  244.          Procedure WriteBack;
  245.       Protected
  246.          Procedure SetupComponent;Override;
  247.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  248.          Procedure SetupShow;Override;
  249.          Procedure Change;Override;
  250.       Public
  251.          Destructor Destroy;Override;
  252.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  253.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  254.          Property Bitmap;
  255.       Published
  256.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  257.          Property DataField:String Read GetDataField Write SetDataField;
  258.     End;
  259.  
  260.  
  261.     TDBMemo=Class(TMemo)
  262.       Private
  263.          FDataLink:TFieldDataLink;
  264.          Procedure SetDataSource(NewValue:TDataSource);
  265.          Function GetDataSource:TDataSource;
  266.          Procedure SetDataField(NewValue:String);
  267.          Function GetDataField:String;
  268.          Procedure WriteBack;
  269.       Protected
  270.          Procedure SetupComponent;Override;
  271.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  272.          Procedure SetupShow;Override;
  273.          Procedure KillFocus;Override;
  274.       Public
  275.          Destructor Destroy;Override;
  276.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  277.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  278.       Published
  279.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  280.          Property DataField:String Read GetDataField Write SetDataField;
  281.     End;
  282.  
  283.     {$HINTS OFF}
  284.     TDBListBox=Class(TListBox)
  285.       Private
  286.          FDataLink:TFieldDataLink;
  287.          FDBStrings:TStrings;
  288.       Private
  289.          Procedure SetDataSource(NewValue:TDataSource);
  290.          Function GetDataSource:TDataSource;
  291.          Procedure SetDataField(NewValue:String);
  292.          Function GetDataField:String;
  293.          Procedure SetItems(NewValue:TStrings);
  294.       Protected
  295.          Procedure SetupComponent;Override;
  296.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  297.          Procedure SetupShow;Override;
  298.          Procedure ItemFocus(Index:LongInt);Override;
  299.       Public
  300.          Destructor Destroy;Override;
  301.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  302.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  303.       Public
  304.          Property Items:TStrings Read FDBStrings Write SetItems;
  305.       Published
  306.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  307.          Property DataField:String Read GetDataField Write SetDataField;
  308.     End;
  309.     {$HINTS ON}
  310.  
  311.     TDBComboBox=Class(TComboBox)
  312.        Private
  313.          FDataLink:TFieldDataLink;
  314.          FLock:Boolean;
  315.        Private
  316.          Procedure SetDataSource(NewValue:TDataSource);
  317.          Function GetDataSource:TDataSource;
  318.          Procedure SetDataField(NewValue:String);
  319.          Function GetDataField:String;
  320.          Procedure WriteBack;
  321.        Protected
  322.          Procedure EditChange;Override;
  323.          Procedure SetupShow;Override;
  324.          Procedure SetupComponent;Override;
  325.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  326.        Public
  327.          Destructor Destroy;Override;
  328.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  329.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  330.        Published
  331.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  332.          Property DataField:String Read GetDataField Write SetDataField;
  333.     End;
  334.  
  335.     TDBRadioGroup=Class(TRadioGroup)
  336.        Private
  337.          FDataLink:TFieldDataLink;
  338.          FValues:TStrings;
  339.          FLock:Boolean;
  340.        Private
  341.          Procedure SetDataSource(NewValue:TDataSource);
  342.          Function GetDataSource:TDataSource;
  343.          Procedure SetDataField(NewValue:String);
  344.          Function GetDataField:String;
  345.          Function GetValue:String;
  346.          Procedure SetValue(Const NewValue:String);
  347.          Procedure SetValues(NewValue:TStrings);
  348.          Procedure WriteBack;
  349.        Protected
  350.          Procedure SetupShow;Override;
  351.          Procedure SetupComponent;Override;
  352.          Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
  353.          Procedure ItemIndexChange;Override;
  354.        Public
  355.          Destructor Destroy;Override;
  356.          Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
  357.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
  358.        Public
  359.          Property Value:String Read GetValue Write SetValue;
  360.          Property Values:TStrings Read FValues Write SetValues;
  361.        Published
  362.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  363.          Property DataField:String Read GetDataField Write SetDataField;
  364.     End;
  365.  
  366.     {$M+}
  367.     TNavigateBtn=(dbFirst, dbPrior, dbNext, dbLast, dbInsert,
  368.                   dbDelete, dbEdit, dbPost, dbCancel, dbRefresh);
  369.     TNavigateBtnSet=Set Of TNavigateBtn;
  370.  
  371.     TNavClick=Procedure(Sender:TObject;Button:TNavigateBtn) Of Object;
  372.     {$M-}
  373.  
  374.     TDBNavigator=Class(TControl)
  375.       Private
  376.          FButtons:Array[TNavigateBtn] Of TBitBtn;
  377.          FVisibleButtons:TNavigateBtnSet;
  378.          FEnabledButtons:TNavigateBtnSet;
  379.          FDataLink:TTableDataLink;
  380.          FOnNavClick:TNavClick;
  381.          Procedure SetVisibleButtons(NewState:TNavigateBtnSet);
  382.          Procedure SetEnabledButtons(NewState:TNavigateBtnSet);
  383.          Function GetButton(Index:TNavigateBtn):TBitBtn;
  384.          Function GetDataSource:TDataSource;
  385.          Procedure SetDataSource(NewValue:TDataSource);
  386.          Procedure EvButtonClick(Sender:TObject);
  387.       Protected
  388.          Procedure CommandEvent(Var Command:TCommand);Override;
  389.          Procedure SetupComponent;Override;
  390.          Procedure CreateWnd;Override;
  391.          Procedure RealignControls;Override;
  392.          Property Buttons[Index:TNavigateBtn]:TBitBtn Read GetButton;
  393.          Property Hint;
  394.          Property Cursor;
  395.       Public
  396.          Destructor Destroy;Override;
  397.          Property XAlign;
  398.          Property XStretch;
  399.          Property YAlign;
  400.          Property YStretch;
  401.       Published
  402.          Property Align;
  403.          Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
  404.          Property DragCursor;
  405.          Property DragMode;
  406.          Property Enabled;
  407.          Property EnabledButtons:TNavigateBtnSet Read FEnabledButtons Write SetEnabledButtons;
  408.          Property ParentShowHint;
  409.          Property ShowHint;
  410.          Property TabOrder;
  411.          Property TabStop;
  412.          Property Visible;
  413.          Property VisibleButtons:TNavigateBtnSet Read FVisibleButtons Write SetVisibleButtons;
  414.          Property ZOrder;
  415.  
  416.          Property OnCanDrag;
  417.          Property OnClick:TNavClick Read FOnNavClick Write FOnNavClick;
  418.          Property OnDragDrop;
  419.          Property OnDragOver;
  420.          Property OnEndDrag;
  421.          Property OnEnter;
  422.          Property OnExit;
  423.          Property OnMouseMove;
  424.          Property OnResize;
  425.          Property OnSetupShow;
  426.          Property OnStartDrag;
  427.     End;
  428.  
  429.  
  430. Implementation
  431.  
  432. {
  433. ╔═══════════════════════════════════════════════════════════════════════════╗
  434. ║                                                                           ║
  435. ║ Speed-Pascal/2 Version 2.0                                                ║
  436. ║                                                                           ║
  437. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  438. ║                                                                           ║
  439. ║ This section: TDBGridColumns Class Implementation                         ║
  440. ║                                                                           ║
  441. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  442. ║                                                                           ║
  443. ╚═══════════════════════════════════════════════════════════════════════════╝
  444. }
  445.  
  446.  
  447. Procedure TDBGridColumns.BeginUpdate;
  448. Begin
  449.      FUpdateLocked:=True;
  450. End;
  451.  
  452. Procedure TDBGridColumns.EndUpdate;
  453. Begin
  454.      FUpdateLocked:=False;
  455.      If FGrid<>Nil Then
  456.       If FGrid.FColumns=Self Then FGrid.Invalidate;
  457. End;
  458.  
  459. Function TDBGridColumns.GetColumn(Index:LongInt):TDBGridColumn;
  460. Begin
  461.      Result:=TDBGridColumn(Inherited Items[Index]);
  462. End;
  463.  
  464. Procedure TDBGridColumns.SetColumn(Index:LongInt;Column:TDBGridColumn);
  465. Var OldColumn:TDBGridColumn;
  466. Begin
  467.      OldColumn:=Items[Index];
  468.      If OldColumn<>Column Then OldColumn.Destroy;
  469.  
  470.      Inherited Items[Index]:=Column;
  471. End;
  472.  
  473. Procedure TDBGridColumns.FreeItem(Item:Pointer);
  474. Var Column:TDBGridColumn;
  475. Begin
  476.      Inherited FreeItem(Item);
  477.      Column:=Item;
  478.      If Column<>Nil Then Column.Destroy;
  479. End;
  480.  
  481. Function TDBGridColumns.Add:TDBGridColumn;
  482. Begin
  483.      Result.Create(FGrid,Self);
  484.      Inherited Add(Result);
  485. End;
  486.  
  487. Procedure TDBGridColumns.Delete(Index:LongInt);
  488. Begin
  489.      Inherited Delete(Index);
  490.      If FGrid<>Nil Then If Not FUpdateLocked Then
  491.        If FGrid.FColumns=Self Then FGrid.Invalidate;
  492. End;
  493.  
  494. Constructor TDBGridColumns.Create(DBGrid:TDBGrid);
  495. Begin
  496.      Inherited Create;
  497.      FGrid:=DBGrid;
  498. End;
  499.  
  500. Destructor TDBGridColumns.Destroy;
  501. Begin
  502.      If FGrid<>Nil Then
  503.        If FGrid.FColumns=Self Then FGrid.FColumns:=Nil;
  504.      Inherited Destroy;
  505. End;
  506.  
  507. {
  508. ╔═══════════════════════════════════════════════════════════════════════════╗
  509. ║                                                                           ║
  510. ║ Speed-Pascal/2 Version 2.0                                                ║
  511. ║                                                                           ║
  512. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  513. ║                                                                           ║
  514. ║ This section: TDBGridColumn Class Implementation                          ║
  515. ║                                                                           ║
  516. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  517. ║                                                                           ║
  518. ╚═══════════════════════════════════════════════════════════════════════════╝
  519. }
  520.  
  521. Function TDBGridColumn.GetFieldName:String;
  522. Begin
  523.      If FFieldName<>Nil Then Result:=FFieldName^
  524.      Else Result:='';
  525. End;
  526.  
  527. Procedure TDBGridColumn.SetFieldName(Const NewValue:String);
  528. Begin
  529.      If FFieldName<>Nil Then FreeMem(FFieldName,Length(FFieldName^)+1);
  530.      GetMem(FFieldName,Length(NewValue)+1);
  531.      FFieldName^:=NewValue;
  532.      If FColumns<>Nil Then
  533.       If Not FColumns.FUpdateLocked Then
  534.        If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  535. End;
  536.  
  537. Procedure TDBGridColumn.SetTitle(NewTitle:TDBColumnTitle);
  538. Begin
  539.      If NewTitle<>FTitle Then FTitle.Destroy;
  540.      FTitle:=NewTitle;
  541.      If FTitle=Nil Then FTitle.Create(FGrid,Self);
  542.      FTitle.FGrid:=FGrid;
  543.      If FColumns<>Nil Then
  544.       If Not FColumns.FUpdateLocked Then
  545.        If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  546. End;
  547.  
  548. Procedure TDBGridColumn.SetColor(NewColor:TColor);
  549. Begin
  550.      FColor:=NewColor;
  551.      If FColumns<>Nil Then
  552.       If Not FColumns.FUpdateLocked Then
  553.        If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  554. End;
  555.  
  556. Procedure TDBGridColumn.SetPenColor(NewColor:TColor);
  557. Begin
  558.      FPenColor:=NewColor;
  559.      If FColumns<>Nil Then
  560.       If Not FColumns.FUpdateLocked Then
  561.         If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  562. End;
  563.  
  564. Function TDBGridColumn.GetWidth:LongInt;
  565. Begin
  566.      If FGrid.Columns<>Nil Then
  567.        If FGrid.Columns.IndexOf(Self)>=0 Then
  568.          Result:=FGrid.ColWidths[FGrid.FColumns.IndexOf(Self)+FGrid.FixedCols];
  569. End;
  570.  
  571. Procedure TDBGridColumn.SetWidth(NewWidth:LongInt);
  572. Begin
  573.      If FGrid.Columns<>Nil Then
  574.        If FGrid.Columns.IndexOf(Self)>=0 Then
  575.          FGrid.ColWidths[FGrid.FColumns.IndexOf(Self)+FGrid.FixedCols]:=NewWidth;
  576. End;
  577.  
  578. Procedure TDBGridColumn.SetAlignment(NewValue:TAlignment);
  579. Begin
  580.      FAlignment:=NewValue;
  581.      If FColumns<>Nil Then
  582.       If Not FColumns.FUpdateLocked Then
  583.        If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  584. End;
  585.  
  586. Function TDBGridColumn.GetFont:TFont;
  587. Begin
  588.      If FFont<>Nil Then Result:=FFont
  589.      Else Result:=FGrid.Font;
  590. End;
  591.  
  592. Procedure TDBGridColumn.SetFont(NewFont:TFont);
  593. Begin
  594.      If NewFont=FFont Then Exit;
  595.      FFont:=NewFont;
  596.      If FColumns<>Nil Then
  597.       If Not FColumns.FUpdateLocked Then
  598.        If FGrid.FColumns=FColumns Then FGrid.Invalidate;
  599. End;
  600.  
  601. {$HINTS OFF}
  602. Constructor TDBGridColumn.Create(DBGrid:TDBGrid;Columns:TDBGridColumn);
  603. Begin
  604.      Inherited Create;
  605.      FGrid:=DBGrid;
  606.      FTitle.Create(FGrid,Self);
  607.      FColor:=FGrid.EntryColor;
  608.      FPenColor:=FGrid.PenColor;
  609.      FWidth:=40;
  610.      FAlignment:=taLeftJustify;
  611. End;
  612. {$HINTS ON}
  613.  
  614. Destructor TDBGridColumn.Destroy;
  615. Begin
  616.      If FFieldName<>Nil Then FreeMem(FFieldName,Length(FFieldName^)+1);
  617.      If FTitle<>Nil Then FTitle.Destroy;
  618. End;
  619.  
  620. {
  621. ╔═══════════════════════════════════════════════════════════════════════════╗
  622. ║                                                                           ║
  623. ║ Speed-Pascal/2 Version 2.0                                                ║
  624. ║                                                                           ║
  625. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  626. ║                                                                           ║
  627. ║ This section: TDBColumnTitle Class Implementation                         ║
  628. ║                                                                           ║
  629. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  630. ║                                                                           ║
  631. ╚═══════════════════════════════════════════════════════════════════════════╝
  632. }
  633.  
  634. Function TDBColumnTitle.GetFont:TFont;
  635. Begin
  636.      If FFont<>Nil Then Result:=FFont
  637.      Else Result:=FGrid.Font;
  638. End;
  639.  
  640. Procedure TDBColumnTitle.SetFont(NewFont:TFont);
  641. Begin
  642.      If NewFont=FFont Then Exit;
  643.      FFont:=NewFont;
  644.      If FColumn.FColumns<>Nil Then
  645.       If Not FColumn.FColumns.FUpdateLocked Then
  646.        If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
  647. End;
  648.  
  649. Procedure TDBColumnTitle.SetColor(NewColor:TColor);
  650. Begin
  651.      FColor:=NewColor;
  652.      If FColumn.FColumns<>Nil Then
  653.       If Not FColumn.FColumns.FUpdateLocked Then
  654.        If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
  655. End;
  656.  
  657. Procedure TDBColumnTitle.SetPenColor(NewColor:TColor);
  658. Begin
  659.      FPenColor:=NewColor;
  660.      If FColumn.FColumns<>Nil Then
  661.       If Not FColumn.FColumns.FUpdateLocked Then
  662.        If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
  663. End;
  664.  
  665. Procedure TDBColumnTitle.SetAlignment(NewValue:TAlignment);
  666. Begin
  667.      FAlignment:=NewValue;
  668.      If FColumn.FColumns<>Nil Then
  669.       If Not FColumn.FColumns.FUpdateLocked Then
  670.        If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
  671. End;
  672.  
  673. Constructor TDBColumnTitle.Create(DBGrid:TDBGrid;Column:TDBGridColumn);
  674. Begin
  675.      Inherited Create;
  676.  
  677.      FGrid:=DBGrid;
  678.      FColumn:=Column;
  679.      FColor:=FGrid.FixedColor;
  680.      FPenColor:=FGrid.PenColor;
  681.      FAlignment:=taLeftJustify;
  682. End;
  683.  
  684. Destructor TDBColumnTitle.Destroy;
  685. Begin
  686.      If FCaption<>Nil Then FreeMem(FCaption,Length(FCaption^)+1);
  687.      Inherited Destroy;
  688. End;
  689.  
  690. Function TDBColumnTitle.GetCaption:String;
  691. Begin
  692.      If FCaption<>Nil Then Result:=FCaption^
  693.      Else Result:=FColumn.FieldName;
  694. End;
  695.  
  696. Procedure TDBColumnTitle.SetCaption(Const NewValue:String);
  697. Begin
  698.      If FCaption<>Nil Then FreeMem(FCaption,Length(FCaption^)+1);
  699.      GetMem(FCaption,Length(NewValue)+1);
  700.      FCaption^:=NewValue;
  701.      If FColumn.FColumns<>Nil Then
  702.       If Not FColumn.FColumns.FUpdateLocked Then
  703.        If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
  704. End;
  705.  
  706. {
  707. ╔═══════════════════════════════════════════════════════════════════════════╗
  708. ║                                                                           ║
  709. ║ Speed-Pascal/2 Version 2.0                                                ║
  710. ║                                                                           ║
  711. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  712. ║                                                                           ║
  713. ║ This section: TDBGrid Class Implementation                                ║
  714. ║                                                                           ║
  715. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  716. ║                                                                           ║
  717. ╚═══════════════════════════════════════════════════════════════════════════╝
  718. }
  719.  
  720. Type TInplaceDBEdit=Class(TInplaceEdit)
  721.         Protected
  722.             FControl:TControl;
  723.             FFieldType:TFieldType;
  724.         Protected
  725.             Function GetText:String;Override;
  726.             Function GetControl:TComponent;Override;
  727.             Procedure SetText(Const NewValue:String);Override;
  728.             Procedure SetWindowPos(X,Y,W,H:LongInt);Override;
  729.             Procedure SetupEdit(Grid:TGrid);Override;
  730.             Destructor Destroy;Override;
  731.             Procedure Show;Override;
  732.             Procedure Hide;Override;
  733.      End;
  734.  
  735. Function TInplaceDBEdit.GetText:String;
  736. Begin
  737.      Case FFieldType Of
  738.         ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:Result:=TEdit(FControl).Text;
  739.         ftBoolean:Result:=TComboBox(FControl).Text;
  740.         ftDate,ftTime,ftDateTime:Result:=TMaskEdit(FControl).Text;
  741.      End; //case
  742. End;
  743.  
  744. Function TInplaceDBEdit.GetControl:TComponent;
  745. Begin
  746.      Result:=FControl;
  747. End;
  748.  
  749. Procedure TInplaceDBEdit.SetText(Const NewValue:String);
  750. Begin
  751.      Case FFieldType Of
  752.         ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:TEdit(FControl).Text:=NewValue;
  753.         ftBoolean:TComboBox(FControl).Text:=NewValue;
  754.         ftDate,ftTime,ftDateTime:TMaskEdit(FControl).Text:=NewValue;
  755.      End; //case
  756. End;
  757.  
  758. Procedure TInplaceDBEdit.SetWindowPos(X,Y,W,H:LongInt);
  759. Begin
  760.      Case FFieldType Of
  761.         ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency,
  762.         ftDate,ftTime,ftDateTime:FControl.SetWindowPos(X,Y,W,H);
  763.         ftBoolean:FControl.SetWindowPos(X-1,Y+2,W+2,H);
  764.      End; //case
  765. End;
  766.  
  767. Procedure TInplaceDBEdit.SetupEdit(Grid:TGrid);
  768. Var Edit:TEdit;
  769.     ComboBox:TComboBox;
  770.     FieldType:TFieldType;
  771.     MaskEdit:TMaskEdit;
  772.     Index:Longint;
  773.  
  774.     Function BuildMask(Value:String):String;
  775.     Var t:LongInt;
  776.     Begin
  777.          If pos(' ampm',Value)<>0 Then Value[0]:=chr(Pos(' ampm',Value)-1);
  778.          If ((pos('h:',Value)=1)Or(pos(' h:',Value)<>0)) Then
  779.            Insert('h',Value,pos('h:',Value));
  780.          For t:=1 To Length(Value) Do
  781.           If Value[t] In ['y','d','m','h','s'] Then Value[t]:='9';
  782.          Result:=Value+';1;0';
  783.     End;
  784. Begin
  785.      Index:=Col-Grid.FixedCols;
  786.      FieldType:=TDBGrid(Grid).FDataLink.DataSource.DataSet.FieldTypes[Index];
  787.      If FControl<>Nil Then If FieldType<>FFieldType Then
  788.      Begin
  789.           FControl.Destroy;
  790.           FControl:=Nil;
  791.      End;
  792.      FFieldType:=FieldType;
  793.  
  794.      If FControl=Nil Then
  795.      Begin
  796.           Case FFieldType Of
  797.              ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:
  798.              Begin
  799.                   Edit.Create(Grid);
  800.                   Edit.NumbersOnly:=True;
  801.                   Edit.BorderStyle:=bsNone;
  802.                   FControl:=Edit;
  803.              End;
  804.              ftBoolean:
  805.              Begin
  806.                   ComboBox.Create(Grid);
  807.                   ComboBox.Style:=csDropDownList;
  808.                   ComboBox.Items.Add('True');
  809.                   ComboBox.Items.Add('False');
  810.                   ComboBox.BorderStyle:=bsNone;
  811.                   FControl:=ComboBox;
  812.              End;
  813.              ftDate:
  814.              Begin
  815.                   MaskEdit.Create(Grid);
  816.                   MaskEdit.BorderStyle:=bsNone;
  817.                   MaskEdit.EditMask:=BuildMask(ShortDateFormat);
  818.                   FControl:=MaskEdit;
  819.              End;
  820.              ftTime:
  821.              Begin
  822.                   MaskEdit.Create(Grid);
  823.                   MaskEdit.BorderStyle:=bsNone;
  824.                   MaskEdit.EditMask:=BuildMask(LongTimeFormat);
  825.                   FControl:=MaskEdit;
  826.              End;
  827.              ftDateTime:
  828.              Begin
  829.                   MaskEdit.Create(Grid);
  830.                   MaskEdit.BorderStyle:=bsNone;
  831.                   MaskEdit.EditMask:=BuildMask(ShortDateFormat+' '+LongTimeFormat);
  832.                   FControl:=MaskEdit;
  833.              End;
  834.           End; //case
  835.      End;
  836. End;
  837.  
  838. Destructor TInplaceDBEdit.Destroy;
  839. Begin
  840.      FControl.Destroy;
  841.      Inherited Destroy;
  842. End;
  843.  
  844. Procedure TInplaceDBEdit.Show;
  845. Begin
  846.     If FFieldType=ftBoolean Then TComboBox(FControl).OnExit:=Nil; //!!
  847.     FControl.Show;
  848. End;
  849.  
  850. Procedure TInplaceDBEdit.Hide;
  851. Begin
  852.      FControl.Hide;
  853. End;
  854.  
  855. Type
  856.     TColumnsRec=Record
  857.                        ColAlignment:TAlignment;
  858.                        ColColor:TColor;
  859.                        ColPenColor:TColor;
  860.                        ColWidth:LongInt;
  861.                        ColReadOnly:Boolean;
  862.                        TitleAlignment:TAlignment;
  863.                        TitleColor:TColor;
  864.                        TitlePenColor:TColor;
  865.      End;
  866.  
  867. Function TDBGrid.ShowEditor(Col,Row:LongInt):TInplaceEditClass;
  868. Var FieldType:TFieldType;
  869. Begin
  870.      Col:=Col-FixedCols;
  871.      Result:=Nil; //default editor
  872.      If FGridOptions*[dgEnableMaskEdit]<>[] Then
  873.        If FDataLink.DataSource<>Nil Then
  874.           If FDataLink.DataSource.DataSet<>Nil Then
  875.             If FDataLink.DataSource.DataSet.Active Then
  876.               If Col>=0 Then
  877.                 If Col<=FDataLink.DataSource.DataSet.FieldCount Then
  878.      Begin
  879.           FieldType:=FDataLink.DataSource.DataSet.FieldTypes[Col];
  880.           Case FieldType Of
  881.              ftSmallInt,ftInteger,ftWord,ftBoolean,
  882.              ftFloat,ftCurrency:Result:=TInplaceDBEdit;
  883.              ftDate,ftTime,ftDateTime:Result:=TInplaceDBEdit;
  884.           End; //case
  885.      End;
  886. End;
  887.  
  888. Procedure TDBGrid.SetFont(NewFont:TFont);
  889. Var Column:TDBGridColumn;
  890.     OldFont:TFont;
  891.     T:LongInt;
  892. Begin
  893.      OldFont:=Font;
  894.      Inherited SetFont(NewFont);
  895.  
  896.      If ((NewFont<>OldFont)And(FColumns<>Nil)) Then For T:=0 To FColumns.Count-1 Do
  897.      Begin
  898.           Column:=FColumns[T];
  899.           If Column.Font=OldFont Then Column.Font:=NewFont;
  900.           If Column.Title.Font=OldFont Then Column.Title.Font:=NewFont;
  901.      End;
  902. End;
  903.  
  904. {$HINTS OFF}
  905. Procedure TDBGrid.RowHeightChanged(Row:LongInt);
  906. Begin
  907. End;
  908. {$HINTS ON}
  909.  
  910. Procedure TDBGrid.ColWidthChanged(Col:LongInt);
  911. Var Column:TDBGridColumn;
  912. Begin
  913.      If FColumns<>Nil Then
  914.      Begin
  915.           If Col-FixedCols>=0 Then
  916.             If Col-FixedCols<=FColumns.Count-1 Then
  917.             Begin
  918.                  Column:=FColumns.Items[Col-FixedCols];
  919.                  If Column<>Nil Then Column.Width:=ColWidths[Col];
  920.             End;
  921.           FColumns.FAutoCreated := False;
  922.      End;
  923. End;
  924.  
  925. Function TDBGrid.WriteSCUResource(Stream:TResourceStream):Boolean;
  926. Var MemStream:TMemoryStream;
  927.     T:LongInt;
  928.     Column:TDBGridColumn;
  929.     rec:TColumnsRec;
  930.     S,s1:String;
  931.     Attrs:TFontAttributes;
  932. Begin
  933.      Result:=Inherited WriteSCUResource(Stream);
  934.      If Not Result Then Exit;
  935.  
  936.      If FColumns<>Nil Then
  937.        If Not FColumns.AutoCreated Then
  938.          If FColumns.Count>0 Then
  939.      Begin
  940.           MemStream.Create;
  941.  
  942.           T:=FColumns.Count-1;
  943.           MemStream.WriteBuffer(T,4);  //Array elements
  944.           For T:=0 To FColumns.Count-1 Do
  945.           Begin
  946.                Column:=FColumns.Items[T];
  947.  
  948.                rec.ColAlignment:=Column.Alignment;
  949.                rec.ColColor:=Column.color;
  950.                rec.ColPenColor:=Column.PenColor;
  951.                rec.ColWidth:=Column.Width;
  952.                rec.ColReadOnly:=Column.ReadOnly;
  953.                rec.TitleAlignment:=Column.Title.Alignment;
  954.                rec.TitlePenColor:=Column.Title.PenColor;
  955.                rec.TitleColor:=Column.Title.color;
  956.  
  957.                MemStream.WriteBuffer(rec,SizeOf(TColumnsRec));
  958.  
  959.                S:=Column.FieldName;
  960.                MemStream.WriteBuffer(S,Length(S)+1);
  961.                S:=Column.Title.Caption;
  962.                MemStream.WriteBuffer(S,Length(S)+1);
  963.  
  964.                If Column.Font=Font Then S:=''
  965.                Else
  966.                Begin
  967.                     S:=Column.Font.FaceName;
  968.                     If Column.Font.IsDefault Then S:='System Default Font';
  969.                     S:=tostr(Column.Font.PointSize)+'.'+S;
  970.  
  971.                     s1:=S;
  972.                     UpcaseStr(s1);
  973.                     Attrs:=Column.Font.Attributes;
  974.                     If Attrs*[faBold]<>[] Then If Pos(' BOLD',s1)=0 Then S:=S+'!BOLD!';
  975.                     If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',s1)=0 Then S:=S+'!ITALIC!';
  976.                     If Attrs*[faOutline]<>[] Then S:=S+'!OUTLINE!';
  977.                     If Attrs*[faStrikeOut]<>[] Then S:=S+'!STRIKEOUT!';
  978.                     If Attrs*[faUnderScore]<>[] Then S:=S+'!UNDERSCORE!';
  979.                End;
  980.                MemStream.WriteBuffer(S,Length(S)+1);
  981.  
  982.                If Column.Title.Font=Font Then S:=''
  983.                Else
  984.                Begin
  985.                     S:=Column.Title.Font.FaceName;
  986.                     If Column.Title.Font.IsDefault Then S:='System Default Font';
  987.                     S:=tostr(Column.Title.Font.PointSize)+'.'+S;
  988.  
  989.                     s1:=S;
  990.                     UpcaseStr(s1);
  991.                     Attrs:=Column.Title.Font.Attributes;
  992.                     If Attrs*[faBold]<>[] Then If Pos(' BOLD',s1)=0 Then S:=S+'!BOLD!';
  993.                     If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',s1)=0 Then S:=S+'!ITALIC!';
  994.                     If Attrs*[faOutline]<>[] Then S:=S+'!OUTLINE!';
  995.                     If Attrs*[faStrikeOut]<>[] Then S:=S+'!STRIKEOUT!';
  996.                     If Attrs*[faUnderScore]<>[] Then S:=S+'!UNDERSCORE!';
  997.                End;
  998.                MemStream.WriteBuffer(S,Length(S)+1);
  999.           End;
  1000.  
  1001.           If MemStream.Size>0 Then Result:=Stream.NewResourceEntry(rnDBGridCols,
  1002.                                                                    MemStream.Memory^,MemStream.Size);
  1003.           MemStream.Destroy;
  1004.      End;
  1005. End;
  1006.  
  1007. Function ModifyFontName(FontName:String;Const Attrs:TFontAttributes):String;
  1008. Begin
  1009.      Result:=FontName;
  1010.      UpcaseStr(FontName);
  1011.      If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',FontName)=0 Then Result:=Result+'.Italic';
  1012.      If Attrs*[faBold]<>[] Then If Pos(' BOLD',FontName)=0 Then Result:=Result+'.Bold';
  1013.      If Attrs*[faOutline]<>[] Then Result:=Result+'.Outline';
  1014.      If Attrs*[faStrikeOut]<>[] Then Result:=Result+'.Strikeout';
  1015.      If Attrs*[faUnderScore]<>[] Then Result:=Result+'.Underscore';
  1016. End;
  1017.  
  1018. Procedure TDBGrid.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  1019. Var Count:^LongInt;
  1020.     T,t1:LongInt;
  1021.     Temp:^Byte;
  1022.     Column:TDBGridColumn;
  1023.     rec:TColumnsRec;
  1024.     S,s1:String;
  1025.     PointSize:LongInt;
  1026.     C:Integer;
  1027.     Attrs:TFontAttributes;
  1028. Begin
  1029.      If ResName=rnDBGridCols Then
  1030.      Begin
  1031.           Count:=@Data;
  1032.           Temp:=@Data;
  1033.           Inc(Temp,4);
  1034.           If Count^>=0 Then  //FColumns.Count-1 was written to SCU
  1035.           Begin
  1036.                FColumns.Create(Self);
  1037.                FColumns.BeginUpdate;
  1038.           End;
  1039.           For T:=0 To Count^ Do
  1040.           Begin
  1041.                Column:=FColumns.Add;
  1042.                System.Move(Temp^,rec,SizeOf(TColumnsRec));
  1043.                Inc(Temp,SizeOf(TColumnsRec));
  1044.                Column.Alignment:=rec.ColAlignment;
  1045.                Column.color:=rec.ColColor;
  1046.                Column.PenColor:=rec.ColPenColor;
  1047.                Column.Width:=rec.ColWidth;
  1048.                Column.ReadOnly:=rec.ColReadOnly;
  1049.                Column.Title.Alignment:=rec.TitleAlignment;
  1050.                Column.Title.PenColor:=rec.TitlePenColor;
  1051.                Column.Title.color:=rec.TitleColor;
  1052.  
  1053.                System.Move(Temp^,S,Temp^+1);
  1054.                Inc(Temp,Temp^+1);
  1055.                Column.FieldName:=S;
  1056.                System.Move(Temp^,S,Temp^+1);
  1057.                Inc(Temp,Temp^+1);
  1058.                Column.Title.Caption:=S;
  1059.  
  1060.                System.Move(Temp^,S,Temp^+1);
  1061.                Inc(Temp,Temp^+1);
  1062.                If S<>'' Then
  1063.                Begin
  1064.                     Attrs:=[];
  1065.                     t1:=Pos('!',S);
  1066.                     If t1<>0 Then
  1067.                     Begin
  1068.                          If Pos('!BOLD!',S)<>0 Then Attrs:=Attrs+[faBold];
  1069.                          If Pos('!ITALIC!',S)<>0 Then Attrs:=Attrs+[faItalic];
  1070.                          If Pos('!OUTLINE!',S)<>0 Then Attrs:=Attrs+[faOutline];
  1071.                          If Pos('!STRIKEOUT!',S)<>0 Then Attrs:=Attrs+[faStrikeOut];
  1072.                          If Pos('!UNDERSCORE!',S)<>0 Then Attrs:=Attrs+[faUnderScore];
  1073.                          If Attrs<>[] Then S[0]:=Chr(t1-1);
  1074.                     End;
  1075.  
  1076.                     PointSize:=0;
  1077.                     If Pos('.',S)<>0 Then
  1078.                     Begin
  1079.                          s1:=Copy(S,1,Pos('.',S)-1);
  1080.                          Delete(S,1,Pos('.',S));
  1081.                          Val(s1,PointSize,C);
  1082.                     End;
  1083.                     S:=ModifyFontName(S,Attrs);
  1084.                     Column.Font:=Screen.GetFontFromPointSize(S,PointSize);
  1085.                End;
  1086.  
  1087.                System.Move(Temp^,S,Temp^+1);
  1088.                Inc(Temp,Temp^+1);
  1089.                If S<>'' Then
  1090.                Begin
  1091.                     Attrs:=[];
  1092.                     t1:=Pos('!',S);
  1093.                     If t1<>0 Then
  1094.                     Begin
  1095.                          If Pos('!BOLD!',S)<>0 Then Attrs:=Attrs+[faBold];
  1096.                          If Pos('!ITALIC!',S)<>0 Then Attrs:=Attrs+[faItalic];
  1097.                          If Pos('!OUTLINE!',S)<>0 Then Attrs:=Attrs+[faOutline];
  1098.                          If Pos('!STRIKEOUT!',S)<>0 Then Attrs:=Attrs+[faStrikeOut];
  1099.                          If Pos('!UNDERSCORE!',S)<>0 Then Attrs:=Attrs+[faUnderScore];
  1100.                          If Attrs<>[] Then S[0]:=Chr(t1-1);
  1101.                     End;
  1102.  
  1103.                     PointSize:=0;
  1104.                     If Pos('.',S)<>0 Then
  1105.                     Begin
  1106.                          s1:=Copy(S,1,Pos('.',S)-1);
  1107.                          Delete(S,1,Pos('.',S));
  1108.                          Val(s1,PointSize,C);
  1109.                     End;
  1110.                     S:=ModifyFontName(S,Attrs);
  1111.                     Column.Title.Font:=Screen.GetFontFromPointSize(S,PointSize);
  1112.                End;
  1113.           End;
  1114.           If FColumns<>Nil Then FColumns.EndUpdate;
  1115.      End
  1116.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  1117. End;
  1118.  
  1119. Procedure TDBGrid.SetColumns(NewColumns:TDBGridColumns);
  1120. Var T:LongInt;
  1121.     Column:TDBGridColumn;
  1122. Begin
  1123.      If NewColumns<>FColumns Then If FColumns<>Nil Then FColumns.Destroy;
  1124.      FColumns:=NewColumns;
  1125.  
  1126.      If FColumns<>Nil Then FColumns.FGrid:=Self;
  1127.  
  1128.      If FColumns<>Nil Then If FColumns.Count=0 Then
  1129.      Begin
  1130.           FColumns.Destroy;
  1131.           FColumns:=Nil;
  1132.      End;
  1133.  
  1134.      If FColumns<>Nil Then
  1135.      Begin
  1136.           ColCount:=FColumns.Count+FixedCols;
  1137.           For T:=0 To FColumns.Count-1 Do
  1138.           Begin
  1139.                Column:=FColumns.Items[T];
  1140.                ColWidths[T+FixedCols]:=Column.Width;
  1141.           End;
  1142.      End
  1143.      Else
  1144.      Begin
  1145.           If FDataLink.DataSource<>Nil Then ColCount:=FDataLink.FieldCount+FixedCols;
  1146.      End;
  1147.  
  1148.      Invalidate;
  1149. End;
  1150.  
  1151. Procedure TDBGrid.SetGridOptions(NewValue:TDBGridOptions);
  1152. Var IOptions:TGridOptions;
  1153. Begin
  1154.      IOptions:=[];
  1155.      FGridOptions:=NewValue;
  1156.      If FGridOptions*[dgBorder]<>[] Then Include(IOptions,goBorder);
  1157.      If FGridOptions*[dgRowResize]<>[] Then Include(IOptions,goRowSizing);
  1158.      If FGridOptions*[dgColumnResize]<>[] Then Include(IOptions,goColSizing);
  1159.      If FGridOptions*[dgEditing]<>[] Then Include(IOptions,goEditing);
  1160.      If FGridOptions*[dgAlwaysShowEditor]<>[] Then Include(IOptions,goAlwaysShowEditor);
  1161.      If FGridOptions*[dgShowSelection]<>[] Then Include(IOptions,goShowSelection);
  1162.      If FGridOptions*[dgAlwaysShowSelection]<>[] Then Include(IOptions,goAlwaysShowSelection);
  1163.      If FGridOptions*[dgMouseSelect]<>[] Then Include(IOptions,goMouseSelect);
  1164.      Inherited Options:=IOptions;
  1165.  
  1166.      If FGridOptions*[dgIndicator]=[] Then FixedCols:=0
  1167.      Else FixedCols:=1;
  1168.      If FGridOptions*[dgTitles]=[] Then FixedRows:=0
  1169.      Else FixedRows:=1;
  1170. End;
  1171.  
  1172. Function TDBGrid.SelectCell(Col,Row:LongInt):Boolean;
  1173. Begin
  1174.      Result:=Inherited SelectCell(Col,Row);
  1175.      If FDataLink.DataSource<>Nil Then
  1176.       If FDataLink.DataSource.DataSet<>Nil Then
  1177.         If FDataLink.DataSource.DataSet.Active Then
  1178.         Begin
  1179.              Try
  1180.                 FDataLink.DataSource.DataSet.CurrentRow:=Row-1;
  1181.              Except
  1182.                 ON E:ESQLError Do ErrorBox(E.Message);
  1183.                 Else Raise;
  1184.              End;
  1185.         End;
  1186. End;
  1187.  
  1188. Procedure TDBGrid.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
  1189. Begin
  1190.      If ScrollCode In [scVertTrack,scHorzTrack] Then Exit;
  1191.      Inherited Scroll(ScrollBar,ScrollCode,ScrollPos);
  1192. End;
  1193.  
  1194. Procedure TDBGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
  1195. Var Col1:LongInt;
  1196.     Column:TDBGridColumn;
  1197. Begin
  1198.      Col1:=Col-FixedCols;
  1199.      If ((FColumns<>Nil)And(Col1>=0)And(Col1<FColumns.Count)) Then
  1200.      Begin
  1201.           Column:=FColumns.Items[Col1];
  1202.           If Row<FixedRows Then
  1203.           Begin
  1204.                background:=Column.Title.color;
  1205.                ForeGround:=Column.Title.PenColor;
  1206.           End
  1207.           Else
  1208.           Begin
  1209.                background:=Column.color;
  1210.                ForeGround:=Column.PenColor;
  1211.           End;
  1212.      End
  1213.      Else Inherited SetupCellColors(Col,Row,AState,background,ForeGround);
  1214.  
  1215.      If AState*[gdFixed]=[] Then
  1216.      Begin
  1217.           If AState*[gdSelected]<>[] Then If Options*[goShowSelection,goEditing]<>[] Then
  1218.           Begin
  1219.                If AState*[gdFocused]=[] Then
  1220.                Begin
  1221.                     If Options*[goAlwaysShowSelection]<>[] Then
  1222.                     Begin
  1223.                          background:=clHighlight;
  1224.                          ForeGround:=clHighlightText;
  1225.                     End;
  1226.                End
  1227.                Else
  1228.                Begin
  1229.                     background:=clHighlight;
  1230.                     ForeGround:=clHighlightText;
  1231.                End;
  1232.           End;
  1233.      End;
  1234. End;
  1235.  
  1236. Procedure TDBGrid.SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
  1237.                                    Var Alignment:TAlignment;Var DrawFont:TFont);
  1238. Var Col1:LongInt;
  1239.     Column:TDBGridColumn;
  1240. Begin
  1241.      Col1:=Col-FixedCols;
  1242.      If ((FColumns<>Nil)And(Col1>=0)And(Col1<FColumns.Count)) Then
  1243.      Begin
  1244.           Column:=FColumns.Items[Col1];
  1245.           If Row<FixedRows Then
  1246.           Begin
  1247.                Alignment:=Column.Title.Alignment;
  1248.                DrawFont:=Column.Title.Font;
  1249.           End
  1250.           Else
  1251.           Begin
  1252.                Alignment:=Column.Alignment;
  1253.                DrawFont:=Column.Font;
  1254.           End;
  1255.      End
  1256.      Else Inherited SetupCellDrawing(Col,Row,AState,Alignment,DrawFont);
  1257. End;
  1258.  
  1259. Procedure TDBGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
  1260. Var rc:TRect;
  1261.     X,Y,CX,CY:LongInt;
  1262.     s:String;
  1263. Begin
  1264.      If Canvas=Nil Then Exit;
  1265.  
  1266.      Inherited DrawCell(Col,Row,rec,AState);
  1267.  
  1268.      If ((AState*[gdFixed]<>[])And(Col=0)And(Col<FixedCols)And(Row-FixedRows>=0)And
  1269.          (FDataLink.DataSource<>Nil)And(FDataLink.DataSource.DataSet<>Nil)) Then
  1270.      Begin
  1271.           If Row-FixedRows=FDataLink.DataSource.DataSet.CurrentRow Then
  1272.           Begin
  1273.                {Draw Polygon To Mark Current Row In DataSet}
  1274.                rc:=GridRects[Col,Row];
  1275.                Canvas.ClipRect := rc;
  1276.                X:=rc.Left+((((rc.Right-rc.Left)-10) Div 2));
  1277.                Y:=rc.Bottom+(((rc.Top-rc.Bottom)-10) Div 2);
  1278.                Canvas.Pen.Color:=PenColor;
  1279.                If FDataLink.DataSource.DataSet.RowInserted
  1280.                Then Canvas.PolyLine([Point(X,Y),Point(X,Y+10),Point(X+10,Y+5),Point(X,Y)])
  1281.                Else Canvas.Polygon([Point(X,Y),Point(X,Y+10),Point(X+10,Y+5),Point(X,Y)]);
  1282.           End
  1283.           Else
  1284.           Begin
  1285.                If dgLineNumbers In FGridOptions Then
  1286.                Begin
  1287.                     rc:=GridRects[Col,Row];
  1288.                     Canvas.ClipRect:=rc;
  1289.                     s:=tostr(Row-FixedRows+1);
  1290.                     Canvas.GetTextExtent(s,CX,CY);
  1291.                     X:=rc.Right-3-CX;
  1292.                     Y:=rc.Top-2-Canvas.Font.Height;
  1293.                     Canvas.Pen.Color:=PenColor;
  1294.                     Canvas.TextOut(X,Y,s);
  1295.                End;
  1296.           End;
  1297.      End;
  1298. End;
  1299.  
  1300. Function TDBGrid.GetCell(Col,Row:LongInt):String;
  1301. Var
  1302.     Field:TField;
  1303.     Column:TDBGridColumn;
  1304.     Col1:LongInt;
  1305. Begin
  1306.      Result:='';
  1307.  
  1308.      If Row<=FixedRows-1 Then
  1309.      Begin
  1310.           If Row=0 Then If Col>=FixedCols-1 Then
  1311.           Begin
  1312.                If FColumns<>Nil Then
  1313.                Begin
  1314.                     Col1:=Col-FixedCols;
  1315.                     If ((Col1>=0)And(Col1<FColumns.Count)) Then
  1316.                     Begin
  1317.                          Column:=FColumns.Items[Col1];
  1318.                          Result:=Column.Title.Caption;
  1319.                          If Result='' Then Result:=Column.FieldName;
  1320.                     End
  1321.                     Else Result:=Inherited GetCell(Col,Row);
  1322.                End
  1323.                Else
  1324.                Begin
  1325.                     If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  1326.                     Result:=FDataLink.DataSource.DataSet.FieldNames[Col-FixedCols];
  1327.                End;
  1328.           End;
  1329.      End
  1330.      Else If Col<=FixedCols-1 Then Exit
  1331.      Else
  1332.      Begin
  1333.           Try
  1334.              Field:=Nil;
  1335.              If FColumns<>Nil Then
  1336.              Begin
  1337.                   Col1:=Col-FixedCols;
  1338.                   If ((Col1>=0)And(Col1<FColumns.Count)) Then
  1339.                   Begin
  1340.                        If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then
  1341.                        Begin
  1342.                             Result:=Inherited GetCell(Col,Row);
  1343.                             Exit;
  1344.                        End;
  1345.  
  1346.                        Column:=FColumns.Items[Col1];
  1347.                        Field:=FDataLink.FieldsFromColumnName[Column.FieldName,Row-FixedRows];
  1348.                        If Field=Nil Then //ColumnName does Not exist
  1349.                        Begin
  1350.                             Result:=Inherited GetCell(Col,Row);
  1351.                             Exit;
  1352.                        End;
  1353.                   End
  1354.                   Else
  1355.                   Begin
  1356.                        Result:=Inherited GetCell(Col,Row);
  1357.                        Exit;
  1358.                   End;
  1359.              End
  1360.              Else
  1361.              Begin
  1362.                   If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  1363.                   Field:=FDataLink.Fields[Col-FixedCols,Row-FixedRows];
  1364.                   If Field=Nil Then RowCount:=Row;  {no more Rows}
  1365.              End;
  1366.           Except
  1367.              ON E:ESQLError Do
  1368.              Begin
  1369.                   ErrorBox(E.Message);
  1370.                   Field:=Nil;
  1371.              End;
  1372.              Else Raise;
  1373.           End;
  1374.           If Field<>Nil Then Result:=Field.AsString;
  1375.      End;
  1376. End;
  1377.  
  1378. {$HINTS OFF}
  1379. Procedure TDBGrid.SetCell(Col,Row:LongInt;Const NewContent:String);
  1380. Var Field:TField;
  1381.     Column:TDBGridColumn;
  1382.     Col1:LongInt;
  1383. Begin
  1384.      If FDataLink.DataSource=Nil Then Exit;
  1385.      If FDataLink.DataSource.DataSet=Nil Then Exit;
  1386.  
  1387.      If ((Col<FixedCols)Or(Row<FixedRows)) Then Exit;
  1388.  
  1389.      Try
  1390.         Field:=Nil;
  1391.         If FColumns<>Nil Then
  1392.         Begin
  1393.              Col1:=Col-FixedCols;
  1394.              If ((Col1>=0)And(Col1<FColumns.Count)) Then
  1395.              Begin
  1396.                   Column:=FColumns.Items[Col1];
  1397.                   If Not Column.ReadOnly Then
  1398.                   Begin
  1399.                        Field:=FDataLink.FieldsFromColumnName[Column.FieldName,Row-FixedRows];
  1400.                        If Field=Nil Then //ColumnName does Not exist
  1401.                        Begin
  1402.                             Inherited SetCell(Col,Row,NewContent);
  1403.                             Exit;
  1404.                        End;
  1405.                   End;
  1406.              End
  1407.              Else
  1408.              Begin
  1409.                   Inherited SetCell(Col,Row,NewContent);
  1410.                   Exit;
  1411.              End;
  1412.         End
  1413.         Else Field:=FDataLink.Fields[Col-FixedCols,Row-FixedRows];
  1414.      Except
  1415.         ON E:ESQLError Do
  1416.         Begin
  1417.              ErrorBox(E.Message);
  1418.              Field:=Nil;
  1419.         End;
  1420.         Else Raise;
  1421.      End;
  1422.  
  1423.      If Field=Nil Then Exit;
  1424.  
  1425.      If Field.AsString=NewContent Then Exit;
  1426.      Field.AsString:=NewContent;
  1427.      If Not FDataLink.DataSource.DataSet.RowInserted
  1428.      Then FDataLink.DataSource.DataSet.Post
  1429.      Else FDataLink.DataSource.DataSet.Refresh;
  1430. End;
  1431.  
  1432. Procedure TDBGrid.DataChange(Sender:TObject;event:TDataChange);
  1433. Var Col,Row:LongInt;
  1434.     I:LongInt;
  1435.     FieldClass:TFieldClass;
  1436.     LastRow:LongInt;
  1437.     T,t1:LongInt;
  1438.     X,Y:LongInt;
  1439.     su:Boolean;
  1440.     Max:LongInt;
  1441.     dummy:TDBGridColumn;
  1442. Begin
  1443.      If Event=deTableNameChanged Then
  1444.      Begin
  1445.           Columns:=Nil;
  1446.           exit;
  1447.      End;
  1448.  
  1449.      GridUpdateLocked:=True;
  1450.      If FDataLink.DataSource<>Nil Then
  1451.      Begin
  1452.           If (FColumns=Nil) And (FDataLink.FieldCount>0) Then
  1453.           Begin
  1454.                //add default columns
  1455.                ColCount:=FDataLink.FieldCount+FixedCols;  {!!}
  1456.  
  1457.                FColumns.Create(Self);
  1458.                FColumns.FAutoCreated := True;
  1459.  
  1460.                For t:=0 To FDataLink.FieldCount-1 Do
  1461.                Begin
  1462.                    dummy:=FColumns.Add;
  1463.                    dummy.Alignment:=taLeftJustify;
  1464.                    dummy.Color:=clEntryField;
  1465.                    dummy.PenColor:=clBlack;
  1466.                    dummy.Width:=DefaultColWidth;
  1467.                    dummy.Font:=Font;
  1468.                    dummy.FieldName:=FDataLink.FieldNames[t];
  1469.                    dummy.Title.Alignment:=taLeftJustify;
  1470.                    dummy.Title.Color:=clLtGray;
  1471.                    dummy.Title.PenColor:=clBlack;
  1472.                    dummy.Title.Font:=Font;
  1473.                    If FDataLink.DataSource.DataSet<>Nil Then
  1474.                    Begin
  1475.                         FieldClass:=FDataLink.DataSource.DataSet.FieldDefs[t].FieldClass;
  1476.                         If (FieldClass Is TMemoField) Or
  1477.                            (FieldClass Is TBlobField)
  1478.                         Then dummy.ReadOnly:=True;
  1479.  
  1480.                         If (FieldClass Is TSmallintField) Or
  1481.                            (FieldClass Is TIntegerField) Or
  1482.                            (FieldClass Is TFloatField)
  1483.                         Then dummy.Alignment:=taRightJustify;
  1484.  
  1485.                         If (FieldClass Is TStringField)
  1486.                         Then dummy.Width:=Font.Width*FDataLink.DataSource.DataSet.FieldDefs[t].Size Div 2;
  1487.                    End;
  1488.                End;
  1489.           End;
  1490.  
  1491.           If (FDataLink.FieldCount = 0) Then
  1492.             If FColumns <> Nil Then
  1493.               If FColumns.FAutoCreated Then
  1494.               Begin
  1495.                    //remove default columns
  1496.                    SetColumns(Nil);
  1497.               End;
  1498.  
  1499.           If FColumns<>Nil Then ColCount:=FColumns.Count+FixedCols
  1500.           Else ColCount:=FDataLink.FieldCount+FixedCols;
  1501.  
  1502.           If FDataLink.DataSource.DataSet<>Nil Then
  1503.           Begin
  1504.                If RowCount<>FDataLink.DataSource.DataSet.MaxRows+FixedRows Then
  1505.                   RowCount:=FDataLink.DataSource.DataSet.MaxRows+FixedRows;
  1506.  
  1507.                //check If CurrentRow fits In Window
  1508.                Max:=FDataLink.DataSource.DataSet.CurrentRow;
  1509.                If Max<>-1 Then
  1510.                Begin
  1511.                     If Max<TopRow Then
  1512.                     Begin
  1513.                          {Scroll up}
  1514.                          FUpScrolled:=0;
  1515.                          FUpExtent:=0;
  1516.                          su:=True;
  1517.                     End
  1518.                     Else su:=False;
  1519.  
  1520.                     //check If marker would fit In Window
  1521.                     If GridOptions*[dgBorder]<>[] Then Y:=Height-1
  1522.                     Else Y:=Height;
  1523.                     If HorzScrollBar<>Nil Then
  1524.                       If HorzScrollBar.Visible Then Dec(Y,HorzScrollBar.Height);
  1525.                     For T:=0 To FixedRows-1 Do Dec(Y,RowHeights[T]);
  1526.                     For T:=FixedRows+TopRow To FixedRows+Max Do Dec(Y,RowHeights[T]);
  1527.                     If Y<0 Then //Scroll
  1528.                     Begin
  1529.                          T:=TopRow;
  1530.                          For t1:=FixedRows+TopRow To FixedRows+Max Do
  1531.                          Begin
  1532.                               Inc(FUpExtent,RowHeights[t1]);
  1533.                               Inc(T);
  1534.                               Inc(Y,RowHeights[t1]);
  1535.                               If Y>0 Then break;
  1536.                          End;
  1537.                          FUpScrolled:=T;
  1538.                     End;
  1539.                     VertScrollBar.Position:=FUpExtent;
  1540.                     Invalidate;
  1541.                End;
  1542.           End;
  1543.      End;
  1544.      GridUpdateLocked:=False;  //Redraw whole Grid
  1545. End;
  1546. {$HINTS ON}
  1547.  
  1548. Procedure TDBGrid.SetDataSource(NewValue:TDataSource);
  1549. Begin
  1550.      FDataLink.DataSource:=NewValue;
  1551. End;
  1552.  
  1553. Function TDBGrid.GetDataSource:TDataSource;
  1554. Begin
  1555.      Result:=FDataLink.DataSource;
  1556. End;
  1557.  
  1558. Procedure TDBGrid.SetupComponent;
  1559. Begin
  1560.      Inherited SetupComponent;
  1561.  
  1562.      FGridOptions:=[dgBorder,dgShowSelection,dgTitles,dgIndicator,dgMouseSelect,dgEnableMaskEdit];
  1563.      FDataLink.Create(Self);
  1564.      FDataLink.OnDataChange:=DataChange;
  1565.      Include(FDataLink.ComponentState, csDetail);
  1566.      Name:='DBGrid';
  1567.      ColWidths[0]:=20;
  1568. End;
  1569.  
  1570. Destructor TDBGrid.Destroy;
  1571. Begin
  1572.      If FColumns<>Nil Then FColumns.Destroy;
  1573.      FDataLink.OnDataChange:=Nil;
  1574.      FDataLink.Destroy;
  1575.      FDataLink:=Nil;
  1576.  
  1577.      Inherited Destroy;
  1578. End;
  1579.  
  1580. {
  1581. ╔═══════════════════════════════════════════════════════════════════════════╗
  1582. ║                                                                           ║
  1583. ║ Speed-Pascal/2 Version 2.0                                                ║
  1584. ║                                                                           ║
  1585. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1586. ║                                                                           ║
  1587. ║ This section: TDBEdit Class Implementation                                ║
  1588. ║                                                                           ║
  1589. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1590. ║                                                                           ║
  1591. ╚═══════════════════════════════════════════════════════════════════════════╝
  1592. }
  1593.  
  1594. Function TDBEdit.WriteSCUResource(Stream:TResourceStream):Boolean;
  1595. Var S:String;
  1596. Begin
  1597.      Result:=Inherited WriteSCUResource(Stream);
  1598.      If Result=False Then Exit;
  1599.  
  1600.      S:=FDataLink.FieldName;
  1601.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  1602. End;
  1603.  
  1604. Procedure TDBEdit.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  1605. Var  S:String;
  1606. Begin
  1607.      If ResName = rnDBDataField Then
  1608.      Begin
  1609.           System.Move(Data,S,DataLen);
  1610.           FDataLink.FieldName:=S;
  1611.      End
  1612.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  1613. End;
  1614.  
  1615. Procedure TDBEdit.SetDataSource(NewValue:TDataSource);
  1616. Begin
  1617.      FDataLink.DataSource:=NewValue;
  1618. End;
  1619.  
  1620. Function TDBEdit.GetDataSource:TDataSource;
  1621. Begin
  1622.      Result:=FDataLink.DataSource;
  1623. End;
  1624.  
  1625. Procedure TDBEdit.SetDataField(NewValue:String);
  1626. Begin
  1627.      FDataLink.FieldName:=NewValue;
  1628. End;
  1629.  
  1630. Function TDBEdit.GetDataField:String;
  1631. Begin
  1632.      Result:=FDataLink.FieldName;
  1633. End;
  1634.  
  1635. Procedure TDBEdit.SetupComponent;
  1636. Begin
  1637.      Inherited SetupComponent;
  1638.  
  1639.      FDataLink.Create(Self);
  1640.      FDataLink.OnDataChange:=DataChange;
  1641.      Include(FDataLink.ComponentState, csDetail);
  1642.      Name:='DBEdit';
  1643. End;
  1644.  
  1645. Destructor TDBEdit.Destroy;
  1646. Begin
  1647.      FDataLink.OnDataChange:=Nil;
  1648.      FDataLink.Destroy;
  1649.      FDataLink:=Nil;
  1650.  
  1651.      Inherited Destroy;
  1652. End;
  1653.  
  1654. {$HINTS OFF}
  1655. Procedure TDBEdit.DataChange(Sender:TObject;event:TDataChange);
  1656. Var Field:TField;
  1657. Begin
  1658.      Try
  1659.         Field:=FDataLink.Field;
  1660.      Except
  1661.         ON E:ESQLError Do
  1662.         Begin
  1663.              ErrorBox(E.Message);
  1664.              Field:=Nil;
  1665.         End;
  1666.         Else Raise;
  1667.      End;
  1668.      If Field<>Nil Then Caption:=Field.AsString
  1669.      Else Caption:='';
  1670. End;
  1671. {$HINTS ON}
  1672.  
  1673. Procedure TDBEdit.SetupShow;
  1674. Begin
  1675.      Inherited SetupShow;
  1676.      DataChange(FDataLink,deDataBaseChanged);
  1677. End;
  1678.  
  1679.  
  1680. Procedure TDBEdit.WriteBack;
  1681. Var  S:String;
  1682.      Field:TField;
  1683. Begin
  1684.      If FDataLink = Nil Then exit;
  1685.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  1686.      S:=Text;
  1687.  
  1688.      Try
  1689.         Field:=FDataLink.Field;
  1690.         If Field<>Nil Then
  1691.           If Field.AsString<>S Then
  1692.           Begin
  1693.                Field.AsString:=S;
  1694.                If Not FDataLink.DataSource.DataSet.RowInserted
  1695.                Then FDataLink.DataSource.DataSet.Post
  1696.                Else FDataLink.DataSource.DataSet.Refresh;
  1697.           End;
  1698.      Except
  1699.         ON E:ESQLError Do
  1700.         Begin
  1701.              ErrorBox(E.Message);
  1702.              Field:=Nil;
  1703.         End;
  1704.         Else Raise;
  1705.      End;
  1706. End;
  1707.  
  1708. Procedure TDBEdit.KillFocus;
  1709. Begin
  1710.      WriteBack;
  1711.  
  1712.      Inherited KillFocus;
  1713. End;
  1714.  
  1715. Procedure TDBEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
  1716. Begin
  1717.      If KeyCode=kbCR Then WriteBack;
  1718.  
  1719.      Inherited ScanEvent(KeyCode,RepeatCount);
  1720. End;
  1721.  
  1722. {
  1723. ╔═══════════════════════════════════════════════════════════════════════════╗
  1724. ║                                                                           ║
  1725. ║ Speed-Pascal/2 Version 2.0                                                ║
  1726. ║                                                                           ║
  1727. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1728. ║                                                                           ║
  1729. ║ This section: TDBText Class Implementation                                ║
  1730. ║                                                                           ║
  1731. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1732. ║                                                                           ║
  1733. ╚═══════════════════════════════════════════════════════════════════════════╝
  1734. }
  1735.  
  1736. Function TDBText.WriteSCUResource(Stream:TResourceStream):Boolean;
  1737. Var S:String;
  1738. Begin
  1739.      Result:=Inherited WriteSCUResource(Stream);
  1740.      If Result=False Then Exit;
  1741.      S:=FDataLink.FieldName;
  1742.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  1743. End;
  1744.  
  1745. Procedure TDBText.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  1746. Var  S:String;
  1747. Begin
  1748.      If ResName = rnDBDataField Then
  1749.      Begin
  1750.           System.Move(Data,S,DataLen);
  1751.           FDataLink.FieldName:=S;
  1752.      End
  1753.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  1754. End;
  1755.  
  1756.  
  1757. Procedure TDBText.SetDataSource(NewValue:TDataSource);
  1758. Begin
  1759.      FDataLink.DataSource:=NewValue;
  1760. End;
  1761.  
  1762. Function TDBText.GetDataSource:TDataSource;
  1763. Begin
  1764.      Result:=FDataLink.DataSource;
  1765. End;
  1766.  
  1767. Procedure TDBText.SetDataField(NewValue:String);
  1768. Begin
  1769.      FDataLink.FieldName:=NewValue;
  1770. End;
  1771.  
  1772. Function TDBText.GetDataField:String;
  1773. Begin
  1774.      Result:=FDataLink.FieldName;
  1775. End;
  1776.  
  1777. Procedure TDBText.SetupComponent;
  1778. Begin
  1779.      Inherited SetupComponent;
  1780.  
  1781.      FDataLink.Create(Self);
  1782.      FDataLink.OnDataChange:=DataChange;
  1783.      Include(FDataLink.ComponentState, csDetail);
  1784.  
  1785.      Name:='DBText';
  1786.      Caption:=Name;
  1787.      AutoSize:=False;
  1788. End;
  1789.  
  1790. Destructor TDBText.Destroy;
  1791. Begin
  1792.      FDataLink.OnDataChange:=Nil;
  1793.      FDataLink.Destroy;
  1794.      FDataLink:=Nil;
  1795.  
  1796.      Inherited Destroy;
  1797. End;
  1798.  
  1799. {$HINTS OFF}
  1800. Procedure TDBText.DataChange(Sender:TObject;event:TDataChange);
  1801. Var Field:TField;
  1802. Begin
  1803.      Try
  1804.         Field:=FDataLink.Field;
  1805.      Except
  1806.         ON E:ESQLError Do
  1807.         Begin
  1808.              ErrorBox(E.Message);
  1809.              Field:=Nil;
  1810.         End;
  1811.         Else Raise;
  1812.      End;
  1813.      If Field<>Nil Then Caption:=Field.AsString
  1814.      Else Caption:='';
  1815. End;
  1816. {$HINTS ON}
  1817.  
  1818. Procedure TDBText.SetupShow;
  1819. Begin
  1820.      Inherited SetupShow;
  1821.      DataChange(FDataLink,deDataBaseChanged);
  1822. End;
  1823.  
  1824. {
  1825. ╔═══════════════════════════════════════════════════════════════════════════╗
  1826. ║                                                                           ║
  1827. ║ Speed-Pascal/2 Version 2.0                                                ║
  1828. ║                                                                           ║
  1829. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1830. ║                                                                           ║
  1831. ║ This section: TDBCheckBox Class Implementation                            ║
  1832. ║                                                                           ║
  1833. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1834. ║                                                                           ║
  1835. ╚═══════════════════════════════════════════════════════════════════════════╝
  1836. }
  1837.  
  1838. Function TDBCheckBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  1839. Var S:String;
  1840. Begin
  1841.      Result:=Inherited WriteSCUResource(Stream);
  1842.      If Result=False Then Exit;
  1843.      S:=FDataLink.FieldName;
  1844.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  1845. End;
  1846.  
  1847. Procedure TDBCheckBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  1848. Var  S:String;
  1849. Begin
  1850.      If ResName = rnDBDataField Then
  1851.      Begin
  1852.           System.Move(Data,S,DataLen);
  1853.           FDataLink.FieldName:=S;
  1854.      End
  1855.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  1856. End;
  1857.  
  1858.  
  1859. Procedure TDBCheckBox.SetDataSource(NewValue:TDataSource);
  1860. Begin
  1861.      FDataLink.DataSource:=NewValue;
  1862. End;
  1863.  
  1864. Function TDBCheckBox.GetDataSource:TDataSource;
  1865. Begin
  1866.      Result:=FDataLink.DataSource;
  1867. End;
  1868.  
  1869. Procedure TDBCheckBox.SetDataField(NewValue:String);
  1870. Begin
  1871.      FDataLink.FieldName:=NewValue;
  1872. End;
  1873.  
  1874. Function TDBCheckBox.GetDataField:String;
  1875. Begin
  1876.      Result:=FDataLink.FieldName;
  1877. End;
  1878.  
  1879. Procedure TDBCheckBox.SetupComponent;
  1880. Begin
  1881.      Inherited SetupComponent;
  1882.  
  1883.      FDataLink.Create(Self);
  1884.      FDataLink.OnDataChange:=DataChange;
  1885.      Include(FDataLink.ComponentState, csDetail);
  1886.  
  1887.      Name:='DBCheckBox';
  1888.      Caption:=Name;
  1889.  
  1890.      ValueChecked := 'True';
  1891.      ValueUnchecked := 'False';
  1892. End;
  1893.  
  1894. Destructor TDBCheckBox.Destroy;
  1895. Begin
  1896.      FDataLink.OnDataChange:=Nil;
  1897.      FDataLink.Destroy;
  1898.      FDataLink:=Nil;
  1899.      If FValueChecked<>Nil Then FreeMem(FValueChecked,Length(FValueChecked^)+1);
  1900.      FValueChecked:=Nil;
  1901.      If FValueUnchecked<>Nil Then FreeMem(FValueUnchecked,Length(FValueUnchecked^)+1);
  1902.      FValueUnchecked:=Nil;
  1903.  
  1904.      Inherited Destroy;
  1905. End;
  1906.  
  1907.  
  1908. Procedure TDBCheckBox.WriteBack;
  1909. Var S:String;
  1910.     Field:TField;
  1911. Begin
  1912.      If FDataLink = Nil Then exit;
  1913.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  1914.      If Checked Then S:=ValueChecked
  1915.      Else S:=ValueUnchecked;
  1916.  
  1917.      Try
  1918.         Field:=FDataLink.Field;
  1919.         If Field<>Nil Then
  1920.           If Field.AsString<>S Then
  1921.           Begin
  1922.                Field.AsString:=S;
  1923.                If Not FDataLink.DataSource.DataSet.RowInserted
  1924.                Then FDataLink.DataSource.DataSet.Post
  1925.                Else FDataLink.DataSource.DataSet.Refresh;
  1926.           End;
  1927.      Except
  1928.         ON E:ESQLError Do
  1929.         Begin
  1930.              ErrorBox(E.Message);
  1931.              Field:=Nil;
  1932.         End;
  1933.         Else Raise;
  1934.      End;
  1935. End;
  1936.  
  1937. Procedure TDBCheckBox.Click;
  1938. Begin
  1939.      Inherited Click;
  1940.  
  1941.      WriteBack;
  1942. End;
  1943.  
  1944. {$HINTS OFF}
  1945. Procedure TDBCheckBox.DataChange(Sender:TObject;event:TDataChange);
  1946. Var Field:TField;
  1947.     S,s1:String;
  1948.     Value:String;
  1949.     B:Byte;
  1950. Begin
  1951.      Try
  1952.         Field:=FDataLink.Field;
  1953.      Except
  1954.         ON E:ESQLError Do
  1955.         Begin
  1956.              ErrorBox(E.Message);
  1957.              Field:=Nil;
  1958.         End;
  1959.         Else Raise;
  1960.      End;
  1961.      If Field<>Nil Then
  1962.      Begin
  1963.           Value:=Field.AsString;
  1964.           If Value <> '' Then
  1965.           Begin
  1966.                S:=ValueChecked;
  1967.                UpcaseStr(S);
  1968.                UpcaseStr(Value);
  1969.                B:=Pos(';',S);
  1970.                While B<>0 Do
  1971.                Begin
  1972.                     s1:=Copy(S,1,B-1);
  1973.                     Delete(S,1,B);
  1974.                     If s1=Value Then
  1975.                     Begin
  1976.                          Checked:=True;
  1977.                          Exit;
  1978.                     End;
  1979.                     B:=Pos(';',S);
  1980.                End;
  1981.                Checked:=S=Value;
  1982.           End
  1983.           Else State:=cbGrayed;
  1984.      End
  1985.      //Else Checked:=False;
  1986.      Else State:=cbGrayed;
  1987. End;
  1988. {$HINTS ON}
  1989.  
  1990. Procedure TDBCheckBox.SetupShow;
  1991. Begin
  1992.      Inherited SetupShow;
  1993.      DataChange(FDataLink,deDataBaseChanged);
  1994. End;
  1995.  
  1996. Procedure TDBCheckBox.SetValueChecked(NewValue:String);
  1997. Begin
  1998.      If FValueChecked<>Nil Then FreeMem(FValueChecked,Length(FValueChecked^)+1);
  1999.      If NewValue<>'' Then
  2000.      Begin
  2001.           GetMem(FValueChecked,Length(NewValue)+1);
  2002.           FValueChecked^:=NewValue;
  2003.      End
  2004.      Else FValueChecked:=Nil;
  2005. End;
  2006.  
  2007. Function TDBCheckBox.GetValueChecked:String;
  2008. Begin
  2009.      If FValueChecked=Nil Then Result:=''
  2010.      Else Result:=FValueChecked^;
  2011. End;
  2012.  
  2013. Procedure TDBCheckBox.SetValueUnchecked(NewValue:String);
  2014. Begin
  2015.      If FValueUnchecked<>Nil Then FreeMem(FValueUnchecked,Length(FValueUnchecked^)+1);
  2016.      If NewValue<>'' Then
  2017.      Begin
  2018.           GetMem(FValueUnchecked,Length(NewValue)+1);
  2019.           FValueUnchecked^:=NewValue;
  2020.      End
  2021.      Else FValueUnchecked:=Nil;
  2022. End;
  2023.  
  2024. Function TDBCheckBox.GetValueUnchecked:String;
  2025. Begin
  2026.      If FValueUnchecked=Nil Then Result:=''
  2027.      Else Result:=FValueUnchecked^;
  2028. End;
  2029.  
  2030.  
  2031. {
  2032. ╔═══════════════════════════════════════════════════════════════════════════╗
  2033. ║                                                                           ║
  2034. ║ Speed-Pascal/2 Version 2.0                                                ║
  2035. ║                                                                           ║
  2036. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2037. ║                                                                           ║
  2038. ║ This section: TDBImage Class Implementation                               ║
  2039. ║                                                                           ║
  2040. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2041. ║                                                                           ║
  2042. ╚═══════════════════════════════════════════════════════════════════════════╝
  2043. }
  2044.  
  2045. Function TDBImage.WriteSCUResource(Stream:TResourceStream):Boolean;
  2046. Var S:String;
  2047. Begin
  2048.      Result:=Inherited WriteSCUResource(Stream);
  2049.      If Result=False Then Exit;
  2050.      S:=FDataLink.FieldName;
  2051.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  2052. End;
  2053.  
  2054. Procedure TDBImage.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  2055. Var  S:String;
  2056. Begin
  2057.      If ResName = rnDBDataField Then
  2058.      Begin
  2059.           System.Move(Data,S,DataLen);
  2060.           FDataLink.FieldName:=S;
  2061.      End
  2062.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  2063. End;
  2064.  
  2065.  
  2066. Procedure TDBImage.SetDataSource(NewValue:TDataSource);
  2067. Begin
  2068.      FDataLink.DataSource:=NewValue;
  2069. End;
  2070.  
  2071. Function TDBImage.GetDataSource:TDataSource;
  2072. Begin
  2073.      Result:=FDataLink.DataSource;
  2074. End;
  2075.  
  2076. Procedure TDBImage.SetDataField(NewValue:String);
  2077. Begin
  2078.      FDataLink.FieldName:=NewValue;
  2079. End;
  2080.  
  2081. Function TDBImage.GetDataField:String;
  2082. Begin
  2083.      Result:=FDataLink.FieldName;
  2084. End;
  2085.  
  2086. Procedure TDBImage.SetupComponent;
  2087. Begin
  2088.      Inherited SetupComponent;
  2089.  
  2090.      FDataLink.Create(Self);
  2091.      FDataLink.OnDataChange:=DataChange;
  2092.      Include(FDataLink.ComponentState, csDetail);
  2093.  
  2094.      Name:='DBImage';
  2095. End;
  2096.  
  2097. Destructor TDBImage.Destroy;
  2098. Begin
  2099. (* destroyed In Inherited
  2100.      If FBitmap<>Nil Then
  2101.      Begin
  2102.           FBitmap.Destroy;
  2103.           FBitmap:=Nil;
  2104.      End;
  2105. *)
  2106.      FDataLink.OnDataChange:=Nil;
  2107.      FDataLink.Destroy;
  2108.      FDataLink:=Nil;
  2109.  
  2110.      Inherited Destroy;
  2111. End;
  2112.  
  2113. Procedure TDBImage.SetupShow;
  2114. Begin
  2115.      NeedBitmap := False;
  2116.      Inherited SetupShow;
  2117.      DataChange(FDataLink,deDataBaseChanged);
  2118. End;
  2119.  
  2120. //Inhalt der Grafik hat sich geändert - in DB zurückschreiben
  2121. Procedure TDBImage.Change;
  2122. Begin
  2123.      If FChangeLock Then exit;
  2124.  
  2125.      Inherited Change;
  2126.  
  2127.      FChangeLock:=True;
  2128.      WriteBack;
  2129.  
  2130.      FChangeLock:=False;
  2131. End;
  2132.  
  2133. {$HINTS OFF}
  2134. Procedure TDBImage.DataChange(Sender:TObject;event:TDataChange);
  2135. Var  Field:TField;
  2136. Begin
  2137.      If FChangeLock Then exit;
  2138.      FChangeLock:=True;
  2139.      Try
  2140.         Field := FDataLink.Field;
  2141.      Except
  2142.         ON E:ESQLError Do
  2143.         Begin
  2144.              ErrorBox(E.Message);
  2145.              Field:=Nil;
  2146.         End;
  2147.         Else
  2148.         Begin
  2149.              FChangeLock:=False;
  2150.              Raise;
  2151.         End;
  2152.      End;
  2153.      If Field Is TBlobField Then
  2154.      Begin
  2155.           Try
  2156.              {creates A New Bitmap In GetBitmap If FBitmap = Nil}
  2157.              Bitmap.LoadFromMem(TBlobField(Field).Value^,Field.ValueLen);
  2158.           Except
  2159.              Bitmap := Nil;
  2160.           End;
  2161.      End
  2162.      Else Bitmap := Nil;
  2163.  
  2164.      Invalidate;
  2165.      FChangeLock:=False;
  2166. End;
  2167. {$HINTS ON}
  2168.  
  2169. Procedure TDBImage.WriteBack;
  2170. Var  Field:TBlobField;
  2171.      Stream:TMemoryStream;
  2172. Begin
  2173.      If FDataLink = Nil Then exit;
  2174.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2175.  
  2176.      Try
  2177.         Field:=TBlobField(FDataLink.Field);
  2178.         If Field<>Nil Then
  2179.         Begin
  2180.           If Field Is TBlobField Then
  2181.           Begin
  2182.             Stream.Create;
  2183.             Bitmap.SaveToStream(Stream);
  2184.             Field.LoadFromStream(Stream);
  2185.             Stream.Destroy;
  2186.  
  2187.             If Not FDataLink.DataSource.DataSet.RowInserted
  2188.             Then FDataLink.DataSource.DataSet.Post
  2189.             Else FDataLink.DataSource.DataSet.Refresh;
  2190.           End;
  2191.         End;
  2192.      Except
  2193.         On E:ESQLError Do
  2194.         Begin
  2195.              ErrorBox(E.Message);
  2196.              Field:=Nil;
  2197.         End;
  2198.         Else Raise;
  2199.      End;
  2200. End;
  2201.  
  2202.  
  2203. {
  2204. ╔═══════════════════════════════════════════════════════════════════════════╗
  2205. ║                                                                           ║
  2206. ║ Speed-Pascal/2 Version 2.0                                                ║
  2207. ║                                                                           ║
  2208. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2209. ║                                                                           ║
  2210. ║ This section: TDBMemo Class Implementation                                ║
  2211. ║                                                                           ║
  2212. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2213. ║                                                                           ║
  2214. ╚═══════════════════════════════════════════════════════════════════════════╝
  2215. }
  2216.  
  2217. Function TDBMemo.WriteSCUResource(Stream:TResourceStream):Boolean;
  2218. Var S:String;
  2219. Begin
  2220.      Result:=Inherited WriteSCUResource(Stream);
  2221.      If Result=False Then Exit;
  2222.      S:=FDataLink.FieldName;
  2223.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  2224. End;
  2225.  
  2226. Procedure TDBMemo.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  2227. Var  S:String;
  2228. Begin
  2229.      If ResName = rnDBDataField Then
  2230.      Begin
  2231.           System.Move(Data,S,DataLen);
  2232.           FDataLink.FieldName:=S;
  2233.      End
  2234.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  2235. End;
  2236.  
  2237.  
  2238. Procedure TDBMemo.SetDataSource(NewValue:TDataSource);
  2239. Begin
  2240.      FDataLink.DataSource:=NewValue;
  2241. End;
  2242.  
  2243. Function TDBMemo.GetDataSource:TDataSource;
  2244. Begin
  2245.      Result:=FDataLink.DataSource;
  2246. End;
  2247.  
  2248. Procedure TDBMemo.SetDataField(NewValue:String);
  2249. Begin
  2250.      FDataLink.FieldName:=NewValue;
  2251. End;
  2252.  
  2253. Function TDBMemo.GetDataField:String;
  2254. Begin
  2255.      Result:=FDataLink.FieldName;
  2256. End;
  2257.  
  2258. Procedure TDBMemo.SetupComponent;
  2259. Begin
  2260.      Inherited SetupComponent;
  2261.  
  2262.      FDataLink.Create(Self);
  2263.      FDataLink.OnDataChange:=DataChange;
  2264.      Include(FDataLink.ComponentState, csDetail);
  2265.  
  2266.      Name:='DBMemo';
  2267. End;
  2268.  
  2269. Destructor TDBMemo.Destroy;
  2270. Begin
  2271.      FDataLink.OnDataChange:=Nil;
  2272.      FDataLink.Destroy;
  2273.      FDataLink:=Nil;
  2274.  
  2275.      Inherited Destroy;
  2276. End;
  2277.  
  2278. {$HINTS OFF}
  2279. Procedure TDBMemo.DataChange(Sender:TObject;event:TDataChange);
  2280. Var Field:TField;
  2281. Begin
  2282.      Try
  2283.         Field:=FDataLink.Field;
  2284.      Except
  2285.         ON E:ESQLError Do
  2286.         Begin
  2287.              ErrorBox(E.Message);
  2288.              Field:=Nil;
  2289.         End;
  2290.         Else Raise;
  2291.      End;
  2292.      If Field<>Nil Then
  2293.      Begin
  2294.           If Field Is TBlobField Then
  2295.             Lines.SetText(PChar(TBlobField(Field).Value))
  2296.           Else If Field Is TMemoField Then
  2297.             Lines.SetText(PChar(TMemoField(Field).Value))
  2298.           Else
  2299.             Lines.SetText(Nil);
  2300.      End
  2301.      Else
  2302.      Begin
  2303.           Lines.SetText(Nil);
  2304.      End;
  2305. End;
  2306. {$HINTS ON}
  2307.  
  2308. Procedure TDBMemo.SetupShow;
  2309. Begin
  2310.      Inherited SetupShow;
  2311.      DataChange(FDataLink,deDataBaseChanged);
  2312. End;
  2313.  
  2314.  
  2315. Procedure TDBMemo.WriteBack;
  2316. Var  Ansi:AnsiString;
  2317.      pc:PChar;
  2318.      Field:TField;
  2319. Begin
  2320.      If FDataLink = Nil Then exit;
  2321.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2322.  
  2323.      Try
  2324.         Field:=FDataLink.Field;
  2325.         If Field<>Nil Then
  2326.         Begin
  2327.           pc:=Lines.GetText;
  2328.           If pc <> Nil Then
  2329.           Begin
  2330.                Ansi:=pc^;
  2331.                StrDispose(pc);
  2332.           End
  2333.           Else Ansi := '';
  2334.  
  2335.           If Field.AsAnsiString<>Ansi Then
  2336.           Begin
  2337.                Field.AsAnsiString:=Ansi;
  2338.                If Not FDataLink.DataSource.DataSet.RowInserted
  2339.                Then FDataLink.DataSource.DataSet.Post
  2340.                Else FDataLink.DataSource.DataSet.Refresh;
  2341.           End;
  2342.         End;
  2343.      Except
  2344.         On E:ESQLError Do
  2345.         Begin
  2346.              ErrorBox(E.Message);
  2347.              Field:=Nil;
  2348.         End;
  2349.         Else Raise;
  2350.      End;
  2351. End;
  2352.  
  2353. Procedure TDBMemo.KillFocus;
  2354. Begin
  2355.      WriteBack;
  2356.  
  2357.      Inherited KillFocus;
  2358. End;
  2359.  
  2360.  
  2361. {
  2362. ╔═══════════════════════════════════════════════════════════════════════════╗
  2363. ║                                                                           ║
  2364. ║ Speed-Pascal/2 Version 2.0                                                ║
  2365. ║                                                                           ║
  2366. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2367. ║                                                                           ║
  2368. ║ This section: TDBListBox Class Implementation                             ║
  2369. ║                                                                           ║
  2370. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2371. ║                                                                           ║
  2372. ╚═══════════════════════════════════════════════════════════════════════════╝
  2373. }
  2374.  
  2375. Function TDBListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  2376. Var S:String;
  2377. Begin
  2378.      Result:=Inherited WriteSCUResource(Stream);
  2379.      If Result=False Then Exit;
  2380.      S:=FDataLink.FieldName;
  2381.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  2382. End;
  2383.  
  2384. Procedure TDBListBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  2385. Var  S:String;
  2386. Begin
  2387.      If ResName = rnDBDataField Then
  2388.      Begin
  2389.           System.Move(Data,S,DataLen);
  2390.           FDataLink.FieldName:=S;
  2391.      End
  2392.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  2393. End;
  2394.  
  2395.  
  2396. Procedure TDBListBox.SetDataSource(NewValue:TDataSource);
  2397. Begin
  2398.      FDataLink.DataSource:=NewValue;
  2399. End;
  2400.  
  2401. Function TDBListBox.GetDataSource:TDataSource;
  2402. Begin
  2403.      Result:=FDataLink.DataSource;
  2404. End;
  2405.  
  2406. Procedure TDBListBox.SetDataField(NewValue:String);
  2407. Begin
  2408.      FDataLink.FieldName:=NewValue;
  2409. End;
  2410.  
  2411. Function TDBListBox.GetDataField:String;
  2412. Begin
  2413.      Result:=FDataLink.FieldName;
  2414. End;
  2415.  
  2416. Type
  2417.   TDBListBoxStrings=Class(TStrings)
  2418.       Private
  2419.          Items:TStrings;
  2420.          DataLink:TFieldDataLink;
  2421.       Protected
  2422.          Function GetCount:LongInt; Override;
  2423.          Function Get(Index:LongInt):String; Override;
  2424.          Function GetObject(Index:LongInt):TObject; Override;
  2425.          Procedure Put(Index:LongInt;Const S:String); Override;
  2426.          Procedure PutObject(Index:LongInt;AObject:TObject); Override;
  2427.       Public
  2428.          Procedure Assign(AStrings:TStrings); Override;
  2429.          Function Add(Const S:String):LongInt; Override;
  2430.          Procedure Insert(Index:LongInt;Const S:String); Override;
  2431.          Procedure Delete(Index:LongInt); Override;
  2432.          Procedure Clear; Override;
  2433.          {$IFDEF OS2}
  2434.          Function IndexOf(Const S:String):LongInt; Override;
  2435.          {$ENDIF}
  2436.     End;
  2437.  
  2438. Function TDBListBoxStrings.GetCount:LongInt;
  2439. Begin
  2440.      Result:=Items.Count;
  2441. End;
  2442.  
  2443. Function TDBListBoxStrings.Get(Index:LongInt):String;
  2444. Begin
  2445.      Result:=Items.Strings[Index];
  2446. End;
  2447.  
  2448. Function TDBListBoxStrings.GetObject(Index:LongInt):TObject;
  2449. Begin
  2450.      Result:=Items.Objects[Index];
  2451. End;
  2452.  
  2453. Procedure TDBListBoxStrings.Put(Index:LongInt;Const S:String);
  2454. Var Field:TField;
  2455. Begin
  2456.      If ((DataLink.DataSource=Nil)Or(DataLink.DataSource.DataSet=Nil)) Then Exit;
  2457.  
  2458.      //Change DataBase
  2459.      Try
  2460.         Field:=DataLink.Field;
  2461.         If Field<>Nil Then If Field.AsString<>S Then
  2462.         Begin
  2463.              Field.AsString:=S;
  2464.              If Not DataLink.DataSource.DataSet.RowInserted
  2465.              Then DataLink.DataSource.DataSet.Post
  2466.              Else DataLink.DataSource.DataSet.Refresh;
  2467.         End;
  2468.      Except
  2469.         ON E:ESQLError Do
  2470.         Begin
  2471.              ErrorBox(E.Message);
  2472.              Field:=Nil;
  2473.         End;
  2474.         Else Raise;
  2475.      End;
  2476.  
  2477.      If Field<>Nil Then Items.Strings[Index]:=S;
  2478. End;
  2479.  
  2480. Procedure TDBListBoxStrings.PutObject(Index:LongInt;AObject:TObject);
  2481. Begin
  2482.      Items.Objects[Index]:=AObject;
  2483. End;
  2484.  
  2485. Procedure TDBListBoxStrings.Assign(AStrings:TStrings);
  2486. Var T:LongInt;
  2487. Begin
  2488.      If AStrings=Nil Then Exit;
  2489.      For T:=0 To Count-1 Do
  2490.      Begin
  2491.           If T>AStrings.Count-1 Then Exit;
  2492.           Strings[T]:=AStrings.Strings[T];
  2493.      End;
  2494. End;
  2495.  
  2496. Function TDBListBoxStrings.Add(Const S:String):LongInt;
  2497. Begin
  2498.      Result := Items.Add(S);
  2499.      //Change DataBase
  2500. End;
  2501.  
  2502. Procedure TDBListBoxStrings.Insert(Index:LongInt;Const S:String);
  2503. Begin
  2504.      Items.Insert(Index,S);
  2505.      //Change DataBase
  2506. End;
  2507.  
  2508. Procedure TDBListBoxStrings.Delete(Index:LongInt);
  2509. Begin
  2510.      Items.Delete(Index);
  2511.      //Change DataBase
  2512. End;
  2513.  
  2514. Procedure TDBListBoxStrings.Clear;
  2515. Begin
  2516.      Items.Clear;
  2517.      //Change DataBase
  2518. End;
  2519.  
  2520. {$IFDEF OS2}
  2521. Function TDBListBoxStrings.IndexOf(Const S:String):LongInt;
  2522. Begin
  2523.      Result:=Items.IndexOf(S);
  2524. End;
  2525. {$ENDIF}
  2526.  
  2527. Procedure TDBListBox.SetupComponent;
  2528. Begin
  2529.      Inherited SetupComponent;
  2530.  
  2531.      FDBStrings:=TDBListBoxStrings.Create;
  2532.      TDBListBoxStrings(FDBStrings).Items:=Inherited Items;
  2533.      FDataLink.Create(Self);
  2534.      FDataLink.OnDataChange:=DataChange;
  2535.      Include(FDataLink.ComponentState, csDetail);
  2536.  
  2537.      Name:='DBListBox';
  2538. End;
  2539.  
  2540. Destructor TDBListBox.Destroy;
  2541. Begin
  2542.      FDataLink.OnDataChange:=Nil;
  2543.      FDataLink.Destroy;
  2544.      FDataLink:=Nil;
  2545.      FDBStrings.Destroy;
  2546.      FDBStrings:=Nil;
  2547.  
  2548.      Inherited Destroy;
  2549. End;
  2550.  
  2551. {$HINTS OFF}
  2552. Procedure TDBListBox.DataChange(Sender:TObject;event:TDataChange);
  2553. Var Field:TField;
  2554.     OldRow:LongInt;
  2555.     Eof:Boolean;
  2556. Begin
  2557.      If ((event=deDataBaseChanged)Or(Items.Count=0)) Then
  2558.      Begin
  2559.           BeginUpdate;
  2560.           Items.Clear;
  2561.           If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)Or
  2562.               (Not FDataLink.DataSource.DataSet.Active)) Then
  2563.           Begin
  2564.                EndUpdate;
  2565.                Exit;
  2566.           End;
  2567.  
  2568.           FDataLink.DataSource.DataSet.DataChangeLock:=True;
  2569.           OldRow:=FDataLink.DataSource.DataSet.CurrentRow;
  2570.  
  2571.           Try
  2572.              FDataLink.DataSource.DataSet.First;
  2573.  
  2574.              Repeat
  2575.                   Try
  2576.                      Field:=FDataLink.Field;
  2577.                   Except
  2578.                      ON E:ESQLError Do
  2579.                      Begin
  2580.                           ErrorBox(E.Message);
  2581.                           Field:=Nil;
  2582.                      End;
  2583.                      Else Raise;
  2584.                   End;
  2585.  
  2586.                   If Field<>Nil Then TDBListBoxStrings(FDBStrings).Items.Add(Field.AsString);
  2587.  
  2588.                   Eof:=FDataLink.DataSource.DataSet.Eof;
  2589.                   FDataLink.DataSource.DataSet.Next;
  2590.              Until Eof;
  2591.           Except
  2592.           End;
  2593.  
  2594.           FDataLink.DataSource.DataSet.CurrentRow:=OldRow;
  2595.           FDataLink.DataSource.DataSet.DataChangeLock:=False;
  2596.           EndUpdate;
  2597.           ItemIndex:=OldRow;
  2598.      End
  2599.      Else If event=dePositionChanged Then
  2600.      Begin
  2601.           If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2602.           ItemIndex:=FDataLink.DataSource.DataSet.CurrentRow;
  2603.      End;
  2604. End;
  2605. {$HINTS ON}
  2606.  
  2607. Procedure TDBListBox.SetupShow;
  2608. Begin
  2609.      Inherited SetupShow;
  2610.      TDBListBoxStrings(FDBStrings).Items:=Inherited Items;
  2611.      DataChange(FDataLink,deDataBaseChanged);
  2612. End;
  2613.  
  2614. Procedure TDBListBox.SetItems(NewValue:TStrings);
  2615. Begin
  2616.      TDBListBoxStrings(FDBStrings).Assign(NewValue);
  2617. End;
  2618.  
  2619. Procedure TDBListBox.ItemFocus(Index:LongInt);
  2620. Begin
  2621.      Inherited ItemFocus(Index);
  2622.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2623.      FDataLink.DataSource.DataSet.CurrentRow:=ItemIndex;
  2624. End;
  2625.  
  2626. {
  2627. ╔═══════════════════════════════════════════════════════════════════════════╗
  2628. ║                                                                           ║
  2629. ║ Speed-Pascal/2 Version 2.0                                                ║
  2630. ║                                                                           ║
  2631. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2632. ║                                                                           ║
  2633. ║ This section: TDBComboBox Class Implementation                            ║
  2634. ║                                                                           ║
  2635. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2636. ║                                                                           ║
  2637. ╚═══════════════════════════════════════════════════════════════════════════╝
  2638. }
  2639.  
  2640. Function TDBComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
  2641. Var S:String;
  2642. Begin
  2643.      Result:=Inherited WriteSCUResource(Stream);
  2644.      If Result=False Then Exit;
  2645.      S:=FDataLink.FieldName;
  2646.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  2647. End;
  2648.  
  2649. Procedure TDBComboBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  2650. Var  S:String;
  2651. Begin
  2652.      If ResName = rnDBDataField Then
  2653.      Begin
  2654.           System.Move(Data,S,DataLen);
  2655.           FDataLink.FieldName:=S;
  2656.      End
  2657.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  2658. End;
  2659.  
  2660. Procedure TDBComboBox.SetDataSource(NewValue:TDataSource);
  2661. Begin
  2662.      FDataLink.DataSource:=NewValue;
  2663. End;
  2664.  
  2665. Function TDBComboBox.GetDataSource:TDataSource;
  2666. Begin
  2667.      Result:=FDataLink.DataSource;
  2668. End;
  2669.  
  2670. Procedure TDBComboBox.SetDataField(NewValue:String);
  2671. Begin
  2672.      FDataLink.FieldName:=NewValue;
  2673. End;
  2674.  
  2675. Function TDBComboBox.GetDataField:String;
  2676. Begin
  2677.      Result:=FDataLink.FieldName;
  2678. End;
  2679.  
  2680. Procedure TDBComboBox.SetupComponent;
  2681. Begin
  2682.      Inherited SetupComponent;
  2683.  
  2684.      FDataLink.Create(Self);
  2685.      FDataLink.OnDataChange:=DataChange;
  2686.      Include(FDataLink.ComponentState, csDetail);
  2687.  
  2688.      Name:='DBComboBox';
  2689. End;
  2690.  
  2691. Destructor TDBComboBox.Destroy;
  2692. Begin
  2693.      FDataLink.OnDataChange:=Nil;
  2694.      FDataLink.Destroy;
  2695.      FDataLink:=Nil;
  2696.  
  2697.      Inherited Destroy;
  2698. End;
  2699.  
  2700. {$HINTS OFF}
  2701. Procedure TDBComboBox.DataChange(Sender:TObject;event:TDataChange);
  2702. Var Field:TField;
  2703.     S:String;
  2704. Begin
  2705.      Try
  2706.         Field:=FDataLink.Field;
  2707.         If Field<>Nil Then
  2708.         Begin
  2709.             S:=Field.AsString;
  2710.             If S<>Text Then Text:=S;
  2711.         End;
  2712.      Except
  2713.         ON E:ESQLError Do
  2714.         Begin
  2715.              ErrorBox(E.Message);
  2716.              Field:=Nil;
  2717.         End;
  2718.         Else Raise;
  2719.      End;
  2720. End;
  2721. {$HINTS ON}
  2722.  
  2723. Procedure TDBComboBox.SetupShow;
  2724. Begin
  2725.      Inherited SetupShow;
  2726.      DataChange(FDataLink,deDataBaseChanged);
  2727. End;
  2728.  
  2729. Procedure TDBComboBox.WriteBack;
  2730. Var Field:TField;
  2731. Begin
  2732.      If FDataLink = Nil Then exit;
  2733.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2734.  
  2735.      Try
  2736.         Field:=FDataLink.Field;
  2737.         If Field<>Nil Then
  2738.           If Field.AsString<>Text Then
  2739.           Begin
  2740.                Field.AsString:=Text;
  2741.                If Not FDataLink.DataSource.DataSet.RowInserted
  2742.                Then FDataLink.DataSource.DataSet.Post
  2743.                Else FDataLink.DataSource.DataSet.Refresh;
  2744.           End;
  2745.      Except
  2746.         FLock:=False;
  2747.         ON E:ESQLError Do
  2748.         Begin
  2749.              ErrorBox(E.Message);
  2750.              Field:=Nil;
  2751.         End;
  2752.         Else Raise;
  2753.      End;
  2754. End;
  2755.  
  2756.  
  2757. Procedure TDBComboBox.EditChange;
  2758. Begin
  2759.      If FLock Then Exit;
  2760.      FLock:=True;
  2761.      WriteBack;
  2762.      FLock:=False;
  2763. End;
  2764.  
  2765.  
  2766. {
  2767. ╔═══════════════════════════════════════════════════════════════════════════╗
  2768. ║                                                                           ║
  2769. ║ Speed-Pascal/2 Version 2.0                                                ║
  2770. ║                                                                           ║
  2771. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2772. ║                                                                           ║
  2773. ║ This section: TDBRadioGroup Class Implementation                          ║
  2774. ║                                                                           ║
  2775. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2776. ║                                                                           ║
  2777. ╚═══════════════════════════════════════════════════════════════════════════╝
  2778. }
  2779.  
  2780. Function TDBRadioGroup.WriteSCUResource(Stream:TResourceStream):Boolean;
  2781. Var S:String;
  2782. Begin
  2783.      Result:=Inherited WriteSCUResource(Stream);
  2784.      If Result=False Then Exit;
  2785.      S:=FDataLink.FieldName;
  2786.      Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
  2787. End;
  2788.  
  2789. Procedure TDBRadioGroup.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
  2790. Var  S:String;
  2791. Begin
  2792.      If ResName = rnDBDataField Then
  2793.      Begin
  2794.           System.Move(Data,S,DataLen);
  2795.           FDataLink.FieldName:=S;
  2796.      End
  2797.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  2798. End;
  2799.  
  2800. Procedure TDBRadioGroup.SetDataSource(NewValue:TDataSource);
  2801. Begin
  2802.      FDataLink.DataSource:=NewValue;
  2803. End;
  2804.  
  2805. Function TDBRadioGroup.GetDataSource:TDataSource;
  2806. Begin
  2807.      Result:=FDataLink.DataSource;
  2808. End;
  2809.  
  2810. Procedure TDBRadioGroup.SetDataField(NewValue:String);
  2811. Begin
  2812.      FDataLink.FieldName:=NewValue;
  2813. End;
  2814.  
  2815. Function TDBRadioGroup.GetDataField:String;
  2816. Begin
  2817.      Result:=FDataLink.FieldName;
  2818. End;
  2819.  
  2820. Procedure TDBRadioGroup.SetupComponent;
  2821. Begin
  2822.      Inherited SetupComponent;
  2823.  
  2824.      FValues:=TStringList.Create;
  2825.      FDataLink.Create(Self);
  2826.      FDataLink.OnDataChange:=DataChange;
  2827.      Include(FDataLink.ComponentState, csDetail);
  2828.  
  2829.      Name:='DBRadioGroup';
  2830. End;
  2831.  
  2832. Destructor TDBRadioGroup.Destroy;
  2833. Begin
  2834.      FDataLink.OnDataChange:=Nil;
  2835.      FDataLink.Destroy;
  2836.      FDataLink:=Nil;
  2837.      FValues.Destroy;
  2838.      FValues:=Nil;
  2839.  
  2840.      Inherited Destroy;
  2841. End;
  2842.  
  2843. {$HINTS OFF}
  2844. Procedure TDBRadioGroup.DataChange(Sender:TObject;event:TDataChange);
  2845. Var Field:TField;
  2846.     S:String;
  2847.     T:LongInt;
  2848. Begin
  2849.      Try
  2850.         Field:=FDataLink.Field;
  2851.         If Field<>Nil Then
  2852.           If Value<>Field.AsString Then Value:=Field.AsString;
  2853.      Except
  2854.         ON E:ESQLError Do
  2855.         Begin
  2856.              ErrorBox(E.Message);
  2857.              Field:=Nil;
  2858.         End;
  2859.         Else Raise;
  2860.      End;
  2861. End;
  2862. {$HINTS ON}
  2863.  
  2864. Procedure TDBRadioGroup.SetupShow;
  2865. Begin
  2866.      Inherited SetupShow;
  2867.      DataChange(FDataLink,deDataBaseChanged);
  2868. End;
  2869.  
  2870. Procedure TDBRadioGroup.WriteBack;
  2871. Var S:String;
  2872.     Field:TField;
  2873. Begin
  2874.      If FDataLink = Nil Then exit;
  2875.      If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
  2876.      If ((FLock)Or(ItemIndex<0)) Then Exit;
  2877.  
  2878.      FLock:=True;
  2879.      If ItemIndex<FValues.Count Then S:=FValues[ItemIndex]
  2880.      Else If ItemIndex<Items.Count Then S:=Items[ItemIndex]
  2881.      Else Exit;
  2882.  
  2883.      Try
  2884.         Field:=FDataLink.Field;
  2885.         If Field<>Nil Then
  2886.           If Field.AsString<>S Then
  2887.           Begin
  2888.                Field.AsString:=S;
  2889.                If Not FDataLink.DataSource.DataSet.RowInserted
  2890.                Then FDataLink.DataSource.DataSet.Post
  2891.                Else FDataLink.DataSource.DataSet.Refresh;
  2892.           End;
  2893.      Except
  2894.         FLock:=False;
  2895.         ON E:ESQLError Do
  2896.         Begin
  2897.              ErrorBox(E.Message);
  2898.              Field:=Nil;
  2899.         End;
  2900.         Else Raise;
  2901.      End;
  2902.      FLock:=False;
  2903. End;
  2904.  
  2905.  
  2906. Procedure TDBRadioGroup.ItemIndexChange;
  2907. Begin
  2908.      WriteBack;
  2909. End;
  2910.  
  2911.  
  2912. Function TDBRadioGroup.GetValue:String;
  2913. Begin
  2914.     If ItemIndex<0 Then Result:=''
  2915.     Else
  2916.     Begin
  2917.         If ItemIndex<FValues.Count Then Result:=FValues[ItemIndex]
  2918.         Else If ItemIndex<Items.Count Then Result:=Items[ItemIndex]
  2919.         Else Result:='';
  2920.     End;
  2921. End;
  2922.  
  2923. Procedure TDBRadioGroup.SetValue(Const NewValue:String);
  2924. Var T:LongInt;
  2925. Begin
  2926.      For T:=0 To FValues.Count-1 Do
  2927.      Begin
  2928.           If FValues[T]=NewValue Then
  2929.           Begin
  2930.                If ItemIndex<>T Then ItemIndex:=T;
  2931.                Exit;
  2932.           End;
  2933.      End;
  2934.  
  2935.      For T:=0 To Items.Count-1 Do
  2936.      Begin
  2937.           If Items[T]=NewValue Then
  2938.           Begin
  2939.                If ItemIndex<>T Then ItemIndex:=T;
  2940.                Exit;
  2941.           End;
  2942.      End;
  2943.  
  2944.      ItemIndex:=-1;
  2945. End;
  2946.  
  2947. Procedure TDBRadioGroup.SetValues(NewValue:TStrings);
  2948. Begin
  2949.      FValues.Assign(NewValue);
  2950. End;
  2951.  
  2952. {
  2953. ╔═══════════════════════════════════════════════════════════════════════════╗
  2954. ║                                                                           ║
  2955. ║ Speed-Pascal/2 Version 2.0                                                ║
  2956. ║                                                                           ║
  2957. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2958. ║                                                                           ║
  2959. ║ This section: TDBNavigator Class Implementation                           ║
  2960. ║                                                                           ║
  2961. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2962. ║                                                                           ║
  2963. ╚═══════════════════════════════════════════════════════════════════════════╝
  2964. }
  2965.  
  2966. Const
  2967.     cmDBFirst           = TCommand(cmBase+70);
  2968.     cmDBPrior           = TCommand(cmBase+71);
  2969.     cmDBNext            = TCommand(cmBase+72);
  2970.     cmDBLast            = TCommand(cmBase+73);
  2971.     cmDBInsert          = TCommand(cmBase+74);
  2972.     cmDBDelete          = TCommand(cmBase+75);
  2973.     cmDBEdit            = TCommand(cmBase+76);
  2974.     cmDBPost            = TCommand(cmBase+77);
  2975.     cmDBCancel          = TCommand(cmBase+78);
  2976.     cmDBRefresh         = TCommand(cmBase+79);
  2977.  
  2978.  
  2979. Procedure TDBNavigator.SetVisibleButtons(NewState:TNavigateBtnSet);
  2980. Var T:TNavigateBtn;
  2981. Begin
  2982.      FVisibleButtons:=NewState;
  2983.      For T:=dbFirst To dbRefresh Do FButtons[T].Visible:=NewState*[T]<>[];
  2984.      RealignControls;
  2985. End;
  2986.  
  2987. Procedure TDBNavigator.SetEnabledButtons(NewState:TNavigateBtnSet);
  2988. Var T:TNavigateBtn;
  2989. Begin
  2990.      FEnabledButtons:=NewState;
  2991.      For T:=dbFirst To dbRefresh Do FButtons[T].Enabled:=NewState*[T]<>[];
  2992.      If Handle<>0 Then Invalidate;
  2993. End;
  2994.  
  2995. Procedure TDBNavigator.RealignControls;
  2996. Var X:LongInt;
  2997.     Count,W:LongInt;
  2998.     T:TNavigateBtn;
  2999. Begin
  3000.      If Handle=0 Then Exit;
  3001.  
  3002.      X:=0;
  3003.  
  3004.      Count:=0;
  3005.      For T:=dbFirst To dbRefresh Do If FVisibleButtons*[T]<>[] Then Inc(Count);
  3006.  
  3007.      W:=Width Div Count;
  3008.      For T:=dbFirst To dbRefresh Do
  3009.      Begin
  3010.           If FVisibleButtons*[T]<>[] Then
  3011.           Begin
  3012.                FButtons[T].SetWindowPos(X,0,W,Height);
  3013.                Inc(X,FButtons[T].Width);
  3014.           End
  3015.           Else
  3016.           If Designed Then FButtons[T].SetWindowPos(X,Height,W,Height);
  3017.      End;
  3018. End;
  3019.  
  3020.  
  3021. Function TDBNavigator.GetButton(Index:TNavigateBtn):TBitBtn;
  3022. Begin
  3023.      Result := FButtons[Index];
  3024. End;
  3025.  
  3026.  
  3027. Procedure TDBNavigator.SetupComponent;
  3028. Type
  3029.      TButDataRec=Record
  3030.         bmp:String[20];
  3031.         cmd:TCommand;
  3032.         Bubble:LongWord;
  3033.      End;
  3034. Const
  3035.      ButData:Array[TNavigateBtn] Of TButDataRec=
  3036.         ((bmp:'StdBmpDBFirst';cmd:cmDBFirst;Bubble:SFirstRecordHint),
  3037.          (bmp:'StdBmpDBPrior';cmd:cmDBPrior;Bubble:SPriorRecordHint),
  3038.          (bmp:'StdBmpDBNext';cmd:cmDBNext;Bubble:SNextRecordHint),
  3039.          (bmp:'StdBmpDBLast';cmd:cmDBLast;Bubble:SLastRecordHint),
  3040.          (bmp:'StdBmpDBInsert';cmd:cmDBInsert;Bubble:SInsertRecordHint),
  3041.          (bmp:'StdBmpDBDelete';cmd:cmDBDelete;Bubble:SDeleteRecordHint),
  3042.          (bmp:'StdBmpDBEdit';cmd:cmDBEdit;Bubble:SEditRecordHint),
  3043.          (bmp:'StdBmpDBPost';cmd:cmDBPost;Bubble:SPostRecordHint),
  3044.          (bmp:'StdBmpDBCancel';cmd:cmDBCancel;Bubble:SCancelRecordHint),
  3045.          (bmp:'StdBmpDBRefresh';cmd:cmDBRefresh;Bubble:SRefreshRecordHint));
  3046. Var  T:TNavigateBtn;
  3047. Begin
  3048.      Inherited SetupComponent;
  3049.  
  3050.      FDataLink.Create(Self);
  3051.      FDataLink.OnDataChange:=Nil{DataChange};
  3052.      Include(FDataLink.ComponentState, csDetail);
  3053.  
  3054.      Name:='DBNavigator';
  3055.      FVisibleButtons:=[dbFirst..dbRefresh];
  3056.      FEnabledButtons:=[dbFirst..dbRefresh];
  3057.      Width:=240;
  3058.      Height:=25;
  3059.      ParentColor:=True;
  3060.  
  3061.      For T:=dbFirst To dbRefresh Do
  3062.      Begin
  3063.           FButtons[T]:=InsertBitBtn(Self,32,0,32,32, bkCustom,'',
  3064.                                     LoadNLSStr(ButData[T].Bubble));
  3065.           FButtons[T].Command:=ButData[T].cmd;
  3066.           FButtons[T].Glyph.LoadFromResourceName(ButData[T].bmp);
  3067.           FButtons[T].YAlign:=yaBottom;
  3068.           FButtons[T].YStretch:=ysParent;
  3069.           Include(FButtons[T].ComponentState, csDetail);
  3070.           FButtons[T].SetDesigning(Designed);
  3071.  
  3072.           If Not Designed Then
  3073.           Begin
  3074.                FButtons[T].Tag := LongInt(T);
  3075.                FButtons[T].OnClick := EvButtonClick;
  3076.           End;
  3077.      End;
  3078.  
  3079.      VisibleButtons:=VisibleButtons-[dbEdit];
  3080. End;
  3081.  
  3082. Destructor TDBNavigator.Destroy;
  3083. Begin
  3084.      FDataLink.OnDataChange:=Nil;
  3085.      FDataLink.Destroy;
  3086.      FDataLink:=Nil;
  3087.  
  3088.      Inherited Destroy;
  3089. End;
  3090.  
  3091. Procedure TDBNavigator.CreateWnd;
  3092. Begin
  3093.      Inherited CreateWnd;
  3094.  
  3095.      RealignControls;
  3096. End;
  3097.  
  3098.  
  3099. Procedure TDBNavigator.SetDataSource(NewValue:TDataSource);
  3100. Begin
  3101.      FDataLink.DataSource:=NewValue;
  3102. End;
  3103.  
  3104. Function TDBNavigator.GetDataSource:TDataSource;
  3105. Begin
  3106.      Result:=FDataLink.DataSource;
  3107. End;
  3108.  
  3109.  
  3110. Procedure TDBNavigator.CommandEvent(Var Command:TCommand);
  3111. Begin
  3112.      Inherited CommandEvent(Command);
  3113.  
  3114.      If ((FDataLink<>Nil)And(FDataLink.DataSource<>Nil)And
  3115.          (FDataLink.DataSource.DataSet<>Nil)) Then
  3116.      Begin
  3117.           Try
  3118.              Case Command Of
  3119.                cmDBFirst:FDataLink.DataSource.DataSet.First;
  3120.                cmDBPrior:FDataLink.DataSource.DataSet.Prior;
  3121.                cmDBNext:FDataLink.DataSource.DataSet.Next;
  3122.                cmDBLast:FDataLink.DataSource.DataSet.Last;
  3123.                cmDBInsert:FDataLink.DataSource.DataSet.Insert;
  3124.                cmDBDelete:FDataLink.DataSource.DataSet.Delete;
  3125.                cmDBEdit: ;
  3126.                cmDBPost:FDataLink.DataSource.DataSet.Post;
  3127.                cmDBCancel:FDataLink.DataSource.DataSet.Cancel;
  3128.                cmDBRefresh:FDataLink.DataSource.DataSet.Refresh;
  3129.              End;
  3130.           Except
  3131.               ON E:ESQLError Do ErrorBox(E.Message);
  3132.               ON EDataBaseError Do
  3133.               Begin
  3134.               End;
  3135.               Else Raise;
  3136.           End;
  3137.      End;
  3138. End;
  3139.  
  3140.  
  3141. Procedure TDBNavigator.EvButtonClick(Sender:TObject);
  3142. Begin
  3143.      If FOnNavClick <> Nil
  3144.      Then FOnNavClick(Self,TNavigateBtn(TComponent(Sender).Tag));
  3145. End;
  3146.  
  3147.  
  3148. Begin
  3149. End.
  3150.  
  3151.