UNIT STRING_GRID_2021; // Created May 10, 2021 ancestor for all grids that take arrays of strings
// loads arrays of strings into a grid and shows my color scheme
{$mode objfpc}{$H+}
INTERFACE
USES
CLASSES, SYSUTILS, FILEUTIL, FORMS, CONTROLS, ExtCtrls, StdCtrls,
UTIL_2023, ENGLISH_STRINGS_2023, Buttons, ComCtrls, app_unit_2024, Graphics,
Grids, MY_POLYMORPH_2024,Dialogs,HELPERS_UNIT_2024;
TYPE
{ TFRAME_STRING_GRID_2021 }
TFRAME_STRING_GRID_2021 = CLASS(TFrame_MY_POLYMORPH_2024)
GRID: TStringGrid;
PRIVATE { private declarations } // ♀ ♂ ♂
PUBLIC { public declarations }
CONSTRUCTOR Create(THEOWNER:TComponent); OVERRIDE;
PROCEDURE ACTIVATE; OVERRIDE;
PROCEDURE CREATE_GRID (CONST NUM_COL,NUM_ROWS:Word); // when dimensions of grid are known and constant
PROCEDURE CREATE_SQUARE_GRID (CONST SIDE_LEN:Word); // makes a square grid
PROCEDURE CREATE_TITLES (CONST TITLES:TStringArray); // creates columns and adds titles titles and
PROCEDURE CREATE_LEFT_COLUMN (CONST ROW_TITLES:TStringArray); // the left side of the grid will be made fixed and added to
PROCEDURE SIZE_PRIORITIES;
PROCEDURE DRAW_GRID_LINE (SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE); VIRTUAL; // this an be overridden for descendants that want to blank out parts of the grid
PROCEDURE USE_PARENT_COLORS (SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE);
PROCEDURE COLOR_CELL (CONST ACOLOR,TXT_COLOR:TColor ;SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE); // for colors that dont work well with invert color
PROCEDURE COLOR_CELL (CONST ACOLOR:TColor;SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE); // text is always white
PROCEDURE HIGHLIGHT (SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE); VIRTUAL; // the default is to highlight by positive negative numbers
{} PROCEDURE PREPARE_FIXED_CANVAS ( SENDER: TOBJECT;ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ; //
PROCEDURE PREPARE_CANVAS( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
FUNCTION ROW_COUNT:Word; // used for adding things at the end by descendants
PROCEDURE ADD_ROW (CONST ROW_NUMBER:WORD; CONST STRINGS:TStringArray);
PROCEDURE RESIZE_FRAME;OVERRIDE;//( SENDER: TOBJECT) ; OVERRIDE;
PROCEDURE TEST; OVERRIDE;
PROTECTED { protected declarations }
PROCEDURE GET_HINT_COL_AND_ROW (SENDER: TOBJECT;HINTINFO: PHINTINFO); // set global variables once per hint event
FUNCTION TITLE_STRING ( SENDER: TOBJECT) : String; // called by cell screen when cell is a title row
FUNCTION CELL_STRING( SENDER: TOBJECT) : STRING; // get the value of the cell using global variables for hint_row and hint column
FUNCTION TITLE_TO_CELL_STRING (CONST SEPARATOR:ShortString ;SENDER:TObject):STRING; // for two dates scores and ephem grid
FUNCTION HINT_STRING (SENDER: TOBJECT) :String; VIRTUAL; //{;HINTINFO: PHINTINFO} the actual string that is assigned to the hint
PROCEDURE SHOW_HINT(SENDER: TOBJECT; HINTINFO: PHINTINFO) ; //VIRTUAL; // to make it easier to read default behaviors just shows what is in the grid cell
VAR
HINT_COL,HINT_ROW:INTEGER;
END;
IMPLEMENTATION
{$R *.lfm}
{ TFRAME_STRING_GRID_2021 }
CONSTRUCTOR TFRAME_STRING_GRID_2021.CREATE( THEOWNER: TCOMPONENT) ;
VAR X:INTEGER;
O:TGridOption;
S:STRING;
BEGIN
INHERITED Create(THEOWNER);
WITH GRID DO
BEGIN
ShowHint := True;
TitleFont:= Parent.Font;
DoubleBuffered := TRUE;
ScrollBars := ssNone;
FixedCols := 0;
FixedRows := 0;
ColCount := 1;
RowCount := 1;
AutoAdjustColumns ;
AutoSizeColumns;
ParentFont := True;
Options := options - [goRowHighlight,goSelectionActive,goRowSelect];
options:= Options +[goRowSizing];
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.ACTIVATE;
BEGIN
INHERITED ACTIVATE;
GRID.OnPrepareCanvas := @PREPARE_CANVAS;
GRID.OnShowHint := @SHOW_HINT;
END;
PROCEDURE TFRAME_STRING_GRID_2021.CREATE_GRID( CONST NUM_COL, NUM_ROWS: WORD) ;
VAR X:Integer;
BEGIN
WITH GRID,Columns DO
BEGIN
RowCount := NUM_ROWS;
FOR X:= Count TO NUM_COL DO
Add;
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.CREATE_SQUARE_GRID( CONST SIDE_LEN: WORD) ;
BEGIN
CREATE_GRID(SIDE_LEN,SIDE_LEN);
END;
PROCEDURE TFRAME_STRING_GRID_2021.CREATE_TITLES( CONST TITLES: TSTRINGARRAY) ;
VAR X:INTEGER;
BEGIN
WITH GRID DO
BEGIN
FixedRows := 1; // make sure there is a place to put titles they dont work for non fixed rows
WITH Columns DO
BEGIN
X:= Count;
X:= FixedCols + Length(TITLES);
IF Count < Length(TITLES)
THEN FOR X:= 1 TO ( Length(TITLES))- Count DO
Add;
FOR X:= 0 TO High(TITLES) DO
WITH Items[X] DO
BEGIN
Title.Alignment:= taCenter; // everything centered
Alignment:= taCenter;
//test TitleFont.Color := Parent.FONT.Color;
Title.Caption:= TITLES [X];
END;
X:= Count ;
END;
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.CREATE_LEFT_COLUMN( CONST ROW_TITLES: TSTRINGARRAY) ;
VAR X:INTEGER;
s:string;
BEGIN
WITH GRID DO
BEGIN
FixedCols := 1;
WITH Columns DO
BEGIN
IF Count = 0
THEN Add; // the grid has minimum of one column but these arent the same
Items[0].Alignment := taCenter;
END;
IF FixedRows > 0
THEN Cells[0,0]:= '';
RowCount := LENGTH(ROW_TITLES)+1;
// Cells[0,0]:= ''; // clear the text
FOR X:= 0 TO High(ROW_TITLES) DO
begin
Cells[0,X + ORD (FixedRows)]:= ROW_TITLES [X];
s:= Cells[0,X + ORD (FixedRows)];
END;
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.GET_HINT_COL_AND_ROW ( SENDER: TOBJECT; HINTINFO: PHINTINFO) ;
BEGIN
HINT_COL := -1;
HINT_ROW := -1;
WITH SENDER AS TStringGrid,HINTINFO^.CursorPos DO
MouseToCell(X, Y, HINT_COL, HINT_ROW);
END;
FUNCTION TFRAME_STRING_GRID_2021.TITLE_STRING( SENDER: TOBJECT) : STRING;
VAR
EMPTY_CORNER:Boolean; // to shift things over only when corner is empty
OFFSET:ShortInt;
BEGIN
WITH SENDER AS TStringGrid DO
BEGIN
EMPTY_CORNER := ((FixedCols =1)AND(FixedRows =1));
IF EMPTY_CORNER AND (HINT_COL = 0) THEN EXIT (''); //its in the empty corner
OFFSET:= ORD (EMPTY_CORNER AND (HINT_COL > 0)); // when there is an empty corner offset by -1 for titles not in corner
RESULT:= Columns.Items[HINT_COL - OFFSET].Title.Caption //title caption
END;
END;
FUNCTION TFRAME_STRING_GRID_2021.CELL_STRING( SENDER: TOBJECT) : STRING;
BEGIN
WITH SENDER AS TStringGrid DO
IF (FixedRows = 1) AND (HINT_ROW = 0)
THEN Exit (TITLE_STRING(SENDER)) // title rows are treated differently because they can have an empty corner that is nil apparently
ELSE RESULT:= Cells[HINT_Col,HINT_Row]; //cell text
END;
FUNCTION TFRAME_STRING_GRID_2021.TITLE_TO_CELL_STRING( CONST SEPARATOR: SHORTSTRING; SENDER: TOBJECT) : STRING;
//CONST AR_SYM:ARRAY[BOOLEAN] OF ShortString = (' -> ','');
BEGIN
WITH SENDER AS TStringGrid DO
IF (HINT_ROW = 0) AND (GRID.FixedRows = 1)
THEN Exit (TITLE_STRING(SENDER)) // call the ancestor method to show contents of title row cell
ELSE IF (HINT_COL = 0) AND (FixedCols = 1) //its in fixed left column
THEN RESULT:= CELL_STRING(SENDER)
ELSE RESULT:= TITLE_STRING(SENDER) + SEPARATOR + CELL_STRING(SENDER);
// RESULT:= TITLE_STRING(SENDER) + AR_SYM[(HINT_COL = 0) AND (FixedCols = 1)]+CELL_STRING(SENDER);
END;
FUNCTION TFRAME_STRING_GRID_2021.HINT_STRING( SENDER: TOBJECT) : STRING;
BEGIN
RESULT:= CELL_STRING(SENDER); // get the info in the cell defined by global hint_col and hint_row variables
//RESULT:= CELL_STRING(SENDER,HINTINFO); // for descendants other things can be added to cell string to make a report
END;
PROCEDURE TFRAME_STRING_GRID_2021.SHOW_HINT( SENDER: TOBJECT; HINTINFO: PHINTINFO) ;
BEGIN
GET_HINT_COL_AND_ROW(SENDER, HINTINFO); // hint_col and hint_row are variables that tell where the cell is
WITH SENDER AS TStringGrid,HINTINFO^ DO
BEGIN
HintStr := HINT_STRING(SENDER );
HintWindowClass := MY_HINT;
HintColor := APP.MY_FONT.Color; // make hint stand out more
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.SIZE_PRIORITIES;
VAR X:Integer;
BEGIN
WITH GRID.Columns DO
FOR X:= 0 TO VisibleCount-1 DO
WITH Items[X] DO
SizePriority := ORD (X <> 0);
END;
PROCEDURE TFRAME_STRING_GRID_2021.DRAW_GRID_LINE( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
BEGIN
WITH SENDER AS TStringGrid DO
GridLineColor := canvas.Font.Color; // default behavior
END;
PROCEDURE TFRAME_STRING_GRID_2021.USE_PARENT_COLORS ( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
BEGIN
WITH TStringGrid(SENDER),Canvas DO
BEGIN
Brush.Color:= Parent.Color;
Font.Color:= Parent.Font.Color;
DRAW_GRID_LINE(SENDER, ACOL, AROW, ASTATE);
//GridLineColor := Font.Color;// TitleFont.Color;// clBlue; //Font.Color ;
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.COLOR_CELL( CONST ACOLOR, TXT_COLOR: TCOLOR; SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE ) ;
BEGIN
WITH TStringGrid(SENDER).CANVAS DO
BEGIN
Font.Color := TXT_COLOR;
Brush.Color := ACOLOR;
END;
END;
// use this one more for highlighting because user color preferences will vary
PROCEDURE TFRAME_STRING_GRID_2021.COLOR_CELL( CONST ACOLOR: TCOLOR; SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
BEGIN
COLOR_CELL(ACOLOR,InvertColor(ACOLOR),SENDER, ACOL, AROW, ASTATE);
END;
// redo this to use app unit GRID_HILITE_COLOR
PROCEDURE TFRAME_STRING_GRID_2021.HIGHLIGHT( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
FUNCTION CELL_VALUE:Integer;
VAR REAL_VAL:Real;
BEGIN
REAL_VAL:= 0;
WITH SENDER AS TStringGrid,Canvas DO
IF (NOT TryStrToInt(Cells[ACOL,AROW],Result) AND NOT TryStrToFloat(Cells[ACOL,AROW],REAL_VAL)) AND ((TRUNC(REAL_VAL) = 0) AND (Result = 0))
THEN RESULT:= 0
ELSE IF Result = 0
THEN Result := trunc(REAL_VAL); // the cell value was a real number
END;
VAR CELL_VAL:Integer;
BEGIN
WITH SENDER AS TStringGrid,Canvas DO
BEGIN // redo to use method in app unit to get color
CELL_VAL := CELL_VALUE;
IF APP.NEEDS_TO_HILITE(CELL_VAL) // CELL_VAL = 0
THEN COLOR_CELL(APP.GRID_HILITE_COLOR(CELL_VAL),SENDER,ACOL,AROW,ASTATE)
ELSE USE_PARENT_COLORS(SENDER,ACOL,AROW,ASTATE); // string grid will be black if i dont do this
END;
END;
// for fixed rows and columns
PROCEDURE TFRAME_STRING_GRID_2021.PREPARE_FIXED_CANVAS ( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ;
VAR
BRUSH_COLOR,FONT_COLOR:TCOLOR;
S:STRING;
BEGIN
WITH TStringGrid(SENDER) DO
BEGIN
IF (AROW = 0)
THEN BEGIN
s:= Font.Name;
IF ACOL= 0 // to reduce number of times this is done
THEN RowHeights[0]:= STRING_HEIGHT('♆♅ ',TitleFont,Canvas)+ 5;//+2;
TitleFont.Name := Parent.Font.Name; // for some reason the font was still default
s:= TitleFont.Name;
TitleFont.Color := Parent.Color; //InvertColor(Parent.Color); // text of titles
TitleFont.Bold:= TRUE;
FixedColor := Parent.font.Color; //test
END
ELSE BEGIN // it is the left fixed column
Font.Bold:= TRUE;
Font:= TitleFont;
Font.Color := Parent.Color;
IF ACOL = 0
THEN Font.Bold:= TRUE;
RowHeights[AROW]:=STRING_HEIGHT('♆♅ ',TitleFont,Canvas)+ 5 ;
END;
END;
END;
// redo this to use the new function in app unit for grid color
PROCEDURE TFRAME_STRING_GRID_2021.PREPARE_CANVAS( SENDER: TOBJECT; ACOL, AROW: INTEGER; ASTATE: TGRIDDRAWSTATE) ; // fixed rows stay the system color when i dont use this
BEGIN
WITH TStringGrid(SENDER) DO //,ACOL, AROW
IF{ APP.CONTRASTING_CONTROLS AND} (((AROW = 0) AND (FixedRows > 0)) OR ((ACOL = 0) AND (FixedCols > 0)))
THEN PREPARE_FIXED_CANVAS(SENDER,ACOL,AROW,ASTATE) // this makes contrast in fixed rows and columns
ELSE IF APP.HIGHLIGHT_CELLS AND (Cells[ACOL,AROW] <> '') AND (Cells[ACOL,AROW] <> '0')
THEN HIGHLIGHT(SENDER,ACOL,AROW,ASTATE)
ELSE USE_PARENT_COLORS(SENDER,ACOL,AROW,ASTATE)
END;
FUNCTION TFRAME_STRING_GRID_2021.ROW_COUNT: WORD;
BEGIN
RESULT:= GRID.RowCount;
END;
PROCEDURE TFRAME_STRING_GRID_2021.ADD_ROW( CONST ROW_NUMBER: WORD; CONST STRINGS: TSTRINGARRAY) ;
var X:integer;
BEGIN
WITH GRID DO
BEGIN
WITH Columns DO
FOR X:= Count TO HIGH(STRINGS) DO
BEGIN
Add;
Columns[X].Alignment := taCenter;
END;
IF RowCount < ROW_NUMBER + 1
THEN RowCount := ROW_NUMBER + 1;
FOR X:= 0 TO HIGH(STRINGS) DO
Cells[X + Ord(FixedCols = 1),ROW_NUMBER]:= STRINGS [X];
IF goFixedRowNumbering IN Options // make sure that this option is turned off for things that dont need this
THEN cells [0,ROW_NUMBER]:= ROW_NUMBER.ToString;
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.RESIZE_FRAME;
VAR
X:INTEGER;
RH:WORD; // row heights total
BEGIN
GRID.TitleFont.Bold:= true; ///test
WITH GRID DO
BEGIN
Color:= clRed;
//AutoSizingAll;
TitleFont.Size:= SELF.Font.Size;
Font.Size := SELF.Font.Size;
AutoAdjustColumns ; // too short when i dont use this
AutoSizeColumns;
Columns.Items[0].Alignment := taCenter;
rh:= GridLineWidth *1; // if i dont do this it loses bottom line
FOR X:= 0 TO RowCount-1 DO
INC (RH,RowHeights[X] );
CONSTRAIN_HT(RH);
//old CONSTRAIN_HEIGHT(RH);
END;
END;
PROCEDURE TFRAME_STRING_GRID_2021.TEST;
const
AR_LEFT_COL :ARRAY [0..2] OF String = ('1','2','3');
// AR_LEFT_COL :ARRAY [0..7] OF String = ('one','two','three','four','five','six','seven','eight');
AR_DATA:ARRAY [0..11] OF STRING = ('0','-1','10','A','?','-5','blank','-2.0','-23.9','5.6','9.7','1');
//AR_DATA:ARRAY [0..11] OF String = ('1984-2-22','8781 GE','2 TA','3 ar','4 aq','5 ge','6 vi','3 ar','3 ar','3 ar','3 ar','3 ar');
var x:Integer;
BEGIN
APP.CONTRASTING_CONTROLS := FALSE;
GRID.FixedRows := 1;
GRID.FixedCols := 1;
CREATE_TITLES(AR_Data);
//HIGLIGHT_THE_CELLS := TRUE;
app.UPDATE_ALL_FORMS;
//EXIT;
for x:= 1 to 1 do
ADD_ROW(x,AR_DATA);
END;
END.
Recent
