I have a DBGrid where I am using following query to get the data:
Select * from table1 where <condition>
One of the fields in Password coming from database, which I want to display as ***. But keep it editable for the Grid itself.
Can you please suggest what can be done for this. Sample code will be much appreciated
You can do this by dropping a TEdit on your form and set the password char property to be '*'. Then you need to add code into the OnDrawColumnCell event of the TDBGrid like this :-
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
grid : TDBGrid;
maskValue : String;
aRect : TRect;
begin
maskValue := '**';
aRect := Rect;
grid := sender as TDBGrid;
if column.FieldName = 'password' then
if gdfocused in State then
begin
Edit1.Left := Rect.Left + grid.Left + 1;
Edit1.Top := rect.Top + grid.Top + 1;
Edit1.Width := Rect.Right - Rect.Left + 2;
Edit1.Height := Rect.Bottom - Rect.Top + 2;
Edit1.Clear;
Edit1.Visible := True;
end
else
begin
grid.Canvas.FillRect(Rect);
DrawText(grid.Canvas.Handle, PChar(maskValue), Length(maskValue), aRect,
DT_SINGLELINE or DT_LEFT or DT_VCENTER);
end
else
grid.DefaultDrawColumnCell(Rect, DataCol, Column, state);
end;
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
Edit1.Visible := False;
end;
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = Chr(9) then Exit;
if (Sender as TDBGrid).SelectedField.FieldName = 'password' then
begin
Edit1.SetFocus;
SendMessage(Edit1.Handle, WM_CHAR, word(Key), 0);
end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
if DBGrid1.DataSource.State in [dsEdit, dsInsert] then
DBGrid1.DataSource.DataSet.FieldByName('password').AsString := Edit1.Text;
end;
procedure TForm1.Edit1Enter(Sender: TObject);
begin
DBGrid1.DataSource.Edit;
end;
This should get you going, but as has been mentioned it's not ideal to be editing passwords in this way.
Related
I have dataset with 2 different sources - some are for goverment and others are for organization only. I need to distinct them somehow, like making some items bold or different color.
I tried to use DrawItem event, but couldn't figure it out.
For adding items I used:
while not (cdDataset1.Eof) do
begin
if ((cdDataset1.fieldbyName('displayName').value<> '') and (cdDataset1.fieldbyName('TyypId').value=1280781)) then
begin
cxDBCheckListBox1.Items.Add.Text:= cdDataset1.fieldbyName('displayName').value;
end;
cdDataset1.Next;
end;
cdDataset1.First;
while not (cdDataset1.Eof) do
begin
if ((cdDataset1.fieldbyName('displayName').value<> '') and (cdDataset1.fieldbyName('TyypId').value=1243501)) then
begin
cxDBCheckListBox1.Items.Add.Text:= cdDataset1.fieldbyName('displayName').value;
end;
cdDataset1.Next;
end;
This part works well. But can I use field TyypID for distinction on cxdbchecklistbox ?
It should look like this(checkboxs intead of bullets ofcourse):
Important option1
Impotant option2
extra info option1
I found the solution. First add tags . OnDrawItem creating canvas is needed:
//adding items to checklistbox where needed.
cxDBCheckListBox1.Items.Clear;
while not (cdDataset1.Eof) do
begin
if ((cdDataset1.fieldbyName('displayName').value<> '') and
(cdDataset1.fieldbyName('TyypId').value=28078)) then
begin
with cxDBCheckListBox1.Items.Add do
begin
Text:= cdDataset1.fieldbyName('displayName').value;
Tag := 1280781;
end;
end;
cdDataset1.Next;
end;
//Then on drawitem:
procedure TfmSample.cxDBCheckListBox1DrawItem(
Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
ACanvas: TcxCanvas;
AText: string;
ATextRect: TRect;
AGlyphWidth: Integer;
AListBox: TcxDBCheckListBox;
ACanvasFont: TFont;
AItemEnabled: Boolean;
AItemTag: Integer;
begin
AListBox := (Control as TcxDBCheckListBox);
ACanvas := AListBox.InnerCheckListBox.Canvas;
ACanvasFont := ACanvas.Font;
AItemTag := AListBox.Items[Index].Tag;
AItemEnabled := AListBox.Items[Index].Enabled;
case AItemTag of
1243501:
begin
ACanvasFont.Color := clBlue;
end;
1280781 :
begin
ACanvasFont.Style := [fsBold];
ACanvasFont.Color := clBlack;
end;
end;
ACanvas.Brush.Color := clWhite;
ACanvas.FillRect(Rect);
AText := AListBox.Items[Index].Text;
ATextRect := Rect;
ATextRect.Left := 20;
ACanvas.DrawTexT(AText, ATextRect, 0);
end;
I need your help. Draw method the DBGrid. I have table DBGrid.
How? To my method "DrawDBGrid", add my method "LoadDefaultImage"
If there is no file path (image), a replacement image from the resource will be displayed.
My "LoadDefaultImage"
procedure LoadDefaultImage(AImage: TImage; aPngName: string);
var
lImage: TPngImage;
begin
lImage := TPngImage.Create();
try
lImage.LoadFromResourceName(hInstance, aPngName);
AImage.picture.Graphic := lImage;
finally
lImage.Free();
end;
end;
Call the method
LoadDefaultImage(AImage, 'No image');
My "DrawDBGrid"
procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState; Sender: TObject;
const Rect: TRect; DataCol: Integer);
var
lRect: TRect;
lImage: TJPEGImage;
lPicturePath: string;
lDataset: TclientDataSet;
lIsFile: Boolean;
begin
lDataset := TclientDataSet(aDBGrid.DataSource.DataSet);
lPicturePath := extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString;
lIsFile := fileexists(lPicturePath);
if (Column.Field.FieldName <> aGraphicFieldName) or (not lIsFile) then
begin
if (gdSelected in State) and (TDBGrid(Sender).Focused) then
TDBGrid(Sender).canvas.Brush.color := $E8E3A8
else
TDBGrid(Sender).canvas.Brush.color := clWhite;
aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end
else
begin
lRect.left := Rect.left + 1;
lRect.Top := Rect.Top + 1;
lRect.Right := Rect.Right - 1;
lRect.Bottom := Rect.Bottom - 1;
lImage := TJPEGImage.Create;
try
try
lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
aDBGrid.canvas.StretchDraw(lRect, lImage);
except
on e: exception do
begin
raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
.AsString + ''#13'' + ''#10'' + e.Message);
end;
end;
finally
lImage.Free;
end;
end;
end;
If the DrawDBGrid is a standalone procedure called from the rendering event, you can modify it for passing a pre-loaded default image like so:
procedure DrawDBGrid(aDBGrid: TDBGrid; aGraphicFieldName: string; Column: TColumn; State: TGridDrawState; Sender: TObject;
const Rect: TRect; DataCol: Integer; DefaultImage: TPngImage);
Then inside it you can do this:
...
lIsFile := FileExists(lPicturePath);
// if not the desired column
if (Column.Field.FieldName <> aGraphicFieldName) then
begin
if (gdSelected in State) and (TDBGrid(Sender).Focused) then
TDBGrid(Sender).canvas.Brush.color := $E8E3A8
else
TDBGrid(Sender).canvas.Brush.color := clWhite;
aDBGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end
else // the right column
begin
// if the file was not found, draw the default image that was passed
if not lIsFile then
begin
aDBGrid.canvas.Draw(Rect, DefaultImage);
end
else
begin
lRect.left := Rect.left + 1;
lRect.Top := Rect.Top + 1;
lRect.Right := Rect.Right - 1;
lRect.Bottom := Rect.Bottom - 1;
lImage := TJPEGImage.Create;
try
try
lImage.LoadFromFile(extractfilepath(paramstr(0)) + lDataset.FieldByName(aGraphicFieldName).AsString);
aDBGrid.canvas.StretchDraw(lRect, lImage);
except
on e: exception do
begin
raise exception.Create('Błąd wyświetlania pliku ' + lDataset.FieldByName(aGraphicFieldName)
.AsString + ''#13'' + ''#10'' + e.Message);
end;
end;
finally
lImage.Free;
end;
end;
...
The last piece of Lego here is that you'll pre-load the default image, for instance when the form is created and keep it stored e.g. as a private field of type TPngImage in the form class and pass it into your standalone procedure.
I'd like to add DBLookupComboboxes to certain columns in a DBGrid. There is a nice article on About.com on how to do this here. The problem is that with a table having many columns, if you select from the DBLookupCombobox in one column and then try to scroll left, the combobox will move left too as shown in the included images. How can the About.com code can be changed to prevent this behavior? A web search showed two others complaining of the exact same problem with no solution. Note that I want to use a DBLookupCombobox to show a name but enter the id, so using a simple picklist will not do.
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
if DBGrid1.SelectedField.FieldName = DBLookupComboBox1.DataField then
DBLookupComboBox1.Visible := False
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (gdFocused in State) then
begin
if (Column.Field.FieldName = DBLookupComboBox1.DataField) then
with DBLookupComboBox1 do
begin
Left := Rect.Left + DBGrid1.Left + 2;
Top := Rect.Top + DBGrid1.Top + 2;
Width := Rect.Right - Rect.Left;
Width := Rect.Right - Rect.Left;
Height := Rect.Bottom - Rect.Top;
Visible := True;
end;
end
end;
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if (key = Chr(9)) then Exit;
if (DBGrid1.SelectedField.FieldName = DBLookupComboBox1.DataField) then
begin
DBLookupComboBox1.SetFocus;
SendMessage(DBLookupComboBox1.Handle, WM_Char, word(Key), 0);
end
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with DBLookupComboBox1 do
begin
DataSource := DataSource1; // -> AdoTable1 -> DBGrid1
ListSource := DataSource2;
DataField := 'resource_id'; // from AdoTable1 - displayed in the DBGrid
KeyField := 'id';
ListField := 'resource_name; id';
Visible := False;
end;
DataSource2.DataSet := AdoQuery1;
AdoQuery1.Connection := AdoConnection1;
AdoQuery1.SQL.Text := 'SELECT id,resource_name FROM resources';
AdoQuery1.Open;
end;
Here is one solution using a neat hack from François.
type
// Hack to redeclare your TDBGrid here without the the form designer going mad
TDBGrid = class(DBGrids.TDBGrid)
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
end;
TForm1 = class(TForm)
[...]
procedure TDBGrid.WMHScroll(var Msg: TWMHScroll);
begin
if Form1.DBGrid1.SelectedField.FieldName = Form1.DBLookupComboBox1.DataField then begin
case Msg.ScrollCode of
SB_LEFT,SB_LINELEFT,SB_PAGELEFT: begin
Form1.DBGrid1.SelectedIndex := Form1.DBGrid1.SelectedIndex-1;
Form1.DBLookupComboBox1.Visible := False;
end;
SB_RIGHT,SB_LINERIGHT,SB_PAGERIGHT: begin
Form1.DBGrid1.SelectedIndex := Form1.DBGrid1.SelectedIndex+1;
Form1.DBLookupComboBox1.Visible := False;
end;
end;
end;
inherited; // to keep the expected behavior
end;
I would like to show in a DBGRID as follows:
Imagine "Grid" as follows:
ID - DESCRIPTION
1 - Line 1 of the grid
2 - Line 2 of the grid
3 - Line 3 of the grid
Now, suppose the size of the DESCRIPTION column is changed and no longer appear the words "GRID";
I would like to stay as well DBGRID
ID - DESCRIPTION
1 - Line 1 of the
grid
2 - Line 2 of the
grid
3 - Line 3 of the
grid
is there any possibility that ??
Not what you're asking, but might help... I once used this code to show complete Memo fields in the standard DBGrid:
TMyForm = class(TForm)
...
private
FormMemoRect: TRect;
MemoGrid: TDBGrid;
BMemo: TBitBtn;
...
Procedure TMyForm.FormMemoDeactivate(Sender: TObject);
Begin
(Sender As TForm).Close;
Sender.Free;
End;
Procedure TMyForm.BMemoClick(Sender: TObject);
Var FormMemo: TForm;
Begin
MemoGrid.SetFocus;
FormMemo := TForm.Create(Self);
With TMemo.Create(FormMemo) Do Begin
Parent := FormMemo;
Align := alClient;
ReadOnly := True;
WordWrap := True;
ScrollBars := ssVertical;
Lines.Text := MemoGrid.DataSource.DataSet.Fields[TComponent(Sender).Tag].AsString;
End;
With FormMemo Do Begin
OnDeactivate := FormMemoDeactivate;
Left := FormMemoRect.Left;
Top := FormMemoRect.Top;
Width := Max(FormMemoRect.Right - FormMemoRect.Left, 300);
Height := FormMemoRect.Bottom - FormMemoRect.Top;
BorderStyle := bsNone;
Show;
End;
End;
Procedure TMyForm.GrdMemoDrawColumnCell(Sender: TObject; Const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
Begin
If (gdFocused In State) Then Begin
If Column.Field.DataType In [ftBlob, ftMemo] Then Begin
{Desenha botão para visualização do Memo}
FormMemoRect.Left := TWinControl(Sender).ClientToScreen(Rect.TopLeft).X;
FormMemoRect.Right := TWinControl(Sender).ClientToScreen(Rect.BottomRight).X;
FormMemoRect.Top := TWinControl(Sender).ClientToScreen(Rect.BottomRight).Y;
FormMemoRect.Bottom := FormMemoRect.Top + 100;
If Not Assigned(BMemo) Then
BMemo := TBitBtn.Create(Self);
BMemo.Parent := TWinControl(Sender).Parent;
BMemo.Width := 16;
BMemo.Height := 16;
BMemo.Caption := '...';
BMemo.OnClick := BMemoClick;
BMemo.Tag := Column.Field.Index;
BMemo.Left := TWinControl(Sender).Left + Rect.Right - BMemo.Width + 1;
BMemo.Top := TWinControl(Sender).Top + Rect.Top + 2;
MemoGrid := TDBGrid(Sender);
End
Else
FreeAndNil(BMemo);
End;
End;
For Blob/Memo Fields, you may also find it useful to do some custom GetText to show something directly in the Grid:
Procedure TMyForm.DataSetMemoGetText(Sender: TField; var Text: String; DisplayText: Boolean);
Begin
Text := Copy(Sender.AsString, 1, 50);
If Text <> Sender.AsString Then
Text := Text + '...';
End;
This is how the result looks like.
PS: Sorry for non-standard code style.
I want to have a button with icon at the end of each row.
Like here:
I tried this
procedure TMyFrame.sgrd1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
canvas: TCanvas;
sgrd: TStringGrid;
point: TPoint;
btn: TSpeedButton;
begin
sgrd := TStringGrid(Sender);
canvas := sgrd.Canvas;
canvas.FillRect(Rect);
if (ACol = 1) then
begin
point := Self.ScreenToClient(ClientToScreen(Rect.TopLeft));
btn := TSpeedButton.Create(sgrd);
btn.Parent := sgrd;
btn.OnClick := SpeedButton1Click;
btn.Tag := ARow;
btn.enabled:=true;
btn.visible:= true;
btn.Top := point.Y;
btn.Left := point.X;
btn.Width := 20;
btn.Height := 24;
end;
end;
but the button doesn't look like "alive" although click event works. No click, hover animation, focus, etc.
Assuming you might want to be able to scroll within your StringGrid and have the Buttons beeing associated with the selected row, you will have to implement an handler for TopLeftChanged. The buttons won't be moved if you scroll in your Stringgrid, without implementing code for this.
procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
Showmessage(TSpeedButton(Sender).Name + ' ' + IntToStr(TSpeedButton(Sender).Tag));
end;
const
C_COL = 4;
procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
point: TPoint;
btn: TSpeedButton;
row: integer;
rect: TRect;
y: integer;
begin
rect := TStringGrid(Sender).CellRect(C_COL, TStringGrid(Sender).TopRow);
point := ScreenToClient(ClientToScreen(rect.TopLeft));
y := rect.Top;
for row := 0 to TStringGrid(Sender).RowCount - 1 do
begin
btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
if row >= TStringGrid(Sender).TopRow then
begin
btn.Top := y;
btn.Left := rect.Left;
btn.Visible := rect.Right > 0;
y := y + TStringGrid(Sender).DefaultRowHeight;
end
else
btn.Visible := false;
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
var
point: TPoint;
btn: TSpeedButton;
row: integer;
rect: TRect;
y: integer;
begin
rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
point := ScreenToClient(ClientToScreen(rect.TopLeft));
y := rect.Top;
for row := 0 to StringGrid1.RowCount - 1 do
begin
btn := TSpeedButton.Create(StringGrid1);
btn.Name := Format('SP%d', [row]);
btn.Parent := StringGrid1;
btn.OnClick := SpeedButton1Click;
btn.tag := row;
btn.Width := StringGrid1.ColWidths[C_COL];
btn.Height := StringGrid1.DefaultRowHeight;
btn.Visible := false;
end;
StringGrid1TopLeftChanged(TStringGrid(Sender));
end;
an enhanced version as suggested by #Tlama would make it necessary to implement an interposer class or use an own component to override ColWidthsChanged and RowHeightsChanged to keep the buttons painted correct not just on scrolling but on row/column sizing.
//.....
type
TStringGrid=Class(Grids.TStringGrid)
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
End;
TForm3 = class(TForm)
StringGrid1: TStringGrid;
SpeedButton1: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure StringGrid1TopLeftChanged(Sender: TObject);
private
procedure SpeedButton1Click(Sender: TObject);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
{ TStringGrid }
procedure TStringGrid.ColWidthsChanged;
begin
inherited;
TopLeftChanged;
end;
procedure TStringGrid.RowHeightsChanged;
begin
inherited;
TopLeftChanged;
end;
procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
Showmessage(TSpeedButton(Sender).Name + ' ' + IntToStr(TSpeedButton(Sender).Tag));
end;
const
C_COL = 4;
procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
point: TPoint;
btn: TSpeedButton;
row: integer;
rect: TRect;
y: integer;
begin
for row := 0 to TStringGrid(Sender).RowCount - 1 do
begin
btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
if row >= TStringGrid(Sender).TopRow then
begin
rect := TStringGrid(Sender).CellRect(C_COL, row);
btn.BoundsRect := rect;
btn.Visible := rect.Right > 0;
y := y + TStringGrid(Sender).DefaultRowHeight;
end
else
btn.Visible := false;
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
var
point: TPoint;
btn: TSpeedButton;
row: integer;
rect: TRect;
y: integer;
begin
rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
point := ScreenToClient(ClientToScreen(rect.TopLeft));
y := rect.Top;
for row := 0 to StringGrid1.RowCount - 1 do
begin
btn := TSpeedButton.Create(StringGrid1);
btn.Name := Format('SP%d', [row]);
btn.Parent := StringGrid1;
btn.OnClick := SpeedButton1Click;
btn.tag := row;
btn.Visible := false;
end;
StringGrid1TopLeftChanged(TStringGrid(Sender));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Canvas: TCanvas;
Point: TPoint;
MySpeedBtn: TSpeedButton;
Row: integer;
Rect: TRect;
begin
for Row := 1 to StringGrid1.RowCount - 1 do
begin
Rect := StringGrid1.CellRect(4, Row);
point := ScreenToClient(ClientToScreen(Rect.TopLeft));
MySpeedBtn := TSpeedButton.Create(StringGrid1);
MySpeedBtn.Parent := StringGrid1;
MySpeedBtn.OnClick := SpeedButton1Click;
MySpeedBtn.Tag := Row;
MySpeedBtn.Width := 20;
MySpeedBtn.Height := StringGrid1.RowHeights[1];
MySpeedBtn.Top := Point.Y;
MySpeedBtn.Left := Point.X + StringGrid1.ColWidths[1] - MySpeedBtn.Width;
end;
end;
The problem is that you are continuously creating a new speedbutton every time the cell needs refreshing. You must create the buttons in the Create event.
procedure TForm1.FormCreate(Sender: TObject);
var
canvas: TCanvas;
point: TPoint;
btn: TSpeedButton;
row : integer;
rect: TRect;
begin
for row:=0 to stringGrid1.RowCount-1 do
begin
rect := stringGrid1.CellRect(1,row);
point := ScreenToClient(ClientToScreen(Rect.TopLeft));
btn := TSpeedButton.Create(StringGrid1);
btn.Parent := StringGrid1;
btn.OnClick := SpeedButton1Click;
btn.Tag := row;
btn.enabled:=true;
btn.visible:= true;
btn.Top := point.Y;
btn.Left := point.X;
btn.Width := 20;
btn.Height := 24;
end;