Delphi: How to make cells' texts in TStringGrid center aligned? - delphi

It seems something obvious to have. I want the texts to be in the center of the cells, but for some reason I can't find it in properties. How can I do this?

There's no property to center the text in TStringGrid, but you can do that at DrawCell event as:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
S: string;
SavedAlign: word;
begin
if ACol = 1 then begin // ACol is zero based
S := StringGrid1.Cells[ACol, ARow]; // cell contents
SavedAlign := SetTextAlign(StringGrid1.Canvas.Handle, TA_CENTER);
StringGrid1.Canvas.TextRect(Rect,
Rect.Left + (Rect.Right - Rect.Left) div 2, Rect.Top + 2, S);
SetTextAlign(StringGrid1.Canvas.Handle, SavedAlign);
end;
end;
The code I posted from here
UPDATE:
to center text while writing in the cell, add this code to GetEditText Event:
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
var Value: string);
var
S : String;
I: Integer;
IE : TInplaceEdit ;
begin
for I := 0 to StringGrid1.ControlCount - 1 do
if StringGrid1.Controls[i].ClassName = 'TInplaceEdit' then
begin
IE := TInplaceEdit(StringGrid1.Controls[i]);
ie.Alignment := taCenter
end;
end;

This one is a much better solution that the others and on them there was a mistype on procedures TStringGrid.SetCellsAlignment and TStringGrid.SetCellsAlignment the (-1 < Index) compare was correct, but then and else parts were swapped... The correct version (this one) will show that when index is bigger than -1 it will overwrite value stored else it will add a new entry, the others will do just the oposite bringing a list out of index message, thanks for detecting such.
I have also make able to be all in another separated unit, so here it is (hope now it is correct and thanks for detecting such mistypes):
unit AlignedTStringGrid;
interface
uses Windows,SysUtils,Classes,Grids;
type
TStringGrid=class(Grids.TStringGrid)
private
FCellsAlignment:TStringList;
FColsDefaultAlignment:TStringList;
function GetCellsAlignment(ACol,ARow:Integer):TAlignment;
procedure SetCellsAlignment(ACol,ARow:Integer;const Alignment:TAlignment);
function GetColsDefaultAlignment(ACol:Integer):TAlignment;
procedure SetColsDefaultAlignment(ACol:Integer;const Alignment:TAlignment);
protected
procedure DrawCell(ACol,ARow:Longint;ARect:TRect;AState:TGridDrawState);override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
property CellsAlignment[ACol,ARow:Integer]:TAlignment read GetCellsAlignment write SetCellsAlignment;
property ColsDefaultAlignment[ACol:Integer]:TAlignment read GetColsDefaultAlignment write SetColsDefaultAlignment;
end;
implementation
constructor TStringGrid.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FCellsAlignment:=TStringList.Create;
FCellsAlignment.CaseSensitive:=True;
FCellsAlignment.Sorted:=True;
FCellsAlignment.Duplicates:=dupIgnore;
FColsDefaultAlignment:=TStringList.Create;
FColsDefaultAlignment.CaseSensitive:=True;
FColsDefaultAlignment.Sorted:=True;
FColsDefaultAlignment.Duplicates:=dupIgnore;
end;
destructor TStringGrid.Destroy;
begin
FCellsAlignment.Free;
FColsDefaultAlignment.Free;
inherited Destroy;
end;
procedure TStringGrid.SetCellsAlignment(ACol,ARow: Integer; const Alignment: TAlignment);
var
Index:Integer;
begin
if (-1 < Index) then begin
FCellsAlignment.Objects[Index]:= TObject(Alignment);
end else begin
FCellsAlignment.AddObject(IntToStr(ACol) + '-' + IntToStr(ARow), TObject(Alignment));
end;
end;
function TStringGrid.GetCellsAlignment(ACol,ARow: Integer): TAlignment;
var
Index:Integer;
begin
Index:= FCellsAlignment.IndexOf(IntToStr(ACol)+'-'+IntToStr(ARow));
if (-1 < Index) then begin
GetCellsAlignment:= TAlignment(FCellsAlignment.Objects[Index]);
end else begin
GetCellsAlignment:= ColsDefaultAlignment[ACol];
end;
end;
procedure TStringGrid.SetColsDefaultAlignment(ACol: Integer; const Alignment: TAlignment);
var
Index:Integer;
begin
Index:= FColsDefaultAlignment.IndexOf(IntToStr(ACol));
if (-1 < Index) then begin
FColsDefaultAlignment.Objects[Index]:= TObject(Alignment);
end else begin
FColsDefaultAlignment.AddObject(IntToStr(ACol), TObject(Alignment));
end;
end;
function TStringGrid.GetColsDefaultAlignment(ACol:Integer):TAlignment;
var
Index:Integer;
begin
Index:= FColsDefaultAlignment.IndexOf(IntToStr(ACol));
if (-1 < Index) then begin
GetColsDefaultAlignment:= TAlignment(FColsDefaultAlignment.Objects[Index]);
end else begin
GetColsDefaultAlignment:=taLeftJustify;
end;
end;
procedure TStringGrid.DrawCell(ACol,ARow:Longint;ARect:TRect;AState:TGridDrawState);
var
Old_DefaultDrawing:Boolean;
begin
if DefaultDrawing then begin
case CellsAlignment[ACol,ARow] of
taLeftJustify: begin
Canvas.TextRect(ARect,ARect.Left+2,ARect.Top+2,Cells[ACol,ARow]);
end;
taRightJustify: begin
Canvas.TextRect(ARect,ARect.Right -2 -Canvas.TextWidth(Cells[ACol,ARow]), ARect.Top+2,Cells[ACol,ARow]);
end;
taCenter: begin
Canvas.TextRect(ARect,(ARect.Left+ARect.Right-Canvas.TextWidth(Cells[ACol,ARow]))div 2,ARect.Top+2,Cells[ACol,ARow]);
end;
end;
end;
Old_DefaultDrawing:= DefaultDrawing;
DefaultDrawing:=False;
inherited DrawCell(ACol,ARow,ARect,AState);
DefaultDrawing:= Old_DefaultDrawing;
end;
end.
This is a whole unit, save it to a file called AlignedTStringGrid.pas.
Then on any form you have a TStringGrid add ,AlignedTStringGrid at the end of the interface uses clause.
Note: The same can be done for rows, but for now I do not know how to mix both (cols and rows) because of how to select priority, if anyone is very interested on it let me know.
P.D.: The same idea is possible to be done for TEdit, just search on stackoverflow.com for TEdit.CreateParams or read post How to set textalignment in TEdit control

Related

Writing a custom property inspector - How to handle inplace editor focus when validating values?

