I'm using LMD Innovative library in my inherited Delphi project, and in particular the TLMDGrid component.
I just want to set last row color (summary) different from the rest of the table.
I can set different colors for different columns in the designer, but (due to poor documentation) cannot find how to set color for a single row.
Thanks for help.
I don't use the LMD grids myself, so the following is based on their most recent trial download.
I wasn't sure whether you were asking about the TLMDGrid or the TLMDDbGrid so the
minimal demo below shows how to set the last row of both of them to a specific color. As you'll
see, it is just a question of setting up an OnGetCellColor event handler for each grid, and then
setting the value of the AColor variable by whatever criteria suit you.
The onGetCellColor event is passed the current column as well as the
row number of the grid cell which is about to be drawn, so this show give
you the possibility of coloring cells in the same row differently if you want.
I confess I'm not very happy with basing the test on the OnGetCellColor event of LMDDBGrid1
on the dataset's RecordCount, because not all dataset types return a meaningful value
(and for some, there can be big performance hit in getting its value. With a standard TDBGrid,
in its drawing events, you can rely on the dataset cursor being synced with the event calls (so that
any data values can be picked up from the current dataset row). I'm not sure yet about how
you would do that with the LMD grid - obviously the best place to ask about that would be LMD themselves.
Code:
unit LMDGridTestu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB, DBClient, Grids, LMDGrid, LMDDBGrid;
type
TForm1 = class(TForm)
CDS1: TClientDataSet;
DataSource1: TDataSource;
CDS1ID: TIntegerField;
CDS1Name: TStringField;
LMDDBGrid1: TLMDDBGrid;
LMDGridIntegerColumn1: TLMDGridIntegerColumn;
LMDGridTextColumn1: TLMDGridTextColumn;
LMDGrid1: TLMDGrid;
NameCol: TLMDGridTextColumn;
IDCol: TLMDGridIntegerColumn;
procedure FormCreate(Sender: TObject);
procedure LMDDBGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
procedure LMDGrid1GetCellColor(Sender: TObject; ACellState: TLMDGridCellStates;
ARowState: TLMDGridRowState; const AData: Variant; AColumn: TLMDGridColumn;
ARow: Integer; var AColor: TColor);
public
end;
[...]
procedure TForm1.LMDDBGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
begin
if ARow = CDS1.Recordcount - 1 then
AColor := clYellow;
end;
procedure TForm1.LMDGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
begin
if ARow = LMDGrid1.DataRowCount - 1 then // Rows are numbered from zero
AColor := clYellow;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
CDS1.CreateDataSet;
CDS1.IndexFieldNames := 'ID';
for i := 1 to 12 do
CDS1.InsertRecord([i, StringOfChar(Chr((ord('a') + i -1)), 20)]);
CDS1.First;
LMDGrid1.DataRowCount := 10;
for i := 0 to LMDGrid1.DataRowCount - 1 do begin
LMDGrid1.Cells[IDCol.Position, i] := IntToStr(i);
LMDGrid1.Cells[NameCol.Position, i] := 'Name' + IntToStr(i);
end;
end;
Related
I have a grid on a form connected to a database table with 10 fields. The first field (hidden) is the ID. The second field is First_Name, the third Last_Name, etc. These columns are indexed 1 through 10. Now, if the user wants the Last_Name before the First_Name, he can grab that column and slide it over. First_Name now holds index 3 and Last_Name is at index 2.
I need to be able to read the order of the column indices so I can write them to an INI file. Then the next time the user opens the app, I can set the grid back to the preferred state.
I'm doing this with Lazarus 2.0.6 using a TRxDBGrid. I've tried several of its properties, but none of them show the grid column order.
I usually use Delphi rather than Lazarus and have been trying to install the RXDbGrid package into Lazarus 2.0.6 to check my suggested answer to this without any luck so far. However ...
TRxColumn descends from TColumn in the DBGrids source file.
TColumnhas a public property Index which is an integer, which is the index of the column into the GridColumns collection.
Because I can't get the RXDBGrid to install atm, the example below uses a normal TDBGrid, but should work fine with obvious detail changes.
The example has 3 fields, ID integer, Name String[20] and Value integer.
For simplicity, instead of saving and loading an IniFile, the Column order is saved to a TMemo, and to test the LoadColumnInfo you need to change the column order in the memo.
As you'll see, to reload the grid column order, it's easiest to save the column tit;es in left->right order and use a function ColumnByName to find the correct column when reloading the saved info.
uses
Classes, SysUtils, memds, db, Forms, Controls, Graphics, Dialogs, DBGrids,
StdCtrls;
type
TForm1 = class(TForm)
btnSaveColumns: TButton;
btnLoadColumns: TButton;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
MemDataset1: TMemDataset;
Memo1: TMemo;
procedure btnLoadColumnsClick(Sender: TObject);
procedure btnSaveColumnsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function ColumnByName(const AName: String): TColumn;
procedure LoadColumnInfo;
procedure SaveColumnInfo;
public
end;
[...]
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
MemDataSet1.Open;
for i := 0 to 5 do
MemDataSet1.InsertRecord([i, 'Name' + IntToStr(i), i]);
end;
procedure TForm1.btnSaveColumnsClick(Sender: TObject);
begin
SaveColumnInfo;
end;
procedure TForm1.btnLoadColumnsClick(Sender: TObject);
begin
LoadColumnInfo;
end;
procedure TForm1.SaveColumnInfo;
var
i : Integer;
S : String;
begin
Memo1.Lines.Clear;
for i := 0 to DBGrid1.Columns.Count - 1 do begin
S := DBGrid1.Columns[i].Title.Caption;
Memo1.Lines.Add(S);
end;
end;
function TForm1.ColumnByName(const AName : String) : TColumn;
var
i : integer;
begin
for i := 0 to DBGrid1.Columns.Count - 1 do begin
Result := DBGrid1.Columns[i];
if CompareText(AName, Result.Title.Caption) = 0 then
exit;
end;
Result := Nil;
end;
procedure TForm1.LoadColumnInfo;
var
i : Integer;
Index : Integer;
Column : TColumn;
S : String;
begin
for i := 0 to Memo1.Lines.Count - 1 do begin
S := Memo1.Lines[i];
Column := ColumnByName(S);
Assert(Column <> Nil);
Column.Index := i;
end;
end;
end.
I am working on Delphi 10.2 and SQL Server 2008.
I have to modify some value in TDBGrid. when I modify the value using OnDrawColumnCell Data is getting over lapped when I click on that column and the same is working fine in Delphi 7.
Example Code:
Create table and insert some data in SQL Server 2008.
CREATE TABLE [dbo].[Persons](
[P_ID] [int] IDENTITY(1,1) NOT NULL PRIMARY KEY,
[LastName] [varchar](15) NOT NULL,
)
insert into Persons (LastName) values ('LastName')
Create New VCL Forms Application - Delphi
To display the Data on DBGrid I am using TADOCOnnection, TADOQuery, TDataSource and TDBGrid
set TADOQuery.SQL to "select LastName from Persons"
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, ADODB, Vcl.StdCtrls;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure FormShow(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
ADOQuery1.Active := False;
ADOQuery1.Active := True;
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
Var
CellData : String;
begin
CellData := Column.Field.DisplayText;
if Column.Field.FieldName = 'LastName' then
begin
CellData := 'change';
DBGrid1.Canvas.TextRect(Rect, Rect.Left, Rect.Top, CellData);
end
else
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, state);
end;
end.
This is a general drawing issue and not related to SQL Server or the TDBGrid in particular. The same would apply to drawing to a VCL TCanvas or something similar.
Clear the area before drawing text
You are calling Canvas.TextRect(..), but nothing more. The text will get drawn, but nothing more. You will have to clear the area first: Imagine painting a white background before drawing black text.
The TDBGrid offers a convenient method DrawCellBackground(..). Since this method is not public, this screams for implementing it by leveraging helper classes.
Implementation example
The following code uses DrawCellHighlight(..) for clearing the cell paint area when the cell is selected and DrawCellBackground(..) otherwise.
type
TDBGridHelper = class helper for TDBGrid
public const textPaddingPx = 2; // Siehe TDBGrid::DefaultDrawColumnCell
public procedure writeText(
const inRect: TRect;
const text: String;
const State: TGridDrawState;
const columnIndex: Integer
);
end;
procedure TDBGridHelper.writeText(
const inRect: TRect;
const text: String;
const State: TGridDrawState;
const columnIndex: Integer
);
const
cellGridPx = 1;
var
backgroungRect: TRect;
begin
backgroungRect := inRect;
backgroungRect.Inflate(-cellGridPx, -cellGridPx);
if (Vcl.Grids.gdSelected in State) then
DrawCellHighlight(inRect, State, columnIndex, 0)
else
DrawCellBackground(backgroungRect, self.Color, State, Columnindex, 0);
Canvas.TextRect(
inRect,
inRect.Left + textPaddingPx,
inRect.Top + textPaddingPx,
text
);
end;
Leveraging the TDBGrid.OnDrawColumnCell event was absolutely correct, you can now simplify it to something like
procedure TYourFrame.dbGridDrawColumnCell(
Sender: TObject;
const Rect: TRect;
DataCol: Integer;
Column: TColumn;
State: TGridDrawState
);
var
columnText: String;
begin
columnText := '---';
if Assigned(Column.Field) then begin
if (Column.FieldName = 'yourField') then
columnText := getDeviationColumnText(Column.Field.AsSingle)
else
// This is the default text
columnText := Column.Field.DisplayText;
end;
(Sender as TDBGrid).writeText(Rect, columnText, State, Column.Index);
end;
If going through 30 forms is to tedious, you can turn off "Runtime themes" to get back that fancy Windows 2000 look and the drawing algorithms that came with it.
Choose Project > Options > Application.
Clear the Enable Runtime Themes check box.
Source: http://docwiki.embarcadero.com/RADStudio/en/Disabling_Themes_in_the_IDE_and_in_Your_Application
I have a table with two columns. ConfigItem and ConfigValue. Now I want to populate this in a dbgrid where ConfigValue should be a dbcombobox.
Sample ConfigItem(First Column)
Product
Product Type
Item Type
Items
ConfigValue should have a dbcombobox and the items of the combobox should be populated on the basis of the values in the first column.
Example.
If user clicks on the first row which has Product as config Item then for the same row ConfigValue column in the grid should contain combobox with list of Products.
Possibly I can use BeforeDrawCell event of grid however I am trying to find a way by which this can be handled using adoquery or dataset component.
Could someone please guide on the solution approach tho this problem.
Thanks in advance,
Divyesh
You can use the AfterScrollEvent to assign a PickList to your Column.
Picklist are here Stringlists assigned to the object of a master StringList.
Depdending on your Delphi version you could use a generic dictionary.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, Grids, DBGrids, ADODB;
type
TForm2 = class(TForm)
ADODataSet1: TADODataSet;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
procedure FormCreate(Sender: TObject);
procedure ADODataSet1AfterScroll(DataSet: TDataSet);
private
{ Private-Deklarationen }
FList: TStringList;
public
{ Public-Deklarationen }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.ADODataSet1AfterScroll(DataSet: TDataSet);
var
idx: Integer;
begin
if Assigned(FList) and (DBGrid1.Columns.Count > 1) then
begin
DBGrid1.Columns[1].ButtonStyle := cbsAuto;
idx := FList.IndexOf(DBGrid1.Columns[0].Field.asString);
if idx > -1 then
DBGrid1.Columns[1].PickList := TStringList(FList.Objects[idx])
else
DBGrid1.Columns[1].PickList := nil;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
i: Integer;
begin // some demo filling
FList := TStringList.Create;
FList.AddObject('A1A1', TStringList.Create);
for i := 0 to 10 do
TStringList(FList.Objects[FList.Count - 1]).Add(Format('group1_%d', [i]));
FList.AddObject('A1A2', TStringList.Create);
for i := 0 to 10 do
TStringList(FList.Objects[FList.Count - 1]).Add(Format('group2_%d', [i]));
end;
procedure TForm2.FormDestroy(Sender: TObject);
var
i: Integer;
begin
for I := 0 to FList.Count - 1 do Flist.Objects[i].Free;
FList.Free;
end;
end.
I am using delphi 2010 for a project with a stringgrid. I want some columns of the grid to be right justified. I understand how I can do this with defaultdrawing set to false.
I would like, however, to keep the runtime theme shading for the grid, if possible. Is there a way to right justify a column with defaultdrawing enabled, or at least duplicate the code in the onDrawCell event to imitate the runtime theme shading?
you can use an interposer class and override the DrawCell method, check this sample
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
end;
TForm79 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
end;
var
Form79: TForm79;
implementation
{$R *.dfm}
{ TStringGrid }
procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
s : string;
LDelta : integer;
begin
if (ACol=1) and (ARow>0) then
begin
s := Cells[ACol, ARow];
LDelta := ColWidths[ACol] - Canvas.TextWidth(s);
Canvas.TextRect(ARect, ARect.Left+LDelta, ARect.Top+2, s);
end
else
Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
end;
procedure TForm79.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:='title 1';
StringGrid1.Cells[1,0]:='title 2';
StringGrid1.Cells[2,0]:='title 3';
StringGrid1.Cells[0,1]:='normal text';
StringGrid1.Cells[1,1]:='right text';
StringGrid1.Cells[2,1]:='normal text';
end;
And the result
I have to create an array and place all controls there in order to access them.Here's a short example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
const Test:Array[0..2] of TButton = (Button1,Button2,Button3);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
end.
Undeclarated idenitifier 'Button1' at the line where I declarated my array.But it's declarated three lines above.
Where's the problem,how to put all controls in an array?
EDIT:
Thank you for your answers,but I've got problems:
var TestA:TObjectList<TButton>;
var index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
for index in Form7 do
if pos(index.name, 'Button') = 1 then
TestA.add(TButton(index));
TestA[0].Caption := 'Test'; //Exception out of range.
Ben's right. You can't set up a control array in the form designer. But if you have 110 images, for this specific case you can put them into a TImageList component and treat its collection of images as an array.
If you've got a bunch of more normal controls, like buttons, you'll have to create an array and load them into it in code. There are two ways to do this. The simple way, for small arrays at least, is Ben's answer. For large control sets, or ones that change frequently, (where your design is not finished, for example,) as long as you make sure to give them all serial names (Button1, Button2, Button3...), you can try something like this:
var
index: TComponent;
list: TObjectList;
begin
list := TObjectList.Create(false); //DO NOT take ownership
for index in frmMyForm do
if pos('Button', index.name) = 1 then
list.add(index);
//do more stuff once the list is built
end;
(Use a TObjectList<TComponent>, or something even more specific, if you're using D2009.) Build the list, based on the code above, then write a sorting function callback that will sort them based on name and use it to sort the list, and you've got your "array."
You may not be able to reference public properties of your form in an array constant like that. Try doing it in your form constructor/OnCreate event instead.
procedure TForm1.FormCreate(Sender: TObject);
begin
Test[0] := Button1;
Test[1] := Button2;
Test[2] := Button3;
end;
This function will iterate over all the controls on a specified container, like a particular TPanel or even the entire form, and populate a specified TObjectList with your TImage controls.
procedure TForm1.AddImageControlsToList(AParent: TWinControl; AList: TObjectList; Recursive: boolean);
var
Index: integer;
AChild: TControl;
begin
for Index := 0 to AParent.ControlCount - 1 do
begin
AChild := AParent.Controls[Index];
if AChild is TImage then // Or whatever test you want to use
AList.Add(AChild)
else if Recursive and (AChild is TWinControl) then
AddImageControlsToList(TWinControl(AChild), AList, True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Call like this or similar to get your list of images
// (assumes MyImageList is declared in Form)
MyImageList := TObjectList.Create(False);
AddImageControlsToList(Self, MyImageList, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Destroy the list
FreeAndNil(MyImageList);
end;
How about this?
procedure TForm1.FormCreate(Sender: TObject);
begin
for b := 1 to 110 do
Test[b] := FindComponent('Button' + IntToStr(b)) as TButton;
end;
You'll have to declare the array as a variable rather than a constant and it will have to go from 1 to 110 rather than 0 to 109 but that's no problem.
I use this all the time - it is simple and fast (despite Mr Wheeler's comment)- declare the maxbuttons as a constant
var
Form1: TForm1;
pbutton:array[1..maxbuttons] of ^tbutton;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
(* Exit *)
var k:integer;
begin
for k:=1 to maxbuttons do dispose(pbutton[k]);
close;
end;
procedure TForm1.FormActivate(Sender: TObject);
var k:integer;
begin
(*note the buttons must be Button1, Button2 etc in sequence or you need to
allocate them manually eg pbutton[1]^:=exitbtn etc *)
for k:=1 to maxbuttons do
begin
new(pbutton[k]);
pbutton[k]^:= tbutton(FindComponent('Button'+IntToStr(k)));
end;
end;
procedure TForm1.ButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var k:integer;
b:boolean;
begin
b:=false;
k:=1;
while (k<= maxbuttons) and (not b) do
begin
if pbutton[k]^ = sender then (Note sender indicates which button has been clicked)
begin
{ found it so do something}
b:=true;
end;
k:=k+1;
end;
end;
Try this
var
TestA:TObjectList;
index:TComponent;
begin
TestA := TObjectList<TButton>.Create(false);
try
for index in Form7 do
if (pos is TButton) OR {or/and} (pos.tag and 8=8) then
TestA.add(TButton(index));
if TestA.Count>0 then //Fix:Exception out of range.
TestA[0].Caption := 'Test';
finally
TestA.Free;
end;
end;