[SOLVED] Panel paint

[Pe3s]

It seems that Linux and Windowes interpret differently. I am using windows 11
@Handoko Please look at my video

[Handoko]

Perhaps, that's the case. I did not made many changes, but here is the code I used when creating the video.

Anyway, glad to know you have solved the issue.

[Pe3s]

I checked your code, both bars work the same. I will look in my code what I did wrong

[KodeZwerg]

I was curious and did my own research, maybe you liking?

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, ACurrent, AMax: Integer; const AStartColor, AEndColor: TColor; const ABorderSpace: Integer);
2. var
3.   VolumeRect: TRect;
4.   VolumeColor: TColor;
5. begin
6.   VolumeRect := APanel.ClientRect;
7.  
8.   InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
9.  
10.   VolumeRect.Right := VolumeRect.Left + Round((ACurrent - AMin) / (AMax - AMin) * VolumeRect.Width);
11.  
12.   VolumeColor := RGBToColor(
13.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetRValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetRValue(AEndColor)),
14.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetGValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetGValue(AEndColor)),
15.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetBValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetBValue(AEndColor)));
16.  
17.   APanel.Canvas.Brush.Color := APanel.Color;
18.   APanel.Canvas.FillRect(APanel.ClientRect);
19.  
20.   APanel.Canvas.Pen.Color := clBlack;
21.   APanel.Canvas.Rectangle(APanel.ClientRect);
22.  
23.   APanel.Canvas.Brush.Color := VolumeColor;
24.   APanel.Canvas.FillRect(VolumeRect);
25. end;
26.  
27. procedure TForm1.TrackBar1Change(Sender: TObject);
28. begin
29.   PanelVolume(Panel1, TrackBar1.Min, TrackBar1.Position, TrackBar1.Max, clLime, clRed, 4);
30. end;

Not forget to add to "uses" = "LCLIntf"

[KodeZwerg]

A nicer looking variation:

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, ACurrent, AMax: Integer; const AStartColor, AEndColor: TColor; const ABorderSpace: Integer);
2. var
3.   VolumeRect: TRect;
4.   ClearRect: TRect;
5.   VolumeColor: TColor;
6. begin
7.   VolumeRect := APanel.ClientRect;
8.   InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
9.   VolumeRect.Right := VolumeRect.Left + Round((ACurrent - AMin) / (AMax - AMin) * VolumeRect.Width);
10.   ClearRect := APanel.ClientRect;
11.   ClearRect.Left := VolumeRect.Right;
12.   VolumeColor := RGBToColor(
13.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetRValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetRValue(AEndColor)),
14.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetGValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetGValue(AEndColor)),
15.     Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetBValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetBValue(AEndColor)));
16.   APanel.Canvas.Brush.Style := bsSolid;
17.   APanel.Canvas.Brush.Color := APanel.Color;
18.   APanel.Canvas.FillRect(ClearRect);
19.   APanel.Canvas.Pen.Style := psSolid;
20.   APanel.Canvas.Pen.Color := clBlack;
21.   APanel.Canvas.Rectangle(APanel.ClientRect);
22.   APanel.Canvas.GradientFill(VolumeRect, AStartColor, VolumeColor, gdHorizontal);
23. end;

I tried to reduce flickering by just filling the empty space but it not work that acurate.
Can somebody help reduce flickering better than I did?

[Pe3s]

Thank you 

[KodeZwerg]

Can somebody help reduce flickering better than I did?

My working solution that really works almost cool:

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, ACurrent, AMax: Integer; const AStartColor, AEndColor: TColor; const ABorderSpace: Integer);
2. var
3.   BufferBitmap: TBitmap;
4.   VolumeRect: TRect;
5.   ClearRect: TRect;
6.   VolumeColor: TColor;
7. begin
8.   BufferBitmap := TBitmap.Create;
9.   try
10.     BufferBitmap.Width := APanel.Width;
11.     BufferBitmap.Height := APanel.Height;
12.     VolumeRect := BufferBitmap.Canvas.ClipRect;
13.     InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
14.     ClearRect := VolumeRect;
15.     VolumeRect.Right := VolumeRect.Left + Round((ACurrent - AMin) / (AMax - AMin) * VolumeRect.Width);
16.     ClearRect.Left := VolumeRect.Right;
17.     VolumeColor := RGBToColor(
18.       Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetRValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetRValue(AEndColor)),
19.       Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetGValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetGValue(AEndColor)),
20.       Round((1 - (ACurrent - AMin) / (AMax - AMin)) * GetBValue(AStartColor) + (ACurrent - AMin) / (AMax - AMin) * GetBValue(AEndColor)));
21.     BufferBitmap.Canvas.Lock;
22.     BufferBitmap.Canvas.Pen.Style := psSolid;
23.     BufferBitmap.Canvas.Pen.Color := clBlack;
24.     BufferBitmap.Canvas.Rectangle(BufferBitmap.Canvas.ClipRect);
25.     BufferBitmap.Canvas.Brush.Style := bsSolid;
26.     BufferBitmap.Canvas.Brush.Color := APanel.Color;
27.     BufferBitmap.Canvas.FillRect(ClearRect);
28.     BufferBitmap.Canvas.GradientFill(VolumeRect, AStartColor, VolumeColor, gdHorizontal);
29.     BufferBitmap.Canvas.Unlock;
30.     APanel.Canvas.Draw(0, 0, BufferBitmap);
31.   finally
32.     BufferBitmap.Free;
33.   end;
34. end;

