home *** CD-ROM | disk | FTP | other *** search
- unit CustGrid;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Grids, DBGrids, DB, DBTables, ShowMemo, ShowRich, ShowImg;
-
- const
- MT_RichText : String = '{\rtf1';
-
- type
- TNotifyMiddleClickEvent = procedure (Sender: TObject; Column: TColumn) of object;
- TDBCustGrid = class(TDBGrid)
- private
- { Private declarations }
- FOnMiddleClick : TNotifyMiddleClickEvent;
- FRowsMark : Integer;
- procedure MiddleClick(Sender: TObject; Column: TColumn);
- procedure WMMiddleMouseClick(var Message: TWMMouse); message WM_MBUTTONUP;
- procedure MarkGridRows(tblSource : TTable; nMarkGridRows : Integer);
- procedure MoveRecordPointer(Key : Word; tblSource : TTable);
- procedure ShowMemoOrRichEdit;
- procedure ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
- procedure ShowRichEdit(tblRichEdit : TTable; sFieldName, sHeading : String; lReadOnlyFlag : Boolean);
- procedure ShowImage(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean);
- procedure TitleClick(Column : TColumn); override;
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- published
- { Published declarations }
- property OnMiddleClick : TNotifyMiddleClickEvent read FOnMiddleClick write FOnMiddleClick;
- property RowsMark : Integer read FRowsMark write FRowsMark stored 10;
- end;
-
- procedure Register;
-
- implementation
-
- constructor TDBCustGrid.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- OnMiddleClick := MiddleClick;
- if (csDesigning in ComponentState) then
- FRowsMark := 10;
- end;
-
- procedure TDBCustGrid.KeyDown(var Key: Word; Shift: TShiftState);
- var
- nOldRecNo : Integer;
- begin
- if (Key = 13) then
- ShowMemoOrRichEdit;
- if (ssShift in Shift) and ((Key = 33) or (Key = 34)) and (Self.DataSource.DataSet <> nil) and
- (Self.DataSource.DataSet.Active) and (Self.DataSource.DataSet.RecordCount > 0) then begin
- try
- TTable(Self.DataSource.DataSet).DisableControls;
- MoveRecordPointer(Key,TTable(Self.DataSource.DataSet));
- nOldRecNo := 0; nOldRecNo := TTable(Self.DataSource.DataSet).RecNo;
- MarkGridRows(TTable(Self.DataSource.DataSet),FRowsMark);
- if (Key = 33) then
- TTable(Self.DataSource.DataSet).RecNo := nOldRecNo;
- finally
- TTable(Self.DataSource.DataSet).EnableControls;
- end;
- Key := 0;
- end;
- inherited;
- end;
-
- procedure TDBCustGrid.MarkGridRows(tblSource : TTable; nMarkGridRows : Integer);
- var
- I : Integer;
- begin
- for I := 1 to nMarkGridRows do begin
- Self.SelectedRows.CurrentRowSelected := not Self.SelectedRows.CurrentRowSelected;
- if tblSource.EOF then
- Break
- else
- tblSource.Next;
- end;
- end;
-
- procedure TDBCustGrid.MoveRecordPointer(Key : Word; tblSource : TTable);
- begin
- { if (Key = 34) then
- tblSource.RecNo := tblSource.RecNo + FRowsMark;}
- if (Key = 33) then begin
- if (tblSource.RecNo <= FRowsMark) then
- tblSource.RecNo := 1
- else
- tblSource.RecNo := tblSource.RecNo - FRowsMark;
- end;
- end;
-
- procedure TDBCustGrid.MiddleClick(Sender: TObject; Column: TColumn);
- begin
- FOnMiddleClick(Self,Self.Columns.Items[Self.SelectedIndex]);
- end;
-
- procedure TDBCustGrid.WMMiddleMouseClick(var Message: TWMMouse);
- begin
- inherited;
- FOnMiddleClick(Self,Self.Columns.Items[Self.SelectedIndex]);
- end;
-
- procedure TDBCustGrid.ShowMemoOrRichEdit;
- var
- sRichText : String;
- begin
- if Self.SelectedField.DataType = ftMemo then begin
- sRichText := Self.SelectedField.AsString;
- if Copy(sRichText,0,Length(MT_RichText)) = MT_RichText then begin
- ShowRichEdit(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
- Self.SelectedField.DisplayLabel,
- Self.Columns.Items[Self.SelectedIndex].ReadOnly);
- end
- else
- begin
- ShowMemo(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
- Self.SelectedField.DisplayLabel,
- Self.Columns.Items[Self.SelectedIndex].ReadOnly,
- Self.Columns.Items[Self.SelectedIndex].Font.Name,
- Self.Columns.Items[Self.SelectedIndex].Font.Size);
- end;
- end;
- if (Self.SelectedField.DataType = ftGraphic) or
- (Self.SelectedField.DataType = ftBlob) or
- (Self.SelectedField.DataType = ftParadoxOle) or
- (Self.SelectedField.DataType = ftDBaseOle) then begin
- ShowImage(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
- Self.SelectedField.DisplayLabel,
- Self.Columns.Items[Self.SelectedIndex].ReadOnly);
- end;
- end;
-
- procedure TDBCustGrid.ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
- begin
- if (Application.FindComponent('FrmShowMemo') = nil) then
- Application.CreateForm(TFrmShowMemo, FrmShowMemo);
- if lReadOnlyFlag then
- sHeading := sHeading + ' - [Read Only]';
- FrmShowMemo.Caption := sHeading;
- FrmShowMemo.SrcMemo.DataSet := tblMemo;
- FrmShowMemo.DBMemo.DataField := sFieldName;
- FrmShowMemo.DBMemo.ReadOnly := lReadOnlyFlag;
- FrmShowMemo.DBMemo.Font.Name := sFontName;
- FrmShowMemo.DBMemo.Font.Size := nFontSize;
- FrmShowMemo.Show;
- end;
-
- procedure TDBCustGrid.ShowRichEdit(tblRichEdit : TTable; sFieldName, sHeading : String; lReadOnlyFlag : Boolean);
- begin
- if (Application.FindComponent('FrmShowRich') = nil) then
- Application.CreateForm(TFrmShowRich, FrmShowRich);
- if lReadOnlyFlag then
- sHeading := sHeading + ' - [Read Only]';
- FrmShowRich.Caption := sHeading;
- FrmShowRich.SrcRichEdit.DataSet := tblRichEdit;
- FrmShowRich.DBRichEdit.DataField := sFieldName;
- FrmShowRich.DBRichEdit.ReadOnly := lReadOnlyFlag;
- FrmShowRich.Show;
- end;
-
- procedure TDBCustGrid.ShowImage(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean);
- begin
- if (Application.FindComponent('FrmShowImage') = nil) then
- Application.CreateForm(TFrmShowImage, FrmShowImage);
- if lReadOnlyFlag then
- sHeading := sHeading + ' - [Read Only]';
- FrmShowImage.Caption := sHeading;
- FrmShowImage.SrcMemo.DataSet := tblMemo;
- FrmShowImage.DBImage1.DataField := sFieldName;
- FrmShowImage.DBImage1.ReadOnly := lReadOnlyFlag;
- FrmShowImage.Show;
- end;
-
- procedure TDBCustGrid.TitleClick(Column : TColumn);
- begin
- try
- TTable(Self.DataSource.DataSet).IndexFieldNames := Column.FieldName;
- except
- ;
- end
- end;
-
- destructor TDBCustGrid.Destroy;
- begin
- inherited Destroy;
- if (Application.FindComponent('FrmShowMemo') <> nil) then begin
- FrmShowMemo.Close;
- FrmShowMemo := nil;
- end;
- if (Application.FindComponent('FrmShowRich') <> nil) then begin
- FrmShowRich.Close;
- FrmShowRich := nil;
- end;
- end;
-
- procedure Register;
- begin
- RegisterComponents('Delphi 3.0 Components', [TDBCustGrid]);
- end;
-
- end.
-