I have a control derived from TImage32:
TChromaDisplay = class(TImage32)
Everything is fine except that when I drop my TChromaDisplay on the form, the resulted DFM file is huge (300KB instead of <1KB) because I have garbage data (it is just a gray image) saved in the Bitmap.Data field. The Bitmap image is created and filled with gray color every time I drop my control on a form. I don't want to save the content of the image (garbage) to the DFM file since it makes the EXE larger but I don't know how.
Probably I need to write somewhere in TChromaDisplay.Create that I don't have any image data saved/stored in my TChromaDisplay. But I don't know where/how to do it.
object Display: TChromaDisplay
Left = 0
Top = 0
Width = 1465
Height = 246
Bitmap.Data = {
C0000000C0000000EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
etc
etc
etc
I have tried this in Create but won't help:
Bitmap.Width := 1;
Bitmap.Height:= 1;
Update:
Looking at design time image dialog GR32_Dsgn_Bitmap.pas for TImage32.Bitmap property, the Clear button there uses the Bitmap.Delete procedure what just sets the bitmap size to 0x0. So you can try to call it to clear the bitmap before the form stream is saved:
type
TChromaDisplay = class(TImage32)
protected
procedure WriteState(Writer: TWriter); override;
end;
implementation
procedure TChromaDisplay.WriteState(Writer: TWriter);
begin
Bitmap.Delete;
inherited;
end;
But it still doesn't explain why you have a bitmap data when you put a control on the form. You can also call the Bitmap.Delete in your control constructor after inherited part is done (when the Bitmap is already instantiated).
Still untested, since I can't simulate your problem.
This is not "garbage". It's an image (whether it's one you assigned or one that the control creates in it's constructor). It's a bitmap located at position 0, 0 with a width and height of 1465, 246.
The BitmapData is the data in the bitmap (the pixels, etc.), encoded as a hex string so it will go in the text dfm.
The solution is to figure out how the bitmap is being assigned. It's either:
In the component's constructor (a default image?)
On your form (you've assigned an image in the IDE)
It's not being removed from the DFM from a previous time it was assigned.
The first one requires that you closely examine the source code of the component to figure out where it's being assigned. You can check to see what the bitmap property is called internally (for instance, FBitmap or FImage), and then search for places it gets an image assigned (LoadFromFile, LoadFromStream, LoadFromResource, Assign, and so forth).
The second and third: Backup your dfm just in case. Delete the component from your form. Comment out any code related to it, so your unit will compile. Right-click it, and choose View as Text. Search for TChromaDisplay (or just TChroma), and delete everything you find in the dfm related to it. Right-click and chhose View as Form, and then build your project. Go back into the dfm and make sure all traces of TChroma are still gone.
Related
Using Delphi Tokyo 10.2, with Stylized Themes. I am trying to highlight components on the form, e.g., ComboBoxes, EditTexts, etc. For example, if a user entered invalid data, I would like to highlight the component.
In the past, we just colored components Red, and the color persisted through resizes/movement/repaints in general. Now with theming, we need to do a bit more to get the color to show and persist.
I have tried disabling each component's StyleElements [seFont, seClient, seBorder] properties to force show the color. This works but seems kludgy, particularly when there are many components being validated. Also, simply coloring a component red might not look right with some of the themes.
I have also tried simply drawing a red rectangle around the components using WinAPI SetRop2(..). E.g., here is some clever code, I tweaked to take a TWinControl and Draw a redbox around it; I can also remove the redbox using a similar call. This works:
…but doesn't persist through repaints, obviously. It seems like adding custom paint methods might be an overkill here. Unless, there is some better way?
Other things I have considered:
All of the components sit on panels, and I have considered using a protected hack to draw red rects on the panel's canvas around the components, but again, more custom paint routines…
I am also considering drawing TShapes dynamically as needed, but this strikes me as silly.
There must be others in the same situation, e.g., data entry validation that worked neatly in older versions of Delphi, but doesn't look so good when themed. What is the best approach when using themes? The SetRop2(..) approach seems to be the cleanest, but can someone suggest a simple way to make the color persist? I would welcome other ideas, too. Thank you.
EDIT
So maybe, just dynamically drawing TShapes around the invalid responses isn't so bad. They persist through repaints and don't descend from TWinControl, meaning they automatically show up behind the control they are highlighting.
This works quite well for me and I hope it's helpful to others.
// assuming owning control will be free'd properly and
// will in turn free HI_LITE Box.
//
// tantamount to adding an instance variable, TShape, to existing Control,
// since class helpers don't allow. And I don't want to descend
// new controls just to have a hiLiteBox Instance Variable.
procedure HiLiteMe(aControl : TWinControl; HILITE_FLAG : Boolean = TRUE; aColor : TColor = clRed);
const OFFSET = 4; // specify the offset of the border size of the box.
const BOX_NAME_PREFIX = 'HI_LITE_BOX_';
var
hiLiteBox : TShape; // reference created on stack, but object created on the heap,
uniqueBoxName : String; // so use the persistent aControl's owned component list to maintain the reference.
begin
uniqueBoxName := BOX_NAME_PREFIX + aControl.Name; // uniquename for each associated HiLiteBox.
HiLiteBox := aControl.FindComponent(uniqueBoxName) as TShape; // phishing for the HiLiteBox if it was previously created.
if NOT Assigned(hiLiteBox) then // create HiLiteBox and make persist outside this proc.
begin
if NOT HILITE_FLAG then exit; // don't create a box if we're just going to hide it anyway.
hiLiteBox := TShape.Create(aControl); // Create HiLiteBox, setting aControl as owner, quicker retrieval using aControl.findComponent
hiLiteBox.Parent := aControl.Parent; // Render the box on the control's parent, e.g., panel, form, etc.
hiLiteBox.Name := uniqueBoxName;
hiLiteBox.Pen.Color := aColor; // Color the Pen
hiLiteBox.Pen.Width := offset-1; // Make the Pen just slightly smaller than the offset.
hiLiteBox.Brush.Color := clWindow; // Choose a brush color, to fill the space between the pen and the Control
hiLiteBox.Left := aControl.Left - offset;
hiLiteBox.Width := aControl.Width + offset*2;
hiLiteBox.Top := aControl.Top - offset;
hiLiteBox.Height := aControl.Height + offset*2;
end;
hiLiteBox.Visible := HILITE_FLAG; // Show/Hide HiLite as appropriate.
end;
Called like this to HiLite with a red and blue box...
begin
HiLiteMe(checkListBox1, TRUE, clRed); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, TRUE, clBlue); // Draw a Blue Box around the Button, e.g., Required.
end;
Called like this to remove HiLites…
begin
HiLiteMe(checkListBox1, FALSE); // Draw a RedBox around the CheckListBox, e.g., Invalid.
HiLiteMe(bitBtn3, FALSE); // Draw a Blue Box around the Button, e.g., Required.
end;
I suggest having a red TShape on only one side of the control (e.g. just the left or bottom) that you show or hide.
I Put a TImageEnView on my form and put a Label on the TImageEnView.
I want to save this parent and child as one Png or Jpg on my hard drive.
I write this code :
CharLbl.Font.Size := I;
CharLbl.Top:=22;
ImageEnIO1.SaveToFile('D:\output2.png'); // Save in thread 2
ImageEnIO1.WaitThreads(false);
ShowMessage(inttoStr(I));
But the output is only background with out Label. How can I save the label as well?
Try the following:
var
paintbmp:tbitmap;
begin
paintbmp:=tbitmap.Create;
try
paintbmp.Width:=ImageEnIO1.Width;
paintbmp.Height:=ImageEnIO1.Height;
paintbmp.Canvas.Draw(0,0,ImageEnIO1.Picture.Graphic);
paintbmp.Canvas.CopyRect(rect(0,0,ImageEnIO1.Width,ImageEnIO1.Height)
,CharLbl.Canvas
,rect(0,0,ImageEnIO1.Width,ImageEnIO1.Height));
paintbmp.SaveToFile('D:\output2.png');
finally
paintbmp.Free;
end;
end;
Just be careful in order for this to give you what you want the size of the label is to be the same as the image's and the top and left is the same as the image's.
Note: I would still recommend you to see the link I gave you in comments, because it will aid you to learn a valuable tool that would even enable you to write your own component in the future.
Note 2: The output image is not a valid PNG it is still a Bitmap so you still need to convert it.(thanks to Kobik)
I am having a strange problem, and I do not think I can solve it.
I have an ImgView containing layers (transparent png images) and I intend to save all the layers as png files (like a "Save Project" thing), so that later on I can re-open them and place them where I left them. (like an "Open Project" thing)
This is my problem, following steps work just fine:
I add layers (transparent PNG files)
I move them around and place them where I want them
I press save project (so here I save all layers as png image files)
It works
If I do the next following steps, something goes wrong:
I add layers (transparent PNG files)
I move them around and place them where I want them
I change the location of the layers (as in: send to back one layer for example) (so this step is different)
I press save project (so here I save all layers as png image files)
It crashes with "Access violation at address 005380FB in module 'MyApp.exe'. Read of address 000000C0"
Right now it only gives me the above error, but a few runs ago, it pointed me to this line:
procedure TCustomBitmap32.ResetAlpha(const AlphaValue: Byte);
var
I: Integer;
P: PByteArray;
begin
if not FMeasuringMode then <<<<<------ this line
So if I change the index of layers... I cannot save them anymore as PNG ?!?!?!
Here is my save procedure:
for i:=0 to mainForm.ImgView.Layers.Count-2 do
begin
mylay := TBitmapLayer(mainForm.ImgView.Layers.Items[i]);
SaveBMPAsPng(mylay.Bitmap,'C:\MyApp\tmp\'+getLayerPan(i)+'.png');
end;
// where getLayerPan is a function that retrieves a name that I gave to the layer
... and
procedure SaveBmpAsPng(bmp:TBitmap32;dest:string);
var
Y: Integer;
X: Integer;
Png: TPortableNetworkGraphic32;
function IsWhite(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 255) and
(TColor32Entry(Color32).G = 255) and
(TColor32Entry(Color32).R = 255);
end;
begin
bmp.ResetAlpha;
for Y := 0 to bmp.Height-1 do
for X := 0 to bmp.Width-1 do
begin
if IsWhite(bmp.Pixel[X, Y]) then
bmp.Pixel[X,Y]:=Color32(255,255,255,0);
end;
Png:= TPortableNetworkGraphic32.Create;
Png.Assign(bmp);
Png.SaveToFile(dest);
Png.Free;
end;
What could be wrong?
Please help...
EDIT
I think I discovered my problem...
When I move the layers around, the only way (that I know of) to do it clean, is to load all layers into an imagelist (TBitmap32List was my choice at that moment) and after that clean the layers and re-add them from the imagelist to my ImageView in the desired order.
I can only assume that this is where something goes wrong.
It must be because in the layers I have transparent PNGs, and when I load them into the Bitmap32List, I load them as BMPs.
I must look for another way of reorganizing my layers before going any further. I will update you with my solution. If any of you know of a better way of reordering layers in ImageView32, please let me know.
EDIT
So, please observe in the image bellow that the GUI is done, and working. I have the panels representing the layers, I can move them around (as you may see in the image I am dragging layer 'Elementul 0' and movin it up in the chain).
And I repeat, my logic also works when I use temporary files for moving layers up or down in the order. One of the answers suggested that I should just use the Index property to change a layers position in the layers hierarchy, and I am saying that it cannot be done without at least adding new layers to the image. So this is not a double question. It is just a response to one of the answers I received.
Thank you
Your problem is a lot simpler than you might think. Working with layers comes natural:
Send to back
Set the layer's index to 0 or simply call SendToBack. All layers previously before it will have their index increased by 1. All layers previously after it remain at the same position.
Send backward
Decrease the layer's index by 1. The layer previously before it will now come after it, thus has its index increased by one.
Send forward
Increase the layer's index by 1. The layer previously after it will now come before it, thus has its index decreased by one.
Send to front
Set the layer's index to the number of layers minus 1. The layers previously after it have their increased decreased by one.
Hence there is absolutely no need to touch the bitmap, save to disk it to disk, or use any kind of temporary layers to change the order. In virtually every case, the right thing happens when you just set the index of the layer to the position (counting from 0, back to front) you want it to appear at. After moving a panel in your list, you could set the corresponding layer's index to the new index of the panel in the list. However, because the panel is ordered front to back and GR32 orders back to front, you need to translate the index of the panel to the desired index of the layer.
Here's an example how to do that with a TListBox and a TButton:
procedure TForm1.SendBackwardButtonClick(Sender: TObject);
var
LNewListBoxItemIndex: Integer;
begin
// Calculate the new list index and make sure it's valid
LNewListBoxItemIndex := Max(0, Min(ListBox1.ItemIndex + 1, ListBox1.Items.Count - 1));
// Transform the current and new list indices and use them to move the layer
ImgView321.Layers[ListBox1.Items.Count - 1 - ListBox1.ItemIndex].Index :=
ListBox1.Items.Count - 1 - LNewListBoxItemIndex;
// Move the list item
ListBox1.Items.Move(ListBox1.ItemIndex, LNewListBoxItemIndex);
// Preserve the selection (if applicable)
ListBox1.ItemIndex := LNewListBoxItemIndex;
end;
You may also decide to fully synchronize the list with the layers. In that case you should associate each item (possibly TPanel) with a layer.
// Create layers from front to back
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('First layer', LLayer);
// Could use LPanel := TPanel.Create(...); LPanel.Tag := Integer(Pointer(LLayer)) instead
LLayer := TBitmapLayer.Create(ImgView321.Layers);
ListBox1.Items.AddObject('Second layer', LLayer);
// Now the list is correct but the layers are not in the right order.
// Use the code listed below whenever you need to synchronize the layers
// with the list. In theory it may be slow (O(n^2)) but practically it
// won't matter much assuming you won't have hundreds of layers.
// Don't update the screen every time we move a layer to get closer to the final result
ImgView321.BeginUpdate;
try
for LIndex := 0 to ListBox1.Items.Count - 1 do
// Get the associated layer and make it the least visible of all processed so far
TCustomLayer(ListBox1.Items.Objects[LIndex]).SendToBack;
// Could use TCustomLayer(Pointer(SomePanel.Tag)).SendToBack instead
finally
// Always do this not to have strange behavior after an error
ImgView321.EndUpdate;
end;
// When it's done, update the screen
ImgView321.Changed;
By your description of how you changed the order of the layers, it is most likely the reason for your problem. Since you did not post that part of the code it can not be assessed with certainty.
Anyway, to rearrange the layers, you can use the Index property of TCustomLayer (of which TBitmapLayer is a descendant)
So the solution to the problem is to NOT use a Bitmap32List as a temporary container for png layers when reordering layers, because something gets lost in the process.
So try other solution for reordering. My curent solution is to drop the layers as PNG files to the disk, then reload them from the disk in the desired order.
Another solution (untested yet) would be to create a number of new layers, equal to the number of existing layers, move actual layers there, then get them back one by one in the desired order, and then remove the extra layers.
Anyway. That was the question, and this is the answer so far
My Application has several TSpeedButtons with which to choose a color and I want each choice to be shown by the color of the TSpeedButton.
I found this answer on Stackoverflow on how to change the color of a TButton. The second answer (change colors dynamically) appears to be the solution I am looking for. It reads as follows:
var r: TRectangle;
begin
// Find the background TRectangle style element for the button
r := (Button1.FindStyleResource('background') as TRectangle);
if Assigned(r) then
begin
r.Fill.Color := claBlue;
end;
end;
This does not work anymore (i use XE5, this is XE2?). It generates an exception at the r := ... statement with:
"illegal cast".
The FindStyleResource returns a FMXObject.
TRectangle is a TShape->TControl->TFMXObject.
I can cast to TControl but not to TShape. In case you wonder, Button1 is a TButton.
Does anyone know how I do change the color of a TSpeedButton?
As an aside: is there a way to determine which type of object exactly is beging returned? I couldn't find out in the debugger.
The answer to the question you linked to relates to vector styles, where the style constructed entirely from shapes etc (such as the TRectangle).
In newer versions of FireMonkey the 'system' styles (which mimic the OS look) and some other styles use bitmaps.
If you want to edit a bitmap style, you'll need to find the bitmap image in the style, edit it, and then redo/edit the button's style to use the new image. (If you're on mobile this will probably be hard enough that you shouldn't even try it).
Another route would be be to change to one of the bitmap styles supplied with Delphi. You will find them under the redist/styles/fmx folder of your Delphi installation.
As for the class of the object, and as per other comments, examine the ClassName property of the object returned.
But bear in mind that not every style will have an object called 'background'. Both the name of the object and it's class can easily vary between styles. You really ought to look at the style you want to pluck objects from to see what's there. (Note that the objects name ('background') will be in the StyleName property).
It would be much easier to use a TColorButton instead, which directly exposes the Color property. You can find it on the Colors page of the component palette. Here are two on a new FMX form in the IDE's form designer:
As far as "which type of object is being returned", you can use the debugger or a ShowMessage for the TFMXObject.ClassName of the return value:
var
Obj: TFmxObject;
begin
Obj := Button1.FindResource('background');
if Assigned(Obj) then
ShowMessage(Obj.ClassName);
end;
I'm working in a custom control which mix two windows controls (listview and treeview). In some point, I need to draw the image which uses windows 7 (with themes enabled) to identify the parent nodes, I'm using the DrawThemeBackground function with the TVP_GLYPH part and the GLPS_CLOSED state (I tried with all the parts and states related to the TREEVIEW class without luck), but the result image always is the old (+) or (-).
This image show the issue
I want to draw the Arrow image (inside of black circle) instead of the (+) sign (inside of orange circle).
This is the sample code which I use to draw the image.
uses
UxTheme;
procedure TForm40.Button1Click(Sender: TObject);
var
iPartId : integer;
iStateId: integer;
hTheme : THandle;
begin
hTheme := OpenThemeData(Handle, VSCLASS_TREEVIEW);
iPartId := TVP_GLYPH;
iStateId:= GLPS_CLOSED;
//iPartId := TVP_TREEITEM;
//iStateId:= TREIS_NORMAL;
if hTheme <> 0 then
try
//if (IsThemeBackgroundPartiallyTransparent(hTheme, iPartId, iStateId)) then
// DrawThemeParentBackground(Handle, PaintBox1.Canvas.Handle, nil);
DrawThemeBackground(hTheme, PaintBox1.Canvas.Handle, iPartId, iStateId, Rect(0, 0, 31, 31), nil);
finally
CloseThemeData(hTheme);
end;
end;
I check a couple of tools like the application made by Andreas Rejbrand and this too, but I can't find the image which I want.
My question is : how I can obtain the arrow image?
UPDATE
Thanks to the answer posted for Stigma I found additional resources to the values of the parts and states of the Explorer::Treeview class.
VisualStyleRenderer and themes
CodeProject
First of all, in the case of an ordinary ListView or TreeView, one can simply call SetWindowTheme on its handle to apply the proper sort of styling. The example from its MSDN page is as follows:
SetWindowTheme(hwndList, L"Explorer", NULL);
Since we are talking about a custom control, I am not so sure that applies here however. But since SetWindowTheme causes the WM_THEMECHANGED message to be sent to the proper window, it implies that you will just need to use the proper OpenThemeData call for the specific sub theme.
I think Luke's comment is correct. You probably just need to pass 'Explorer::Treeview' rather than the plain style. So, barring years of not having touched Delphi/Pascal:
hTheme := OpenThemeData(Handle, 'Explorer::Treeview');
You must set SetWindowTheme(Handle, 'explorer', nil); before painting to ensure that OpenThemeData will use new explorer style theme. Of course, window handle must be the same for both functions.