In Delphi 10.2 Tokyo I use a TAniIndicator until the database is loaded.
By default, the color of the bubble is black. I would like to change it to be white without creating a Style. I haven't found any property for that.
Is there any way to change it?
You can do something like this (for default style), note that you'll need to improve ReplaceBlackColor function to make bubble completely white
procedure ReplaceBlackColor(const ABitmap: TBitmap);
var
I, J: Integer;
M: TBitmapData;
C: PAlphaColorRec;
begin
if ABitmap.Map(TMapAccess.ReadWrite, M) then
try
for J := 0 to ABitmap.Height - 1 do
for I := 0 to ABitmap.Width - 1 do
begin
C := #PAlphaColorArray(M.Data)[J * (M.Pitch div 4) + I];
if C^.Color = TAlphaColorRec.Black then
C^.Color := TAlphaColorRec.White;
end;
finally
ABitmap.Unmap(M);
end;
end;
procedure TForm3.Button1Click(Sender: TObject);
var
bla: TBitmapListAnimation;
begin
bla := AniIndicator1.FindStyleResource('ani') as TBitmapListAnimation;
ReplaceBlackColor(bla.AnimationBitmap);
end;
Add a TFillRGBEffect to the indicator control and set its Color property to desired color.
TFillRGBEffect, like other effects, will apply to any controls "below" it, so you can repaint whole UI in just one go.
Related
Need a component derived from TMemo (not TSyn components)
I need a line to the left(inside or outside) of a TMemo whose thickness(optional) and color can be controlled just for the purposes of indication. It need not be functional as a gutter but looks like one especially like that of a SynMemo as shown in the image. The problem with SynMemo is that it doesn't support variable width fonts like Tahoma but the TMemo does.
I tried making a few composite components with CustomContainersPack by combining a TShape with TMemo, even superimposing a TMemo on top of TSynMemo but didn't succeed as the paint while dragging made it look disassembled and CCPack is not that robust for my IDE.
KMemo, JvMemo and many other Torry.net components were installed and checked for any hidden support for achieving the same but none worked.
Grouping of components together is also not a solution for me since many mouse events are tied to the Memo and calls to FindVCLWindow will return changing components under the mouse. Furthermore many components will be required so grouping with TPanel will up the memory usage.
You can use the WM_Paint message and a hack to do this without creating a new component,
Otherwise create a descendant of TMemo and apply the same changes below
TMemo = class(Vcl.StdCtrls.TMemo)
private
FSidecolor: TColor;
FSideColorWidth: Integer;
FAskForAttention: Boolean;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetSideColorWidth(const Value: Integer);
procedure SetSideColor(const Value: TColor);
procedure SetAskForAttention(const Value: Boolean);
published
property SideColor: TColor read FSideColor write SetSideColor default clRed;
property SideColorWidth: Integer read FSideColorWidth write SetSideColorWidth default 2;
property AskForAttension: Boolean read FAskForAttention write SetAskForAttention;
end;
{ TMemo }
procedure TMemo.SetAskForAttention(const Value: Boolean);
begin
FAskForAttention := Value;
Invalidate;
end;
procedure TMemo.SetSideColor(const Value: TColor);
begin
FSideColor := Value;
Invalidate;
end;
procedure TMemo.SetSideColorWidth(const Value: Integer);
begin
FSideColorWidth := Value;
Invalidate;
end;
procedure TMemo.WMPaint(var Message: TWMPaint);
var
DC: HDC;
Pen: HPen;
R,G,B: Byte;
begin
inherited;
if FAskForAttention then
begin
DC := GetWindowDC(Handle);
try
B := Byte(FSidecolor);
G := Byte(FSidecolor shr 8);
R := Byte(FSidecolor shr 16);
Pen := CreatePen(PS_SOLID, FSideColorWidth, RGB(R,G,B));
SelectObject(DC, Pen);
SetBkColor(DC, RGB(R,G,B));
Rectangle(DC, 1, 1, FSideColorWidth, Height - 1);
DeleteObject(Pen);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
And you can use it like this
procedure TForm15.Button1Click(Sender: TObject);
begin
memo1.SideColor := ColorBox1.Selected;
memo1.SideColorWidth := 2;
memo1.AskForAttension := True;
end;
and you get this result
Limitations:
As this is merely another hack to draw a simple rectangle on the side, do not expect it to be perfect on all situations. I did notice the following when testing:
If the border is too thick you get the following effect
When on mouse move the line sometimes disappear and don't get painted (I think it is because of drawing focus rect).
Note: I see the guys in comments suggested to create a custom component with panel and memo put together, If you want to try this, take a look at my answer to
Creating a new components by combining two controls (TEdit and TTrackBar) in Delphi VCL
It is basically the same Ideas.
Edit:
Ok I took into consideration what is mentioned in comments and adapted my answer,
I also changed the way I'm getting the canvas of the component. The new implementation becomes this
{ TMemo }
procedure TMemo.SetAskForAttention(const Value: Boolean);
var
FormatRect: TRect;
begin
if FAskForAttention <> Value then
begin
FAskForAttention := Value;
if not FAskForAttention then
begin
Perform(EM_SETRECT, 0, nil);
end
else
begin
FormatRect := GetClientRect;
if IsRightToLeft then
FormatRect.Right := FormatRect.Right - FSideColorWidth - 3
else
FormatRect.Left := FormatRect.Left + FSideColorWidth + 3;
Perform(EM_SETRECT, 0, FormatRect);
end;
Invalidate;
end;
end;
procedure TMemo.SetSideColor(const Value: TColor);
begin
if FSideColor <> Value then
begin
FSideColor := Value;
Invalidate;
end;
end;
procedure TMemo.SetSideColorWidth(const Value: Integer);
var
FormatRect: TRect;
begin
if FSideColorWidth <> Value then
begin
FSideColorWidth := Value;
FormatRect := GetClientRect;
if IsRightToLeft then
FormatRect.Right := FormatRect.Right - FSideColorWidth - 3
else
FormatRect.Left := FormatRect.Left + FSideColorWidth + 3;
Perform(EM_SETRECT, 0, FormatRect);
end;
end;
procedure TMemo.WMPaint(var Message: TWMPaint);
var
Canvas: TControlCanvas;
CRect: TRect;
begin
inherited;
if FAskForAttention then
begin
Canvas := TControlCanvas.Create;
try
Canvas.Control := Self;
Canvas.Font.Assign(Self.Font);
CRect := GetClientRect;
if IsRightToLeft then
CRect.Left := CRect.Right - FSideColorWidth
else
CRect.Width := FSideColorWidth;
Canvas.Brush.Color := FSidecolor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(CRect);
finally
Canvas.Free;
end;
end;
end;
There is no limitations for the size and it does not overlap the scrollbars.
Final result:
References I used to write this answer:
MSDN Painting and Drawing Functions
MSDN Using the WM_PAINT Message
Creating Colored Pens and Brushes example
Vcl.Controls TWinControl WM_Paint message implementation
EM_SETRECT message
How can I get a TEdit's canvas in Delphi? (Kobik's answer)
Instead of writing a custom control, put a panel or a shape beside the standard memo and give it any colour you like.
If this is too tedious to repeat many times, then put the memo and the shape on a frame and put that in the repository. Set the anchors to make sure they resize correctly. You don't even need to write code for that and you have an instant "imitation custom control".
Much better and simpler than writing, installing and testing a custom control, IMO.
Now if you want to put text or numbers or icons in the gutter, then it would pay out to write a custom control. Use EM_SETRECT to set the internal formatting rectangle, and custom draw the gutter in the overridden Paint method. Do not forget to call inherited.
How can I customize my listview to display different background colors like in the picture below ?
My listview is bound to a datasource (Livebindng). I want to use the color field to set my backgroud color.
I've customized my view this way :
3 Text items (Designation,Date and Resume)
1 Bitmap item (Couleur)
Text items are bound to datasource but there is no way to bind my Bitmap to my "color" field.
I've filled the listview ActivesUpdateObjects event but this is not enough as bitmap is not changed when datasource record is updated!
procedure TfrmMain.lvTachesActivesUpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
begin
SetItemColor(AItem);
end;
procedure TfrmMain.SetItemColor(const AItem: TListViewItem; const UpdateColor:
Boolean = False);
var
LObject: TListItemImage;
VC: TColor;
begin
LObject := AItem.Objects.FindObjectT<TListItemImage>('Couleur');
VC:= dtmMain.qrTaches.FieldByName('couleur').AsInteger;
if LObject.Bitmap = nil then
begin
LObject.Bitmap := FMX.Graphics.TBitmap.Create(10,240);
LObject.Bitmap.Clear(VC);
end else if UpdateColor then LObject.Bitmap.Clear(VC);
end;
Is there a better way to proceed? I was also looking to use style but it appears (or I didn't find) that itemlistview can apply styles!
Ps : Firemonkey / Windows / Delphi Berlin XE10.1
I'm using Delphi 7 so take this with a grain of salt.
You may have to write your own CustomDrawItem method on your TreeView to handle this stuff
This is mine (I edited out some code because it has some lengthy logic behind). Also, I don't draw icons so the DrawImage part is commented.
procedure TVentanaVisorComponentes.TreeView1CustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
NodeRect: TRect;
EsSeleccion, EsDespejado: boolean;
begin
with TreeView1.Canvas do
begin
//If DefaultDraw it is true, any of the node's font properties can be
//changed. Note also that when DefaultDraw = True, Windows draws the
//buttons and ignores our font background colors, using instead the
//TreeView's Color property.
DefaultDraw := False;
//DefaultDraw = False means you have to handle all the item drawing yourself,
//including the buttons, lines, images, and text.
if not DefaultDraw then
begin
Brush.Color := clMenuHighLight;
Font.Color := clWhite;
NodeRect := Node.DisplayRect(True);
FillRect(NodeRect);
// ...
NodeRect := Node.DisplayRect(False);
// ...
FillRect(NodeRect);
NodeRect.Left := NodeRect.Left + (Node.Level * TreeView1.Indent);
//NodeRect.Left now represents the left-most portion of the expand button
DrawButton(NodeRect, Node);
NodeRect.Left := NodeRect.Left + TreeView1.Indent;
//NodeRect.Left is now the leftmost portion of the image.
//DrawImage(NodeRect, Node.ImageIndex);
// NodeRect.Left := NodeRect.Left + ImageList.Width;
//Now we are finally in a position to draw the text.
TextOut(NodeRect.Left, NodeRect.Top, (Node as TNodoArbolComponentes).Texto);
end;
end;
end;
I probably have a very simple to fix problem, though I have no clue how to do it. I am pretty new to Delphi, which is why I have very little experience.
Below is the piece of code I want to simplify:
procedure TForm1.Asign();
begin
case TileValue[1,1] of
0: Fx1y1.Color:=clBtnFace;
1: Fx1y1.Color:=clBlue;
2: Fx1y1.Color:=clMaroon;
end;
case TileValue[1,2] of
0: Fx1y2.Color:=clBtnFace;
1: Fx1y2.Color:=clBlue;
2: Fx1y2.Color:=clMaroon;
end;
case TileValue[1,3] of
0: Fx1y3.Color:=clBtnFace;
1: Fx1y3.Color:=clBlue;
2: Fx1y3.Color:=clMaroon;
end;
end;
The Fx1y1 is a panel while the x1 is coordinate as well as the y1 (Coordinates on a "4 in a row game"). I am trying to somehow replace the x and y coordinate in the panel name by another variable, so I can shorten the code. It should look something like this:
procedure TForm1.Asign();
var A,B:integer;
begin
for B:=1 to 6 do begin
for A:=1 to 7(Because the 4 in a row playing field is 6 by 7) do begin
case TileValue[A,B] of
0: Fx{A}y{b}.Color:=clBtnFace;
1: Fx{A}y{b}.Color:=clBlue;
2: Fx{A}y{b}.Color:=clMaroon;
end;
end;
end;
end;
Is that even possible? If yes or no please tell me.
You can do what you're asking for by using the Form's FindComponent function, which returns the component for the supplied name. Since that can be any component, you have to cast the result to TPanel. This will throw an exception if there is no component with the supplied name, or (possibly) if it is not a Panel. To further simplify the code I would also use an array for the colors.
procedure TForm1.Assign;
const Colors: array[0..2] of TColor = (clBtnFace, clBlue, clMaroon);
var x,y: integer;
Panel: TPanel;
begin
for x := 1 to 7 do
for y := 1 to 6 do
begin
Panel := TPanel(FindComponent('Fx' + x.ToString + 'y' + y.ToString));
Panel.Color := Colors[TileValue[x,y]];
end;
end;
As David mentioned, it would be cleaner to put the Panels in an array, and use that. From the code you showed it seems like you have created all the panels at design time, which is not required. It looks like you already have 42 panels, which is a lot to create manually, and if you wanted to make the field larger, it would become even more infeasible. That's why it's probably best to create the panels from code:
procedure TForm1.FormCreate(Sender: TObject);
begin
CreatePanels;
Assign;
end;
procedure TForm1.CreatePanels;
var x,y: integer;
begin
for x := 1 to 7 do
for y := 1 to 6 do
begin
Panels[x,y] := TPanel.Create(Self);
Panels[x,y].Parent := Self;
// set the position of the panel
Panels[x,y].Left := 10 + (x-1)*50;
Panels[x,y].Top := 10 + (y-1)*50;
Panels[x,y].Width := 50;
Panels[x,y].Height := 50;
// make sure we can assign a non-default color
Panels[x,y].ParentBackground := false;
// do whatever else you want to do with the panel
end;
end;
procedure TForm1.Assign;
const Colors: array[0..2] of TColor = (clBtnFace, clBlue, clMaroon);
var x,y: integer;
begin
for x := 1 to 7 do
for y := 1 to 6 do
Panels[x,y].Color := Colors[TileValue[x,y]];
end;
You would declare the array of Panels where-ever you declared TileValue. Not only makes this assigning the colors easier, you can also change appearance & dimensions of the playing field a lot more quickly.
I would like to get the font color of a TGroupBox caption, so I can assign that color to a TLabel.
I think I need to use GetThemeColor, but I can't seem to figure out which parameters to use?
Update - This is the code I use based on the answer:
function GetGroupBoxTextColor: TColor;
var
C: COLORREF;
ElementDetails: TThemedElementDetails;
begin
Result := clWindowText;
if ThemeServices.ThemesEnabled then
begin
ElementDetails := ThemeServices.GetElementDetails(tbGroupBoxNormal);
if GetThemeColor(ThemeServices.Theme[teButton], ElementDetails.Part, ElementDetails.State, TMT_TEXTCOLOR, C) = S_OK then
Result := C;
end;
end;
I think this works:
var
h: HTHEME;
clr: COLORREF;
begin
h := OpenThemeData(Handle, 'BUTTON');
if h <> 0 then
try
OleCheck(GetThemeColor(h, BP_GROUPBOX, GBS_NORMAL, TMT_TEXTCOLOR, clr));
finally
CloseThemeData(h);
end;
(uses OleAuto, UxTheme)
I have a "wide" TPanel with several buttons on it (essentially a tool bar). All the buttons have Align=Left. I have created a function which will resize the buttons to the same size and calculate the width of them so they fill the entire TPanel. I call this function in the OnResize event handler of the TPanel.
procedure ScaleButtonsOnPanel;
var i: Integer;
begin
for i:=0 to mPanel.ControlCount-1 do begin
mPanel.Controls[i].Width := round(mPanel.width/mPanel.ControlCount-1)
end;
end;
The problem is if I minimize and then restore the form the layout of the buttons change from the design layout.
Can anyone offer a solution to having buttons on a panel which can be resized but maintain the design time order (in terms of left to right placement) ?
I do not really see your problem. But of course, you must set the position of the buttons, not only their size.
procedure TForm1.Panel1Resize(Sender: TObject);
var
i: Integer;
btnWidth: integer;
begin
btnWidth := Panel1.Width div Panel1.ControlCount;
for i := 0 to Panel1.ControlCount - 1 do
begin
Panel1.Controls[i].Left := i * btnWidth;
Panel1.Controls[i].Width := btnWidth;
end;
end;
This works very well.
See https://privat.rejbrand.se/panelresize.wmv.
OK, now I see. I think the alLeft is actually your problem. Controls with the same align tend to change their order. This is a well-known Delphi annoyance. Do it like I do above, instead. Just make sure that you go through the buttons in the right order. If you cannot rely on the ordering of Panel1.Controls, then you can do like this: Set the Tag property of each toolbar button to its position (0, 1, ...) in the toolbar then do
procedure TForm1.Panel1Resize(Sender: TObject);
var
i: Integer;
btnWidth: integer;
begin
btnWidth := Panel1.Width div Panel1.ControlCount;
for i := 0 to Panel1.ControlCount - 1 do
begin
Panel1.Controls[i].Left := Panel1.Controls[i].Tag * btnWidth;
Panel1.Controls[i].Width := btnWidth;
end;
end;
Have you tried to see if a TFlowPanel doesn't better suit your needs?