Unit cbstrgrid;
{*************** The extended TStringGrid control tcbstrgrid ********************
[Features Introduction] Enhanced String Table Control, main features
1. Show columns with Checkbox on Strgrid;
2. Set the column header and the column data alignment, the column data is displayed, such as the way, the way, the number of numbers;
If it is displayed in the currency / digital mode, it can be input control, that is, only the number can be entered.
3. Automatically generate line numbers, set the total row to display, automatically evaluate;
4. Add to remove the table Clear method, etc.
Implementation]
1. Overload the Drawcell method. Customize the content displayed in accordance with the setting of the property.
The actual value remains unchanged.
2. Overload the SelectCell method to implement a read only column.
3. Remover the SIZECHANGED method to achieve the automatic add line number
4. According to the above method, you can do more, including
Picture in the form, progress bar, etc.
Binding the data set, I believe it will be helpful to do three layers.
[Key Properties / Methods]
Collect string, specifically referred to in numbers and, composed strings, such as '1, 2, 3'
1.procedure clear; / / Clear data in the table
2.Procedure DOSUMALL; / / Strive for all numeric columns / currency
Property OnSumValuechanged: TsumValueChanged
Trigger when the total value changes
Property DisplaySumrow: Boolean
Whether to display a total
Please call DOSUMALL method
3.Property CheckColumnIndex: integer // Set columns with Checkbox
Property oncheckchanged: tcheckchanged
This event is triggered when the mouse / space bar operation causes the value of the checkbox column.
Note: Just responding to the mouse / keyboard on the Strgrid, the event does not trigger when the checkbox is changed in the program.
Function nonchecked: boolean; // If there is no Check to select any row;
4.Property titleAlign: TtitleAlign // Title Alignment
5.Property colScurrency: String // Collection string of columns displayed in currency
Property Colsnumber: String // Collection string of columns displayed in digitally
Property colsalignleft: String / / Collect string of columns displayed to left
Property colsaligncenter: String // Collect string of columns displayed in
Property colsalignright: String / / Collect string of columns to right on the right
Note: Please do not repeat the column when set, including CheckColumnIndex, why? Please see the source code
6.Property colsreadonly: String // Sets the collection string of the read-only column, other columns can be edited directly
[Precautions]
It is a little problem when it is a bit drawing FocusRect according to the arrow keys.
[Modify Log]
Author: majorsoft (Yang Meizhong) Creation Date: 2004-6-6 modification date 2004-6-8 Ver0.92
Email: Majorcompu@163.com QQ: 122646527 (DFW) Welcome to advice!
[Copyright Notice] VER0.92 This program is copyrighted by Majorsoft (Yang Meizhong), you can use, modify, reprinted free, but please come with this paragraph,
Please respect the labor results of others, thank you.
*********************************************************** ***********************************
Interface
Uses
Windows, Sysutils, Classes, Controls, Grids, Graphics
Const
STRSUM = 'total';
Type
Ttitlealign = (TALEFT, TACENTER, TARIGHT); // Title Alignment
TINTEGER = set of 0..254;
Tcheckchanged = procedure (sender: TOBJECT; AROW: longint) OF Object;
TsumValueChanged = procedure (sender: TOBJECT) OF Object;
TCBSTRGRID = Class (TSTRINGGRID)
Private
FCheckColumnIndex: integer;
FDOWNCOLOR: TCOLOR;
FISDOWN: BOOLEAN; / / Mouse (or keyboard) Whether to press the animation effect
Ftitlealign: TtitleAlign; // Title Alignment
FALIGNLEFTCOLS: STRING;
FALIGNLEFTSET: TINTEGER;
FALIGNRIGHTCOLS: STRING;
FALIGNRIGHTSET: TINTEGER;
FALIGNCENTERCOLS: STRING;
FALIGNCENTERSET: TINTEGER;
Fcurrcols: String; // Needs the string of the column displayed in a currency method, with ','
Fcurrcolsset: TINTEGER; / / The collection of sequence numbers that need to be displayed in a currency method
Fnumcols: string; // Need to be a string of columns displayed in digitally, with ','
Fnumcolsset: Tinteger; / / need to be a collection of sequence numbers in digitally displayed columns
FcolsReadonly: String; // Read only column number string
Freadonlyset: TINTEGER; // Read only collections of serial numbers
FCheckChanged: tcheckchanged; // Recent Check Change Event
FDISPLAYSUMROW: BOOLEAN;
FONSUMVALUECHANGED: TSUMVALUECHANGED;
Procedure altercheckcolvalue; // Alternately replace the value of columns with Checkbox
Procedure setAlignLEFTCOLS (Const Value: String);
Procedure setAligncentercols (const value: string);
Procedure setAlignrightCols (const value: string);
Procedure setCheckColumnIndex (Const value: integer); Procedure SetColordown (Const Value: Tcolor);
Procedure setTitlealign (const value: ttitlealign);
Procedure setCurrcols (const value: string);
Procedure setnumcols (const value: string);
Procedure setColsReadOnly (const value: string);
Procedure setDisplaysumrow (const value: boolean);
Procedure SetonsumValueChanged (const value: tsumvaluechan);
protected
Procedure Drawcell (Acol, AROW: Longint; "
ASTATE: TGRIDDRAWSTATE); OVERRIDE; / /
Procedure KeyDown (Var Key: Word; Shift: tshiftstate); OVERRIDE;
Procedure Keypress (VAR Key: char); override;
Procedure Keyup (Var Key: Word; Shift: tshiftstate); OVERRIDE;
Procedure MouseDown (Button: tmousebutton; shift: tshiftstate;
X, Y: integer; OVERRIDE;
Procedure Mouseup (Button: tmousebutton; shift: tshiftstate;
X, Y: integer; OVERRIDE;
Function SelectCell (Acol, Arow: longint): boolean; override;
Procedure Sizechanged (Oldcolcount, OldrowCount: Longint); OVERRIDE;
public
Constructor Create (Aowner: Tcomponent); OVERRIDE;
DESTRUCTOR DESTROY; OVERRIDE;
Procedure clear; / / Clear data in the table
Procedure dosumall; // For all numeric columns / currency
Function nonchecked: boolean; // If there is no Check to select any row;
Published
Property CheckColumnIndex: Integer Read FcheckColumnIndex Write SetCheckColumnIndex Default 1; // Set columns with checkbox
Property Colordown: Tcolor Read FDOWNCOLOR WRITE SETCOLORDOWN Default $ 00c5d6d9;
Property titleAlign: TtitleAlign Read Ftitlealign Write Settitlealign Default Taleft; // Title Alignment
Property ColScurrency: String Read Fcurrcols Write setCurrcols; // Collection string of columns displayed in money
Property Colsnumber: String Read Fnumcols Write SetNumCols; // Collection string of columns displayed in digitally
property ColsAlignLeft: String read FAlignLeftCols write SetAlignLeftCols; // Left Snap displayed a collection of strings property column ColsAlignCenter: String read FAlignCenterCols write SetAlignCenterCols; // centered set of string column
Property Colsalignright: String Read FaliGnrightCols Write SetAlignrightCols; / / A collection of collections of columns to the right
Property ColSreadOnly: String Read FcolsReadonly Write SetColsReadOnly; // Sets the collection of read-only columns, other columns can be edited directly
{Property DisplaySumrow:
Whether to display a total
Please call DOSUMALL method}
Property DisplaySumrow: Boolean Read FDisplaysumrow Write setDisplaysumrow;
{Property OnCheckchanged:
This event is triggered when the mouse / space bar operation causes the value of the checkbox column.
Note: Just responding to the mouse / keyboard on the Strgrid, the event does not trigger when the checkbox is changed in the program.
Property oncheckchanged: Tcheckchanged Read Fcheckchanged Write Fcheckchanged;
Property OnSumValuechanged: TsumValueChanged Read FONSUMVALUECHANGED WRITE SETONSUMVALUECHANGED DITONSUMVALUECHANGED
END;
PROCEDURE register;
Function MySTRTOINT (Value: String): Integer;
Function MySTRTOFLOAT (STR: STRING): Extended;
Function PointInRect (const): Boolean;
Function ExtractNumToSet (Const str: string; var aset: tinteger): Boolean; // Extract the number from STR to the ASET collection, return true if successful
IMPLEMentation
Function MySTRTOINT (Value: String): Integer;
Begin
TrystrtOint (Trim (value), result);
END;
Function MySTRTOFLOAT (STR: STRING): Extended;
Begin
IF trim (str) = '' THEN
Result: = 0.0
Else Trystrtofloat (TRIM (STR), RESULT
END;
Function PointInRect (const): Boolean;
Begin
IF (pt.x> = Rect.Left) and (pt.x <= Rect.right) and
(Pt.y> = Rect.top) and (pt.y <= Rect.bottom) THEN
Result: = TRUE
Else Result: = FALSE
END;
Function ExtractNumToSet (Const str: string; var aset: tinteger): boolean; var
Tmpstr: String;
ICOMMA, I: integer; // comma position
Begin
ASET: = []; // Initialization Collection
if Length (STR) = 0 THEN
Begin
RESULT: = TRUE;
EXIT;
END;
IF not (Str [1] in ['0' .. '9']) THEN / / Check legality 1
Begin
Result: = FALSE;
EXIT;
END;
For i: = 1 to length (str) DO // Check legality 2
IF not (Str [I] in ['0' .. '9', ',']) THEN
Begin
Result: = FALSE;
EXIT;
END;
Tmpstr: = Trim (STR);
While Length (tmpstr)> 0 do
Begin
ICOMMA: = POS (',', tmpstr);
IF (TmpStr [1] in ['0' .. '9']) THEN
IF (iComma> 0) THEN
Begin
INCLUDE (ASET, STRTOINT (Copy (Tmpstr, 1, ICOMMA-1));
TMPSTR: = Copy (Tmpstr, ICOMMA 1, Length (Tmpstr) -ICOMMA);
end
Else Begin
INCLUDE (ASET, STRTOINT (TMPSTR));
Tmpstr: = '';
end
Else Tmpstr: = COPY (Tmpstr, ICOMMA 1, Length (Tmpstr) -ICOMMA);
END;
RESULT: = TRUE;
END;
PROCEDURE register;
Begin
Registercomponents ('MA', [TCBSTRGRID]);
END;
{TCBSTRGRID}
Procedure tcbstrgrid.altercheckcolvalue;
Begin
IF (row> 0) and (col = fcheckcolumnindex) THEN
Begin
IF MySTRTOINT (Cells [col, row]) = 0 THEN
Cells [Col, Row]: = '1'
Else Cells [col, row]: = '0';
END;
END;
Constructor Tcbstrgrid.create (Aowner: Tcomponent);
Begin
inherited;
Options: = Options [gocolsizing];
FCheckColumnIndex: = 1;
FDOWNCOLOR: = $ 00c5d6d9;
HEIGHT: = 150;
Width: = 350;
Col: = colcount-1;
END;
DESTRUCTOR TCBSTRGRID.DESTROY;
Begin
inherited;
END;
Procedure tcbstrgrid.drawcell (acol, imp / turn: integer;
ASTATE: TGRIDDRAWSTATE);
VAR
Area, CheckBoxRect: TRECT;
Curpt: tpoint;
Value, Offsetx, Offsety: Integer
Strcell: String; Begin
Area: = aRECT;
Inflaterect (Area, -2, -2); // Reduced area mainly as a Text Out area
IF (Arow> 0) THEN
Begin
IF acol in fnumcolsset dam // digital way
Begin
Strcell: = formatfloat ('#, ## 0. ##', MySTRTOFLOAT (Cells [Acol, Arow]);
DrawText (canvas.handle, Pchar (Strcell), Length (Strcell), Area, DT_Right) // is set to right
end
Else if acol in fcurrcolsset dam // currency method
Begin
Strcell: = '¥' Formatfloat ('#, ###. 00', MySTRTOFLOAT (Cells [Acol, AROW]));
DrawText (canvas.handle, Pchar (Strcell), Length (Strcell), Area, DT_Right) // is set to right
end
Else if acol in falignleftset
Drawtext (canvas.handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, DT_LEFT
Else if acol in faligncenterset the
Drawtext (canvas.handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, Dt_Center
Else if acol in faliGnrightset
DrawText (canvas.handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, DT_Right
Else if (acol = fcheckcolumnindex) THEN // Checkbox method
Begin
IF (Cells [0, AROW] = strsum) THEN EXIT; / / Total Wire Checkbox is not painted
Value: = MySTRTOINT (Cells [fcheckcolumnIndex, all);
Canvas.FillRect (all);
WITH ARECT DO
Begin
OFFSETX: = (Right- Left- 10) DIV 2;
OFFSETY: = (Bottom - TOP- 10) DIV 2;
END;
CheckboxRect: = Re (all, all, // getting the area to draw CHECKBOX
Arect.Left OffsetX 11, Arect.top Offsety 11);
Canvas.pen.Style: = pssolid;
Canvas.pen.width: = 1;
GetCursorpos (CURPT);
Curpt: = Self.screentoClient (CURPT);
{Painted background}
IF (FISDOWN) AND POINTINRECT (CURPT, ARECT) THEN
Begin
Canvas.brush.color: = fdowncolor;
Canvas.pen.color: = CLBLACK;
end
Else Begin
Canvas.brush.color: = color;
CANVAS.PEN.COLOR: = CLBLACK; END;
Canvas.FillRect (CheckboxRect);
{Picture}
IF (Value <> 0) THECKED = TRUE;
Begin
Canvas.penpos: = Point (CheckBoxRect.Left 2, checkboxRect.top 4); // Set the starting point
Canvas.Lineto (CheckBoxRect.Top 8); // Draw ...
Canvas.penpos: = Point (CheckBoxRect.Left 2, CheckBoxRect.top 5);
CANVAS.LINETO (CheckboxRect.Top 8);
Canvas.penpos: = Point (CheckBoxRect.Left 2, CheckboxRect.top 6);
Canvas.Lineto (CheckboxRect.Top 9); CHECKBOXRECT.TOP 9
Canvas.penpos: = Point (CheckBoxRect.TOP 2);
Canvas.Lineto (CheckBoxRect.Top 6); CHECKBOXRECT.TOP 6
Canvas.penpos: = Point (CheckBoxRect.Left 8, CheckboxRect.top 3);
Canvas.Lineto (CheckBoxRect.Left 4, CheckboxRect.top 7);
Canvas.penpos: = Point (CheckBoxRect.Left 8, checkboxRect.top 4);
Canvas.LineTo (CheckBoxRect.Top 5, CheckboxRect.top 7);
END;
{Painted boundary}
Area: = CellRect (col, row);
DrawFocusRect (canvas.handle, Area); //
Canvas.brush.color: = CLBLACK;
Canvas.FrameRect (CheckBoxRect);
end
Else Inherited Drawcell (Acol, Arow, all, Astate);
end
Else if (arow = 0) THEN
Begin
Canvas.FillRect (all);
Case ftitlealign of
TALEFT: DRAWTEXT (Canvas.Handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, Dt_left;
Tacenter: DrawText (Canvas.Handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, Dt_Center;
TATIGHT: DRAWText (canvas.handle, Pchar (Cells [Acol, Arow]), Length (Cells [Acol, Arow]), Area, Dt_Right;
END;
end
Else Inherited Drawcell (Acol, Arow, all, Astate);
END;
Procedure TCBSTRGRID.KEYDOWN (VAR Key: Word; Shift: TshiftState); Begin
IF (Key = vk_space) and (row> 0) and (col = fcheckcolumnindex) THEN
FISDOWN: = True;
inherited;
END;
Procedure tcbstrgrid.keyup (var key: word; shift: tshiftstate);
VAR
Area: TRECT;
Begin
IF (Key = vk_space) and (row> 0) and (col = fcheckcolumnindex) THEN
Begin
AltercheckColValue;
FISDOWN: = FALSE;
IF assigned (fcheckchanged) Then fcheckchanged (self);
END;
inherited;
IF key = vk_up then // vk_up TMD metamorphosis
Begin
Area: = SELF.CellRect (COL, ROW);
DrawFocusRect (canvas.handle, Area);
END;
IF fdisplaysumrow the dosumall;
END;
Procedure TCBSTRGRID.MOUSEDOWN (Button: tmousebutton; shift: tshiftstate; x,
Y: integer);
Begin
IF (row> 0) and (col = fcheckcolumnindex) THEN
FISDOWN: = true;
inherited;
END;
Procedure tcbstrgrid.mouseup (Button: tmousebutton; shift: tshiftstate; x,
Y: integer);
VAR
Curpt: tpoint;
Area: TRECT;
Begin
GetCursorpos (CURPT);
Curpt: = Self.screentoClient (CURPT);
Area: = SELF.CellRect (COL, ROW);
IF (row> 0) and (col = fcheckcolumnindex) and pointinRect (Curpt, Area) THEN
Begin
AltercheckColValue;
FISDOWN: = FALSE;
IF assigned (fcheckchanged) Then fcheckchanged (self);
END;
inherited;
IF fdisplaysumrow the dosumall;
END;
Procedure tcbstrgrid.setalignleftcols (const value: string);
Begin
IF extractnumtoseet (value, falignleftset) THEN
FalignLEFTCOLS: = Value
Else Raise Exception.create ('Property Value Setup error, use the number and, separately set the properties');
INVALIDATEGRID;
END;
Procedure tcbstrgrid.setCheckColumnIndex (const value: integer);
Begin
IF (Value> Colcount) The Raise Exception.create ('CheckColumnIndex Crossing ");
FCheckColumnIndex: = value;
Repaint;
END;
Procedure TCBSTRGRID.SETCOLORDOWN (Const Value: Tcolor); Begin
FDOWNCOLOR: = Value;
Invalidatecell (fcheckcolumnIndex, row);
END;
Procedure TCBSTRGRID.SETALIGNCENTERCOLS (Const value: string);
Begin
IF extractnumtoseet (value, faligncenterset) THEN
Faligncentercols: = value
Else Raise Exception.create ('Property Value Setup error, use the number and, separately set the properties');
INVALIDATEGRID;
END;
Procedure TCBSTRGRID.SETALIGNRIGHTCOLS (Const value: String);
Begin
IF extractnumtoseet (value, falignrightset)
FALIGNRIGHTCOLS: = Value
Else Raise Exception.create ('Property Value Setup error, use the number and, separately set the properties');
INVALIDATEGRID;
END;
Procedure TCBSTRGRID.SETCURRCOLS (Const Value: String);
Begin
IF extractnumtoseet (value, fcurrcolsset) THEN
Fcurrcols: = value
Else Raise Exception.create ('Property Value Setup error, use the number and, separately set the properties');
INVALIDATEGRID;
END;
Procedure tcbstrgrid.setnumcols (const value: string);
Begin
IF extractnumtoseet (value, fnumcolsset) THEN
Fnumcols: = value
Else Raise Exception.create ('Property Value Setup error, use the number and, separately set the properties');
INVALIDATEGRID;
END;
Procedure tcbstrgrid.settitlealign (const value: ttitlealign);
Begin
If Not (Value In [Taleft, Tacenter, TARIGHT]) THEN RAISE EXCETION.CREATE ('attribute value setting error, please select');
Ftitlealign: = Value;
INVALIDATEGRID;
END;
Function TCBSTRGRID.SELECTCELL (ACOL, AROW: Integer): Boolean;
Begin
IF (acol = fcheckcolumnindex) or (acol in freadonlyset) THEN
Options: = options - [gaediting]
Else Options: = Options [GoEDITING];
Inherited SelectCell (Acol, Arow);
END;
Procedure TCBSTRGRID.SETCOLSREADONLY (Const value: string);
Begin
IF extractnumtoseet (value, freadonlyset) THEN
FcolsreadOnly: = Value
Else Raise Exception.create ('attribute value setting error, set attribute'); invalidategrid;
END;
Procedure TCBSTRGRID.CLEAR;
VAR
I, J: Integer;
Begin
For i: = 1 to Rowcount-1 DO
For j: = 1 to colcount-1 do
Cells [J, I]: = '; // Note J, I
INVALIDATEGRID;
END;
Procedure tcbstrgrid.sizechanged (Oldcolcount, Oldrowcount: Integer);
VAR
i: integer;
Begin
inherited;
For i: = 1 to Rowcount-1 DO
Cells [0, I]: = INTTOSTR (i);
If FDISPLAYSUMROW THEN CELLS [0, RowCount-1]: = strsum
INVALIDATEGRID;
END;
Procedure tcbstrgrid.setdisplaysumrow (const value: boolean);
Begin
FDISPLAYSUMROW: = Value;
Rowcount: = rowcount 1; // Only refresh, call SIZECHANGED
RowCount: = rowcount-1; // Unconventional practice. I didn't expect a good way.
IF fdisplaysumrow the dosumall;
INVALIDATEGRID;
END;
Procedure tcbstrgrid.dosumall;
VAR
I, J: Integer;
Begin
IF not fdisplaysumrow kilove
For j: = 1 to color-1 do // initialized
IF (jin fcurrcolsset) or (jin fnumcolsset) THEN
Cells [J, Rowcount-1]: = '0';
For i: = 1 to Rowcount-2 DO
For j: = 1 to colcount-1 do
IF (jin fcurrcolsset) or (jin fnumcolsset) THEN
Cells [J, RowCount-1]: = floattostr ((MySTRTOFLOAT (Cells [J, RowCount-1]) MySTRTOFLOAT (Cells [J, I])));
IF Assigned (FonsumValueChanged) THEN FONSUMVALUECHANGED (SELF);
END;
Procedure TCBSTRGRID.KEYPRESS (VAR Key: char);
Begin
IF (COL in Fcurrcolsset Fnumcolsset) THEN
IF not (key in ['0' .. '9', '.', '-', char (vk_back), char (vk_delete)]) THEN
Key: = # 0;
Inherited KeyPress (key);
END;
Function TCBSTRGRID.NONCHECKED: BOOLEAN;
VAR
I, IMAX: Integer;
Begin
RESULT: = true;
IF fdisplaysumrow the iMax: = rowcount-2 else iMax: = rowcount-1;
For i: = 1 to IMAX DO
Beginif Cells [CheckColumnIndex, I] = '1' Then
Begin
Result: = FALSE;
EXIT;
end
END;
END;
Procedure TCBSTRGRID.SETONSUMVALUECHANGED (Const Value: TsumValueChange);
Begin
FONSUMVALUECHANGED: = Value;
END;
End.
