Unit ads_SGrid;
{Copyright(c)2017 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_SGrid.pas This unit contains the following routines.
IsDate ListBoxMoveItem MyChar RaiseError StringGridColIsNumeric StringGridColNumericWidth StringGridColNumFromLabel StringGridColumnMoved StringGridDeleteRow StringGridDeleteRowsWhere StringGridFontDecreaseSize StringGridFontIncreaseSize StringGridFontSize StringGridGetFieldValueByFieldName StringGridIsMultiSelectOn StringGridListToRowValues StringGridLoadFromTable StringGridMouseDown StringGridMouseUp StringGridMultiSelectOff StringGridMultiSelectOn StringGridRowValuesToList StringGridSelect StringGridSelectAll StringGridSelectColumn StringGridSelectionFilter StringGridSetFieldValueByFieldName StringGridSetOptions StringGridSizeColumns StringGridSortAscending StringGridSortColumns StringGridSortDescending StringGridSortOnCol StringGridSortOnXY StringGridSortToggle StringGridToggleSelect StringGridToggleSelectAll StringGridToggleValueCoord StringGridToggleValueCurRec StringGridUniqueDateList StringGridUnSelect StringGridUnSelectAll TSortListBox_ads.SortListBox_adsMouseDown TSortListBox_ads.SortListBox_adsMouseUp
*)
Interface
Uses
ActnList,
Classes,
Grids,
StdCtrls,
SysUtils;
Function IsDate(sgTest: String): Boolean;
Function StringGridColIsNumeric(Var Grid: TStringGrid; inColNum: Integer): Boolean;
Function StringGridColNumericWidth(Var Grid: TStringGrid; inColNum: Integer): Integer;
Function StringGridColNumFromLabel(Grid: TStringGrid; sg: String): Integer;
Function StringGridDeleteRow(Grid: TStringGrid; Row: Integer): Boolean;
Function StringGridDeleteRowsWhere(Grid: TStringGrid; Col: Integer; Value: String): Boolean;
Function StringGridFontDecreaseSize(Grid: TStringGrid): Boolean;
Function StringGridFontIncreaseSize(Grid: TStringGrid): Boolean;
Function StringGridGetFieldValueByFieldName(Grid: TStringGrid; FieldName: String; Row: Integer): String;
Function StringGridIsMultiSelectOn(Grid: TStringGrid): Boolean;
Function StringGridListToRowValues(Grid: TStringGrid; Row: Integer; lst: TStringList): Boolean;
Function StringGridRowValuesToList(Grid: TStringGrid; Row: Integer; lst: TStringList): Boolean;
Function StringGridSelectColumn(Grid: TStringGrid; Title: String): Integer;
Function StringGridSetFieldValueByFieldName(Grid: TStringGrid; FieldName: String; Row: Integer; FieldValue: String): Boolean;
Function StringGridToggleValueCoord(Grid: TStringGrid; inCol, inRow: Integer): Boolean;
Function StringGridToggleValueCurRec(Grid: TStringGrid; ColName: String): Boolean;
Function StringGridUniqueDateList(Grid: TStringGrid; ColNum: Integer): String;
Procedure ListBoxMoveItem(Var ListBox: TListBox; YBefore, YAfter: Integer);
Procedure StringGridColumnMoved(Grid: TStringGrid);
Procedure StringGridFontSize(SenderAction, PartnerAction: TAction; Grid: TStringGrid; Increase: Boolean);
Procedure StringGridLoadFromTable(Grid: TStringGrid; DatabaseName, TableName: String);
Procedure StringGridMouseDown(Grid: TStringGrid);
Procedure StringGridMouseUp(Grid: TStringGrid; X, Y: Integer);
Procedure StringGridMultiSelectOff(Grid: TStringGrid);
Procedure StringGridMultiSelectOn(Grid: TStringGrid);
Procedure StringGridSelect(Grid: TStringGrid);
Procedure StringGridSelectAll(Grid: TStringGrid);
Procedure StringGridSelectionFilter(Grid: TStringGrid);
Procedure StringGridSetOptions(Grid: TStringGrid);
Procedure StringGridSizeColumns(Grid: TStringGrid);
Procedure StringGridSortAscending(Grid: TStringGrid);
Procedure StringGridSortColumns(Grid: TStringGrid);
Procedure StringGridSortDescending(Grid: TStringGrid);
Procedure StringGridSortOnCol(Var Grid: TStringGrid; inColNum: Integer; Toggle, SortAsc: Boolean);
Procedure StringGridSortOnXY(Var Grid: TStringGrid; inColX: Integer; Toggle, SortAsc: Boolean);
Procedure StringGridSortToggle(Grid: TStringGrid);
Procedure StringGridToggleSelect(Grid: TStringGrid);
Procedure StringGridToggleSelectAll(Grid: TStringGrid);
Procedure StringGridUnSelect(Grid: TStringGrid);
Procedure StringGridUnSelectAll(Grid: TStringGrid);
Var
//An error handler can be assigned here
RaiseErrorHandle: Function(UnitName, ProcName: String; E: Exception): Boolean;
Sorts: Array of Integer;
implementation
Uses
Buttons,Controls,DB,DBTables,ExtCtrls,Forms;
Const
UnitName = 'ads_SGrid';
Type
TSortListBox_ads = Class(TListBox)
Procedure SortListBox_adsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure SortListBox_adsMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
End;
{$WARNINGS OFF}
//Unit Description UnitIndex Master Index
Function MyChar(s: String): PChar;
Begin
Result:=PChar(s);
End;
{$WARNINGS ON}
//Unit Description UnitIndex Master Index
Procedure RaiseError(UnitName, ProcName: String; E: Exception);
Var
boHandled: Boolean;
Begin
Begin
boHandled := RaiseErrorHandle(UnitName, ProcName, E);
If boHandled Then Exit;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TSortListBox_ads.SortListBox_adsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
ProcName: String;
Begin
ProcName := 'TSortListBox_ads.SortListBox_adsMouseDown';
Try
TListBox(Sender).Tag := y;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure TSortListBox_ads.SortListBox_adsMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
ProcName: String;
Begin
ProcName := 'TSortListBox_ads.SortListBox_adsMouseUp';
Try
ListBoxMoveItem(TListBox(Sender), TListBox(Sender).Tag, Y);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridColumnMoved(Grid: TStringGrid);
Var
ProcName: String;
Begin
ProcName := 'StringGridColumnMoved';
Try
Grid.Tag := 421;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridMouseDown(Grid: TStringGrid);
Var
ProcName: String;
Begin
ProcName := 'StringGridMouseDown';
Try
Grid.Tag := 0;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridMouseUp(
Grid: TStringGrid;
X, Y: Integer);
Var
inRow: Integer;
ProcName: String;
Begin
ProcName := 'StringGridMouseUp';
Try
If Not (Grid.Tag = 421) Then
Begin
If Y < Grid.DefaultRowHeight Then
Begin
StringGridSortOnXY(Grid, x, True, True);
End
Else
Begin
If x < Grid.ColWidths[0] Then
Begin
inRow :=
(y Div (Grid.DefaultRowHeight + Grid.GridLineWidth)) +
Grid.TopRow - Grid.FixedRows;
If Grid.Cells[0, inRow] = 'N' Then
Begin
Grid.Cells[0, inRow] := 'Y';
End
Else
Begin
Grid.Cells[0, inRow] := 'N';
End;
End;
End;
End;
Grid.Tag := 0;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortOnXY(
Var Grid: TStringGrid;
inColX: Integer;
Toggle: Boolean;
SortAsc: Boolean
);
Var
boGotCol: Boolean;
inColNum: Integer;
inColWidth: Integer;
inCounter: Integer;
sgBlanks: String;
sgZeros: String;
ProcName: String;
Begin
ProcName := 'StringGridSortOnXY';
Try
InColNum := 0;
sgZeros := '0000';
inColWidth := 0;
sgBlanks := '';
For inCounter := 1 To 250 Do
Begin
sgBlanks := sgBlanks + ' ';
End;
boGotCol := False;
For inCounter := 0 To Grid.FixedCols - 1 Do
Begin
inColWidth := inColWidth + Grid.ColWidths[inCounter];
If inColWidth > inColX Then
Begin
inColNum := inCounter;
If inColNum < 0 Then inColNum := 0;
boGotCol := True;
Break;
End;
End;
If Not boGotCol Then
Begin
For inCounter := Grid.LeftCol To Grid.ColCount - 1 Do
Begin
inColWidth := inColWidth + Grid.ColWidths[inCounter];
If inColWidth > inColX Then
Begin
inColNum := inCounter;
If inColNum < 0 Then inColNum := 0;
Break;
End;
End;
End;
StringGridSortOnCol(Grid, inColNum, Toggle, SortAsc);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridToggleSelect(Grid: TStringGrid);
Var
inCounter: Integer;
inTop: Integer;
inBottom: Integer;
sgSelected: String;
ProcName: String;
Begin
ProcName := 'StringGridToggleSelect';
Try
inTop := Grid.Selection.Top;
inBottom := Grid.Selection.Bottom;
If (inTop > 0) And
(inBottom > 0) And
(inBottom >= inTop) Then
Begin
For inCounter := inTop To inBottom Do
Begin
sgSelected := Grid.Cells[0, inCounter];
If sgSelected = 'N' Then
Begin
Grid.Cells[0, inCounter] := 'Y';
End
Else
Begin
Grid.Cells[0, inCounter] := 'N';
End;
End;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSetOptions(Grid: TStringGrid);
Var
ProcName: String;
Begin
ProcName := 'StringGridSetOptions';
Try
If StringGridIsMultiSelectOn(Grid) Then
Begin
StringGridMultiSelectOn(Grid);
End
Else
Begin
StringGridMultiSelectOff(Grid);
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSizeColumns(Grid: TStringGrid);
Var
inColEndPad: Integer;
inCounter: Integer;
inRow: Integer;
inWidth: Integer;
inWidthMax: Integer;
lab: TLabel;
ProcName: String;
Begin
ProcName := 'StringGridSizeColumns';
Try
lab := TLabel.Create(Nil);
Try
inColEndPad := 3;
lab.Font := Grid.Font;
lab.AutoSize := True;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
inWidthMax := 4;
For inRow := 0 To Grid.RowCount - 1 Do
Begin
lab.Caption := Grid.Cells[inCounter, inRow];
inWidth := lab.Width;
If inWidth > inWidthMax Then inWidthMax := inWidth;
End;
Grid.ColWidths[inCounter] := inWidthMax + (2 * Grid.GridLineWidth) + inColEndPad;
End;
Finally
lab.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSelectAll(Grid: TStringGrid);
Var
inCounter: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSelectAll';
Try
For inCounter := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
Grid.Cells[0, inCounter] := 'Y';
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridUnSelectAll(Grid: TStringGrid);
Var
inCounter: Integer;
ProcName: String;
Begin
ProcName := 'StringGridUnSelectAll';
Try
For inCounter := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
Grid.Cells[0, inCounter] := 'N';
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSelect(Grid: TStringGrid);
Var
inCounter: Integer;
inTop: Integer;
inBottom: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSelect';
Try
inTop := Grid.Selection.Top;
inBottom := Grid.Selection.Bottom;
If (inTop > 0) And
(inBottom > 0) And
(inBottom >= inTop) Then
Begin
For inCounter := inTop To inBottom Do
Begin
Grid.Cells[0, inCounter] := 'Y';
End;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridUnSelect(Grid: TStringGrid);
Var
inCounter: Integer;
inTop: Integer;
inBottom: Integer;
ProcName: String;
Begin
ProcName := 'StringGridUnSelect';
Try
inTop := Grid.Selection.Top;
inBottom := Grid.Selection.Bottom;
If (inTop > 0) And
(inBottom > 0) And
(inBottom >= inTop) Then
Begin
For inCounter := inTop To inBottom Do
Begin
Grid.Cells[0, inCounter] := 'N';
End;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridSelectColumn(
Grid: TStringGrid;
Title: String): Integer;
Var
frm: TForm;
pnlTop: TPanel;
pnlButtons: TPanel;
lst: TListBox;
btnOk: TBitBtn;
btnCancel: TBitBtn;
inCounter: Integer;
inColEndPad: Integer;
inWidth: Integer;
inWidthMax: Integer;
lab: TLabel;
ProcName: String;
Begin
Result := -1;
ProcName := 'StringGridSelectColumn';
Try
frm := TForm.create(Nil);
pnlTop := TPanel.create(Nil);
pnlButtons := TPanel.create(Nil);
lst := TListBox.create(Nil);
btnOk := TBitBtn.create(Nil);
btnCancel := TBitBtn.create(Nil);
lab := TLabel.Create(Nil);
Try
With frm Do
Begin
Caption := Title;
Position := poScreenCenter;
Height :=
26 + //Control Bar
35 + //Buttons Panel
10 + //pnlTop BorderWidth
(Grid.ColCount * lst.ItemHeight);
BorderIcons := [];
End;
inColEndPad := 3;
lab.Font := Grid.Font;
lab.AutoSize := True;
inWidthMax := 165;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
lab.Caption := Grid.Cells[0, inCounter];
inWidth := lab.Width;
If inWidth > inWidthMax Then inWidthMax := inWidth;
End;
frm.Width := inWidthMax + inColEndPad + 10;
With pnlButtons Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Height := 35;
Align := alBottom;
End;
With pnlTop Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Align := alClient;
End;
With lst Do
Begin
Parent := pnlTop;
BorderStyle := bsSingle;
Align := alClient;
Items.Clear;
End;
With btnCancel Do
Begin
Parent := pnlButtons;
Kind := bkCancel;
Left := pnlButtons.Width - 75;
Top := 5;
Anchors := [akTop, akRight];
End;
With btnOk Do
Begin
Parent := pnlButtons;
Kind := bkOk;
Left := pnlButtons.Width - 5 - 75 - 5 - 75;
Top := 5;
Anchors := [akTop, akRight];
End;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
lst.Items.Add(Grid.Cells[inCounter, 0]);
End;
lst.Focused;
If frm.ShowModal = mrOK Then
Begin
Result := lst.ItemIndex;
End
Else
Begin
Result := -1;
End;
Finally
btnOk.Free;
btnCancel.Free;
pnlButtons.Free;
lst.Free;
pnlTop.Free;
frm.Free;
lab.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortAscending(Grid: TStringGrid);
Var
inColNum: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSortAscending';
Try
inColNum :=
StringGridSelectColumn(
Grid, //Grid : TStringGrid;
'Sort Ascending' //Title : String): Integer;
);
If inColNum <> -1 Then
StringGridSortOnCol(
Grid, //var Grid : TStringGrid;
inColNum, //inColNum : Integer;
False, //Toggle : Boolean;
True //SortAsc : Boolean
);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortOnCol(
Var Grid: TStringGrid;
inColNum: Integer;
Toggle: Boolean;
SortAsc: Boolean
);
Var
boDateCol: Boolean;
boCaseCol: Boolean;
boNumbers: Boolean;
dt: TDateTime;
GridBack: TStringGrid;
inCols: Integer;
inCounter: Integer;
inLen: Integer;
inRows: Integer;
inZeros: Integer;
lst: TStringList;
lstPreSort: TStringList;
sgBlanks: String;
sgRowNum: String;
sgStr: String;
sgTemp: String;
sgZeros: String;
ProcName: String;
inNumWidth: Integer;
sgNumPad: String;
Begin
ProcName := 'StringGridSortOnCol';
Try
lst := TStringList.Create();
lstPreSort := TStringList.Create();
GridBack := TStringGrid.Create(Nil);
Try
boDateCol := False;
boCaseCol := False;
boNumbers := False;
inNumWidth := 1;
If Grid.RowCount >= 1 Then
Begin
If UpperCase(Grid.Cells[inColNum, 0]) = 'CASE NO' Then
Begin
boCaseCol := True;
End;
End;
If Not boCaseCol Then
Begin
For inRows := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
sgStr := Grid.Cells[inColNum, inRows];
Try
If IsDate(sgStr) Then
Begin
dt := StrToDateTime(sgStr);
sgStr := FormatFloat('#.0000', dt);
boDateCol := True;
Break;
End;
Except
End;
If inRows > 15 Then Break;
End;
If Not boDateCol Then
Begin
boNumbers := StringGridColIsNumeric(Grid, inColNum);
If boNumbers Then
Begin
inNumWidth := StringGridColNumericWidth(Grid, inColNum);
sgNumPad := '';
For inCounter := 1 To inNumWidth Do
Begin
sgNumPad := sgNumPad + ' ';
End;
End;
End;
End;
sgZeros := '0000';
inZeros := 4;
sgBlanks := '';
For inCounter := 1 To 250 Do
Begin
sgBlanks := sgBlanks + ' ';
End;
GridBack.RowCount := Grid.RowCount;
GridBack.ColCount := Grid.ColCount;
GridBack.FixedCols := Grid.FixedCols;
GridBack.FixedRows := Grid.FixedRows;
If boNumbers Then
Begin
For inRows := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
sgTemp := Trim(Grid.Cells[inColNum, inRows]);
sgTemp := Copy(sgNumPad, 1, inNumWidth - Length(sgTemp)) + sgTemp;
Grid.Cells[inColNum, inRows] := sgTemp;
End;
End;
For inCols := 0 To Grid.ColCount - 1 Do
Begin
For inRows := 0 To Grid.RowCount - 1 Do
Begin
GridBack.Cells[inCols, inRows] := Grid.Cells[inCols, inRows];
End;
End;
For inRows := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
sgStr := Grid.Cells[inColNum, inRows];
sgTemp := sgStr;
If boDateCol Then
Begin
Try
If IsDate(sgStr) Then
Begin
dt := StrToDateTime(sgStr);
sgStr := FormatFloat('#.0000', dt);
End;
Except
Try
sgStr := ' ';
Except
End;
End;
End;
If boCaseCol Then
Begin
Try
sgStr := Trim(sgStr);
sgStr := Copy(sgStr, Length(sgStr) - 2, 3) + Copy(sgStr, 1, Length(sgStr) - 3);
Except
Try
sgStr := ' ';
Except
End;
End;
End;
sgStr := Copy(sgStr + sgBlanks, 1, 250);
sgRowNum := IntToStr(inRows);
inLen := Length(sgRowNum);
sgRowNum := Copy(sgZeros, 1, inZeros - inLen) + sgRowNum;
sgStr := sgStr + sgRowNum;
lst.Add(sgStr);
End;
lstPreSort.SetText(MyChar(lst.Text));
lst.Sorted := True;
If Toggle Then
Begin
If lst.Text = lstPresort.Text Then
Begin
//List is already sorted and needs to be reverse sorted
lst.Sorted := False;
lst.Clear;
For inCounter := (lstPreSort.Count - 1) Downto 0 Do
Begin
lst.Add(lstPreSort[inCounter]);
End;
End;
End
Else
Begin
If Not SortAsc Then
Begin
//needs to be reverse sorted
lst.Sorted := False;
lstPreSort.Sorted := True;
lstPreSort.Sorted := False;
lst.Clear;
For inCounter := (lstPreSort.Count - 1) Downto 0 Do
Begin
lst.Add(lstPreSort[inCounter]);
End;
End;
End;
For inCounter := 0 To lst.Count - 1 Do
Begin
sgStr := lst[inCounter];
inRows := StrToInt(Copy(sgStr, 251, Length(sgStr) - 250));
For inCols := 0 To Grid.ColCount - 1 Do
Begin
Grid.Cells[inCols, inCounter + Grid.FixedRows] := GridBack.Cells[inCols, inRows];
End;
End;
Finally
lst.Free;
lstPreSort.Free;
GridBack.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortDescending(Grid: TStringGrid);
Var
inColNum: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSortDescending';
Try
inColNum :=
StringGridSelectColumn(
Grid, //Grid : TStringGrid;
'Sort Descending' //Title : String): Integer;
);
If inColNum <> -1 Then
StringGridSortOnCol(
Grid, //var Grid : TStringGrid;
inColNum, //inColNum : Integer;
False, //Toggle : Boolean;
False //SortAsc : Boolean
);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortToggle(Grid: TStringGrid);
Var
inColNum: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSortToggle';
Try
inColNum :=
StringGridSelectColumn(
Grid, //Grid : TStringGrid;
'Sort Descending' //Title : String): Integer;
);
If inColNum <> -1 Then
StringGridSortOnCol(
Grid, //var Grid : TStringGrid;
inColNum, //inColNum : Integer;
True, //Toggle : Boolean;
True //SortAsc : Boolean
);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure ListBoxMoveItem(
Var ListBox: TListBox;
YBefore: Integer;
YAfter: Integer);
Var
ItemWas: Integer;
ItemNew: Integer;
lst: TStringList;
inCounter: Integer;
inTopIndex: Integer;
ProcName: String;
Begin
ProcName := 'ListBoxMoveItem';
Try
ListBox.Tag := 0;
inTopIndex := ListBox.TopIndex;
ItemWas := (YBefore Div ListBox.ItemHeight) + inTopIndex;
ItemNew := (YAfter Div ListBox.ItemHeight) + inTopIndex;
If ItemWas = ItemNew Then Exit;
If ItemWas < 0 Then Exit;
If ItemNew < 0 Then Exit;
If ItemWas > (ListBox.Items.Count - 1) Then Exit;
If ItemNew > (ListBox.Items.Count - 1) Then Exit;
lst := TStringList.Create();
Try
If ItemWas > ItemNew Then
Begin
For inCounter := 0 To ItemNew - 1 Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
lst.Add(ListBox.Items[ItemWas]);
For inCounter := ItemNew To ItemWas - 1 Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
For inCounter := ItemWas + 1 To ListBox.Items.Count - 1 Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
End
Else
Begin
For inCounter := 0 To ItemWas - 1 Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
For inCounter := ItemWas + 1 To ItemNew Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
lst.Add(ListBox.Items[ItemWas]);
For inCounter := ItemNew + 1 To ListBox.Items.Count - 1 Do
Begin
lst.Add(ListBox.Items[inCounter]);
End;
End;
ListBox.Items.SetText(MyChar(lst.Text));
ListBox.TopIndex := inTopIndex;
Finally
lst.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSortColumns(
Grid: TStringGrid);
Var
frm: TForm;
pnlTop: TPanel;
pnlButtons: TPanel;
lst: TSortListBox_ads;
btnOk: TBitBtn;
btnCancel: TBitBtn;
inCounter: Integer;
inColEndPad: Integer;
inWidth: Integer;
inRow: Integer;
inWidthMax: Integer;
lab: TLabel;
GridBack: TStringGrid;
lstOldOrder: TStringList;
sgColName: String;
inColNum: Integer;
ProcName: String;
Begin
ProcName := 'StringGridSortColumns';
Try
frm := TForm.create(Nil);
pnlTop := TPanel.create(Nil);
pnlButtons := TPanel.create(Nil);
lst := TSortListBox_ads.create(Nil);
btnOk := TBitBtn.create(Nil);
btnCancel := TBitBtn.create(Nil);
lab := TLabel.Create(Nil);
GridBack := TStringGrid.Create(Nil);
lstOldOrder := TStringList.Create();
Try
With frm Do
Begin
Caption := 'Sort The Columns';
Position := poScreenCenter;
Height :=
26 + //Control Bar
35 + //Buttons Panel
10 + //pnlTop BorderWidth
(Grid.ColCount * lst.ItemHeight);
BorderStyle := bsDialog;
BorderIcons := [];
End;
inColEndPad := 3;
lab.Font := Grid.Font;
lab.AutoSize := True;
inWidthMax := 165;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
lab.Caption := Grid.Cells[0, inCounter];
inWidth := lab.Width;
If inWidth > inWidthMax Then inWidthMax := inWidth;
End;
frm.Width := inWidthMax + inColEndPad + 10;
With pnlButtons Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Height := 35;
Align := alBottom;
End;
With pnlTop Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Align := alClient;
End;
With lst Do
Begin
Parent := pnlTop;
BorderStyle := bsSingle;
Align := alClient;
OnMouseDown := SortListBox_adsMouseDown;
OnMouseUp := SortListBox_adsMouseUp;
ShowHint := True;
Hint := 'Drag a column to arrange column order.';
Items.Clear;
End;
With btnCancel Do
Begin
Parent := pnlButtons;
Kind := bkCancel;
Left := pnlButtons.Width - 75;
Top := 5;
Anchors := [akTop, akRight];
ShowHint := True;
Hint := 'Make no changes to column orders.';
End;
With btnOk Do
Begin
Parent := pnlButtons;
Kind := bkOk;
Left := pnlButtons.Width - 5 - 75 - 5 - 75;
Top := 5;
Anchors := [akTop, akRight];
ShowHint := True;
Hint := 'Implement column order changes.';
End;
lstOldOrder.Clear;
For inCounter := 1 To Grid.ColCount - 1 Do
Begin
lst.Items.Add(Grid.Cells[inCounter, 0]);
lstOldOrder.Add(Grid.Cells[inCounter, 0]);
End;
lst.Focused;
If frm.ShowModal = mrOK Then
Begin
//Rearrange the columns
GridBack.ColCount := Grid.ColCount;
GridBack.RowCount := Grid.RowCount;
GridBack.FixedCols := Grid.FixedCols;
GridBack.FixedRows := Grid.FixedRows;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
For inRow := 0 To Grid.RowCount - 1 Do
Begin
GridBack.Cells[inCounter, inRow] := Grid.Cells[inCounter, inRow];
End;
End;
For inCounter := 0 To lst.Items.Count - 1 Do
Begin
sgColName := lst.Items[inCounter];
inColNum := lstOldOrder.IndexOf(sgColName);
If inColNum = -1 Then Continue;
inColNum := inColNum + 1;
For inRow := 0 To GridBack.RowCount - 1 Do
Begin
Grid.Cells[inCounter + 1, inRow] := GridBack.Cells[inColNum, inRow];
End;
End;
StringGridSizeColumns(Grid);
End
Else
Begin
//Don't do anything
End;
Finally
btnOk.Free;
btnCancel.Free;
pnlButtons.Free;
lst.Free;
pnlTop.Free;
frm.Free;
lab.Free;
GridBack.Free;
lstOldOrder.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridSelectionFilter(
Grid: TStringGrid);
Var
boAllTrue: Boolean;
btnCancel: TBitBtn;
btnOk: TBitBtn;
ComboBoxes: Array Of TComboBox;
frm: TForm;
GroupBoxes: Array Of TGroupBox;
Bases: Array Of TPanel;
inBaseCount: Integer;
grpSelToTop: TRadioGroup;
grpSelType: TRadioGroup;
inColEndPad: Integer;
inCounter: Integer;
inCounter2: Integer;
inBase: Integer;
inNewRowCnt: Integer;
inWidth: Integer;
inWidthMax: Integer;
lab: TLabel;
lst: TStringList;
lstColNums: TStringList;
lstValues: TStringList;
pnlButtons: TPanel;
pnlTop: TPanel;
ProcName: String;
Begin
ProcName := 'StringGridSelectionFilter';
Try
lst := TStringList.Create();
frm := TForm.create(Nil);
pnlTop := TPanel.create(Nil);
pnlButtons := TPanel.create(Nil);
btnOk := TBitBtn.create(Nil);
btnCancel := TBitBtn.create(Nil);
lab := TLabel.Create(Nil);
grpSelType := TRadioGroup.Create(Nil);
grpSelToTop := TRadioGroup.Create(Nil);
lstValues := TStringList.Create();
lstColNums := TStringList.Create();
If Odd(Grid.ColCount) Then
Begin
inBaseCount := ((Grid.ColCount Div 2) + 1) + 1;
End
Else
Begin
inBaseCount := (Grid.ColCount Div 2) + 1;
End;
SetLength(Bases, inBaseCount);
SetLength(GroupBoxes, Grid.ColCount);
SetLength(ComboBoxes, Grid.ColCount);
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
GroupBoxes[inCounter] := TGroupBox.Create(Nil);
ComboBoxes[inCounter] := TComboBox.Create(Nil);
End;
For inCounter := 0 To inBaseCount - 1 Do
Begin
Bases[inCounter] := TPanel.Create(Nil);
Bases[inCounter].Caption := ' ';
Bases[inCounter].BorderStyle := bsNone;
Bases[inCounter].BorderWidth := 0;
Bases[inCounter].BevelInner := bvNone;
Bases[inCounter].BevelOuter := bvNone;
End;
Try
With frm Do
Begin
Caption := 'Change Selection Where';
Position := poScreenCenter;
Height :=
26 + //Control Bar
35 + //Buttons Panel
10 + //pnlTop BorderWidth
10 + //Second Row of radio buttons in grpSelType
((inBaseCount) * 42);
BorderStyle := bsDialog;
BorderIcons := [];
Width := 500;
End;
inColEndPad := 3;
lab.Font := Grid.Font;
lab.AutoSize := True;
inWidthMax := 600;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
lab.Caption := Grid.Cells[0, inCounter];
inWidth := lab.Width;
If inWidth > inWidthMax Then inWidthMax := inWidth;
End;
frm.Width := inWidthMax + inColEndPad + 10;
With pnlButtons Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Height := 35;
Align := alBottom;
TabStop := False;
TabOrder := 0;
End;
With pnlTop Do
Begin
Parent := frm;
Caption := ' ';
BorderStyle := bsNone;
BevelOuter := bvNone;
BevelInner := bvNone;
BorderWidth := 5;
Align := alClient;
TabStop := False;
TabOrder := 0;
End;
For inCounter := 0 To (inBaseCount - 1) Do
Begin
Bases[inCounter].Parent := pnlTop;
Bases[inCounter].Height := 42;
Bases[inCounter].Align := alTop;
End;
With grpSelToTop Do
Begin
Parent := Bases[inBaseCount - 1];
Items.Clear;
Items.Add('Sort to Top');
Items.Add('No Sort');
Columns := 2;
Caption := 'Sort Selected to Top';
Width := Bases[inBaseCount - 1].Width Div 2;
ShowHint := True;
Hint := 'Sort selected records to the top.';
ItemIndex := 0;
Align := alRight;
TabStop := False;
TabOrder := 0;
End;
With grpSelType Do
Begin
Parent := Bases[inBaseCount - 1];
Items.Clear;
Items.Add('Select');
Items.Add('UnSelect');
Items.Add('Toggle');
Items.Add('Delete');
Columns := 2;
Caption := 'Selection Type';
Align := alLeft;
Width := Bases[inBaseCount - 1].Width Div 2;
ShowHint := True;
Hint := 'Identify Selection action.';
ItemIndex := 0;
TabStop := False;
TabOrder := 0;
End;
grpSelToTop.Align := alClient;
For inCounter := (Grid.ColCount - 1) Downto 0 Do
Begin
inBase := (((inCounter + 2) Div 2) - 1);
GroupBoxes[inCounter].Parent := Bases[inBase];
GroupBoxes[inCounter].Caption := Grid.Cells[inCounter, 0] + ' Column';
GroupBoxes[inCounter].Height := 38;
GroupBoxes[inCounter].Width := Bases[inBase].Width Div 2;
If Odd(inCounter + 1) Then
Begin
GroupBoxes[inCounter].Align := alLeft;
End
Else
Begin
GroupBoxes[inCounter].Align := alClient;
End;
ComboBoxes[inCounter].Parent := GroupBoxes[inCounter];
ComboBoxes[inCounter].Align := alTop;
lst.Clear;
lst.Duplicates := dupIgnore;
lst.Sorted := True;
If IsDate(Grid.Cells[inCounter, Grid.FixedRows]) Then
Begin
lst.Sorted := False;
lst.SetText(MyChar(StringGridUniqueDateList(Grid, inCounter)));
End
Else
Begin
For inCounter2 := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
If Trim(Grid.Cells[inCounter, inCounter2]) <> '' Then
lst.Add(Grid.Cells[inCounter, inCounter2]);
End;
End;
ComboBoxes[inCounter].Items.SetText(MyChar(lst.Text));
GroupBoxes[inCounter].TabStop := False;
GroupBoxes[inCounter].TabOrder := 0;
End;
With btnCancel Do
Begin
Parent := pnlButtons;
Kind := bkCancel;
Left := pnlButtons.Width - 75;
Top := 5;
Anchors := [akTop, akLeft];
ShowHint := True;
Hint := 'Make no selection changes.';
TabStop := True;
TabOrder := 0;
End;
With btnOk Do
Begin
Parent := pnlButtons;
Kind := bkOk;
Left := pnlButtons.Width - 5 - 75 - 5 - 75;
Top := 5;
Anchors := [akTop, akLeft];
ShowHint := True;
Hint := 'Implement selection changes.';
TabStop := True;
TabOrder := 0;
End;
If frm.Width < 210 Then frm.Width := 210;
Bases[inBaseCount - 1].Align := alClient;
If frm.ShowModal = mrOK Then
Begin
lstValues.Clear;
lstColNums.Clear;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
If ComboBoxes[inCounter].Text <> '' Then
Begin
lstValues.Add(ComboBoxes[inCounter].Text);
lstColNums.Add(IntToStr(inCounter));
End;
End;
If lstValues.Count > 0 Then
Begin
//Find Items
For inCounter := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
boAllTrue := False;
For inCounter2 := 0 To lstValues.Count - 1 Do
Begin
If Grid.Cells[StrToInt(lstColNums[inCounter2]), inCounter] <> lstValues[inCounter2] Then Break;
If inCounter2 = (lstValues.Count - 1) Then boAllTrue := True;
End;
If boAllTrue Then
Begin
Case grpSelType.ItemIndex Of
0: Grid.Cells[0, inCounter] := 'Y';
1: Grid.Cells[0, inCounter] := 'N';
2:
Begin
If Grid.Cells[0, inCounter] = 'Y' Then
Begin
Grid.Cells[0, inCounter] := 'N';
End
Else
Begin
Grid.Cells[0, inCounter] := 'Y';
End;
End;
3: Grid.Cells[0, inCounter] := 'Z';
End;
End;
End;
If grpSelType.ItemIndex = 3 Then
Begin
StringGridSortOnCol(Grid, 0, False, True);
inNewRowCnt := Grid.RowCount;
For inCounter := (Grid.RowCount - 1) Downto Grid.FixedRows Do
Begin
If Grid.Cells[0, inCounter] <> 'Z' Then Break;
inNewRowCnt := inNewRowCnt - 1;
End;
Grid.RowCount := inNewRowCnt;
End;
If grpSelToTop.ItemIndex = 0 Then
StringGridSortOnCol(Grid, 0, False, False);
End;
End
Else
Begin
//Don't do anything
End;
Finally
grpSelType.Free;
grpSelToTop.Free;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
ComboBoxes[inCounter].Free;
GroupBoxes[inCounter].Free;
End;
For inCounter := 0 To inBaseCount - 1 Do
Begin
Bases[inCounter].Free;
End;
btnOk.Free;
btnCancel.Free;
pnlButtons.Free;
pnlTop.Free;
frm.Free;
lab.Free;
lstValues.Free;
lstColNums.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridLoadFromTable(Grid: TStringGrid; DatabaseName, TableName: String);
Var
inColCount: Integer;
inCounter: Integer;
inPos: Integer;
sgName: String;
T: TTable;
lab: TLabel;
ProcName: String;
Begin
ProcName := 'StringGridLoadFromTable';
Try
T := TTable.Create(Nil);
lab := TLabel.Create(Nil);
Try
lab.AutoSize := True;
lab.Font := Grid.Font;
T.Active := False;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.Active := True;
inColCount := T.FieldCount;
Grid.ColCount := inColCount + 1;
Grid.RowCount := 2;
Grid.FixedRows := 1;
Grid.FixedCols := 1;
Grid.Cells[0, 0] := 'Get';
For inCounter := 0 To inColCount - 1 Do
Begin
sgName := T.FieldDefs[inCounter].DisplayName;
inPos := Pos('_', sgName);
If inPos <> 0 Then sgName := StringReplace(sgName, '_', ' ', [rfReplaceAll]);
sgName := UpperCase(Copy(sgName, 1, 1)) + Copy(sgName, 2, 255);
Grid.Cells[inCounter + 1, 0] := sgName;
End;
T.First;
While Not T.EOF Do
Begin
Grid.RowCount := Grid.RowCount + 1;
Grid.Cells[0, Grid.RowCount - 2] := 'N';
For inCounter := 0 To inColCount - 1 Do
Begin
If (T.FieldDefs[inCounter].DataType = ftDateTime) Or
(T.FieldDefs[inCounter].DataType = ftDate) Then
Begin
sgName := FormatDateTime('mm/dd/yyyy', T.Fields[inCounter].AsDateTime);
End
Else
Begin
sgName := T.Fields[inCounter].AsString;
End;
Grid.Cells[inCounter + 1, Grid.RowCount - 2] := sgName;
End;
T.Next;
End;
Grid.RowCount := Grid.RowCount - 1;
StringGridSizeColumns(Grid);
Finally
T.Active := False;
T.Free;
lab.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function IsDate(sgTest: String): Boolean;
Var
sgNumbers: String;
inPos: Integer;
sgTemp: String;
sgMonth: String;
sgDays: String;
sgYear: String;
inCounter: Integer;
sgAllNum: String;
inMonth: Integer;
inDays: Integer;
inYear: Integer;
ProcName: String;
Begin
Result := False;
ProcName := 'IsDate';
Try
Result := False;
sgNumbers := '0123456789';
sgTest := Trim(sgTest);
sgTemp := sgTest;
If sgTest = '' Then Exit;
inPos := Pos('/', sgTemp);
If inPos = 0 Then Exit;
sgMonth := Trim(Copy(sgTemp, 1, inPos - 1));
sgTemp := Copy(sgTemp, inPos + 1, 255);
inPos := Pos('/', sgTemp);
If inPos = 0 Then Exit;
sgDays := Trim(Copy(sgTemp, 1, inPos - 1));
sgYear := Trim(Copy(sgTemp, inPos + 1, 255));
sgAllNum := sgMonth + sgDays + sgYear;
For inCounter := 1 To Length(sgAllNum) Do
Begin
If Pos(Copy(sgAllNum, inCounter, 1), sgNumbers) = 0 Then Exit;
End;
inMonth := StrToInt(sgMonth);
inDays := StrToInt(sgDays);
inYear := StrToInt(sgYear);
If inMonth < 1 Then Exit;
If inMonth > 12 Then Exit;
If inDays < 1 Then Exit;
If inDays > 31 Then Exit;
If inYear < 1 Then Exit;
If inYear > 3000 Then Exit;
Try
StrToDateTime(sgMonth + '/' + sgDays + '/' + sgYear);
Result := True;
Except
Result := False;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridUniqueDateList(Grid: TStringGrid; ColNum: Integer): String;
Var
lstDateNums: TStringList;
lstDates: TStringList;
inCounter: Integer;
ProcName: String;
Begin
ProcName := 'StringGridUniqueDateList';
Try
lstDateNums := TStringList.Create();
lstDates := TStringList.Create();
Try
Try
lstDateNums.Clear;
lstDateNums.Duplicates := dupIgnore;
lstDateNums.Sorted := True;
For inCounter := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
lstDateNums.Add(FormatFloat('000000.0000', StrToDateTime(Grid.Cells[ColNum, inCounter])));
End;
lstDates.Clear;
lstDates.Sorted := False;
For inCounter := 0 To lstDateNums.Count - 1 Do
Begin
lstDates.Add(FormatDateTime('mm/dd/yyy', StrToFloat(lstDateNums[inCounter])));
End;
Result := lstDates.Text;
Except
Result := '';
End;
Finally
lstDateNums.Free;
lstDates.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridToggleSelectAll(Grid: TStringGrid);
Var
inCounter: Integer;
inTop: Integer;
inBottom: Integer;
sgSelected: String;
ProcName: String;
Begin
ProcName := 'StringGridToggleSelectAll';
Try
inTop := Grid.FixedRows;
inBottom := Grid.RowCount - 1;
If (inTop > 0) And
(inBottom > 0) And
(inBottom >= inTop) Then
Begin
For inCounter := inTop To inBottom Do
Begin
sgSelected := Grid.Cells[0, inCounter];
If sgSelected = 'N' Then
Begin
Grid.Cells[0, inCounter] := 'Y';
End
Else
Begin
Grid.Cells[0, inCounter] := 'N';
End;
End;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridFontIncreaseSize(Grid: TStringGrid): Boolean;
Var
ProcName: String;
Begin
Result := False;
ProcName := 'StringGridFontIncreaseSize';
Try
Case Grid.Font.Size Of
8: Grid.Font.Size := 10;
10: Grid.Font.Size := 12;
12: Grid.Font.Size := 16;
16: Grid.Font.Size := 18;
18: Grid.Font.Size := 18;
Else
Grid.Font.Size := 8;
End;
StringGridSizeColumns(Grid);
Result := Not (Grid.Font.Size >= 18);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridFontDecreaseSize(Grid: TStringGrid): Boolean;
Var
ProcName: String;
Begin
Result := False;
ProcName := 'StringGridFontDecreaseSize';
Try
Case Grid.Font.Size Of
8: Grid.Font.Size := 8;
10: Grid.Font.Size := 8;
12: Grid.Font.Size := 10;
16: Grid.Font.Size := 12;
18: Grid.Font.Size := 16;
Else
Grid.Font.Size := 8;
End;
StringGridSizeColumns(Grid);
Result := Not (Grid.Font.Size <= 8);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridFontSize(SenderAction, PartnerAction: TAction; Grid: TStringGrid; Increase: Boolean);
Var
ProcName: String;
Begin
ProcName := 'StringGridFontSize';
Try
If Increase Then
Begin
StringGridFontIncreaseSize(Grid);
SenderAction.Enabled := True;
PartnerAction.Enabled := True;
If Grid.Font.Size >= 18 Then SenderAction.Enabled := False;
If Grid.Font.Size <= 8 Then PartnerAction.Enabled := False;
End
Else
Begin
StringGridFontDecreaseSize(Grid);
SenderAction.Enabled := True;
PartnerAction.Enabled := True;
If Grid.Font.Size >= 18 Then PartnerAction.Enabled := False;
If Grid.Font.Size <= 8 Then SenderAction.Enabled := False;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridMultiSelectOn(Grid: TStringGrid);
Var
ProcName: String;
Begin
ProcName := 'StringGridMultiSelectOn';
Try
If Grid.Options <> [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColMoving, goRowSelect, goColSizing] Then
Grid.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColMoving, goRowSelect, goColSizing];
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Procedure StringGridMultiSelectOff(Grid: TStringGrid);
Var
ProcName: String;
Begin
ProcName := 'StringGridMultiSelectOff';
Try
If Grid.Options <> [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColMoving, goRowSelect, goColSizing] Then
Grid.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColMoving, goRowSelect, goColSizing];
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridIsMultiSelectOn(Grid: TStringGrid): Boolean;
Var
ProcName: String;
Begin
Result := False;
ProcName := 'StringGridIsMultiSelectOn';
Try
If goRangeSelect In Grid.Options Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridDeleteRow(Grid: TStringGrid; Row: Integer): Boolean;
Var
inCounterRows: Integer;
inCounterCols: Integer;
inRowMax: Integer;
inColMax: Integer;
ProcName: String;
inRowCur: Integer;
inRowNew: Integer;
Begin
ProcName := 'StringGridDeleteRow';
Result := False;
Try
Result := False;
inRowMax := Grid.RowCount - 1;
inColMax := Grid.ColCount - 1;
inRowCur := Grid.Row;
If Row > inRowMax Then Exit;
If Row < 0 Then Exit;
If inRowCur < Row Then
Begin
inRowNew := inRowCur;
End
Else
Begin
If inRowCur = Row Then
Begin
inRowNew := inRowCur - 1;
End
Else
Begin
inRowNew := inRowCur - 1;
End;
End;
If inRowNew < Grid.FixedRows Then inRowNew := Grid.FixedRows;
If inRowNew >= Grid.RowCount Then inRowNew := Grid.RowCount - 1;
If Row = inRowMax Then
Begin
Grid.RowCount := Grid.RowCount - 1;
Grid.Row := inRowNew;
Result := True;
Exit;
End;
For inCounterRows := (Row + 1) To inRowMax Do
Begin
For inCounterCols := 0 To inColMax Do
Begin
Grid.Cells[inCounterCols, inCounterRows - 1] := Grid.Cells[inCounterCols, inCounterRows];
End;
End;
Grid.RowCount := Grid.RowCount - 1;
Grid.Row := inRowNew;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridDeleteRowsWhere(Grid: TStringGrid; Col: Integer; Value: String): Boolean;
Var
inCounterRows: Integer;
inCounterCols: Integer;
inRowMax: Integer;
inRowMin: Integer;
ProcName: String;
Grid2: TStringGrid;
Begin
ProcName := 'StringGridDeleteRowsWhere';
Result := False;
Try
inRowMax := Grid.RowCount - 1;
inRowMin := Grid.FixedRows;
{
For inCounterRows := inRowMax DownTo inRowMin Do
Begin
If Grid.Cells[Col,inCounterRows] = Value Then
StringGridDeleteRow(Grid, inCounterRows);
End;
}
Grid2 := TStringGrid.Create(Nil);
Try
Grid2.RowCount := Grid.FixedRows;
For inCounterRows := inRowMin To inRowMax Do
Begin
If Grid.Cells[Col, inCounterRows] <> Value Then
Begin
Grid2.RowCount := Grid2.RowCount + 1;
For inCounterCols := 0 To Grid.ColCount - 1 Do
Begin
Grid2.Cells[inCounterCols, Grid2.RowCount - 1] := Grid.Cells[inCounterCols, inCounterRows];
End;
End;
End;
Grid.RowCount := Grid2.RowCount;
For inCounterRows := inRowMin To inRowMax Do
Begin
For inCounterCols := 0 To Grid.ColCount - 1 Do
Begin
Grid.Cells[inCounterCols, inCounterRows] := Grid2.Cells[inCounterCols, inCounterRows];
End;
End;
Finally
Grid2.Free;
End;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridRowValuesToList(Grid: TStringGrid; Row: Integer; lst: TStringList): Boolean;
Var
ProcName: String;
inCounter: Integer;
Begin
Result := False;
ProcName := 'StringGridRowValuesToList';
Try
lst.Clear;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
lst.Values[Grid.Cells[inCounter, 0]] := Grid.Cells[inCounter, Row];
End;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridColNumFromLabel(Grid: TStringGrid; sg: String): Integer;
Var
ProcName: String;
inCounter: Integer;
Begin
Result := -1;
ProcName := 'StringGridColNumFromLabel';
Try
sg := UpperCase(sg);
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
If sg = UpperCase(Grid.Cells[inCounter, 0]) Then
Begin
Result := inCounter;
Break;
End;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridToggleValueCoord(Grid: TStringGrid; inCol, inRow: Integer): Boolean;
Var
ProcName: String;
sg: String;
Begin
Result := False;
ProcName := 'StringGridToggleValueCoord';
Try
If Grid.FixedRows > inRow Then Exit;
If (Grid.ColCount - 1) < inCol Then Exit;
sg := UpperCase(Grid.Cells[inCol, inRow]);
sg := Copy(sg, 1, 1);
If sg = 'Y' Then
Begin
Grid.Cells[inCol, inRow] := 'N';
End
Else
Begin
Grid.Cells[inCol, inRow] := 'Y';
End;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridToggleValueCurRec(Grid: TStringGrid; ColName: String): Boolean;
Var
ProcName: String;
inRow: Integer;
inCol: Integer;
Begin
Result := False;
ProcName := 'StringGridToggleValueCurRec';
Try
inCol := StringGridColNumFromLabel(Grid, ColName);
If inCol = -1 Then Exit;
inRow := Grid.Row;
If inRow < 0 Then Exit;
Result := StringGridToggleValueCoord(Grid, inCol, inRow);
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridListToRowValues(Grid: TStringGrid; Row: Integer; lst: TStringList): Boolean;
Var
ProcName: String;
inCounter: Integer;
sgColName: String;
sgNewValue: String;
Begin
Result := False;
ProcName := 'StringGridListToRowValues';
Try
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
sgColName := Grid.Cells[inCounter, 0];
sgNewValue := lst.Values[sgColName];
If (sgNewValue = 'y') Or (sgNewValue = 'n') Then
sgNewValue := UpperCase(sgNewValue);
Grid.Cells[inCounter, Row] := sgNewValue;
End;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridGetFieldValueByFieldName(Grid: TStringGrid; FieldName: String; Row: Integer): String;
Var
ProcName: String;
inCol: Integer;
Begin
Result := '';
ProcName := 'StringGridGetFieldValueByFieldName';
Try
inCol := StringGridColNumFromLabel(Grid, FieldName);
If inCol < 0 Then Exit;
If Row > (Grid.RowCount - 1) Then Exit;
If Row < 0 Then Exit;
Result := Grid.Cells[inCol, Row];
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridSetFieldValueByFieldName(Grid: TStringGrid; FieldName: String; Row: Integer; FieldValue: String): Boolean;
Var
ProcName: String;
inCol: Integer;
Begin
Result := False;
ProcName := 'StringGridSetFieldValueByFieldName';
Try
inCol := StringGridColNumFromLabel(Grid, FieldName);
If inCol < 0 Then Exit;
If Row > (Grid.RowCount - 1) Then Exit;
If Row < 0 Then Exit;
Grid.Cells[inCol, Row] := FieldValue;
Result := True;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridColIsNumeric(Var Grid: TStringGrid; inColNum: Integer): Boolean;
Var
ProcName: String;
sgTemp: String;
lst: TStringList;
inCounter: Integer;
Begin
Result := False;
ProcName := 'StringGridColIsNumeric';
Try
lst := TStringList.Create();
Try
lst.clear;
lst.SetText(MyChar(Grid.cols[inColNum].Text));
For inCounter := 0 To Grid.FixedRows - 1 Do
Begin
lst.Delete(inCounter);
End;
sgTemp := lst.Text;
sgTemp := StringReplace(sgTemp, #10, '', [rfReplaceall]);
sgTemp := StringReplace(sgTemp, #13, '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, ' ', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
Result := True;
sgTemp := StringReplace(sgTemp, '0', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '1', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '2', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '3', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '4', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '5', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '6', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '7', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '8', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '9', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '-', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '+', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
sgTemp := StringReplace(sgTemp, '.', '', [rfReplaceall]);
If sgTemp = '' Then Exit;
Result := False;
Finally
lst.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
//Unit Description UnitIndex Master Index
Function StringGridColNumericWidth(Var Grid: TStringGrid; inColNum: Integer): Integer;
Var
ProcName: String;
sgTemp: String;
lst: TStringList;
inCounter: Integer;
inWidth: Integer;
inLen: Integer;
Begin
Result := 1;
ProcName := 'StringGridColNumericWidth';
Try
lst := TStringList.Create();
Try
inWidth := 1;
lst.Clear;
lst.SetText(MyChar(Grid.Cols[inColNum].Text));
For inCounter := 0 To Grid.FixedRows - 1 Do
Begin
lst.Delete(inCounter);
End;
For inCounter := 0 To lst.Count - 1 Do
Begin
sgTemp := Trim(lst[inCounter]);
inLen := Length(sgTemp);
If inLen > inWidth Then inWidth := inLen;
End;
Result := inWidth;
Finally
lst.Free;
End;
Except On E: Exception Do RaiseError(UnitName, ProcName, E);
End;
End;
End.
//