Bu unit program String grid işleminde kullanılır.
Kod: Tümünü seç
unit ads_SGrid;
interface
Uses Grids, Classes, SysUtils, Dialogs, StdCtrls, Forms, ExtCtrls, Buttons,
Controls, DBTables, DB, Menus, ComCtrls, ActnList, Graphics, ads_Exception;
Procedure ListBoxMoveItem(
Var ListBox : TListBox;
YBefore : Integer;
YAfter : Integer);
Function StringGridColNumericWidth(var Grid: TStringGrid;inColNum: Integer): Integer;
Function StringGridColIsNumeric(var Grid: TStringGrid;inColNum: Integer): Boolean;
Procedure StringGridFontSize(SenderAction,PartnerAction: TAction;Grid: TStringGrid;Increase: Boolean);
Function StringGridUniqueDateList(Grid: TStringGrid;ColNum : Integer): String;
Procedure StringGridSelectionFilter(Grid: TStringGrid);
Procedure StringGridLoadFromTable(Grid: TStringGrid;DatabaseName,TableName: String);
Function StringGridSelectColumn(Grid: TStringGrid;Title: String): Integer;
procedure StringGridColumnMoved(Grid: TStringGrid);
procedure StringGridMouseDown(Grid: TStringGrid);
procedure StringGridMouseUp(Grid: TStringGrid;X, Y: Integer);
procedure StringGridSelect(Grid : TStringGrid);
procedure StringGridSelectAll(Grid : TStringGrid);
procedure StringGridSetOptions(Grid : TStringGrid);
procedure StringGridSizeColumns(Grid : TStringGrid);
procedure StringGridSortAscending(Grid : TStringGrid);
procedure StringGridSortToggle(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 StringGridToggleSelect(Grid : TStringGrid);
procedure StringGridToggleSelectAll(Grid : TStringGrid);
Function StringGridFontIncreaseSize(Grid : TStringGrid):Boolean;
procedure StringGridUnSelect(Grid : TStringGrid);
procedure StringGridUnSelectAll(Grid : TStringGrid);
Function StringGridFontDecreaseSize(Grid : TStringGrid):Boolean;
Procedure StringGridMultiSelectOn(Grid : TStringGrid);
Procedure StringGridMultiSelectOff(Grid : TStringGrid);
Function StringGridIsMultiSelectOn(Grid : TStringGrid):Boolean;
Function StringGridDeleteRow(Grid : TStringGrid; Row : Integer): Boolean;
Function StringGridDeleteRowsWhere(Grid:TStringGrid;Col:Integer;Value:String): Boolean;
Function StringGridRowValuesToList(Grid:TStringGrid;Row:Integer;lst: TStringList): Boolean;
Function StringGridColNumFromLabel(Grid:TStringGrid;sg : String): Integer;
Function StringGridToggleValueCoord(Grid:TStringGrid;inCol,inRow:Integer): Boolean;
Function StringGridToggleValueCurRec(Grid:TStringGrid;ColName: String): Boolean;
Function StringGridListToRowValues(Grid:TStringGrid;Row:Integer;lst: TStringList): Boolean;
Function StringGridGetFieldValueByFieldName(Grid:TStringGrid;FieldName: String;Row:Integer): String;
Function StringGridSetFieldValueByFieldName(Grid:TStringGrid;FieldName: String;Row:Integer;FieldValue:String): Boolean;
procedure StringGridSortColumns(Grid: TStringGrid);
Function IsDate(sgTest : String): Boolean;
implementation
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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(PChar(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;
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;
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;
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(PChar(lst.Text));
ListBox.TopIndex := inTopIndex;
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
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;
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(PChar(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(PChar(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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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(PChar(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;
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(PChar(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.