Wait, why I said almost?
There is a micro problem with the Color for the background, it slightly differs from original color and I don't know yet how to fix that.
But flickering is full gone with my custom "DoubleBuffer" way of doing.
The color problem is visible, I've attached an image that shows it.

[KodeZwerg]

Aslong I do not find a fix for the color, this is my final version.
Now you can switch betweet vertical or horizontal and I've added comments to make you understand what I am doing.

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, ACurrent, AMax: Integer; const AStartColor, AEndColor: TColor; const ABorderSpace: Integer; const ADrawHorizontal: Boolean = True);
2. var
3.   BufferBitmap: TBitmap;
4.   VolumeRect: TRect;
5.   ClearRect: TRect;
6.   VolumeColor: TColor;
7.   Progress: Double;
8. begin
9.   // sanity checks
10.   if AMin < 0 then
11.     Exit;
12.   if AMax <= AMin then
13.     Exit;
14.   if ACurrent > AMax then
15.     Exit;
16.   BufferBitmap := TBitmap.Create;
17.   try
18.     BufferBitmap.Width := APanel.Width;
19.     BufferBitmap.Height := APanel.Height;
20.     // begin creating the rectangle for drawing
21.     VolumeRect := BufferBitmap.Canvas.ClipRect;
22.     // respect a maybe needed border
23.     InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
24.     // begin creating the rectangle for clearing
25.     ClearRect := VolumeRect;
26.     // calculate the current progress
27.     Progress := (ACurrent - AMin) / (AMax - AMin);
28.     if ADrawHorizontal then
29.       begin
30.         // apply the current progress to the rectangle
31.         VolumeRect.Right := VolumeRect.Left + Round(Progress * VolumeRect.Width);
32.         // subtract the clearing space
33.         ClearRect.Left := VolumeRect.Right;
34.       end
35.     else
36.       begin
37.         // apply the current progress to the rectangle
38.         VolumeRect.Top := VolumeRect.Bottom - Round(VolumeRect.Height * Progress);
39.         // subtract the clearing space
40.         ClearRect.Bottom := VolumeRect.Top;
41.     end;
42.     // calculate the current needed color for the current progress
43.     VolumeColor := RGBToColor(
44.       Round((1 - Progress) * GetRValue(AStartColor) + Progress * GetRValue(AEndColor)),
45.       Round((1 - Progress) * GetGValue(AStartColor) + Progress * GetGValue(AEndColor)),
46.       Round((1 - Progress) * GetBValue(AStartColor) + Progress * GetBValue(AEndColor)));
47.     // freeze the canvas
48.     BufferBitmap.Canvas.Lock;
49.     if (ABorderSpace > 0) then
50.       begin
51.         // draw a border
52.         BufferBitmap.Canvas.Pen.Style := psSolid;
53.         BufferBitmap.Canvas.Pen.Color := clBlack;
54.         BufferBitmap.Canvas.Rectangle(BufferBitmap.Canvas.ClipRect);
55.       end;
56.     // reset the unused space color
57.     BufferBitmap.Canvas.Brush.Style := bsSolid;
58.     BufferBitmap.Canvas.Brush.Color := APanel.Color;
59.     BufferBitmap.Canvas.FillRect(ClearRect);
60.     // paint the progress
61.     if ADrawHorizontal then
62.       BufferBitmap.Canvas.GradientFill(VolumeRect, AStartColor, VolumeColor, gdHorizontal)
63.     else
64.       BufferBitmap.Canvas.GradientFill(VolumeRect, VolumeColor, AStartColor, gdVertical);
65.     // unfreeze the canvas
66.     BufferBitmap.Canvas.Unlock;
67.     // update the screen
68.     APanel.Canvas.Draw(0, 0, BufferBitmap);
69.   finally
70.     BufferBitmap.Free;
71.   end;
72. end;

