Add and delete StringGrid Columns
Type
TExCell = class (TStringGrid)
Public
Procedure DeleteRow (ARow: Longint );
Procedure DeleteColumn (ACol: Longint );
Procedure InsertRow (ARow: LongInt );
Procedure InsertColumn (ACol: LongInt );
End;
Procedure TExCell. InsertColumn (ACol: Integer );
Begin
ColCount: = ColCount + 1;
MoveColumn (ColCount-1, ACol );
End;
Procedure TExCell. InsertRow (ARow: Integer );
Begin
RowCount: = RowCount + 1;
MoveRow (RowCount-1, ARow );
End;
Procedure TExCell. DeleteColumn (ACol: Longint );
Begin
MoveColumn (ACol, ColCount-1 );
ColCount: = ColCount-1;
End;
Procedure TExCell. DeleteRow (ARow: Longint );
Begin
MoveRow (ARow, RowCount-1 );
RowCount: = RowCount-1;
End;
How to compile a column in StringGrid with the Check function is the same as that in CheckBox
Unit Unit1;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;
Type
TForm1 = class (TForm)
Grid: TStringGrid;
Procedure FormCreate (Sender: TObject );
Procedure gridDrawCell (Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState );
Procedure gridClick (Sender: TObject );
Private
{Private declarations}
Public
{Public declarations}
End;
Var
Form1: TForm1;
Fcheck, fnocheck: tbitmap;
Implementation
{$ R *. DFM}
Procedure TForm1.FormCreate (Sender: TObject );
Var
I: SmallInt;
Bmp: TBitmap;
Begin
FCheck: = TBitmap. Create;
FNoCheck: = TBitmap. Create;
Bmp: = TBitmap. create;
Try
Bmp. handle: = LoadBitmap (0, PChar (OBM_CHECKBOXES ));
With FNoCheck Do Begin
Width: = bmp. width div 4;
Height: = bmp. height div 3;
Canvas. copyrect (canvas. cliprect, bmp. canvas, canvas. cliprect );
End;
With FCheck Do Begin
Width: = bmp. width div 4;
Height: = bmp. height div 3;
Canvas. copyrect (canvas. cliprect, bmp. canvas, rect (width, 0, 2 * width, height ));
End;
Finally
Bmp. free
End;
End;
Procedure TForm1.gridDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState );
Begin
If not (gdFixed in State) then
With TStringGrid (Sender). Canvas do
Begin
Brush. Color: = clWindow;
FillRect (Rect );
If Grid. Cells [ACol, ARow] = 'yes' then
Draw (rect. right + rect. left-FCheck. width) div 2, (rect. bottom + rect. top-FCheck. height) div 2, FCheck)
Else
Draw (rect. right + rect. left-FCheck. width) div 2, (rect. bottom + rect. top-FCheck. height) div 2, FNoCheck );
End;
End;
Procedure TForm1.gridClick (Sender: TObject );
Begin
If grid. Cells [grid. col, grid. row] = 'yes' then
Grid. Cells [grid. col, grid. row]: = 'no'
Else
Grid. Cells [grid. col, grid. row]: = 'yes ';
End;
End.
The content branch of the StringGrid component Cells is displayed in the Tstringgrid. ondrawcell event.
DrawText (StringGrid1.Canvas. Handle, pchar (StringGrid1.Cells [Acol, Arow]), Length (StringGrid1.Cells [Acol, Arow]), Rect, DT_WORDBREAK or DT_LEFT );
Line feed is supported!
How to Create a read-only column in StringGrid in the OnSelectCell event handler, add: (all columns are set to modifiable)
If Col mod 2 = 0 then
Grd. Options: = grd. Options + [goEditing]
Else
Grd. Options: = grd. Options-[goEditing];
Question about reading stringgrid from text (Save/Load a TStringGrid to/from a file ?) Reading stringgrid from text
// Save a TStringGrid to a file
Procedure SaveStringGrid (StringGrid: TStringGrid; const FileName: TFileName );
Var
F: TextFile;
I, k: Integer;
Begin
AssignFile (f, FileName );
Rewrite (f );
With StringGrid do
Begin
// Write number of Columns/Rows
Writeln (f, ColCount );
Writeln (f, RowCount );
// Loop through cells
For I: = 0 to ColCount-1 do
For k: = 0 to RowCount-1 do
Writeln (F, Cells [I, k]);
End;
CloseFile (F );
End;
// Load a TStringGrid from a file
Procedure LoadStringGrid (StringGrid: TStringGrid; const FileName: TFileName );
Var
F: TextFile;
ITmp, I, k: Integer;
StrTemp: String;
Begin
AssignFile (f, FileName );
Reset (f );
With StringGrid do
Begin
// Get number of columns
Readln (f, iTmp );
ColCount: = iTmp;
// Get number of rows
Readln (f, iTmp );
RowCount: = iTmp;
// Loop through cells & fill in values
For I: = 0 to ColCount-1 do
For k: = 0 to RowCount-1 do
Begin
Readln (f, strTemp );
Cells [I, k]: = strTemp;
End;
End;
CloseFile (f );
End;
// Save StringGrid1 to 'C:. txt ':
Procedure TForm1.Button1Click (Sender: TObject );
Begin
SaveStringGrid (StringGrid1, 'c:. txt ');
End;
// Load StringGrid1 from 'C:. txt ':
Procedure TForm1.Button2Click (Sender: TObject );
Begin
LoadStringGrid (StringGrid1, 'c:. txt ');
End;
**************************************** ***
Open an existing text file and place the content in stringgrid. the lines of the text are the same as those of stringgrid;
In the text, place space in the next cell.
Done! Note: I only wrote one space interval. You can modify the splitstring to separate multiple spaces!
Procedure TForm1.Button1Click (Sender: TObject );
Var
Aa, bb: tstringlist;
I: integer;
Begin
Aa: = tstringlist. Create;
Bb: = tstringlist. Create;
Aa. LoadFromFile ('C:. txt ');
For I: = 0 to aa. Count-1 do
Begin
Bb: = SplitString (aa. Strings [I], '');
Stringgrid1.Rows [I]: = bb;
End;
Aa. Free;
Bb. Free;
End;
Splitstring:
Function SplitString (const source, ch: string): tstringlist;
Var
Temp: string;
I: integer;
Begin
Result: = tstringlist. Create;
Temp: = source;
I: = pos (ch, source );
While I <> 0 do
Begin
Result. Add (copy (temp, 0, I-1 ));
Delete (temp, 1, I );
I: = pos (ch, temp );
End;
Result. Add (temp );
End;
StringGrid component Cells content alignment
Add similar code to the DrawCell event of StringGrid:
VAR
VCol, vRow: LongInt;
Begin
VCol: = ACol; vRow: = ARow;
WITH Sender AS TStringGrid, Canvas DO
IF vCol = 2 then begin // set the 2nd column to the right alignment
SetTextAlign (Handle, TA_RIGHT );
FillRect (Rect );
TextRect (Rect, Rect. RIGHT-2, Rect. Top + 2, Cells [vCol, vRow]);
END;
End;
When I include the goRowSelect option in the options attribute of StringGird, each time I select a line in StringGrid, the selected line is displayed in dark blue. What should I do if I change the dark blue to another color? When I include the goRowSelect option in the options attribute of StringGird, each time I select a line in StringGrid, the selected line is displayed in dark blue. What should I do if I change the dark blue to another color?
Procedure TForm1.StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState );
Begin
With StringGrid1 do
Begin
If (ARow = Krow) and not (acol = 0) then
Begin
Canvas. Brush. Color: = clYellow; // ClBlue;
Canvas. FillRect (Rect );
Canvas. font. color: = ClBlack;
Canvas. TextOut (rect. left, rect. top, cells [acol, arow]);
End;
End;
End;
Procedure TForm1.StringGrid1SelectCell (Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean );
Begin
Krow: = Arow ;//*
Kcol: = Acol;
End;
Note: the value of the variable KROW must be initially set to 1 or another value not 0. Otherwise, if the first row is locked, the color of the first row will be replaced by the custom color, the locked row will not be repainted.
How to change the background of a column in the StringGrid control and the read-only attribute of a column, and align the title bar of the StringGrid control. how to change the background of a column in the StringGrid control and the read-only attribute of a column, and align the title bar of the StringGrid control.
See the following code:
Process the background color in the OnDrawCell event. The procedure is as follows:
// Change the background of the second column to red.
Procedure TForm1.StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState );
Begin
If not (acol = 1) and (arow> = stringgrid1.fixedrows) then exit;
With stringgrid1 do
Begin
Canvas. Brush. color: = clRed;
Canvas. FillRect (Rect );
Canvas. TextOut (rect. left + 2, rect. top + 2, cells [acol, arow])
End;
End;
// Add the following code, so the fourth column of StringGrid is read-only. Other columns are not read-only.
Procedure TForm1.StringGrid1SelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean );
Begin
With StringGrid1 do begin
If ACol = 4 then
Options: = Options-[goEditing]
Else Options: = Options + [goEditing];
End;
Procedure TForm1.StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState );
Var
Dx, dy: byte;
Begin
If (acol = 4) and not (arow = 0) then
With stringgrid1 do
Begin
Canvas. Brush. color: = clYellow;
Canvas. FillRect (Rect );
Canvas. font. color: = clblue;
Dx: = 2; // adjust this value to control the horizontal position of the word displayed in the grid
Dy: = 2; // adjust this value to control the vertical position of the word displayed in the grid.
Canvas. TextOut (rect. left + dx, rect. top + dy, cells [acol, arow]);
End;
// Control the alignment of the title bar
If (arow = 0) then
With stringgrid1 do
Begin
Canvas. Brush. color: = clbtnface;
Canvas. FillRect (Rect );
Dx: = 12; // adjust this value to control the horizontal position of the word displayed in the grid
Dy: = 5; // adjust this value to control the vertical position of the word displayed in the grid.
Canvas. TextOut (rect. left + dx, rect. top + dy, cells [acol, arow]);
End;
End;
Use the Enter Key in stringGrid to simulate the function of switching Cells Using the TAB Key... procedure TForm1.StringGrid1KeyPress (Sender: TObject; var Key: Char );
Label
Nexttab;
Begin
If key = #13 then
Begin
Key: = #0;
Nexttab:
If (stringgrid1.Col begin
Stringgrid1.Col: = stringgrid1.Col + 1;
End
Else
Begin
If stringgrid1.Row> = stringgrid1.RowCount-1 then
Stringgrid1.RowCount: = stringgrid1.rowCount + 1;
Stringgrid1.Row: = stringgrid1.Row + 1;
Stringgrid1.Col: = 0;
Goto nexttab;
End;
End;
End;
.........
How to clear stringgrid
With StringGrid1 do for I: = 0 to ColCount-1 do Cols [I]. Clear;
Select a cell, modify it in the cell, select a cell, and modify the setting attribute in the cell:
StringGrid1.Options: = StringGrid1.Options + [goEditing];
Add "ADOInt" to display records in StringGrid by page in Uses.
// First set PageSize to retrieve PageCount
Procedure TForm1.Button1Click (Sender: TObject );
Begin
ADoquery1.Recordset. PageSize: = spinedit1.Value;
Edit1.Text: = IntToStr (ADoquery1.Recordset. PageCount );
ShowData (spinedit2.Value );
End;
// Move the data of AbsolutePage to StringGrid1
Procedure TForm1.ShowData (page: integer );
Var
IRow, iCol, iCount: Integer;
Rs: ADOInt. Recordset;
Begin
ADoquery1.Recordset. AbsolutePage: = Page;
Currpage: = page;
IRow: = 0;
ICol: = 1;
Stringgrid1.Cells [iCol, iRow]: = 'fixedcol1 ';
Inc (iCol );
Stringgrid1.Cells [iCol, iRow]: = 'fixedcol2 ';
Inc (iRow );
Dec (iCol );
Rs: = adoquery1.Recordset;
For iCount: = 1 to SpinEdit1.Value do
Begin
Stringgrid1.Cells [iCol, iRow]: = rs. Fields. Get_Item ('fieldname1'). Value;
Inc (iCol );
Stringgrid1.Cells [iCol, iRow]: = rs. Fields. Get_Item ('fieldname1'). Value;
Inc (iRow );
Dec (iCol );
Rs. MoveNext;
End;
// Previous Page
Procedure TForm1.Button2Click (Sender: TObject );
Begin
If (CurrPage) <> 1 then
ShowData (CurrPage-1 );
End;
// Next page
Procedure TForm1.Button3Click (Sender: TObject );
Begin
If CurrPage <> ADoquery1.Recordset. PageCount then
ShowData (CurrPage + 1 );
End;
The code for printing the StringGrid program source code is not understood, but some friends may need it, so share it all at once :)
Procedure TForm1.SpeedButton11Click (Sender: TObject );
Var
Index_R, ALeft: Integer;
Index: Integer;
Begin
StringGrid_File ('d: \ AAA. TXT ');
If Not LinkTextFile then
Begin
ShowMessage ('failed ');
Exit;
End;
//
QuickRep1.DataSet: = ADOTable1;
Index_R: = ReSize (StringGrid1.Width );
ALeft: = 13;
Create_Title (TitleBand1, ALeft, 24, HeaderControl1.Sections. Items [0]. Width, 20,
HeaderControl1.Sections [0]. Text, taLeftJustify );
With Create_QRDBText (DetailBand1, ALeft, 8, StringGrid1.ColWidths [0], 20,
StringGrid1.Font, taLeftJustify) do
Begin
DataSet: = ADOTable1;
DataField: = ADOTable1.Fields [0]. DisplayName;
End;
ALeft: = ALeft + StringGrid1.ColWidths [0] * Index_R + Index_R;
For Index: = 1 to ADOTable1.FieldCount-1 do
Begin
Create_VLine (TitleBand1, ALeft-13, 16, 1, 40 );
Create_Title (TitleBand1, ALeft, 24, HeaderControl1.Sections. Items [Index]. Width, 20,
HeaderControl1.Sections [Index]. Text, taLeftJustify );
Create_VLine (DetailBand1, ALeft-13,-1, 1, 31 );
With Create_QRDBText (DetailBand1, ALeft, 8, StringGrid1.ColWidths [Index] * Index_R, 20,
StringGrid1.Font, taLeftJustify) do
Begin
DataSet: = ADOTable1;
DataField: = ADOTable1.Fields [Index]. DisplayName;
End;
ALeft: = ALeft + StringGrid1.ColWidths [Index] * Index_R + Index_R;
End;
QuickRep1.Preview;
End;
Function TForm1.ReSize (includwidth: Integer): Integer;
Begin
Result: = Trunc (718/mongodwidth );
End;
Function TForm1.StringGrid _ File (AFileName: String): Boolean;
Var
StrValue: String;
Index: Integer;
ACol, ARow: Integer;
AFileValue: System. TextFile;
Begin
StrValue: = '';
Try
AssignFile (AFileValue, AFileName );
ReWrite (AFileValue );
StrValue: = HeaderControl1.Sections [0]. Text;
For Index: = 1 to HeaderControl1.Sections. Count-1 do
StrValue: = StrValue + ',' + HeaderControl1.Sections [Index]. Text;
Writeln (AFileValue, StrValue );
StrValue: = '';
For ARow: = 0 To StringGrid1.RowCount-1 do
Begin
StrValue: = '';
StrValue: = StringGrid1.Cells [0, ARow];
For ACol: = 1 To StringGrid1.ColCount-1 do
Begin
StrValue: = StrValue + ',' + StringGrid1.Cells [ACol, ARow];
End;
Writeln (AFileValue, StrValue );
End;
Finally
CloseFile (AFileValue );
End;
End;
Function TForm1.LinkTextfile: Boolean;
Begin
Result: = False;
With ADOTable1 do
Begin
{ConnectionString: = 'provider = Microsoft. Jet. OLEDB.4.0; '+
'Data Source = D :\; Extended Properties = Text; '+
'Persist Security Info = false ';
TableName: = 'aaa # TXT ';
Open ;}
If Active then
Result: = True;
End;
End;
Function TForm1.Create _ QRDBText (Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;
Var
AQRDBText: TQRDBText;
Begin
AQRDBText: = TQRDBText. Create (Nil );
With AQRDBText do
Begin
Parent: = Sender;
Left: = ALeft;
Top: = ATop;
Width: = AWidth;
Height: = AHight;
AlignMent: = AAlignMent;
Font. Assign (AFont );
End;
Result: = AQRDBText;
End;
Function TForm1.Create _ VLine (Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer): TQRShape;
Var
AQRShapeV: TQRShape;
Begin
AQRShapeV: = TQRShape. Create (Nil );
With AQRShapeV do
Begin
Parent: = Sender;
Left: = ALeft;
Top: = ATop;
Width: = AWidth;
Height: = AHight;
End;
Result: = AQRShapeV;
End;
Procedure TForm1.Create _ Title (Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; ACaption: String; AAlignMent: TAlignment );
Var
AQRLabel: TQRLabel;
Begin
AQRLabel: = TQRLabel. Create (Nil );
With AQRLabel do
Begin
Parent: = Sender;
Left: = ALeft;
Top: = ATop;
Width: = AWidth;
AlignMent: = AAlignMent;
Caption: = ACaption;
End;
End;