StringGrid uses a book (1)

(1) Correctly set the stringgrid column width without truncating any text method is to call the setoptimalgridcellwidth process after filling the text string for StringGrid ----------- Server --------- ---------------------------------------- (* $ header $ module name: general / BSGrids.Pas main program: STRINGGRID Support functions. 03/21/2000 enhanced by William Sorensen *)

Unit bsgrids;

Interface

Uses Grids;

type TExcludeColumns = set of 0..255; procedure SetOptimalGridCellWidth (sg: TStringGrid; ExcludeColumns: TExcludeColumns);. // Sets column widths of a StringGrid to avoid truncation of text // Fill grid with desired text strings first // If a. column contains no text, DefaultColWidth will be used. // Pass [] for ExcludeColumns to process all columns, including Fixed. // Columns whose numbers (0-based) are specified in ExcludeColumns will not // have their widths adjusted.

IMPLEMENTATION

Uses math; // We need the max function procedure setoptimalgridcellwidth (SG: TSTRINGGRID; Excludecolumns: texcludecolumns);

Var i: integer; J: Integer; Max_Width: Integer; Begin with SG do Begin // ney the Grid's Paint Method Hasn't Been Called Yet, // The Grid's Can't Use The Right Font for TextWidth. // Tcustomgrid.Paint Normal Sets this, Under Drawcells.) Canvas.font.assign (font); for i: = 0 TO (Colcount - 1) Do Begin if i in Excludecolumns the Continue; Max_Width: = 0; // Search for THE Maximal text width of the current column. for j: = 0 to (RowCount - 1) Do max_width: = math.max (max_width, canvas.textwidth (cells [i, j])); // the hardcode of 4 is based . on twice the offset from the left // margin in TStringGrid.DrawCell GridLineWidth is not relevant if max_width> 0 then ColWidths [i]: = max_width 4 else ColWidths [i]: = DefaultColWidth; end; {for} end;. END; END. (2) Implement StringGrid deletion, insert, sort row operation (basic operation) // Implement the delete operation Procedure GridremoveColumn (Strgrid: TstringGrid; DelColumn: integer); Var Column: Integer; begin If DelColumn <= StrGrid.ColCount then Begin For Column: = DelColumn To StrGrid.ColCount-1 do StrGrid.Cols [Column-1] .Assign (StrGrid.Cols [Column]); StrGrid.ColCount: = Strgrid.colcount-1; end;

// add to achieve insertion Procedure GridAddColumn (StrGrid: TStringGrid; NewColumn: Integer); Var Column: Integer; begin StrGrid.ColCount: = StrGrid.ColCount 1; For Column: = StrGrid.ColCount-1 downto NewColumn do StrGrid.Cols [Column] .ssign (strgrid.cols [column-1]); strgrid.cols [newcolumn-1] .Text: = ''; end;

// realize sorting operation Procedure GridSort (StrGrid: TStringGrid; NoColumn: Integer); Var Line, PosActual: Integer; Row: TStrings; begin Renglon: = TStringList.Create; For Line: = 1 to StrGrid.RowCount-1 do Begin PosActual : = Line; row.assign (TStringList (strgrid.rows [posactual)); While True Do Begin IF (STRTOINT (Row.Strings [Nocolumn-1])> = STRTIID (Strgrid.cells [ Nocolumn-1, posactual-1]))))) The Break; strgrid.rows [posactual]: = strgrid.rows [posactual-1]; dec (posactual); end; if stratient (row.strings [nocolumn-1]) < StrtOINT (Strgrid.cells [Nocolumn-1, Posactual]) THEN STRGRID.ROWS [POSAC]: = row; end; resENGLON.FREE; END; (3) TSTRINGGRID ranks atrierity research Unit unit1; // Establish an engineering, / / Paste this unit code to see the StringGrid row merge effect // but find that non-fixed line non-fixed column consolidation effect is not good Interface

Useswindows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, DB, AdoDB, DBTables, Grids; // Note that here is referenced

