Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: StringGridTest.dpr |
program StringGridTest;
{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
Forms,
fmStringGrid in 'fmStringGrid.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmStringGrid.pas |
unit fmStringGrid;
{ UnitOOPS OLE Drag and Drop Components - Example
Form for TStringList demo, showing how you can drag material from Excel.
Last modified: 09/15/98}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uoole, uoUtil, Grids, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Panel2: TPanel;
StringGrid1: TStringGrid;
UOTextTarget1: TUOTextTarget;
procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
X, Y: Integer);
private
{ Private declarations }
procedure ScrollStringGrid(aPt: TPoint; aCol, aRow: integer);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
// Put the dropped text in the string grid.
// Makes extra rows and columns as necessary.
var
aCol, aRow: integer;
j, k: integer;
aSL: TStringList;
begin
with StringGrid1 do
begin
// What cell did we drop over?
MouseToCell(X, Y, aCol, aRow);
// Now, let's interpret the dropped text as tab-delimited columns
// in CR/LF-delimited rows. Use the standard DroppedLines list
// for this purpose. By this point, the component has already done
// all of the work for us, giving us the text in both dropText and
// DroppedLines.
with (Sender as TUOTextTarget).DroppedLines do
begin
for j := 1 to Count do // Iterate over rows
begin
// Make an extra row if necessary
if (aRow+j > RowCount) then
begin
RowCount := aRow+j;
Refresh;
end;
// Parse the row into a temporary stringlist based on tabs
aSL := uoTokenize(Strings[j-1], [#9]);
try
for k := 1 to aSL.Count do // Iterate
begin
// Make an extra column if necessary
if (aCol+k > ColCount) then
begin
ColCount := aCol+k;
Refresh;
end;
// Fill the cell
Cells[aCol+k-1, aRow+j-1] := aSL[k-1];
end; // for
finally
aSL.Free;
end;
end; // for
end;
// Set the selection to the cell where the drop happened
Row := aRow;
Col := aCol;
end; // with
end;
procedure TForm1.ScrollStringGrid(aPt: TPoint; aCol, aRow: integer);
// Scroll the string grid based either on fixed row and column location, or
// on proximity to the edges.
const
delta = 5;
type
TScrollDir = (sdNone, sdLeft, sdRight, sdUp, sdDown);
var
wRect, aRect: TRect;
aSd: TScrollDir;
begin
// Get the client rect for the grid
Windows.GetClientRect(StringGrid1.Handle, wRect);
aSd := sdNone; // Default is no scrolling
// Are we scrolling left?
aRect := Rect(0, 0, delta, wRect.Bottom);
if PtInRect(aRect, aPt) or ((aCol >= 0) and (aCol < StringGrid1.FixedCols)) then
aSd := sdLeft;
// Right?
aRect := Rect(wRect.Right-delta, 0, wRect.Right, wRect.Bottom);
if PtInRect(aRect, aPt) then
aSd := sdRight;
// Up?
aRect := Rect(0, 0, wRect.Right, delta);
if PtInRect(aRect, aPt) or ((aRow >= 0) and (aRow < StringGrid1.FixedRows)) then
aSd := sdUp;
// Down?
aRect := Rect(0, wRect.Bottom-delta, wRect.Right, wRect.Bottom);
if PtInRect(aRect, aPt) then
aSd := sdDown;
with StringGrid1 do
begin
case aSd of //
sdLeft: if (LeftCol > FixedCols) then
LeftCol := LeftCol-1;
sdRight: if (LefTCol < ColCount-VisibleColCount) then
LeftCol := LeftCol+1;
sdUp: if (TopRow > FixedRows) then
TopRow := TopRow-1;
sdDown: if (TopRow < RowCount-VisibleRowCount) then
TopRow := TopRow+1;
end; // case
end;
end;
procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
effect: TDropEffect; X, Y: Integer);
// The user is dragging over our string grid.
// Don't allow drops on the fixed rows or columns
var
aRow, aCol: integer;
aPt: TPoint;
begin
with StringGrid1, (Sender as TUOTextTarget) do
begin
// What cell are we over?
MouseToCell(X, Y, aCol, aRow);
// Accept only if we're not in the fixed range
AcceptText := ((aCol >= FixedCols) and
(aRow >= FixedRows));
// The current point in string grid client coordinates
aPt := Point(x, y);
// Handle scrolling of the grid
ScrollStringGrid(aPt, aCol, aRow);
// Give feedback by selecting that cell
if (aRow >= FixedRows) then
Row := aRow;
if (aCol >= FixedCols) then
Col := aCol;
end;
end;
end.
Back to top
|
| Form source: fmStringGrid.dfm |
object Form1: TForm1
Left = 176
Top = 240
Width = 511
Height = 311
Caption = 'Transfer cells from Excel to a string grid'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 503
Height = 50
Align = alTop
BevelOuter = bvNone
BorderWidth = 3
TabOrder = 0
object Label1: TLabel
Left = 3
Top = 3
Width = 497
Height = 44
Align = alClient
Caption =
'Drag a selection of cells from Excel to this TStringGrid. You c' +
'an only drop on the non-fixed rows and columns, and scrolling is' +
' automatic if you drag within several pixels of any edge of the ' +
'grid. Rows and columns are added to the grid as necessary.'
WordWrap = True
end
end
object Panel2: TPanel
Left = 0
Top = 50
Width = 503
Height = 234
Align = alClient
BevelOuter = bvNone
BorderWidth = 3
Caption = 'Panel2'
TabOrder = 1
object StringGrid1: TStringGrid
Left = 3
Top = 3
Width = 497
Height = 228
Align = alClient
DefaultColWidth = 75
DefaultRowHeight = 20
TabOrder = 0
RowHeights = (
20
20
20
20
20)
end
end
object UOTextTarget1: TUOTextTarget
AcceptorControl = StringGrid1
AcceptTextFormats = [dtfText]
OnDragOver = UOTextTarget1DragOver
OnDrop = UOTextTarget1Drop
Left = 48
Top = 217
end
end
Back to top
|