I have a TDBGrid component called grMain. I need to know length of value of the longest entries of Column which retrivied on grMain to adjust the minimal width of the form holding the grMain.
How to get the length of the longest entry on TDBGrid Columns?
Thanks in advance.
Something like that ...
Procedure FitGrid(Grid:TDBGrid);
Const
C_Add=3;
var
ds:TDataset;
bm:TBookmark;
i:Integer;
w:Integer;
a:Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a,Grid.Columns.Count);
ZeroMemory(#a[0],SizeOf(Integer)*Length(a));
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned( Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth( ds.FieldByName( Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then a[i] := w + C_Add;
end;
end;
ds.Next;
end;
for I := 0 to Grid.Columns.Count - 1 do Grid.Columns[i].Width := a[i];
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FitGrid(DBgrid1)
end;
Related
I have saved my TreeView inside my DataBase by using the next :
var
BlobField :TField;
Query:TADOQuery;
Stream:TStream;
...
try
Query.SQL.Text := 'Select TOP(1) * From MyTable';
DBQueryConnect(Query); // I used this Procedure to connect the Query to the database
try
Query.First;
Query.Edit;
try
BlobField := Query.FieldByName('MyField') as TField;
Stream := Query.CreateBlobStream(BlobField, bmWrite);
try
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
finally
Stream.Free;
end;
Query.Post;
except
Query.Cancel;
raise;
end;
finally
Query.Close;
end;
finally
Query.Free;
end;
end;
and I loaded back the TTreeView form the DataBase by using the next :
...
var
Query:TADOQuery;
Stream:TStream;
begin
Query:=TADOQuery.Create(Self);
try
Query.SQL.Add('Select * From MyTable') ;
DBQueryConnect(Query);
Query.First;
Stream:=Query.CreateBlobStream(Query.FieldByName('MyField'), bmread);
MyTreeView.LoadFromStream(Stream);
Stream.Free;
finally
Query.Free;
end;
how can I retrive the imageindex for my TreeView items from the saved data ..
Thank you .
Perharps we can modify exsisting SaveTreeToStream and LoadTreeFromStream like this :
function GetBufStart(Buffer,idxSeparator: string; var Level,ImageIndex: Integer): string;
var
Pos: Integer;
sidx:String;
begin
Pos := 1;
Level := 0;
ImageIndex := -1;
while (CharInSet(Buffer[Pos], [' ', #9])) do
begin
Inc(Pos);
Inc(Level);
end;
Result := Copy(Buffer, Pos, Length(Buffer) - Pos + 1);
//Check Image Index
pos:=System.SysUtils.AnsiPos(idxSeparator,Result);
if Pos>0 then begin
sidx:=copy(result,Pos + Length(idxSeparator), length(result) - Pos + 1);
ImageIndex := StrToIntDef(sidx,-1);
Result := Copy(Result, 1, Pos - 1);
end;
end;
procedure LoadTreeFromStream(Nodes:TTreeNodes; Stream:TStream; Encoding:TEncoding; idxSeparator:String='|||');
var
List: TStringList;
ANode, NextNode: TTreeNode;
ALevel, i, ImageIndex: Integer;
CurrStr: string;
begin
List := TStringList.Create;
Nodes.BeginUpdate;
try
try
Nodes.Clear;
List.LoadFromStream(Stream, Encoding);
ANode := nil;
for i := 0 to List.Count - 1 do
begin
CurrStr := GetBufStart(PChar(List[i]), idxSeparator, ALevel, ImageIndex);
if ANode = nil then
ANode := Nodes.AddChild(nil, CurrStr)
else if ANode.Level = ALevel then
ANode := Nodes.AddChild(ANode.Parent, CurrStr)
else if ANode.Level = (ALevel - 1) then
ANode := Nodes.AddChild(ANode, CurrStr)
else if ANode.Level > ALevel then
begin
NextNode := ANode.Parent;
while NextNode.Level > ALevel do
NextNode := NextNode.Parent;
ANode := Nodes.AddChild(NextNode.Parent, CurrStr);
end
else raise Exception.CreateFmt('Invalid level (%d) for item "%s"', [ALevel, CurrStr]);
ANode.ImageIndex:=ImageIndex;
end;
finally
Nodes.EndUpdate;
List.Free;
end;
except
Nodes.Owner.Invalidate; // force repaint on exception
raise;
end;
end;
procedure SaveTreeToStream(Nodes:TTreeNodes; Stream:Tstream; Encoding:TEncoding; idxSeparator:String='|||');
const
TabChar = #9;
EndOfLine = #13#10;
var
I: Integer;
ANode: TTreeNode;
NodeStr: TStringBuilder;
Buffer, Preamble: TBytes;
begin
if Nodes.Count > 0 then
begin
if Encoding = nil then
Encoding := TEncoding.Default;
//Buffer := Encoding.GetBytes('');
Preamble := Encoding.GetPreamble;
if Length(Preamble) > 0 then
Stream.WriteBuffer(Preamble{$IFNDEF CLR}[0]{$ENDIF}, Length(Preamble));
NodeStr := TStringBuilder.Create(1024);
try
ANode := Nodes[0];
while ANode <> nil do
begin
NodeStr.Length := 0;
for I := 0 to ANode.Level - 1 do
NodeStr.Append(TabChar);
NodeStr.Append(ANode.Text);
NodeStr.Append(idxSeparator);
NodeStr.Append(ANode.ImageIndex);
NodeStr.Append(EndOfLine);
Buffer := Encoding.GetBytes(NodeStr.ToString);
Stream.Write(Buffer{$IFNDEF CLR}[0]{$ENDIF}, Length(Buffer));
ANode := ANode.GetNext;
end;
finally
NodeStr.Free;
end;
end;
end;
You can replace
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
with
SaveTreeToStream(MyTreeView.Items,Stream,TEncoding.UTF8);
and MyTreeView.LoadFromStream(Stream); with LoadTreeFromStream(MyTreeView.Items,Stream,TEncoding.UTF8);
hi i have a problem with TClientDataset in Delphi. I want to get a Dataset with the changed Data.
here is my code:
procedure TForm2.btnUpdateClick(Sender: TObject);
var
I: Integer;
counter : Integer; //for testing
value : String;
begin
if not Self.DatasetArtikel.Active then
begin
ShowMessage('Nicht aktiv');
Exit;
end;
if Self.DatasetArtikel.ChangeCount = 0 then
begin
ShowMessage('Delta is empty');
Exit;
end;
counter := DatasetArtikel.ChangeCount;
//DatasetArtikelUpdate.ClearFields;
//DatasetArtikelUpdate.CreateDataSet;
DatasetArtikel.Data := Self.DatasetArtikel.Delta; //here i want to transfer the changed data
Release;
//for I := 0 to DatasetArtikelUpdate.Fields.Count -1 do
// if not DatasetArtikelUpdate.Fields[I].IsNull then
// value := DatasetArtikelUpdate.Fields[I].NewValue;
value := DatasetArtikel.Fields[2].OldValue;
value := DatasetArtikel.Fields[2].Value;
value := DatasetArtikel.Fields[2].NewValue; //here i want the new data
end;
for example: In column 3 is the text blueblue and I changed it to redred. the counter say me that 1 is changed it is correct but the value said me that the string is blueblue...but I want the data redred :((
There is no NewValue/OldValue information stored on the field.
Delta will contain
1 Row for deleted rows
1 Row for new inserted rows
2 Rows for modified rows
For every row you can ask for delta.UpdateStatus which can be usUnmodified, usModified, usInserted or usDeleted.
Every unmodified record is followed by a Record with the modifications.
You will take a look in both records to get Old- and NewValue.
procedure TTestForm.RunInfoClick(Sender: TObject);
type
TMyFieldInfo = Record
FieldName: String;
Size: Integer;
DataType: TFieldType;
FieldKind: TFieldKind;
end;
var
I: Integer;
sl: TStringList;
old: String;
FA: Array of TMyFieldInfo;
F: TField;
// get fielddefs after openening and a a definition for a calculated field
// called Status to refect UpdateStatus
Procedure GetFields;
var
I: Integer;
begin
SetLength(FA, delta.FieldCount + 1);
for I := 0 to delta.FieldCount - 1 do
begin
FA[I].FieldName := delta.Fields[I].FieldName;
FA[I].DataType := delta.Fields[I].DataType;
FA[I].Size := delta.Fields[I].Size;
FA[I].FieldKind := fkdata;
end;
FA[High(FA)].FieldName := 'Status';
FA[High(FA)].DataType := ftString;
FA[High(FA)].Size := 10;
FA[High(FA)].FieldKind := fkcalculated;
delta.Close;
end;
// apply our fields to be able to display a calculated field
Procedure SetFields;
var
I: Integer;
begin
delta.Fields.Clear;
for I := Low(FA) to High(FA) do
begin
F := DefaultFieldClasses[FA[I].DataType].Create(delta);
With F do
begin
FieldName := FA[I].FieldName;
FieldKind := FA[I].FieldKind;
Size := FA[I].Size;
DataSet := delta;
end;
end;
delta.Open;
end;
Procedure LogSL;
begin
if sl.Count > 1 then
Memo1.Lines.Add(sl.Text);
sl.Clear;
end;
begin
Memo1.Lines.Clear;
sl := TStringList.Create;
try
delta.Close;
delta.Fields.Clear;
delta.Data := ClientDataSet1.delta;
GetFields;
SetFields;
while not delta.Eof do
begin
if delta.UpdateStatus <> usModified then
begin
LogSL;
end;
if delta.UpdateStatus = usUnmodified then
sl.Add('Unmodified:')
else if delta.UpdateStatus = usInserted then
begin
sl.Add('Insert:');
end
else if delta.UpdateStatus = usDeleted then
begin
sl.Add('Deleted:');
end
else if delta.UpdateStatus = usModified then
begin
sl[0] := ('Modified:');
end;
for I := 0 to delta.FieldCount - 2 do // ignore our calculated field
begin
if delta.UpdateStatus = usModified then
begin
if (sl.Values[delta.Fields[I].FieldName] <> delta.Fields[I].AsString) and not delta.Fields[I].IsNull then
begin // we had changes
sl[I + 1] := sl[I + 1] + ' OldValue: ' + delta.Fields[I].AsString;
end
else
begin // we did not have changes take stored OldValue
sl[I + 1] := sl[I + 1] + ' OldValue: ' + sl.Values[delta.Fields[I].FieldName];
end
end
else // delta.UpdateStatus = usModified
sl.Add(delta.Fields[I].FieldName + '=' + delta.Fields[I].AsString + old);
end;
delta.Next;
end;
LogSL;
finally
sl.Free;
end;
end;
procedure TTestForm.deltaCalcFields(DataSet: TDataSet);
begin
with TClientDataSet(DataSet) do
begin
case UpdateStatus of
usUnmodified:
FieldByName('Status').AsString := 'Unmod';
usModified:
FieldByName('Status').AsString := 'Modi';
usInserted:
FieldByName('Status').AsString := 'Ins';
usDeleted:
FieldByName('Status').AsString := 'Del';
end;
end;
end;
I am trying to write code to calculate sum of all numbers from cells that form main diagonal of stringgrid but the result I get is just number I typed in bottom right cell. Here's my code:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
begin
with StringGrid1 do
begin
RowCount := StrToInt(Edit1.Text);
ColCount := StrtoInt(Edit2.Text);
for i := 0 to RowCount - 1 do
Cells[0, i] := IntToStr(i);
for j := 0 to ColCount - 1 do
Cells[j, 0] := IntToStr(j);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, j, s, z, n: Integer;
begin
z := 0;
with StringGrid1 do
begin
for i := 1 to RowCount - 1 do
for j := 1 to ColCount - 1 do
s := StrToInt(Cells[j, i]);
for n := RowCount - 1 to ColCount - 1 do
if i = j then
z := z + s;
Label1.Caption := IntToStr(z);
end;
end;
end.
What am I missing ? Thanks in advance
Your are not summing up any values. If your columcount is equal to your rowcount, then your for loop will only run once, for your last item.
procedure TForm1.Button2Click(Sender: TObject);
var
i, j, s, z, n: integer;
begin
z:=0;
for i:=1 to StringGrid1.rowcount-1 do
for j:=1 to StringGrid1.colcount-1 do
if i=j then
begin
s:=strtoint(cells[j, i]);
z:=z+s;
end;
Label1.Caption:=inttostr(z);
end;
I have a TDBGrid. It works, but the columns shown are very large.
How can I set an "auto-fix column width"?
The needed Columnwidth is depended of the settings of the Grids canvas and the mamimum length of the displaytext of each field.
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FitGrid(DBgrid1)
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column
procedure FitGrid(Grid: TDBGrid);
const
C_Add = 3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: array of Integer;
begin
ds := Grid.DataSource.DataSet;
if not Assigned(ds) then
exit;
if Grid.Columns.Count = 0 then
exit;
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
for i := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[i].Field) then
a[i] := Grid.Canvas.TextWidth(Grid.Columns[i].FieldName);
while not ds.Eof do
begin
for i := 0 to Grid.Columns.Count - 1 do
begin
if not Assigned(Grid.Columns[i].Field) then
continue;
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w;
end;
ds.Next;
end;
w := 0;
for i := 0 to Grid.Columns.Count - 1 do
begin
Grid.Columns[i].Width := a[i] + C_Add;
inc(w, a[i] + C_Add);
end;
w := (Grid.ClientWidth - w - 20) div (Grid.Columns.Count);
if w > 0 then
for i := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := Grid.Columns[i].Width + w;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName.).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to Grid.Columns.Count - 1 do
begin
w := Grid.Canvas.TextWidth(Grid.Columns[i].Field.FieldName);
if a[i] < w then
a[i] := w ;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
Minor modification of bummi's, TheSteven's and Jens' answers to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column, and take visibility of columns into account.
procedure FitGrid(const Grid: TDBGrid; const CoverWhiteSpace: Boolean = True);
const
C_Add=3;
var
DS: TDataSet;
BM: TBookmark;
I, W, VisibleColumnsCount: Integer;
A: array of Integer;
VisibleColumns: array of TColumn;
begin
DS := Grid.DataSource.DataSet;
if Assigned(DS) then
begin
VisibleColumnsCount := 0;
SetLength(VisibleColumns, Grid.Columns.Count);
for I := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[I].Field) and (Grid.Columns[I].Visible) then
begin
VisibleColumns[VisibleColumnsCount] := Grid.Columns[I];
Inc(VisibleColumnsCount);
end;
SetLength(VisibleColumns, VisibleColumnsCount);
DS.DisableControls;
BM := DS.GetBookmark;
try
DS.First;
SetLength(A, VisibleColumnsCount);
while not DS.Eof do
begin
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(DS.FieldByName(VisibleColumns[I].Field.FieldName).DisplayText);
if A[I] < W then
A[I] := W;
end;
DS.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(VisibleColumns[I].Field.FieldName);
if A[I] < W then
A[I] := W;
end;
W := 0;
if CoverWhiteSpace then
begin
for I := 0 to VisibleColumnsCount - 1 do
Inc(W, A[I] + C_Add);
W := (Grid.ClientWidth - W - 20) div VisibleColumnsCount;
if W < 0 then
W := 0;
end;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + C_Add + W;
DS.GotoBookmark(BM);
finally
DS.FreeBookmark(BM);
DS.EnableControls;
end;
end;
end;
I found 'Columns' in the properties of my TDBGrid and new window is opened. In that window I add new FieldNames - you can choose columnNames only from the result of your SQL string of your TADOQuery and then when you click to the exact column you can find 'Width' in the properties of selected column so change it whatever you like. It works for me.
I'm afraid the last adaptation of the code is no correct.
I would rather write something like :
const
C_Add=20;
//.....
Sup := 0;
if CoverWhiteSpace then
sup :=C_Add;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + sup;
DS.GotoBookmark(BM);
I've found a good component to implement a Caption<->Value List for ComboBox:
Is there a ComboBox that has Items like a TcxRadioGroup?
The only problem is: It has a Sorted property, but that doesn't work.
So, how do I sort the Items of a TcxImageComboBox?
Quick and dirty method, should work fine for most cases:
function CompareItems(AFirst: TcxImageComboBoxItem; ASecond: TcxImageComboBoxItem): Integer;
begin
Result := AnsiCompareText(AFirst.Description, ASecond.Description);
end;
procedure SortCxComboBoxItems(AItems: TcxImageComboBoxItems);
var
I : Integer;
J : Integer;
PMin : Integer;
begin
AItems.BeginUpdate;
try
// Selection Sort (http://en.wikipedia.org/wiki/Selection_sort)
for I := 0 to AItems.Count - 1 do
begin
PMin := I;
for J := I + 1 to AItems.Count - 1 do
begin
if CompareItems(AItems[J], AItems[PMin]) < 0 then begin
PMin := J;
end;
end;
if PMin <> I then
begin
AItems[PMin].Index := I;
end;
end;
finally
AItems.EndUpdate;
end;
end;