I am happy with the result but maybe I add later an optional percentage text that be painted on ... who knows 

[KodeZwerg]

Now with an optional percentage display:

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, ACurrent, AMax: Integer; const AStartColor, AEndColor: TColor; const ABorderSpace: Integer; const ADrawHorizontal, AShowText: Boolean);
2. var
3.   BufferBitmap: TBitmap;
4.   VolumeRect: TRect;
5.   ClearRect: TRect;
6.   VolumeColor: TColor;
7.   Progress: Double;
8.   PercText: string;
9. begin
10.   // sanity checks
11.   if AMin < 0 then
12.     Exit;
13.   if AMax <= AMin then
14.     Exit;
15.   if ACurrent > AMax then
16.     Exit;
17.   BufferBitmap := TBitmap.Create;
18.   try
19.     BufferBitmap.Width := APanel.Width;
20.     BufferBitmap.Height := APanel.Height;
21.     // begin creating the rectangle for drawing
22.     VolumeRect := BufferBitmap.Canvas.ClipRect;
23.     // respect a maybe needed border
24.     if (ABorderSpace > 0) then
25.       InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
26.     // begin creating the rectangle for clearing
27.     ClearRect := VolumeRect;
28.     // calculate the current progress
29.     Progress := (ACurrent - AMin) / (AMax - AMin);
30.     if ADrawHorizontal then
31.       begin
32.         // apply the current progress to the rectangle
33.         VolumeRect.Right := VolumeRect.Left + Round(Progress * VolumeRect.Width);
34.         // subtract the clearing space
35.         ClearRect.Left := VolumeRect.Right;
36.       end
37.     else
38.       begin
39.         // apply the current progress to the rectangle
40.         VolumeRect.Top := VolumeRect.Bottom - Round(VolumeRect.Height * Progress);
41.         // subtract the clearing space
42.         ClearRect.Bottom := VolumeRect.Top;
43.     end;
44.     // calculate the current needed color for the current progress
45.     VolumeColor := RGBToColor(
46.       Round((1 - Progress) * GetRValue(AStartColor) + Progress * GetRValue(AEndColor)),
47.       Round((1 - Progress) * GetGValue(AStartColor) + Progress * GetGValue(AEndColor)),
48.       Round((1 - Progress) * GetBValue(AStartColor) + Progress * GetBValue(AEndColor)));
49.     // freeze the canvas
50.     BufferBitmap.Canvas.Lock;
51.     if (ABorderSpace > 0) then
52.       begin
53.         // draw a border
54.         BufferBitmap.Canvas.Pen.Style := psSolid;
55.         BufferBitmap.Canvas.Pen.Color := clBlack;
56.         BufferBitmap.Canvas.Rectangle(BufferBitmap.Canvas.ClipRect);
57.       end;
58.     // reset the unused space color
59.     BufferBitmap.Canvas.Brush.Style := bsSolid;
60.     BufferBitmap.Canvas.Brush.Color := APanel.Color;
61.     BufferBitmap.Canvas.FillRect(ClearRect);
62.     // paint the progress
63.     if ADrawHorizontal then
64.       BufferBitmap.Canvas.GradientFill(VolumeRect, AStartColor, VolumeColor, gdHorizontal)
65.     else
66.       BufferBitmap.Canvas.GradientFill(VolumeRect, VolumeColor, AStartColor, gdVertical);
67.     // apply percentage display
68.     if AShowText then
69.       begin
70.         BufferBitmap.Canvas.Font := APanel.Font;
71.         BufferBitmap.Canvas.Brush.Style := bsClear;
72.         PercText := Format('%d%%', [Round(Progress * 100)]);
73.         BufferBitmap.Canvas.TextOut(
74.           ((APanel.ClientWidth - BufferBitmap.Canvas.TextWidth(PercText)) div 2),
75.           ((APanel.ClientHeight - BufferBitmap.Canvas.TextHeight(PercText)) div 2),
76.           PercText);
77.       end;
78.     // unfreeze the canvas
79.     BufferBitmap.Canvas.Unlock;
80.     // update the screen
81.     APanel.Canvas.Draw(0, 0, BufferBitmap);
82.   finally
83.     BufferBitmap.Free;
84.   end;
85. end;

[KodeZwerg]

This now really is my final and last update to this subject I guess, as long I can't fix the background color problem.
I reintroduced the possibility of painting in a solid colored way, since that can be useful IMHO.
I rewrote the header definition that it's more sorted and straightforward.

Code: Pascal  [Select][+][-]

