home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 January / Chip_2000-01_cd.bin / zkuste / Delphi / nastroje / browutil.exe / COMPNT / CUSTGRID.PAS next >
Encoding:
Pascal/Delphi Source File  |  1999-07-25  |  7.1 KB  |  211 lines
  1. unit CustGrid;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Grids, DBGrids, DB, DBTables, ShowMemo, ShowRich, ShowImg;
  8.  
  9. const
  10.   MT_RichText : String = '{\rtf1';
  11.  
  12. type
  13.   TNotifyMiddleClickEvent = procedure (Sender: TObject; Column: TColumn) of object;
  14.   TDBCustGrid = class(TDBGrid)
  15.   private
  16.     { Private declarations }
  17.     FOnMiddleClick : TNotifyMiddleClickEvent;
  18.     FRowsMark : Integer;
  19.     procedure MiddleClick(Sender: TObject; Column: TColumn);
  20.     procedure WMMiddleMouseClick(var Message: TWMMouse); message WM_MBUTTONUP;
  21.     procedure MarkGridRows(tblSource : TTable; nMarkGridRows : Integer);
  22.     procedure MoveRecordPointer(Key : Word; tblSource : TTable);
  23.     procedure ShowMemoOrRichEdit;
  24.     procedure ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
  25.     procedure ShowRichEdit(tblRichEdit : TTable; sFieldName, sHeading : String; lReadOnlyFlag : Boolean);
  26.     procedure ShowImage(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean);
  27.     procedure TitleClick(Column : TColumn); override;
  28.   protected
  29.     { Protected declarations }
  30.   public
  31.     { Public declarations }
  32.     constructor Create(AOwner: TComponent); override;
  33.     destructor Destroy; override;
  34.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  35.   published
  36.     { Published declarations }
  37.     property OnMiddleClick : TNotifyMiddleClickEvent read FOnMiddleClick write FOnMiddleClick;
  38.     property RowsMark : Integer read FRowsMark write FRowsMark stored 10;
  39.   end;
  40.  
  41. procedure Register;
  42.  
  43. implementation
  44.  
  45. constructor TDBCustGrid.Create(AOwner: TComponent);
  46. begin
  47.   inherited Create(AOwner);
  48.   OnMiddleClick := MiddleClick;
  49.   if (csDesigning in ComponentState) then
  50.     FRowsMark := 10;
  51. end;
  52.  
  53. procedure TDBCustGrid.KeyDown(var Key: Word; Shift: TShiftState);
  54. var
  55.   nOldRecNo : Integer;
  56. begin
  57.   if (Key = 13) then
  58.     ShowMemoOrRichEdit;
  59.   if (ssShift in Shift) and ((Key = 33) or (Key = 34)) and (Self.DataSource.DataSet <> nil) and
  60.     (Self.DataSource.DataSet.Active) and (Self.DataSource.DataSet.RecordCount > 0) then begin
  61.     try
  62.       TTable(Self.DataSource.DataSet).DisableControls;
  63.       MoveRecordPointer(Key,TTable(Self.DataSource.DataSet));
  64.       nOldRecNo := 0; nOldRecNo := TTable(Self.DataSource.DataSet).RecNo;
  65.       MarkGridRows(TTable(Self.DataSource.DataSet),FRowsMark);
  66.        if (Key = 33) then
  67.         TTable(Self.DataSource.DataSet).RecNo := nOldRecNo;
  68.     finally
  69.       TTable(Self.DataSource.DataSet).EnableControls;
  70.     end;
  71.     Key := 0;
  72.   end;
  73.   inherited;
  74. end;
  75.  
  76. procedure TDBCustGrid.MarkGridRows(tblSource : TTable; nMarkGridRows : Integer);
  77. var
  78.   I : Integer;
  79. begin
  80.   for I := 1 to nMarkGridRows do begin
  81.     Self.SelectedRows.CurrentRowSelected := not Self.SelectedRows.CurrentRowSelected;
  82.     if tblSource.EOF then
  83.       Break
  84.     else
  85.       tblSource.Next;
  86.   end;
  87. end;
  88.  
  89. procedure TDBCustGrid.MoveRecordPointer(Key : Word; tblSource : TTable);
  90. begin
  91. {  if (Key = 34) then
  92.     tblSource.RecNo := tblSource.RecNo + FRowsMark;}
  93.   if (Key = 33) then begin
  94.     if (tblSource.RecNo <= FRowsMark) then
  95.       tblSource.RecNo := 1
  96.     else
  97.       tblSource.RecNo := tblSource.RecNo - FRowsMark;
  98.   end;
  99. end;
  100.  
  101. procedure TDBCustGrid.MiddleClick(Sender: TObject; Column: TColumn);
  102. begin
  103.   FOnMiddleClick(Self,Self.Columns.Items[Self.SelectedIndex]);
  104. end;
  105.  
  106. procedure TDBCustGrid.WMMiddleMouseClick(var Message: TWMMouse);
  107. begin
  108.   inherited;
  109.   FOnMiddleClick(Self,Self.Columns.Items[Self.SelectedIndex]);
  110. end;
  111.  
  112. procedure TDBCustGrid.ShowMemoOrRichEdit;
  113. var
  114.   sRichText : String;
  115. begin
  116.   if Self.SelectedField.DataType = ftMemo then begin
  117.     sRichText := Self.SelectedField.AsString;
  118.     if Copy(sRichText,0,Length(MT_RichText)) = MT_RichText then begin
  119.         ShowRichEdit(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
  120.                      Self.SelectedField.DisplayLabel,
  121.                      Self.Columns.Items[Self.SelectedIndex].ReadOnly);
  122.       end
  123.     else
  124.       begin
  125.         ShowMemo(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
  126.                  Self.SelectedField.DisplayLabel,
  127.                  Self.Columns.Items[Self.SelectedIndex].ReadOnly,
  128.                  Self.Columns.Items[Self.SelectedIndex].Font.Name,
  129.                  Self.Columns.Items[Self.SelectedIndex].Font.Size);
  130.       end;
  131.   end;
  132.   if (Self.SelectedField.DataType = ftGraphic) or
  133.     (Self.SelectedField.DataType = ftBlob) or
  134.     (Self.SelectedField.DataType = ftParadoxOle) or
  135.     (Self.SelectedField.DataType = ftDBaseOle) then begin
  136.     ShowImage(TTable(Self.DataSource.DataSet),Self.SelectedField.FieldName,
  137.               Self.SelectedField.DisplayLabel,
  138.               Self.Columns.Items[Self.SelectedIndex].ReadOnly);
  139.   end;
  140. end;
  141.  
  142. procedure TDBCustGrid.ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
  143. begin
  144.   if (Application.FindComponent('FrmShowMemo') = nil) then
  145.     Application.CreateForm(TFrmShowMemo, FrmShowMemo);
  146.   if lReadOnlyFlag then
  147.     sHeading := sHeading + ' - [Read Only]';
  148.   FrmShowMemo.Caption := sHeading;
  149.   FrmShowMemo.SrcMemo.DataSet := tblMemo;
  150.   FrmShowMemo.DBMemo.DataField := sFieldName;
  151.   FrmShowMemo.DBMemo.ReadOnly := lReadOnlyFlag;
  152.   FrmShowMemo.DBMemo.Font.Name := sFontName;
  153.   FrmShowMemo.DBMemo.Font.Size := nFontSize;
  154.   FrmShowMemo.Show;
  155. end;
  156.  
  157. procedure TDBCustGrid.ShowRichEdit(tblRichEdit : TTable; sFieldName, sHeading : String; lReadOnlyFlag : Boolean);
  158. begin
  159.   if (Application.FindComponent('FrmShowRich') = nil) then
  160.     Application.CreateForm(TFrmShowRich, FrmShowRich);
  161.   if lReadOnlyFlag then
  162.     sHeading := sHeading + ' - [Read Only]';
  163.   FrmShowRich.Caption := sHeading;
  164.   FrmShowRich.SrcRichEdit.DataSet := tblRichEdit;
  165.   FrmShowRich.DBRichEdit.DataField := sFieldName;
  166.   FrmShowRich.DBRichEdit.ReadOnly := lReadOnlyFlag;
  167.   FrmShowRich.Show;
  168. end;
  169.  
  170. procedure TDBCustGrid.ShowImage(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean);
  171. begin
  172.   if (Application.FindComponent('FrmShowImage') = nil) then
  173.     Application.CreateForm(TFrmShowImage, FrmShowImage);
  174.   if lReadOnlyFlag then
  175.     sHeading := sHeading + ' - [Read Only]';
  176.   FrmShowImage.Caption := sHeading;
  177.   FrmShowImage.SrcMemo.DataSet := tblMemo;
  178.   FrmShowImage.DBImage1.DataField := sFieldName;
  179.   FrmShowImage.DBImage1.ReadOnly := lReadOnlyFlag;
  180.   FrmShowImage.Show;
  181. end;
  182.  
  183. procedure TDBCustGrid.TitleClick(Column : TColumn);
  184. begin
  185.   try
  186.     TTable(Self.DataSource.DataSet).IndexFieldNames := Column.FieldName;
  187.   except
  188.     ;
  189.   end
  190. end;
  191.  
  192. destructor TDBCustGrid.Destroy;
  193. begin
  194.   inherited Destroy;
  195.   if (Application.FindComponent('FrmShowMemo') <> nil) then begin
  196.     FrmShowMemo.Close;
  197.     FrmShowMemo := nil;
  198.   end;
  199.   if (Application.FindComponent('FrmShowRich') <> nil) then begin
  200.     FrmShowRich.Close;
  201.     FrmShowRich := nil;
  202.   end;
  203. end;
  204.  
  205. procedure Register;
  206. begin
  207.   RegisterComponents('Delphi 3.0 Components', [TDBCustGrid]);
  208. end;
  209.  
  210. end.
  211.