typeTForm1 = class (TForm) procedure FormCreate (Sender: TObject); procedure SGDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure SGTopLeftChanged (Sender: TObject); private {Private declarations} public {Public declarations} END;

Varform1: TFORM1;

IMPLEMENTATION

{$ R * .dfm}

// The following StringGrid is a fixed line, the merger of the fixed column must be processed // Non-fixed line, non-fixed line merge effect is not good VARSG: TStringGrid; Procedure TFORM1.FormCreate (Sender: TOBJECT); VARI, J: INTEGER Beginsg: = tstringgrid.create (Self);

with SG dobegin parent: = self; align: = alclient; DefaultDrawing: = false; FixedColor: = clYellow; RowCount: = 30; ColCount: = 20; FixedCols: = 1; FixedRows: = 1; GridLineWidth: = 0; Options: = Options [goEditing] - [goVertLine, goHorzLine, goRangeSelect]; OnDrawCell: = SGDrawCell; OnTopLeftChanged: = SGTopLeftChanged; Canvas.Font.name:= 'Times New Roman'; Canvas.Font.Size: = 10; for i: = 0 to COLCOUNT-1 Do for J: = 0 to RowCount-1 Do Cells [i, j]: = format ('% d line% D column', [j, i]);

For i: = 0 to colcount-1 do cells [i, 0]: = Format ('Zheng D Column', [I]); for i: = 0 to RowCount-1 Do Cells [0, I]: = Format ('first% d line ", [i]);

Cells [0,0]: = 'Left upper corner'; cells [1,0]: = 'aa This is column merge BB'; cells [0, 1]: = 'a This is the row' # 10 'merge BB' Cells [1,1]: = '1111111'; cells [1, 2]: = '1111222'; cells [2, 1]: = '2222111'; Cells [2, 2]: = '2222222'; END ;

// Remove the onDrawcell event procedure tform1.sgdrawcell (Sender: Tobject; ACOL, AROW: INTEGER; Rect: TRECT; State: TgriddrawState); Varr: TRECT; D: TSTRINGGRID; STRING; TS: TSTRINGS; I, N: Integer; begind: = tstringgrid (sender); if (acol = 2) and (arow = 0) Thenbegin R.LEFT: = Rect.Left-1-D.COLWIDTHS [Acol-1]; R.Top : = Rect.top-1; r.right: = Rect.right; R.Bottom: = Rect.bottom; s: = d.cells [acol-1, arow]; end elseif (acol = 1) and (Arow = 0) Thenbegin r.Left: = Rect.Left-1; r.top:=Rect.top 1; r.right: = Rect.right D.COLWIDTHS [ACOL 1]; R.BOTTOM: = Rect .bottom; s: = d.cells [acol, zs]; END // Merged ELSEIF (ACOL = 0) and (AROW = 2) Thenbegin R.Left: = Rect.L.TOP := Rect.top-1-D. RowHeights [Arow-1]; R.right: = Rect.right; R.Bottom: = Rect.bottom; s: = D.cells [acol, arow-1]; ELSEIF Acol = 1) and (arow = 0) Thenbegin R.Left: = Rect.Left-1; r.top:=Rect.top 1; r.right: = Rect.right; R.Bottom: = Rect.bottom D. RowHeights [AROW 1]; s: = D.cells [acol, it]; END or above is the row merge ELSEGIN R.LEFT: = Rect.TOP 1; R.TOP :=Rect.top 1; R.right: = Rect.right; R.Bottom: = Rect.b Ottom; s: = d.cells [acol, it]; end; d.canvas.brush.color: = d.color; d.canvas.font.color: = $ ff0000;

Fixed: = false; if (AROW

D.canvas.pen.color: = $ f0f0f0; d.canvas.pen.width: = 2; d.canvas.moveto (R.LEFT 1, R.TOP 2); D.canvas.Lineto (R. Left r.right, r.top 2); d.canvas.pen.color: = $ 808080; d.canvas.pen.width: = 1; d.canvas.moveto (R.LEFT 1, R.BOTTOM -1); d.canvas.Lineto (R.LEFT R.right, R.Bottom-1);

Elsebegin d.canvas.pen.color: = $ 0; d.canvas.pen.width: = 1; d.canvas.rectangle (r); end; n: = r.top 4; TS: = TSTRINGLIST.CREATE ; ts.commatext: = S; for i: = 0 to Ts.count-1 dobegin d.canvas.textout (r.Left 4, n, ts [i]); inc (n, d.rtowHeights [AROW] END;

// Remove the ONTOPLEFTCHANGE event, especially the merges of the line Procedure TForm1.sgtopleftChanged (Sender: TOBJECT); VARD: TSTRINGGRID; Begind: = TStringGrid (Sender); D.cells [0, 1]: = D.Cells [0, 1]; D.cells [0, 2]: = D.Cells [0, 2];

End. (4) Let the StringGrid point column are sorted Procedure Gridquicksort (Grid: TstringGrid; Acol: Integer; Order: Boolean; Numorstr: Boolean; (***************** *********************************************************** ************) (* Function Name: Gridquicksort *) (* Function: Give StringGrid ACOL Column Express Method _ / _ / _ / _ / _ / _ / _ / _ / _ / *) (* Parameter description: _ / _ / _ / *) (* Order: True from small to large _ / _ / *) (*: false from big to small _ / _ / *) (* Numorstr: True value The type is Integer _ / _ / _ / _ / *) (*: FALSE value is string *) (* Function Description: For the date, time, etc., can be sorted by character mode, *) (* *) (* *) (*************************************************** ******************* *************) Procedure MoveStringGriddata (Grid: TstringGrid; Sou, Des: Integer; var TMPSTRLIST: TSTRINGLIST; K: INTEGER; begin try tmpstrlist: = tstringlist.create (); tmpstrlist. CLIAR; for K: = Grid.fixedcols to grid.colcount -1 do tmpstrlist.add (grid.cells [k, so]); grid.rows [Sou]: = grid.rows [des]; fork: = grid .Fixedcols to grid.colcount -1 do grid.cells [k, des]: = tmpstrlist.strings [k]; finally tmpstrlist.free; end; end;

Procedure Quicksort (Grid: TstringGrid; ILO, IHI: Integer; Var: String; Begin Lo: = iLO; Hi: = IHI; MID: = Grid.cells [Acol, (LO HI) Div 2]; Repeat if Order and not numorstr kiln // Press the normal sequence, character begin while grid.cells [acol, lo] MID DO DEC (Hi); END; if not order and not numorstr kiln // Press inwards, character begin while grid.cells [acol, lo]> MID do inc (LO); While Grid.cells [Acol, Hi] StrtOFLOAT (MID) DO DEC (HI); END ELSE BEGIN / / Press inward, digital row While Strtofloat (Grid.cells [Acol, LO])> STRTOFLOAT (MID) DO INC (LO); While Strtofloat (Grid.cells [Acol, Hi]) Hi; IF Hi> iLO THEN Quicksort (Grid, ILO, HI); if LO

BeGintry Quicksort (Grid, Grid.FixedRows, Grid.Rowcount - 1); Excepton E: Exception Do Application.MessageBox (PCHAR ('system encountered an exception when sorting data:' # 13 E.MESSAGE # 13 'Please heavy Try, if the problem still exists, contact the program supplier! '),' System error ', MB_OK MB_ICONEROR); end;

Procedure stringgridtitledown (sender: Tobject; Button: tmousebutton; x, y: integer); (***************************************** ********************************************) (* Function Name: StringGridtitledown *) (* Function: Upper Mouse StringGrid Lei_ / _ / _ / _ / _ / _ / _ / *) (* Parameter Description: _ / _ / _ / *) (* Sender _ / _ / *) (* (********************************* *****************************************) VARI: INTEGER; Beginif (Y > 0) and (y

Procedure TFORM_MAIN.STRINGGRID1MOUSEDOWN (Sender: Tobject; Button: tmousebutton; shift: tshiftstate; x, y: integer; BeginstringGridtitledown (Sender, Button, x, y);