1. procedure TForm1.PanelVolume(const APanel: TPanel; const AMin, AMax, ACurrent, ABorderSpace: Integer; const AStartColor, AEndColor: TColor; const ASolidColor, ADrawHorizontal, AShowText: Boolean);
2. var
3.   BufferBitmap: TBitmap;
4.   VolumeRect: TRect;
5.   ClearRect: TRect;
6.   VolumeColor: TColor;
7.   Progress: Double;
8.   PercText: string;
9. begin
10.   // sanity checks
11.   if ((AMin < 0) or (AMax <= AMin) or (ACurrent > AMax)) then
12.     Exit;
13.   BufferBitmap := TBitmap.Create;
14.   try
15.     BufferBitmap.Width := APanel.Width;
16.     BufferBitmap.Height := APanel.Height;
17.     // begin creating the rectangle for drawing
18.     VolumeRect := BufferBitmap.Canvas.ClipRect;
19.     // respect a maybe needed border
20.     if (ABorderSpace > 0) then
21.       InflateRect(VolumeRect, (ABorderSpace - (2 * ABorderSpace)), (ABorderSpace - (2 * ABorderSpace)));
22.     // begin creating the rectangle for clearing
23.     ClearRect := VolumeRect;
24.     // calculate the current progress
25.     Progress := (ACurrent - AMin) / (AMax - AMin);
26.     if ADrawHorizontal then
27.       begin
28.         // apply the current progress to the rectangle
29.         VolumeRect.Right := VolumeRect.Left + Round(Progress * VolumeRect.Width);
30.         // subtract the clearing space
31.         ClearRect.Left := VolumeRect.Right;
32.       end
33.     else
34.       begin
35.         // apply the current progress to the rectangle
36.         VolumeRect.Top := VolumeRect.Bottom - Round(VolumeRect.Height * Progress);
37.         // subtract the clearing space
38.         ClearRect.Bottom := VolumeRect.Top;
39.     end;
40.     // calculate the current needed color for the current progress
41.     if (AStartColor <> AEndColor) then
42.       VolumeColor := RGBToColor(
43.         Round((1 - Progress) * GetRValue(AStartColor) + Progress * GetRValue(AEndColor)),
44.         Round((1 - Progress) * GetGValue(AStartColor) + Progress * GetGValue(AEndColor)),
45.         Round((1 - Progress) * GetBValue(AStartColor) + Progress * GetBValue(AEndColor)))
46.     else
47.       VolumeColor := AStartColor;
48.     // freeze the canvas
49.     BufferBitmap.Canvas.Lock;
50.     if (ABorderSpace > 0) then
51.       begin
52.         // draw a border
53.         BufferBitmap.Canvas.Pen.Style := psSolid;
54.         BufferBitmap.Canvas.Pen.Color := clBlack;
55.         BufferBitmap.Canvas.Rectangle(BufferBitmap.Canvas.ClipRect);
56.       end;
57.     // reset the unused space color
58.     BufferBitmap.Canvas.Brush.Style := bsSolid;
59.     BufferBitmap.Canvas.Brush.Color := APanel.Color;
60.     BufferBitmap.Canvas.FillRect(ClearRect);
61.     // paint the progress
62.     if (not ASolidColor) then
63.       begin
64.         if ADrawHorizontal then
65.           BufferBitmap.Canvas.GradientFill(VolumeRect, AStartColor, VolumeColor, gdHorizontal)
66.         else
67.           BufferBitmap.Canvas.GradientFill(VolumeRect, VolumeColor, AStartColor, gdVertical);
68.       end
69.     else
70.       begin
71.         BufferBitmap.Canvas.Brush.Color := VolumeColor;
72.         BufferBitmap.Canvas.FillRect(VolumeRect);
73.       end;
74.      // apply percentage display
75.     if AShowText then
76.       begin
77.         BufferBitmap.Canvas.Font := APanel.Font;
78.         BufferBitmap.Canvas.Brush.Style := bsClear;
79.         PercText := Format('%d%%', [Round(Progress * 100)]);
80.         BufferBitmap.Canvas.TextOut(
81.           ((APanel.ClientWidth - BufferBitmap.Canvas.TextWidth(PercText)) div 2),
82.           ((APanel.ClientHeight - BufferBitmap.Canvas.TextHeight(PercText)) div 2),
83.           PercText);
84.       end;
85.     // unfreeze the canvas
86.     BufferBitmap.Canvas.Unlock;
87.     // update the screen
88.     APanel.Canvas.Draw(0, 0, BufferBitmap);
89.   finally
90.     BufferBitmap.Free;
91.   end;
92. end;

Enjoy!