In an FMX component, I have this definition:
published
property BackgroundColor: TColor read fBackgroundColor write fBackgroundColor;
end;
If BackgroundColor is set to a const, like clRed, then I get an EReadError "Error reading BackgroundColor: Invalid property value".
It works with a normal value, like $00FF8000. So why does the Object inspector let you select a const???
The workaround is to declare the property as TAlphaColor, but that means another conditional define in my combined VCL/FMX unit.
Is there any other way I can keep the property as TColor?
Delphi 10.3.2
I assume you mix TColors with TColor. Both are defined in System.UITypes:
TColor = -$7FFFFFFF-1..$7FFFFFFF;
TColors = TColorRec;
TColorRec = record ...
From Vcl.Graphics:
clRed = TColors.Red;
Maybe the following function could help you to convert the types
function AlphaColorToColor(const Color: TAlphaColor): TColor;
Unfortunately, No function ColorToAlphaColor is available in System.UITypes.
Uwe Raabe has published an own solution in the DelphiPraxis forum for this purpose:
function ColorToAlphaColor(Value: TColor): TAlphaColor;
var
CRec: TColorRec;
ARec: TAlphaColorRec;
begin
CRec.Color := Value;
ARec.A := CRec.A;
ARec.B := CRec.B;
ARec.G := CRec.G;
ARec.R := CRec.R;
Result := ARec.Color;
end;
See also here Convert TColor in TAlphaColor
Related
In Delphi 10.1 Berlin, I'm trying to change a picture on a form by loading a PNG image from a resource.
I've followed this:
Load image from embedded resource
and used a TWICImage to automatically handle different possible image formats.
In this case I specifically want to use a PNG for transparency.
For some reason the function I've created returns nothing.
However, if I call result.savetofile('test.png') within the function the resource is succesfully saved, which verifies that the resource exists in the EXE and has been found.
function LoadImageResource(NativeInstance: NativeUInt; ImageResource: string): TWICImage;
var
Strm: TResourceStream;
WICImage: TWICImage;
begin
Strm := TResourceStream.Create(NativeInstance, ImageResource, RT_RCDATA);
try
Strm.Position := 0;
WICImage := TWICImage.Create;
try
WICImage.LoadFromStream(Strm);
result := WICImage; //these return empty
result.savetofile('test.png'); //this succesfully saves the resource to disk
finally
WICImage.Free;
end;
finally
Strm.Free;
end;
end;
Outside of the function, if I attempt to assign the image by calling for example Image1.picture.assign(LoadFromResource(...)) or Image1.picture.graphic := LoadFromResource(...) nothing gets assigned. And If I then call Image1.savetofile('test.png') I get an access violation error.
What might I be missing?
The problem is that you are destroying the image that you return. It's important to understand that classes are reference types in Delphi. So after the assignment to Result, in your code, you still have only a single instance, but two references to that same single instance.
You need to remove the call to Free.
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
Result.LoadFromStream(Strm);
finally
Strm.Free;
end;
end;
A little tweak is needed to make the function exception safe:
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
try
Result.LoadFromStream(Strm);
except
Result.Free;
raise;
end;
finally
Strm.Free;
end;
end;
When you call the function it behaves like a constructor. It either succeeds and returns a new instance, handing over ownership to the caller. Or it raises an exception. Accordingly I would name the function CreateImageFromResource.
The Windows ribbon framework markup supports an EnablePinning attribute for the recent items menu in the application menu:
<ApplicationMenu.RecentItems>
<RecentItems CommandName="MRU" EnablePinning="true" />
</ApplicationMenu.RecentItems>
I expected that there would be a matching property that can be queried/updated at runtime, but I can't find a property key. Does anyone know if there is one, and, if so, what it is?
Alternatively, is there another way to turn pinning on/off at runtime? Neither the element nor its parent support application modes.
TIA
Clarification: What I'm trying to do is enable/disable pinning for the entire menu at runtime. I'm not concerned about the pin states of the individual items.
I'm not sure if you can modify the pinned state from existing entries but it's definitely possible to programmatically query the state and add new items with a specific state using the UI_PKEY_Pinned property:
https://msdn.microsoft.com/en-us/library/windows/desktop/dd940401(v=vs.85).aspx
Wrappers such as the Windows Ribbon Framework for Delphi or the Windows Ribbon for WinForms (.NET) provide an easy access to the API model. This CodeProject article also describes how to query/add recent items using C#.
If you want to change the state during runtime, you could for example query the state of all items, remove them from the list, adjust whetever you need and add them to the list again. Didn't do that yet, could be worth a try however.
Hmm... this will be quite difficult to accomplish as the flag is defined in the XML which will be compiled into a resource file that is linked to the application and then loaded on start up. You could create another resource definition and reload the ribbon if you want to disable/enable the flagging, but that's quite a lot overhead and certainly noticeable from an users perspective as it requires the creation of a new window handle.
I place the recent items by inside UpdateProperty
TRecentItem = class(TInterfacedObject, IUISimplePropertySet)
private
FRecentFile: TSSettings.TRecentFile;
protected
function GetValue(const key: TUIPropertyKey; out value: TPropVariant): HRESULT; stdcall;
public
procedure Initialize(const RecentFile: TSSettings.TRecentFile); safecall;
end;
function TMyForm.UpdateProperty(commandId: UInt32; const key: TUIPropertyKey;
currentValue: PPropVariant; out newValue: TPropVariant): HRESULT;
var
I: Integer;
psa: PSafeArray;
pv: Pointer;
RecentItem: TRecentItem;
begin
if (key = UI_PKEY_RecentItems) then
begin
psa := SafeArrayCreateVector(VT_UNKNOWN, 0, Settings.RecentFiles.Count);
if (not Assigned(psa)) then
Result := E_FAIL
else
begin
for I := 0 to Settings.RecentFiles.Count - 1 do
begin
RecentItem := TRecentItem.NewInstance() as TRecentItem;
RecentItem.Initialize(Settings.RecentFiles[I]);
pv := Pointer(IUnknown(RecentItem));
Check(SafeArrayPutElement(psa, I, pv^));
end;
Result := UIInitPropertyFromIUnknownArray(UI_PKEY_RecentItems, psa, PropVar);
SafeArrayDestroy(psa);
end;
end;
If a pin was changed, I get this command while closing the application menu:
function TMyForm.Execute(commandId: UInt32; verb: _UIExecutionVerb;
key: PUIPropertyKey; currentValue: PPropVariant;
commandExecutionProperties: IUISimplePropertySet): HRESULT; stdcall;
var
Count: Integer;
I: Integer;
Pinned: Boolean;
psa: PSafeArray;
pv: IUnknown;
RecentFile: UInt32;
SimplePropertySet: IUISimplePropertySet;
Value: TPropVariant;
begin
if ((commandId = cmdAppRecentItems)
and Assigned(key) and (key^ = UI_PKEY_RecentItems)
and Assigned(currentValue) and (currentValue^.vt = VT_ARRAY + VT_UNKNOWN)) then
begin
psa := nil;
Result := UIPropertyToIUnknownArrayAlloc(key^, currentValue^, psa);
if (Succeeded(Result)) then
begin
Result := SafeArrayGetUBound(psa, 1, Count);
for I := 0 to Count do
if (Succeeded(Result)) then
begin
Result := SafeArrayGetElement(psa, I, pv);
if (Succeeded(Result) and Assigned(pv)) then
begin
Result := pv.QueryInterface(IUISimplePropertySet, SimplePropertySet);
if (Succeeded(Result)) then
Result := SimplePropertySet.GetValue(UI_PKEY_Pinned, Value);
if (Succeeded(Result)) then
Result := UIPropertyToBoolean(UI_PKEY_Pinned, Value, Pinned);
if (Succeeded(Result)) then
Settings.RecentFiles.SetPinned(I, Pinned);
end;
end;
SafeArrayDestroy(psa);
end;
end
end;
... but I didn't find a documentation of this solution.
Good day,
I have different handles from different non VLC Objects like (SysListView32, ToolbarWin32) and I am wondering if there is any method to cast these handles (HWND).
For example, I got the start button(which is in the left bottom of desktop) handle. Then I found the class name "Button".
I would like to cast him and retrieve from him the caption property "start". For example:
type
TButtonStartMenuFictiveClass = class(TButton)
public
Text: string;
end;
if classname = 'button' then
begin
ShowMessage((objecthandle as TButtonStartMenuFictiveClass).Text);
end;
I am looking to hook all of the objects and to display the text of them. Like the narrator from Windows.
In some cases, you can instantiate a VCL object and assign the external HWND to its WindowHandle property, eg:
var
S: String;
with TButton.Create(nil) do
try
WindowHandle := TheButtonWnd;
try
S := Caption;
finally
WindowHandle := 0; // important
end;
finally
Free;
end;
As I explained in your previous question, you need to use the Windows API to gain access to the properties of a foreign window-control. You can't simply cast a window-handle to an object. They're not pointers to Delphi objects.
The example I linked you too not only shows the classname of the control you're hovering over, but also the caption (text) of the control. This function will also do the trick:
function GetWndText(const Handle: Hwnd): string;
var
Len: Integer;
begin
Len := GetWindowTextLength(Handle) + 1;
SetLength(Result, Len);
GetWindowText(Handle, PChar(Result), Len);
end;
Some background (kind of a continuation of TLabel and TGroupbox Captions Flicker on Resize):
So, I have an application that loads different plugins and creates a
new tab on a TPageControl for each one.
Each DLL has a TForm associated with it.
The forms are created with their parent hWnd as the new TTabSheet.
Since the TTabSheets aren't a parent of the form as far as VCL is
concerned (didn't want to use dynamic RTL, and plugins made in
other languages) I have to handle resizes manually.
I just seem to be running into a lot of new issues (but great learning experiences) for this "plugin" type of application.
So, my current struggle is trying to have a plugin that doesn't get inserted into a TTabSheet but will be resized and aligned directly on the form.
Since this would be easier to explain with a picture:
Now I could manually do the alignment and the resize, but I'd much rather have the VCL alignment procedures (alClient, alTop, etc) do it for me. That way I would just have to set the plugins alignment on its form without thinking.
After looking through the VCL source I began to step through the align code and how it's called. Basically when a TControl gets a WM_RESIZE it will:
Call Realign() which calls AlignControl()
AlignControl() will get the client rect and call AlignControls()
AlignControls() will call DoAlign() for each TAlignment type in this order: alTop, alBottom, alLeft, alRight, alClient, alCustom, alNone
DoAlign() will loop through FControls and FWinControls (which are TLists) and will align them appropriately
So my thought process is that if I create a new TWinControl, set it's handle to the plugins form (window) handle, and insert it into the FControls list with the proper align it should do my work for me.
Of course I'm here, so it failed miserably. I even get an AV when exiting the application about an invalid window handle. My guess is that the TWinControl I created is trying to free the handle of the plugins form (window) which doesn't exist any more.
What I've tried:
procedure AddHandleToControlList(AHandle: DWORD; Align: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
NewWinControl.WindowHandle := AHandle;
NewWinControl.Align := Align;
NewWinControl.Width := frmMain.ClientWidth;
NewWinControl.Height := 30;
NewWinControl.Parent := frmMain;
end;
procedure AddHandleToControlList(AHandle: DWORD; Align: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
NewWinControl.WindowHandle := AHandle;
NewWinControl.Align := Align;
NewWinControl.Width := frmMain.ClientWidth;
NewWinControl.Height := 30;
TWinControl(frmMain).Insert(NewWinControl);
end;
Soooo, thoughts?
EDIT 1:
Ok, so this correctly adds the control to the list and conforms the the TAlign set (why is it that I spend 8 hours trying to figure something out, I post here, and then the answer just appears...oh well someone might find this question and my ramblings useful):
procedure AddHandleToControlList(AHandle: DWORD; AName: PChar; ATop, ALeft, AWidth, AHeight: Integer; AAlign: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
With NewWinControl Do
begin
Name := AName;
Top := ATop;
Left := ALeft;
Width := AWidth;
Height := AHeight;
Align := AAlign;
WindowHandle := AHandle;
Visible := True;
end;
TWinControl(frmMain).InsertControl(NewWinControl);
end;
The issue now is that when the application closes, I get the invalid error AV...I shall continue!!
EDIT 2:
Ok, so it is TWinControl.DestroyWindowHandle that raises the AV because the window handle doesn't exist any more. I'm trying to think of a clean solution.
Derive a new class from TWinControl and override its virtual DestroyWindowHandle() method to not free the HWND you provide. The default implementation of TWinControl.DestroyWindowHandle() calls the Win32 API DestroyWnd() function.
I'm trying to iterate all the controls on a form and enable ClearType font smoothing. Something like this:
procedure TForm4.UpdateControls(AParent: TWinControl);
var
I: Integer;
ACtrl: TControl;
tagLOGFONT: TLogFont;
begin
for I := 0 to AParent.ControlCount-1 do
begin
ACtrl:= AParent.Controls[I];
// if ParentFont=False, update the font here...
if ACtrl is TWinControl then
UpdateControls(Ctrl as TWinControl);
end;
end;
Now, is there a easy way to check if ACtrl have a Font property so i can pass the Font.Handle to somethink like:
GetObject(ACtrl.Font.Handle, SizeOf(TLogFont), #tagLOGFONT);
tagLOGFONT.lfQuality := 5;
ACtrl.Font.Handle := CreateFontIndirect(tagLOGFONT);
Thank you in advance.
You use TypInfo unit, more specifically methods IsPublishedProp and GetOrdProp.
In your case, it would be something like:
if IsPublishedProp(ACtrl, 'Font') then
ModifyFont(TFont(GetOrdProp(ACtrl, 'Font')))
A fragment from one of my libraries that should put you on the right path:
function ContainsNonemptyControl(controlParent: TWinControl;
const requiredControlNamePrefix: string;
const ignoreControls: string = ''): boolean;
var
child : TControl;
iControl: integer;
ignored : TStringList;
obj : TObject;
begin
Result := true;
if ignoreControls = '' then
ignored := nil
else begin
ignored := TStringList.Create;
ignored.Text := ignoreControls;
end;
try
for iControl := 0 to controlParent.ControlCount-1 do begin
child := controlParent.Controls[iControl];
if (requiredControlNamePrefix = '') or
SameText(requiredControlNamePrefix, Copy(child.Name, 1,
Length(requiredControlNamePrefix))) then
if (not assigned(ignored)) or (ignored.IndexOf(child.Name) < 0) then
if IsPublishedProp(child, 'Text') and (GetStrProp(child, 'Text') <> '') then
Exit
else if IsPublishedProp(child, 'Lines') then begin
obj := TObject(cardinal(GetOrdProp(child, 'Lines')));
if (obj is TStrings) and (Unwrap(TStrings(obj).Text, child) <> '') then
Exit;
end;
end; //for iControl
finally FreeAndNil(ignored); end;
Result := false;
end; { ContainsNonemptyControl }
There's no need to use RTTI for this. Every TControl descendant has a Font property. At TControl level its visibility is protected but you can use this workaround to access it:
type
THackControl = class(TControl);
ModifyFont(THackControl(AParent.Controls[I]).Font);
One other thing worth mentioning. Every control has a ParentFont property, which - if set - allows the Form's font choice to ripple down to every control. I tend to make sure ParentFont is set true wherever possible, which also makes it easier to theme forms according to the current OS.
Anyway, surely you shouldn't need to do anything to enable ClearType smoothing? It should just happen automatically if you use a TrueType font and the user has enabled the Cleartype "effect".
Here's a C++Builder example of TOndrej's answer:
struct THackControl : TControl
{
__fastcall virtual THackControl(Classes::TComponent* AOwner);
TFont* Font() { return TControl::Font; };
};
for(int ControlIdx = 0; ControlIdx < ControlCount; ++ControlIdx)
{
((THackControl*)Controls[ControlIdx])->Font()->Color = clRed;
}