Overview
I am trying to write my own simple property inspector but I am facing a difficult and rather confusing problem. First though let me say that my component is not meant to work with or handle component properties, instead it will allow adding custom values to it. The full source code of my component is further down the question and it should look something like this once you have installed it in a package and run it from a new empty project:
Problem (brief)
The issue is regarding the use of inplace editors and validating the property values. The idea is, if a property value is not valid then show a message to the user notifying them that the value cannot be accepted, then focus back to the row and inplace editor that was originally focused on.
We can actually use Delphi's very own Object Inspector to illustrate the behavior I am looking for, for example try writing a string in the Name property that cannot be accepted then click away from the Object Inspector. A message is shown and upon closing it, it will focus back to the Name row.
Source Code
The question becomes too vague without any code but due to the nature of the component I am trying to write it's also quite large. I have stripped it down as much as possible for the purpose of the question and example. I am sure there will be some comments asking me why I didn't do this or do that instead but it's important to know that I am no Delphi expert and often I make wrong decisions and choices but I am always willing to learn so all comments are welcomed, especially if it aids in finding my solution.
unit MyInspector;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.Classes,
System.SysUtils,
Vcl.Controls,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.Graphics,
Vcl.Forms;
type
TMyInspectorItems = class(TObject)
private
FPropertyNames: TStringList;
FPropertyValues: TStringList;
procedure AddItem(APropName, APropValue: string);
procedure Clear;
public
constructor Create;
destructor Destroy; override;
end;
TOnMouseMoveEvent = procedure(Sender: TObject; X, Y: Integer) of object;
TOnSelectRowEvent = procedure(Sender: TObject; PropName, PropValue: string; RowIndex: Integer) of object;
TMyCustomInspector = class(TGraphicControl)
private
FInspectorItems: TMyInspectorItems;
FOnMouseMove: TOnMouseMoveEvent;
FOnSelectRow: TOnSelectRowEvent;
FRowCount: Integer;
FNamesFont: TFont;
FValuesFont: TFont;
FSelectedRow: Integer;
procedure SetNamesFont(const AValue: TFont);
procedure SetValuesFont(const AValue: TFont);
procedure CalculateInspectorHeight;
function GetMousePosition: TPoint;
function MousePositionToRowIndex: Integer;
function RowIndexToMousePosition(ARowIndex: Integer): Integer;
function GetRowHeight: Integer;
function GetValueRowWidth: Integer;
function RowExists(ARowIndex: Integer): Boolean;
function IsRowSelected: Boolean;
protected
procedure Loaded; override;
procedure Paint; override;
procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
procedure WMMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMMouseUp(var Message: TMessage); message WM_LBUTTONUP;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function RowCount: Integer;
property Items: TMyInspectorItems read FInspectorItems write FInspectorItems;
property OnMouseMove: TOnMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnSelectRow: TOnSelectRowEvent read FOnSelectRow write FOnSelectRow;
published
property Align;
end;
TMyPropertyInspector = class(TScrollBox)
private
FInspector: TMyCustomInspector;
FInplaceStringEditor: TEdit;
FSelectedRowName: string;
FLastSelectedRowName: string;
FLastSelectedRow: Integer;
function SetPropertyValue(RevertToPreviousValueOnFail: Boolean): Boolean;
procedure InplaceStringEditorEnter(Sender: TObject);
procedure InplaceStringEditorExit(Sender: TObject);
procedure InplaceStringEditorKeyPress(Sender: TObject; var Key: Char);
procedure SelectRow(Sender: TObject; PropName, PropValue: string; RowIndex: Integer);
function ValidateStringValue(Value: string): Boolean;
protected
procedure Loaded; override;
procedure WMSize(var Message: TMessage); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddItem(APropName, APropValue: string);
function GetSelectedPropertyName: string;
function GetSelectedPropertyValue: string;
function RowCount: Integer;
end;
var
FCanSelect: Boolean;
implementation
{ TMyInspectorItems }
constructor TMyInspectorItems.Create;
begin
inherited Create;
FPropertyNames := TStringList.Create;
FPropertyValues := TStringList.Create;
end;
destructor TMyInspectorItems.Destroy;
begin
FPropertyNames.Free;
FPropertyValues.Free;
inherited Destroy;
end;
procedure TMyInspectorItems.AddItem(APropName, APropValue: string);
begin
FPropertyNames.Add(APropName);
FPropertyValues.Add(APropValue);
end;
procedure TMyInspectorItems.Clear;
begin
FPropertyNames.Clear;
FPropertyValues.Clear;
end;
{ TMyCustomInspector }
constructor TMyCustomInspector.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInspectorItems := TMyInspectorItems.Create;
FNamesFont := TFont.Create;
FNamesFont.Color := clWindowText;
FNamesFont.Name := 'Segoe UI';
FNamesFont.Size := 9;
FNamesFont.Style := [];
FValuesFont := TFont.Create;
FValuesFont.Color := clNavy;
FValuesFont.Name := 'Segoe UI';
FValuesFont.Size := 9;
FValuesFont.Style := [];
end;
destructor TMyCustomInspector.Destroy;
begin
FInspectorItems.Free;
FNamesFont.Free;
FValuesFont.Free;
inherited Destroy;
end;
procedure TMyCustomInspector.Loaded;
begin
inherited Loaded;
end;
procedure TMyCustomInspector.Paint;
procedure DrawBackground;
begin
Canvas.Brush.Color := clWindow;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
end;
procedure DrawNamesBackground;
begin
Canvas.Brush.Color := clWindow;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Self.Width div 2, Self.Height));
end;
procedure DrawNamesSelection;
begin
if (FRowCount > -1) and (RowExists(MousePositionToRowIndex)) then
begin
Canvas.Brush.Color := $00E0E0E0;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, RowIndexToMousePosition(FSelectedRow),
Self.Width div 2, RowIndexToMousePosition(FSelectedRow) + GetRowHeight));
end;
end;
procedure DrawNamesText;
var
I: Integer;
Y: Integer;
begin
FRowCount := FInspectorItems.FPropertyNames.Count;
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FNamesFont.Color;
Canvas.Font.Name := FNamesFont.Name;
Canvas.Font.Size := FNamesFont.Size;
Y := 0;
for I := 0 to FInspectorItems.FPropertyNames.Count -1 do
begin
Canvas.TextOut(2, Y, FInspectorItems.FPropertyNames.Strings[I]);
Inc(Y, GetRowHeight);
end;
end;
procedure DrawValuesBackground;
begin
Canvas.Brush.Color := clWindow;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(Self.Width div 2, 0, Self.Width, Self.Height));
end;
procedure DrawValuesSelection;
begin
if (FRowCount > -1) and (RowExists(MousePositionToRowIndex)) then
begin
Canvas.DrawFocusRect(Rect(Self.Width div 2, RowIndexToMousePosition(FSelectedRow),
Self.Width, RowIndexToMousePosition(FSelectedRow) + GetRowHeight));
end;
end;
procedure DrawValues;
var
I, Y: Integer;
begin
FRowCount := FInspectorItems.FPropertyValues.Count;
Y := 0;
for I := 0 to FInspectorItems.FPropertyValues.Count -1 do
begin
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FValuesFont.Color;
Canvas.Font.Name := FValuesFont.Name;
Canvas.Font.Size := FValuesFont.Size;
Canvas.TextOut(Self.Width div 2 + 2, Y + 1, FInspectorItems.FPropertyValues.Strings[I]);
Inc(Y, GetRowHeight);
end;
end;
begin
DrawNamesBackground;
DrawNamesSelection;
DrawNamesText;
DrawValuesBackground;
DrawValuesSelection;
DrawValues;
end;
procedure TMyCustomInspector.WMKeyDown(var Message: TMessage);
begin
inherited;
case Message.WParam of
VK_DOWN:
begin
end;
end;
end;
procedure TMyCustomInspector.WMMouseDown(var Message: TMessage);
begin
inherited;
Parent.SetFocus;
FSelectedRow := MousePositionToRowIndex;
if FSelectedRow <> -1 then
begin
if Assigned(FOnSelectRow) then
begin
FOnSelectRow(Self, FInspectorItems.FPropertyNames.Strings[FSelectedRow],
FInspectorItems.FPropertyValues.Strings[FSelectedRow], FSelectedRow);
end;
end;
Invalidate;
end;
procedure TMyCustomInspector.WMMouseMove(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseMove) then
begin
FOnMouseMove(Self, GetMousePosition.X, GetMousePosition.Y);
end;
end;
procedure TMyCustomInspector.WMMouseUp(var Message: TMessage);
begin
inherited;
end;
procedure TMyCustomInspector.SetNamesFont(const AValue: TFont);
begin
FNamesFont.Assign(AValue);
Invalidate;
end;
procedure TMyCustomInspector.SetValuesFont(const AValue: TFont);
begin
FValuesFont.Assign(AValue);
Invalidate;
end;
procedure TMyCustomInspector.CalculateInspectorHeight;
var
I, Y: Integer;
begin
FRowCount := FInspectorItems.FPropertyNames.Count;
Y := GetRowHeight;
for I := 0 to FRowCount -1 do
begin
Inc(Y, GetRowHeight);
end;
if Self.Height <> Y then
Self.Height := Y;
end;
function TMyCustomInspector.GetMousePosition: TPoint;
var
Pt: TPoint;
begin
Pt := Mouse.CursorPos;
Pt := ScreenToClient(Pt);
Result := Pt;
end;
function TMyCustomInspector.MousePositionToRowIndex: Integer;
begin
Result := GetMousePosition.Y div GetRowHeight;
end;
function TMyCustomInspector.RowIndexToMousePosition(
ARowIndex: Integer): Integer;
begin
Result := ARowIndex * GetRowHeight;
end;
function TMyCustomInspector.GetRowHeight: Integer;
begin
Result := FNamesFont.Size * 2 + 1;
end;
function TMyCustomInspector.GetValueRowWidth: Integer;
begin
Result := Self.Width div 2;
end;
function TMyCustomInspector.RowCount: Integer;
begin
Result := FRowCount;
end;
function TMyCustomInspector.RowExists(ARowIndex: Integer): Boolean;
begin
Result := MousePositionToRowIndex < RowCount;
end;
function TMyCustomInspector.IsRowSelected: Boolean;
begin
Result := FSelectedRow <> -1;
end;
{ TMyPropertyInspector }
constructor TMyPropertyInspector.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Self.DoubleBuffered := True;
Self.Height := 150;
Self.HorzScrollBar.Visible := False;
Self.TabStop := True; // needed to receive focus
Self.Width := 250;
FInspector := TMyCustomInspector.Create(Self);
FInspector.Parent := Self;
FInspector.Align := alTop;
FInspector.Height := 0;
FInspector.OnSelectRow := SelectRow;
FInplaceStringEditor := TEdit.Create(Self);
FInplaceStringEditor.Parent := Self;
FInplaceStringEditor.BorderStyle := bsNone;
FInplaceStringEditor.Color := clWindow;
FInplaceStringEditor.Height := 0;
FInplaceStringEditor.Left := 0;
FInplaceStringEditor.Name := 'MyPropInspectorInplaceStringEditor';
FInplaceStringEditor.Top := 0;
FInplaceStringEditor.Visible := False;
FInplaceStringEditor.Width := 0;
FInplaceStringEditor.Font.Assign(FInspector.FValuesFont);
FInplaceStringEditor.OnEnter := InplaceStringEditorEnter;
FInplaceStringEditor.OnExit := InplaceStringEditorExit;
FInplaceStringEditor.OnKeyPress := InplaceStringEditorKeyPress;
FCanSelect := True;
end;
destructor TMyPropertyInspector.Destroy;
begin
FInspector.Free;
FInplaceStringEditor.Free;
inherited Destroy;
end;
procedure TMyPropertyInspector.Loaded;
begin
inherited Loaded;
end;
procedure TMyPropertyInspector.WMSize(var Message: TMessage);
begin
FInspector.Width := Self.Width;
Invalidate;
end;
procedure TMyPropertyInspector.AddItem(APropName, APropValue: string);
begin
FInspector.CalculateInspectorHeight;
FInspector.Items.AddItem(APropName, APropValue);
FInspector.Invalidate;
Self.Invalidate;
end;
function TMyPropertyInspector.GetSelectedPropertyName: string;
begin
Result := '';
if FInspector.FSelectedRow <> -1 then
begin
Result := FInspector.FInspectorItems.FPropertyNames.Strings[FInspector.FSelectedRow];
end;
end;
function TMyPropertyInspector.GetSelectedPropertyValue: string;
begin
Result := '';
if FInspector.FSelectedRow <> -1 then
begin
Result := FInspector.FInspectorItems.FPropertyValues.Strings[FInspector.FSelectedRow];
end;
end;
function TMyPropertyInspector.RowCount: Integer;
begin
Result := FInspector.RowCount;
end;
procedure TMyPropertyInspector.InplaceStringEditorEnter(Sender: TObject);
begin
FCanSelect := False;
FLastSelectedRow := FInplaceStringEditor.Tag;
end;
procedure TMyPropertyInspector.InplaceStringEditorExit(Sender: TObject);
begin
if SetPropertyValue(True) then
begin
FCanSelect := True;
end;
end;
procedure TMyPropertyInspector.InplaceStringEditorKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = Chr(VK_RETURN) then
begin
Key := #0;
FInplaceStringEditor.SelectAll;
end;
end;
procedure TMyPropertyInspector.SelectRow(Sender: TObject; PropName, PropValue: string; RowIndex: Integer);
begin
FSelectedRowName := PropName;
FLastSelectedRowName := PropName;
FInplaceStringEditor.Height := FInspector.GetRowHeight - 2;
FInplaceStringEditor.Left := Self.Width div 2;
FInplaceStringEditor.Tag := RowIndex;
FInplaceStringEditor.Text := GetSelectedPropertyValue;
FInplaceStringEditor.Top := FInspector.RowIndexToMousePosition(FInspector.FSelectedRow) + 1 - Self.VertScrollBar.Position;
FInplaceStringEditor.Visible := True;
FInplaceStringEditor.Width := FInspector.GetValueRowWidth - 3;
FInplaceStringEditor.SetFocus;
FInplaceStringEditor.SelectAll;
end;
function TMyPropertyInspector.SetPropertyValue(
RevertToPreviousValueOnFail: Boolean): Boolean;
var
S: string;
begin
Result := False;
S := FInplaceStringEditor.Text;
if ValidateStringValue(S) then
begin
Result := True;
end
else
begin
ShowMessage('"' + S + '"' + 'is not a valid value.');
Result := False;
end;
end;
function TMyPropertyInspector.ValidateStringValue(Value: string): Boolean;
begin
// a quick and dirty way of testing for a valid string value, here we just
// look for strings that are not zero length.
Result := Length(Value) > 0;
end;
end.
Problem (detailed)
The confusion I have all comes down to who receives focus first and how to handle and respond to it correctly. Because I am custom drawing my rows I determine where the mouse is when clicking on the inspector control and then I draw the selected row to show this. When handling the inplace editors however, especially the OnEnter and OnExit event I have been facing all kinds of funky problems where in some cases I have been stuck in a cycle of the validate error message repeatedly showing for example (because focus is switching from my inspector to the inplace editor and back and forth).
To populate my inspector at runtime you can do the following:
procedure TForm1.Button1Click(Sender: TObject);
begin
MyPropertyInspector1.AddItem('A', 'Some Text');
MyPropertyInspector1.AddItem('B', 'Hello World');
MyPropertyInspector1.AddItem('C', 'Blah Blah');
MyPropertyInspector1.AddItem('D', 'The Sky is Blue');
MyPropertyInspector1.AddItem('E', 'Another String');
end;
A little something you may try:
Click on a row
Delete the contents from the inplace editor
Select another row
The validate error message box appears (don't close it yet)
With the message box still visible, move your mouse over another row
Now press Enter to close the message box
You will notice the selected row has now moved to where the mouse was
What I need is after the validate message box has shown and closed, I need to set the focus back to the row that was been validated in the first place. It gets confusing because it seems (or so I think) that the inplace editors OnExit is been called after the WMMouseDown(var Message: TMessage); code of my inspector.
To put it as simple as I can if the question remains unclear, the behavior of the Delphi Object Inspector is what I am trying to implement into my component. You enter a value into the inplace editors, if it fails the validation then display a messagebox and then focus back to the row that was last selected. The inplace editor validation should occur as soon as focus is switched away from the inplace editor.
I just can't seem to figure out what is been called first and what is blocking events been fired, it becomes confusing because the way I draw my selected row is determined by where the mouse was when clicking on the inspector control.
This is your flow of events:
TMyCustomInspector.WMMouseDown is called
Therein, Parent.SetFocus is called
The focus is removed from the Edit control and TMyPropertyInspector.InplaceStringEditorExit is called
The message dialog is shown by SetPropertyValue
FSelectedRow is being reset
TMyPropertyInspector.SelectRow is called (via TMyCustomInspector.FOnSelectRow) which resets the focus to the replaced Edit control.
What you need to is to prevent FSelectedRow being reset in case of validation did not succeed. All needed ingredients are already there, just add this one condition:
if FCanSelect then
FSelectedRow := MousePositionToRowIndex;
A few remarks:
Make FCanSelect a protected or private field of TMyCustomInspector,
You need to check for limits in TMyCustomInspector.MousePositionToRowIndex in order to return -1.
Your problem is very interesting. From what I gather, you want a way to reset the focus to the invalid row, when the evaluation is false. Where I see you do this is in your SetPropertyValue function. I believe if you do the following, you will be able to reset the focus after the user clicks "OK" in the message:
function TMyPropertyInspector.SetPropertyValue(
RevertToPreviousValueOnFail: Boolean): Boolean;
var
S: string;
begin
Result := False;
S := FInplaceStringEditor.Text;
if ValidateStringValue(S) then
begin
Result := True;
end
else
begin
if (MessageDlg('"' + S + '"' + 'is not a valid value.', mtError, [mbOK], 0)) = mrOK then
begin
SelectRow(nil, FSelectedRowName, FInplaceStringEditor.Text, FInplaceStringEditor.Tag);
end;
Result := False;
end;
end;
Changing the ShowMessage to MessageDlg will allow for an action to occur when the button is pressed. Then calling your SelectRow function with (what I believe are) global variables representing the information about the last row will set that focus to the bad cell.

Unexpected behavior of command history unit

I wrote such module to store there last changes of picture in my paint application " in Delphi
unit HistoryQueue;
interface
uses
Graphics;
type
myHistory = class
constructor Create(Size:Integer);
public
procedure Push(Bmp:TBitmap);
function Pop():TBitmap;
procedure Clean();
procedure Offset();
function isEmpty():boolean;
function isFull():boolean;
function getLast():TBitmap;
protected
historyQueueArray: array of TBitmap;
historyIndex, hSize:Integer;
end;
implementation
procedure myHistory.Push(Bmp:TBitmap);
var tbmp:TBitmap;
begin
if(not isFull) then begin
Inc(historyIndex);
historyQueueArray[historyIndex]:=TBitmap.Create;
historyQueueArray[historyIndex].Assign(bmp);
end else begin
Offset();
historyQueueArray[historyIndex]:=TBitmap.Create;
historyQueueArray[historyIndex].Assign(bmp);
end;
end;
procedure myHistory.Clean;
var i:Integer;
begin
{ for i:=0 to hSize do begin
historyQueueArray[i].Free;
historyQueueArray[i].Destroy;
end; }
end;
constructor myHistory.Create(Size:Integer);
begin
hSize:=Size;
SetLength(historyQueueArray, hSize);
historyIndex:=-1;
end;
function myHistory.isEmpty: boolean;
begin
Result:=(historyIndex = -1);
end;
function myHistory.isFull: boolean;
begin
Result:=(historyIndex = hSize);
end;
procedure myHistory.Offset; {to handle overflow}
var i:integer;
begin
//historyQueueArray[0]:=nil;
for i:=0 to hSize-1 do begin
historyQueueArray[i]:=TBitmap.Create;
historyQueueArray[i].Assign(historyQueueArray[i+1]);
end;
end;
function myHistory.Pop: TBitmap;
var
popBmp:TBitmap;
begin
popBmp:= TBitmap.Create;
popBmp.Assign(historyQueueArray[historyIndex]);
Dec(historyIndex);
Result:=popBmp;
end;
function myHistory.getLast: TBitmap; {this function I use when I need refresh the cnvas when I draw ellipse or rect, to get rid of traces and safe previous changes of the picture}
var
tBmp:TBitmap;
begin
tBmp:= TBitmap.Create;
tBmp.Assign(historyQueueArray[historyIndex]);
Result:=tBmp;
end;
end.
And thats how I use it
procedure TMainForm.FormCreate(Sender: TObject);
var
cleanBmp:TBitmap;
begin
{...}
doneRedo:=false;
redomode:=false; undomode:=false;
//init arrays
picHistory:=myHistory.Create(10); //FOR UNDO
tempHistory:=myHistory.Create(10); //FOR REDO
cleanbmp:=TBitmap.Create;
cleanbmp.Assign(imgMain.Picture.Bitmap);
picHistory.Push(cleanbmp);
cleanbmp.Free;
{...}
end;
procedure TMainForm.btnUndoClick(Sender: TObject);
var redBmp:TBitmap;
begin
undoMode:=true;
//if there were some changes
if(not picHistory.isEmpty) then begin
redBmp:=TBitmap.Create;
redBmp.Assign(picHistory.getLast);
//clean canvas
imgMain.Picture.Bitmap:=nil;
//get what was there before
imgMain.Canvas.Draw(0,0, picHistory.Pop);
//and in case if we will not make any changes after UNDO(clicked one or more times)
//and call REDO then
tempHistory.Push(redBmp);//we save what were on canvas before UNDOand push it to redo history
redBmp.Free;
end;
end;
procedure TMainForm.btnRedoClick(Sender: TObject);
var undBmp:TBitmap;
begin
redoMode:=true;
if(not tempHistory.isEmpty) then begin
doneRedo:=True;
undBmp:=TBitmap.Create;
undBmp.Assign(tempHistory.getLast);
imgMain.Picture.Bitmap:=nil;
MainForm.imgMain.Canvas.Draw(0,0, tempHistory.Pop);
//same history (like with UNDO implementation) here but reverse
picHistory.Push(undBmp);
undBmp.Free;
end;
end;
{...}
procedure TMainForm.imgMainMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var bmp:TBitmap;
begin
//if mouse were down and then it's up this means we drew something
//and must save changes into history to be able to make UNDO
{...}
bmp:=TBitmap.Create;
try
bmp.Assign(imgMain.Picture.Bitmap);
picHistory.Push(bmp);
//if there are some changes added after redo then we clean redo history
if (doneRedo) then begin
tempHistory.Clean;
doneRedo:=false;
end;
finally
bmp.Free;
//sor of refresh
imgMain.Canvas.Draw(0,0, picHistory.getLast);
end;
{...}
But the problem is it works not way I expected. an example:
If I push undo button once - nothing happens. On twice - it does what it should at once.
And if I drew an ellipse, then click undo once and start draw new one - last drawn ellipse just dissaperas!
Here's the elipse draw method in case if it could be helpful to find out the problem
procedure TMainForm.ellipseDraw(X, Y: Integer);
begin
imgMain.Canvas.Pen.Color:=useColor;
imgMain.Canvas.Brush.Color:=scndColor;
imgMain.Canvas.Pen.Width:=size;
if(mouseIsDown) then begin
imgMain.Canvas.Draw(0,0, picHistory.getLast); //there gonna be no bizzare traces from figures
imgMain.Canvas.Ellipse(dX, dY, X,Y);
end;
end;
Answer
If I push undo button once - nothing happens. On twice - it does what it should at once.
That is indeed exactly what your code does:
In imgMainMouseUp you add the current picture to the undo list, and
In btnUndoClick you retrieve the last bitmap from the undo list, which is the same as currently seen on the Image.
The solution - to this specific question - is to add the previous bitmap to the undo list instead of the current one.
Bonus
And to address David's comment concerning the leaking, your implementation leaks Bitmaps because:
The routines Pop and getLast return a newly local created Bitmap. This places the responsibility for its destruction on the caller ot the routines. Your MainForm code does not destroy those Bitmaps, thus they are memory leaks. The solution is to simply return the item in the array, instead of creating a new Bitmap.
In the Offset routine, you again create new Bitmaps and leak all previous ones. Just assign Queue[I] to Queue[I + 1].
In the Push method, you forget to free the last item.
The class does not have a destructor, which again places the responsibility for the destruction of all Bitmaps on the user of the object with the need to call Clean, which it does not. The solution is to add a destructor to your object which calls Clean.
Besides these leaks, there are more problems with your code. Here some fixes and tips:
Since dynamic arrays are zero-based, your isFull routine does not return True when it should. It should be implemented as Result := historyIndex = hSize - 1;
Your array is not a queue (FIFO), but a stack (LIFO).
Your Pop routine does not check for an empty list.
Altogether, your history class could better look like:
uses
SysUtils, Graphics;
type
TBitmapHistory = class(TObject)
private
FIndex: Integer;
FStack: array of TBitmap;
procedure Offset;
public
procedure Clear;
function Count: Integer;
constructor Create(ACount: Integer);
destructor Destroy; override;
function Empty: Boolean;
function Full: Boolean;
function Last: TBitmap;
function Pop: TBitmap;
procedure Push(ABitmap: TBitmap);
end;
implementation
{ TBitmapHistory }
procedure TBitmapHistory.Clear;
var
I: Integer;
begin
for I := 0 to Count - 1 do
FreeAndNil(FStack[I]);
FIndex := -1;
end;
function TBitmapHistory.Count: Integer;
begin
Result := Length(FStack);
end;
constructor TBitmapHistory.Create(ACount: Integer);
begin
inherited Create;
SetLength(FStack, ACount);
FIndex := -1;
end;
destructor TBitmapHistory.Destroy;
begin
Clear;
inherited Destroy;
end;
function TBitmapHistory.Empty: Boolean;
begin
Result := FIndex = -1;
end;
function TBitmapHistory.Full: Boolean;
begin
Result := FIndex = Count - 1;
end;
function TBitmapHistory.Last: TBitmap;
begin
if Empty then
Result := nil
else
Result := FStack[FIndex];
end;
procedure TBitmapHistory.Offset;
begin
FStack[0].Free;
Move(FStack[1], FStack[0], (Count - 1) * SizeOf(TBitmap));
end;
function TBitmapHistory.Pop: TBitmap;
begin
if not Empty then
begin
Result := Last;
Dec(FIndex);
end;
end;
procedure TBitmapHistory.Push(ABitmap: TBitmap);
begin
if Full then
Offset
else
Inc(FIndex);
FStack[Findex].Free;
FStack[FIndex] := TBitmap.Create;
FStack[Findex].Assign(ABitmap);
end;
Remarks:
There also exists a specialized class TObjectStack for this in the Contnrs unit which you could override/exploit.
There are also concerns with your MainForm code, but I politely leave that up to you to fix.

How to display hint for a disabled control?

I have a check box which will be enabled/disabled at run time. I just want to show different tool tips if it is enabled/disabled. I was thinking about overriding OnMouseEnter event and handle it there but OnMouseEnter will be called only if the control is enabled. How can i possible achieve that behavior? Any help would be appreciated.
I tried to handle OnMouseMove of the form and do something like this
procedure Tdlg.pnlTopMouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
var
point: TPoint;
checkBoxCursorPos: TPoint;
begin
inherited;
point.X := X;
point.Y := Y;
checkBoxCursorPos := chkBx.ScreenToClient(point);
if (PtInRect(chkBx.ClientRect, checkBoxCursorPos)) then
begin
if(chkBx.Enabled) then
chkBx.Hint := 'Enabled'
else
chkBx.Hint := 'Disabled' ;
Application.ShowHint := True;
end;
end;
but the condition PtinRect is not satisfied. What i am doing wrong?
There is a simple solution: place an empty TLabel over the checkbox and set its Hint to the value for the disabled checkbox state. The label has to be AutoSize off and you can enforce position and size by its BoundsRect property set to that of the CheckBox.
When the CheckBox is enabled the Hint of the Checkbox is used, while the Hint of the Label is used when the CheckBox is disabled.
Update: just saw that Bummi mentions a similar idea in his comment.
The official answer: you can’t.
The workaround: you could try using the form's MouseMove-event (assuming that won’t be disabled, of course), and if the mouse cursor is over the relevant control, display the appropriate hint.
Here is a unit that can show hints for disabled controls.
I used it like this:
TATHintControl.Create(self).HintStyleController := GlobalHintStyleController;
GlobalHintStyleController is a DevExpress stylecontroller.
Then the unit
unit ATHintControl;
{
The purpose of this component is to show hints for disabled controls (VCL doesn't)
It uses timestamp comparison instead of Timers to save resources
}
interface
uses
// VCL
Classes,
Controls,
Forms,
AppEvnts,
Messages,
Windows,
// DevEx
cxHint;
type
TGetHintForControlEvent = function(AControl: TControl): string of object;
THandleControlEvent = function(AControl: TControl): boolean of object;
TATHintControl = class(TComponent)
private
fHintTimeStamp: TDateTime;
fHintHideTimeStamp: TDateTime;
fHintControl: TControl;
fHintVisible: boolean;
FHintStyleController: TcxHintStyleController;
FHintShowDelay: Integer;
FHintHideDelay: Integer;
fGetHintForControlEvent: TGetHintForControlEvent;
fHandleControlEvent: THandleControlEvent;
fApplicationEvents: TApplicationEvents;
procedure IdleHandler(Sender: TObject; var Done: Boolean);
procedure ShortcutHandler(var Msg: TWMKey; var Handled: Boolean);
procedure SetHintStyleController(const Value: TcxHintStyleController);
procedure HideHint;
function GetCursorPos(out APoint: TPoint): Boolean;
function HandleHint: boolean;
protected
function GetHintForControl(AControl: TControl): string; virtual;
function HandleControl(AControl: TControl): boolean; virtual;
public
procedure AfterConstruction; override;
published
property HintStyleController: TcxHintStyleController read FHintStyleController write SetHintStyleController;
property OnGetHintForControl: TGetHintForControlEvent read fGetHintForControlEvent write fGetHintForControlEvent;
property OnHandleControl: THandleControlEvent read fHandleControlEvent write fHandleControlEvent;
end;
implementation
uses
Types,
SysUtils,
DateUtils;
const
cHintShowDelay: Integer = 500; // msec
cHintHideDelay: Integer = 3 * 1000; // 3 sec
{ TATHintControl }
procedure TATHintControl.AfterConstruction;
begin
inherited;
fApplicationEvents := TApplicationEvents.Create(self);
fApplicationEvents.OnIdle := IdleHandler;
fApplicationEvents.OnShortCut := ShortcutHandler;
fHintShowDelay := cHintShowDelay;
fHintHideDelay := cHintHideDelay;
end;
function TATHintControl.GetCursorPos(out APoint: TPoint): Boolean;
begin
{$WARN SYMBOL_PLATFORM OFF}
result := Windows.GetCursorPos(APoint);
{$WARN SYMBOL_PLATFORM ON}
end;
function TATHintControl.GetHintForControl(AControl: TControl): string;
begin
if Assigned(OnGetHintForControl) then
result := OnGetHintForControl(AControl)
else
result := AControl.Hint;
end;
procedure TATHintControl.HideHint;
begin
HintStyleController.HideHint;
fHintTimeStamp := 0;
fHintVisible := false;
fHintHideTimeStamp := 0;
end;
procedure TATHintControl.IdleHandler(Sender: TObject; var Done: Boolean);
begin
if Assigned(HintStyleController) then
Done := HandleHint;
end;
procedure TATHintControl.SetHintStyleController(
const Value: TcxHintStyleController);
begin
FHintStyleController := Value;
end;
procedure TATHintControl.ShortcutHandler(var Msg: TWMKey; var Handled: Boolean);
begin
fHintControl := nil; // clear the HintControl so that keypress causes it to be shown again w/o having to move the mouse
end;
function TATHintControl.HandleControl(AControl: TControl): boolean;
begin
if Assigned(OnHandleControl) then
result := OnHandleControl(AControl)
else
result := not AControl.Enabled;
end;
function TATHintControl.HandleHint: boolean;
var
vNow: TDateTime;
vScreenPos: TPoint;
vClientPos: TPoint;
vControl: TControl;
vHintString: string;
vForm: TForm;
vWinControl: TWinControl;
begin
result := (fHintTimeStamp = 0);
vForm := Screen.ActiveForm;
if not Assigned(vForm) then
exit;
if not boolean(GetCursorPos(vScreenPos)) then
exit;
vNow := Now;
vControl := nil;
vWinControl := vForm as TWinControl;
while Assigned(vWinControl) do
try
vClientPos := vWinControl.ScreenToClient(vScreenPos);
vControl := vWinControl.ControlAtPos(vClientPos, true, true, true);
if not Assigned(vControl) then
begin
vControl := vWinControl;
break;
end
else
if vControl is TWinControl then
vWinControl := vControl as TWinControl
else
vWinControl := nil;
except
exit; // in some cases ControlAtPos can fail with EOleError: Could not obtain OLE control window handle.
end;
if (fHintControl <> vControl) then
begin
if fHintVisible then
HideHint;
if Assigned(vControl) and HandleControl(vControl) then
begin
fHintControl := vControl;
fHintTimeStamp := vNow; // starts timer for hint to show
end
else
begin
fHintTimeStamp := 0;
fHintControl := nil;
end;
end
else
begin
if fHintVisible and (vNow > fHintHideTimeStamp) then
begin
HideHint;
end
else // we check HandleControl again here to make sure we still want to show the hint
if not fHintVisible and Assigned(vControl) and HandleControl(vControl) and (fHintTimeStamp > 0) and (vNow > IncMillisecond(fHintTimeStamp, fHintShowDelay)) then
begin
vHintString := GetHintForControl(vControl);
if vHintString = '' then
exit;
HintStyleController.ShowHint(vScreenPos.X + 0, vScreenPos.Y + 18, '', vHintString);
fHintTimeStamp := vNow;
fHintControl := vControl;
fHintVisible := true;
// base hide delay + dynamic part based on length of the hint string, 500 msec per 30 characters
fHintHideTimeStamp := vNow + IncMillisecond(0, fHintHideDelay) + ((Length(vHintString) div 20) * EncodeTime(0,0,0,500));
end
end;
result := (fHintTimeStamp = 0);
end;
end.

Search for a Label by its Caption

I was trying to figure out how to search for a Label by its Caption:
for I := ComponentCount - 1 downto 0 do
begin
if Components[i] is TLabel then
if Components[i].Caption = mnNumber then
begin
Components[i].Left := Left;
Components[i].Top := Top + 8;
end;
end;
I get an error: Undeclared identifier: 'Caption'.
How can I resolve this issue?
Iterating over Components[] is the wrong approach. That just yields the components that are owned by the form. You will miss any components that are added dynamically, and not owned by the form, or components that are owned by frames.
Instead you should use Controls[]. However, that only yields first generation children. If there is deeper parent/child nesting then you need to recurse. That's more work. I use some helpers to make it easy. I've wrapped them up in this unit:
unit ControlEnumerator;
interface
uses
System.SysUtils, System.Generics.Collections, Vcl.Controls;
type
TControls = class
private
type
TEnumerator<T: TControl> = record
FControls: TArray<T>;
FIndex: Integer;
procedure Initialise(WinControl: TWinControl; Predicate: TFunc<T, Boolean>);
class function Count(WinControl: TWinControl; Predicate: TFunc<T, Boolean>): Integer; static;
function GetCurrent: T;
function MoveNext: Boolean;
property Current: T read GetCurrent;
end;
TEnumeratorFactory<T: TControl> = record
FWinControl: TWinControl;
FPredicate: TFunc<T, Boolean>;
function Count: Integer;
function Controls: TArray<T>;
function GetEnumerator: TEnumerator<T>;
end;
public
class procedure WalkControls<T: TControl>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>; Method: TProc<T>); static;
class function Enumerator<T: TControl>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>=nil): TEnumeratorFactory<T>; static;
class function ChildCount<T: TControl>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>=nil): Integer; static;
end;
implementation
{ TControls.TEnumerator<T> }
procedure TControls.TEnumerator<T>.Initialise(WinControl: TWinControl; Predicate: TFunc<T, Boolean>);
var
List: TList<T>;
Method: TProc<T>;
begin
List := TObjectList<T>.Create(False);
Try
Method :=
procedure(Control: T)
begin
List.Add(Control);
end;
WalkControls<T>(WinControl, Predicate, Method);
FControls := List.ToArray;
Finally
List.Free;
End;
FIndex := -1;
end;
class function TControls.TEnumerator<T>.Count(WinControl: TWinControl; Predicate: TFunc<T, Boolean>): Integer;
var
Count: Integer;
Method: TProc<T>;
begin
Method :=
procedure(Control: T)
begin
inc(Count);
end;
Count := 0;
WalkControls<T>(WinControl, Predicate, Method);
Result := Count;
end;
function TControls.TEnumerator<T>.GetCurrent: T;
begin
Result := FControls[FIndex];
end;
function TControls.TEnumerator<T>.MoveNext: Boolean;
begin
inc(FIndex);
Result := FIndex<Length(FControls);
end;
{ TControls.TEnumeratorFactory<T> }
function TControls.TEnumeratorFactory<T>.Count: Integer;
begin
Result := TEnumerator<T>.Count(FWinControl, FPredicate);
end;
function TControls.TEnumeratorFactory<T>.Controls: TArray<T>;
var
Enumerator: TEnumerator<T>;
begin
Enumerator.Initialise(FWinControl, FPredicate);
Result := Enumerator.FControls;
end;
function TControls.TEnumeratorFactory<T>.GetEnumerator: TEnumerator<T>;
begin
Result.Initialise(FWinControl, FPredicate);
end;
class procedure TControls.WalkControls<T>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>; Method: TProc<T>);
var
i: Integer;
Control: TControl;
Include: Boolean;
begin
if not Assigned(WinControl) then begin
exit;
end;
for i := 0 to WinControl.ControlCount-1 do begin
Control := WinControl.Controls[i];
if not (Control is T) then begin
Include := False;
end else if Assigned(Predicate) and not Predicate(Control) then begin
Include := False;
end else begin
Include := True;
end;
if Include then begin
Method(Control);
end;
if Control is TWinControl then begin
WalkControls(TWinControl(Control), Predicate, Method);
end;
end;
end;
class function TControls.Enumerator<T>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>): TEnumeratorFactory<T>;
begin
Result.FWinControl := WinControl;
Result.FPredicate := Predicate;
end;
class function TControls.ChildCount<T>(WinControl: TWinControl; Predicate: TFunc<T, Boolean>): Integer;
begin
Result := Enumerator<T>(WinControl, Predicate).Count;
end;
end.
Now you can solve your problem like this:
var
lbl: TLabel;
....
for lbl in TControls.Enumerator<TLabel>(Form) do
if lbl.caption=mnNumber then
begin
lbl.Left := Left;
lbl.Top := Top + 8;
end;
Or you could make use of a predicate to put the caption test inside the iterator:
var
Predicate: TControlPredicate;
lbl: TLabel;
....
Predicate := function(lbl: TLabel): Boolean
begin
Result := lbl.Caption='hello';
end;
for lbl in TControls.Enumerator<TLabel>(Form, Predicate) do
begin
lbl.Left := Left;
lbl.Top := Top + 8;
end;
The final piece of information fell into place in your comment to Golez's answer: your Labels are created at run-time, so there's a chance they don't have the Form as an owner. You'll need to use the Controls[] array to look at all the controls that are parented by the form, and look recursively into all TWinControl descendants because they might also contain TLabel's.
If you're going to do this allot and for different types of controls, you'll probably want to implement some sort of helper so you don't repeat yourself too often. Look at David's answer for a ready-made solution that manages to include some "bells and whistles", beyond solving the problem at hand; Like the ability to use anonymous functions to manipulate the found controls, and it's ability use an anonymous function to filter controls based on any criteria.
Before you start using such a complicated solution, you should probably understand the simplest one. A very simple recursive function that simply looks at all TControls on all containers starting from the form. Something like this:
procedure TForm1.Button1Click(Sender: TObject);
procedure RecursiveSearchForLabels(const P: TWinControl);
var i:Integer;
begin
for i:=0 to P.ControlCount-1 do
if P.Controls[i] is TWinControl then
RecursiveSearchForLabels(TWinControl(P.Controls[i]))
else if P.Controls[i] is TLabel then
TLabel(P.Controls[i]).Caption := 'Test';
end;
begin
RecursiveSearchForLables(Self);
end;
Using David's generic code, the above could be re-written as:
procedure TForm1.Button1Click(Sender: TObject);
begin
TControls.WalkControls<TLabel>(Self, nil,
procedure(lbl: TLabel)
begin
lbl.Caption := 'Test';
end
);
end;
ComponentCount is only for the count. Use the Components array to find the actual components. For easy, you can put the label in a TLabel variable, which will also allow you to use label-specific properties that are not visible in TComponent. You could use with for this as well, but I think it degrades readability.
var
l: TLabel;
for I := ComponentCount -1 downto 0 do
begin
if Components[i] is TLabel then // Check if it is.
begin
l := TLabel(Components[i]); // Typecast, to reach it's properties.
if l.Caption = mnNumber then
begin
l.Left := Left;
l.Top := Top +8;
end;
end;
end;
The compiler doesn't know your Components[i] is a TLabel.
You need to cast your component to Tlabel like this:
for I := ComponentCount - 1 downto 0 do
begin
if Components[i] is TLabel then //here you check if it is a tlabel
if TLabel(Components[i]).Caption = mnNumber then //and here you explicitly tell the
begin //compiler to treat components[i]
TLabel(Components[i]).Left := Left; //as a tlabel.
TLabel(Components[i]).Top := Top + 8;
end;
end;
This is needed because components[i] doesn't know the caption.
Try this:
for I := ControlCount-1 downto 0 do
begin
if Controls[i] is TLabel then // Check if it is.
begin
if (Controls[i] as TLabel).Caption = mnNumber then
begin
(Controls[i] as TLabel).Left := Left;
(Controls[i] as TLabel).Top := Top +8;
end;
end;
end;

