I'm using Delphi Seattle with the theme of Windows 10, creating programs for Windows Desktop.
In a TEdit if the active NumbersOnly property, when trying to type words, you see a standard Windows hint.
If I leave the program without the theme, the hint appears correctly, with the message explaining that you can only enter numbers. But if the active theme the message is unreadable.
Anyone have any idea where I can change this, because I was looking inside the Vcl.StdCtrls.pas and could not find the time that is generated this message to the user.
Correct hint:
Wrong hint:
This issue was fixed in RAD Studio 10.1 Berlin. But if you can't upgrade your RAD Studio Version try the VCL Styles Utils project which includes a fix for this. Only you need add the Vcl.Styles.Utils.ScreenTips unit to your project.
Update to Delphi 10.1 (Berlin) - it seems to be fixed there as I cannot reproduce this while I can with 10.0 (Seattle).
The bugfix list for Berlin shows several issues being fixed that are related to VCL Styles.
A workaround for this is to not rely on the rather useless Microsoft implementation behind the ES_NUMBER style, but implement your own logic.
type
TEdit = class(VCL.StdCtrls.TEdit)
protected
FInsideChange: boolean;
function RemoveNonNumbers(const MyText: string): string;
procedure KeyPress(var Key: Char); override;
procedure Change; override;
end;
procedure TEdit.KeyPress(var Key: Char);
begin
if NumbersOnly then begin
if not(Key in ['0'..'9','-',#8,#9,#10,#13,#127]) then begin
Key:= #0;
//Put user feedback code here, e.g.
MessageBeep;
StatusBar.Text:= 'Only numbers allowed';
end else StatusBar.Text:= '';
end;
inherited KeyPress(Key);
end;
procedure TEdit.Change; override;
begin
if FInsideChange then exit;
FInsideChange:= true;
try
inherited Change;
Self.Text:= RemoveNonNumbers(Self.Text);
finally
FInsideChange:= false;
end;
end;
function TEdit.RemoveNonNumbers(const MyText: string): string;
var
i,a: integer;
NewLength: integer;
begin
NewLength:= Length(MyText);
SetLength(Result, NewLength);
a:= 1;
for i:= 1 to Length(MyText) do begin
if MyText[i] in ['0'..'9'] or ((i=1) and (MyText[i] = '-')) then begin
Result[a]:= MyText[i];
Inc(a);
end else begin
Dec(NewLength);
end;
end; {for i}
SetLength(Result, NewLength);
end;
Now non-numbers will not be accepted, not even when pasting text.
Related
This follows on from my answer to this Q:
Can I change the display format for strings in the watch list?
It turns out that at some point between D7 and XE3, the implementation of the IDE's Watch Window changed from using a TListView to a TVirtualStringTree.
Although I posted an update to my answer that works with XE4 by ignoring the VST and getting the watch value from the clipboard, I'd still like to be able to get the watch value from the VST if I can. I think I know how to do that
once I have a reference to the VST but the problem is that my attempt to get one fails.
Following is an MCVE of the code I'm using in my custom package. Hopefully, what it does is self-explanatory. The problem is that the code in the block
if WatchWindow.Components[i] is TVirtualStringTree then begin
[...]
end;
never executes, DESPITE the classname "TVirtualStringTree" appearing in Memo1. Obviously the component with that classname fails the "is" test. I'm guessing that the reason is that the TVirtualTreeView compiled into the IDE is a different version that the one I'm using, v.5.3.0, which is the nearest predecessor I could find to XE4.
So, my question is, is that the likely explanation, and is there anything I can do about it? I suspect if someone can flourish the version of TVirtualStringTree that was used for XE4 from a hat, that might solve my problem.
type
TOtaMenuForm = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
WatchWindow : TForm;
VST : TVirtualStringTree;
end;
procedure TOtaMenuForm.FormCreate(Sender: TObject);
var
i : Integer;
S : String;
begin
WatchWindow := Nil;
VST := Nil;
// Iterate the IDE's forms to find the Watch Window
for i := 0 to Screen.FormCount - 1 do begin
S := Screen.Forms[i].Name;
if CompareText(S, 'WatchWindow') = 0 then begin
WatchWindow := Screen.Forms[i];
Break;
end;
end;
Assert(WatchWindow <> Nil);
if WatchWindow <> Nil then begin
Memo1.Lines.Add('Looking for VST');
for i := 0 to WatchWindow.ComponentCount - 1 do begin
Memo1.Lines.Add(IntToStr(i) + ':' + WatchWindow.Components[i].ClassName);
if WatchWindow.Components[i] is TVirtualStringTree then begin
VST := TVirtualStringTree(WatchWindow.Components[i]);
Memo1.Lines.Add('found VST');
Break;
end;
end;
if VST = Nil then
Memo1.Lines.Add('VST not found');
end;
end;
Btw, I realise that solutions that depend of implementational details of IDE are likely to be fragile, but this is just for amusement (I liked the challenge of getting string data out of a component that goes out of its way to avoid storing any).
May be You can try to use only published properties of embedded into IDE TVirtualStringTree implementation through RTTI methods to do what you want?
I recently migrated from D2010 to DXE2 and found a showstopper bug (Or feature?) in XE2 and XE3 (Tested in my friend XE3) related to RTTI generation for TBytes fields inside classes.
I found that the RTTI information for a TBytes variable inside a class is never generated.
The following code works well in D2010, but shows the message "Error" in XE2/XE3
Does anyone have any clue? This will totally break all our software data serialization implementation
To test the code please add Rtti unit to the uses declaration
type
TMyClass = class
public
Field1: Integer;
Field2: TBytes;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
Data: TMyClass;
Rtti: TRttiContext;
RttiClassType: TRttiInstanceType;
begin
Data := TMyClass.Create;
try
// Get the context
Rtti := TRttiContext.Create;
try
// Get the type for the class
RttiClassType := TRttiInstanceType(Rtti.GetType(Data.ClassInfo));
// Check the fields
for i := 0 to High(RttiClassType.GetFields) do
begin
// Check the field type
if not Assigned(RttiClassType.GetFields[i].FieldType) then
ShowMessage('Error');
end;
finally
Rtti.Free;
end;
finally
Data.Free;
end;
end;
The error message will be displayed when checking for Field2 that is a TBytes becayse the FieldType is always nil!!!
Does anyone has any clue of what have changed in the RTTI from D2010 do XE2? Maybe because the TBytes type was changed from array of Byte to the generic array?
You can fix this error (it is actually not the same bug as the one Mason mentioned).
type
FixTypeInfoAttribute = class(TCustomAttribute)
public
FTypeInfo: PPTypeInfo;
constructor Create(TypeInfo: PTypeInfo);
end;
procedure FixFieldType(TypeInfo: PTypeInfo);
var
ctx: TRttiContext;
t: TRttiType;
f: TRttiField;
a: TCustomAttribute;
n: Cardinal;
begin
t := ctx.GetType(TypeInfo);
for f in t.GetFields do
begin
for a in f.GetAttributes do
begin
if (a is FixTypeInfoAttribute) and f.ClassNameIs('TRttiInstanceFieldEx') then
begin
WriteProcessMemory(GetCurrentProcess, #PFieldExEntry(f.Handle).TypeRef,
#FixTypeInfoAttribute(a).FTypeInfo, SizeOf(Pointer), n);
end;
end;
end;
end;
constructor FixTypeInfoAttribute.Create(TypeInfo: PTypeInfo);
begin
FTypeInfo := PPTypeInfo(PByte(TypeInfo) - SizeOf(Pointer));
end;
Then you add the attribute to your class definition:
type
TMyClass = class
private
Field1: Integer;
[FixTypeInfo(TypeInfo(TBytes))]
Field2: TBytes;
end;
and make sure the FixFieldType routine is called:
initialization
FixFieldType(TypeInfo(TMyClass));
Tested on XE
This is a known issue that was fixed in XE3. Unfortunately, upgrading is the only way to get a fix for it; bug fixes don't usually get ported back.
EDIT: Or not. Apparently this is not actually fixed, as it still occurs in XE3. Reporting it as a new case and mentioning 103729 would probably be the best course of action.
I am requiring a Memo with Auto-completion functionality.
Ultimately, I would like the ability to display a custom auto-completion list when the user presses a hotkey (Ctrl-space) similar to Delphi IDE auto-completion.
I have the TMS AdvMemo, but to be honest the help for this particular component is lacking. It appears the AdvMemo supports custom auto completion, but I cant seem to find out how to display a list.
So, if anyone has any suggestions to achieve auto completion on a memo, or to enlighten me as the use of the AdvMemo, it would be appreciated
I decided to write some handlers for a TMemo using a TPopupmenu as the autocomplete list.
For those that read this please refer to my other post:
Delphi - Get the whole word where the caret is in a memo (thanks to RRUZ)
And the following code:
OnPopup for the AutoComplete TPopupMenu: (memoAutoComplete hold the list of autocomplete items)
procedure AutoCompletePopup(Sender: TObject);
var i : integer;
NewItem : TMenuItem;
AutoCompleteToken: String;
begin
//filter list by token
AutoCompleteToken := SelectWordUnderCaret(edtComment);
AutoComplete.Items.Clear;
for i:=0 to memoAutoComplete.Lines.Count -1 do
begin
if SameText(LeftStr(memoAutoComplete.Lines.Strings[i],Length(AutoCompleteToken)),AutoCompleteToken) then
begin
NewItem := TMenuItem.Create(AutoComplete);
NewItem.Caption := memoAutoComplete.Lines.Strings[i];
NewItem.OnClick := AutoComplete1Click;
NewItem.OnMeasureItem := AutoComplete1MeasureItem;
NewItem.OnAdvancedDrawItem := AutoComplete1AdvancedDrawItem;
AutoComplete.Items.Add(NewItem);
end;
end;
end;
And for the Tmemo:
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var pt : TPoint;
begin
if (Key = VK_SPACE) and (GetKeyState(VK_CONTROL) < 0) then
begin
pt := Memo1.ClientToScreen(Point(0,Memo1.Height));
AutoComplete.Popup(pt.X,pt.Y);
end;
end;
You can have a look at SynEdit. It's free, open source and has an active community to help you out when you get stuck.
I have a Delphi 2010 app which shows/hides the desktop icons under XP fine. However under my Window 7 test environment (happens to be 64 bit) the icons don't disappear.
Here is the critical code I am using (for the hide):
ShowWindow(FindWindow(nil, 'Program Manager'), SW_HIDE );
I have found I can set the registry:
[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced]
"HideIcons"=dword:00000001
And that works fine if I restart windows (or kill explorer and restart it), however is there a way to get the old code to work and/or tell the desktop to reload using the new registry information without such radical methods.
Thank in advance.
Use SHGetSetSettings function. You're interested in fHideIcons field and corresponding SSF_HIDEICONS flag.
Alternatively, you can use corresponding group policy.
Ok, here is the revised hackish method (sorry Alexander!):
var
DeskHandle : HWND;
...
///////////////////////////////////////////////////////////////////////
// Callback function for EnumWindows
///////////////////////////////////////////////////////////////////////
function MyGetWindow (Handle: HWND; NotUsed: longint): bool; stdcall;
var
hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView' ,nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32' ,nil);
if hChild <> 0 then
begin
DeskHandle := hChild;
end;
end;
end;
result := TRUE;
end;
procedure ShowDesktopIcons(const Show : boolean) ;
begin
DeskHandle := 0;
EnumWindows(#MyGetWindow, 0);
if DeskHandle <> 0 then
begin
if Show then
begin
ShowWindow(DeskHandle, SW_SHOW );
end
else
begin
ShowWindow(DeskHandle, SW_HIDE );
end;
end;
end;
The issue arises because parent/child relationship between "Progman" and SysListView32 has changed from XP to Vista/Win7 (precisely why you shouldn't use a hack ;-). In addition, applying a theme with multiple pictures under Win7 (my test environment) changes this relationship even further. Therefore the new routine looks through all windows until it finds one with a "SHELLDLL_DefView" and "SysListView32" child set under one. It then returns the handle of SysListView32 in the global variable DeskHandle. Not elegant, not sure to work in future code, but works today.
If anyone can get a SHGetSetSettings version to work, that is definitely the correct way to go, not this junk.
Use 'ProgMan' instead of 'Program Manager'.
Works in Win 7 32 bits (don't have my 64 bits available here).
procedure ShowDesktopIcons(const Visible: Boolean);
var
h: THandle;
begin
h := FindWindow('ProgMan', nil);
if h = 0 then
RaiseLastOSError;
if Visible then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_HIDE);
end;
procedure TForm1.btnHideClick(Sender: TObject);
begin
ShowDesktopIcons(False);
end;
procedure TForm1.btnShowClick(Sender: TObject);
begin
ShowDesktopIcons(True);
end;
This question already has answers here:
How do I make my GUI behave well when Windows font scaling is greater than 100%
(4 answers)
Closed 8 years ago.
Which do you think are best practices for making a windows dialog compatible both with standard fonts (96 dpi) and "large fonts" setting (120 dpi) so that objects don't overlap or get cut off?
BTW: Just in case it's relevant, I'm interested in doing this for Delphi dialogs.
Thanks in advance!
In general one should use layout managers for this purpose. That what they are designed for.
Delphi (did not work with it for a long time) does not have such managers but is able to handle different dpi ever since. You have to use the autosize propery of the components to ensure that they have the right size for the text they display. To prevent overlapping of components arrange them on the form using the alignment and anchor properties. Eventually you have to group components in containers to achieve a proper layout.
There's a pretty good article in the D2007 help file, under "Considerations When Dynamically Resizing Forms and Controls" (note that the URL is to the help file itself, and not a web page as such).
The same topic, under the same name, can be found in the D2010 help file (same caveat about the URL as above), or on the docwiki.
It also is worthwhile (at least a little bit) to examine TForm.Scaled and TForm.ScaleBy.
This is how I try to deal with Delphi VCL's pixels regardless of Window's font size setting.
unit App.Screen;
interface
uses Controls;
type
TAppScreen = class(TObject)
private
FDefaultPixelsPerInch: integer;
FPixelsPerInch: integer;
function GetPixelsPerInch: integer;
procedure SetPixelsPerInch(const Value: integer);
public
procedure AfterConstruction; override;
function DefaultPixelsPerInch: integer;
function InAcceptableRange(const aPPI: integer): boolean;
procedure ScaleControl(const aControl: TWinControl);
property PixelsPerInch: integer read GetPixelsPerInch write SetPixelsPerInch;
end;
TAppScreenHelper = class helper for TAppScreen
private
class var FInstance: TAppScreen;
class function GetInstance: TAppScreen; static;
public
class procedure Setup;
class procedure TearDown;
class property Instance: TAppScreen read GetInstance;
end;
implementation
uses
TypInfo, Windows, SysUtils, Forms, Graphics;
type
TScreenEx = class(TScreen)
published
property PixelsPerInch;
end;
TScreenHelper = class helper for TScreen
public
procedure SetPixelsPerInch(Value: integer);
end;
procedure TScreenHelper.SetPixelsPerInch(Value: integer);
begin
PInteger(Integer(Self) + (Integer(GetPropInfo(TScreenEx, 'PixelsPerInch').GetProc) and $00FFFFFF))^ := Value;
end;
procedure TAppScreen.AfterConstruction;
begin
inherited;
FDefaultPixelsPerInch := Screen.PixelsPerInch;
FPixelsPerInch := FDefaultPixelsPerInch;
end;
function TAppScreen.DefaultPixelsPerInch: integer;
begin
Result := FDefaultPixelsPerInch;
end;
function TAppScreen.GetPixelsPerInch: integer;
begin
Result := FPixelsPerInch;
end;
function TAppScreen.InAcceptableRange(const aPPI: integer): boolean;
begin
if DefaultPixelsPerInch > aPPI then
Result := DefaultPixelsPerInch * 0.55 < aPPI
else if DefaultPixelsPerInch < aPPI then
Result := DefaultPixelsPerInch * 1.55 > aPPI
else
Result := True;
end;
procedure TAppScreen.ScaleControl(const aControl: TWinControl);
begin
aControl.ScaleBy(PixelsPerInch, DefaultPixelsPerInch);
end;
procedure TAppScreen.SetPixelsPerInch(const Value: integer);
begin
FPixelsPerInch := Value;
Screen.SetPixelsPerInch(FPixelsPerInch);
end;
class function TAppScreenHelper.GetInstance: TAppScreen;
begin
if FInstance = nil then
FInstance := TAppScreen.Create;
Result := FInstance;
end;
class procedure TAppScreenHelper.Setup;
begin
TAppScreen.Instance;
end;
class procedure TAppScreenHelper.TearDown;
begin
FInstance.Free;
FInstance := nil;
end;
initialization
TAppScreen.Setup;
finalization
TAppScreen.TearDown;
end.
Try the following to test the effects of different pixels value:
TAppScreen.Instance.PixelsPerInch := 120;
TAppScreen.Instance.PixelsPerInch := 96;
TAppScreen.Instance.PixelsPerInch := 150;
You should change the PixelsPerInch before instantiate TForm's descendant including Delphi's VCL dialogs.
Never put a control and its describing label side by side, always put the label on top of it.
But apart from that? Maybe:
Leave enough space to the right and bottom of labels so they will not overlap with other controls when large fonts are used.
I have never tried using TLabeledEdit in that scenario, maybe they do that automatically?
There are purported commercial solutions (Developer Express VCL Layout Manager). But I do not trust any of them. I suspect that Embarcadero should address this as a critical weakness in the current UI component set (VCL).
I think that the third-party component set might be your fastest solution right now. It's commercial but not hugely expensive.
http://www.devexpress.com/products/VCL/ExLayoutControl/