Delphi: Is it possible to have a combo box with disabled items in it?

How can I have TComboBox with some items that are disabled? I need the user to see these items, but not be able to select them.
Thanks!
Yes, and this is how to do it:
Drop a TComboBox on your form, and set Style to csOwnerDrawFixed. Then add the event handlers
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
const
INDENT = 3;
begin
with TComboBox(Control) do
begin
FillRect(Canvas.Handle, Rect, GetStockObject(WHITE_BRUSH));
inc(Rect.Left, INDENT);
if boolean(Items.Objects[Index]) then
SetTextColor(Canvas.Handle, clBlack)
else
SetTextColor(Canvas.Handle, clGray);
DrawText(Canvas.Handle,
PChar(Items[Index]),
length(Items[Index]),
Rect,
DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS)
end;
end;
and
procedure TForm1.ComboBox1CloseUp(Sender: TObject);
begin
with TComboBox(Sender) do
if (ItemIndex <> -1) and not boolean(Items.Objects[ItemIndex]) then
begin
beep;
Perform(CB_SHOWDROPDOWN, integer(true), 0);
end;
end;
Also, in the interface section of your form, prior to the declaration of the form class, add
TComboBox = class(StdCtrls.TComboBox)
protected
procedure WndProc(var Message: TMessage); override;
end;
and implement the WndProc as
procedure TComboBox.WndProc(var Message: TMessage);
function NextItemIsDisabled: boolean;
begin
result := (ItemIndex < Items.Count - 1) and
not boolean(Items.Objects[ItemIndex + 1]);
end;
procedure SelectNextEnabledItem;
var
i: Integer;
begin
for i := ItemIndex + 1 to Items.Count - 1 do
if boolean(Items.Objects[i]) then
begin
ItemIndex := i;
Exit;
end;
beep;
end;
procedure KillMessages;
var
msg: TMsg;
begin
while PeekMessage(msg,
Handle,
WM_KEYFIRST,
WM_KEYLAST,
PM_REMOVE) do;
end;
function PrevItemIsDisabled: boolean;
begin
result := (ItemIndex > 0) and
not boolean(Items.Objects[ItemIndex - 1]);
end;
procedure SelectPrevEnabledItem;
var
i: Integer;
begin
for i := ItemIndex - 1 downto 0 do
if boolean(Items.Objects[i]) then
begin
ItemIndex := i;
Exit;
end;
beep;
end;
begin
case Message.Msg of
WM_KEYDOWN:
case Message.WParam of
VK_DOWN:
if NextItemIsDisabled then
begin
SelectNextEnabledItem;
KillMessages;
Exit;
end;
VK_UP:
if PrevItemIsDisabled then
begin
SelectPrevEnabledItem;
KillMessages;
Exit;
end;
end;
end;
inherited;
end;
To test the combo box, write, for example
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.AddObject('Alpha', TObject(true));
ComboBox1.Items.AddObject('Beta', TObject(true));
ComboBox1.Items.AddObject('Gamma', TObject(false));
ComboBox1.Items.AddObject('Delta', TObject(true));
end;
I think you get the meaning of true and false here -- it simply means enabled.
It's not easy (and it's a bad idea, since that's not how comboboxes behave on Windows).
You'd have to owner draw the combobox yourself. Use the Items.Objects array to store whether or not the item is enabled or disabled, and check that array before drawing each item in order to set the colors appropriately.
You'd also need to handle the OnChange and OnClick events, and add a way to track the last selected ItemIndex. In OnChange/OnClick, you disconnect the event handler, check the Objects[ItemIndex] value to see if a selection is allowed, if not set the ItemIndex back to the last selected ItemIndex, and then re-enable the event handler.

Resources