[SOLVED] Custom control picture

[pcurtis]

I am having problems with a component I am designing.
The problem is with assigning a picture .
What am I doing wrong?

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

1. unit mypicturepanel;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, LResources, Forms, Controls,
9.   Graphics, StdCtrls, ExtCtrls, ComCtrls, Dialogs, Buttons;
10. type
11.  
12.   TMyPicturePanel = class(TCustomControl)
13.  
14.   private
15.     fBorderWidth : Integer;
16.     fBorderColor : TColor;
17.     fStretch : Boolean;
18.     fPicture : TPicture;
19.     procedure SetBorderWidth(AValue : Integer);
20.     function GetBorderWidth : Integer;
21.     procedure SetBorderColor(AValue : TColor);
22.     function GetBorderColor : TColor;
23.     procedure SetStretch(AValue : Boolean);
24.     function GetStretch : Boolean;
25.     procedure SetPicture(AValue : TPicture);
26.     function GetPicture : TPicture;
27.   protected
28.  
29.   public
30.     MyImage : TImage;
31.     MyPanel : TPanel;
32.     constructor Create(AOwner : TComponent); override;
33.   published
34.     procedure MyPaint(Sender: TObject);
35.     property BorderWidth : Integer read GetBorderWidth write SetBorderWidth;
36.     property BorderColor : TColor read GetBorderColor write SetBorderColor;
37.     property Stretch : Boolean read GetStretch write SetStretch;
38.     property Picture : TPicture read GetPicture write SetPicture;
39.   end;
40.  
41. procedure Register;
42.  
43. implementation
44.  
45. constructor TMyPicturePanel.Create(AOwner : TComponent);
46. begin
47.   inherited Create(AOwner);
48.  
49.   fBorderColor := clBlack;
50.   fBorderWidth := 1;
51.   fStretch := False;
52.   fPicture := TPicture.Create;
53.  
54.   MyPanel := TPanel.Create(Self);
55.   with MyPanel do
56.     begin;
57.       Parent := Self;
58.       Align := alClient;
59.       BorderStyle := bsNone;
60.       BevelInner := bvNone;
61.       BevelOuter := bvNone;
62.       Color := clLime;
63.       OnPaint := @MyPaint;
64.     end;
65.  
66.   MyImage := TImage.Create(Self);
67.   with MyImage do
68.     begin
69.       Align := alClient;
70.       BorderSpacing.Around := 8;
71.       Parent := MyPanel;
72.       Stretch := fStretch;
73.       Picture := fPicture;
74.     end;
75.  
76.   Constraints.MinHeight := 10;
77.   Constraints.MinWidth := 10;
78.   SetBounds(0, 0, 96, 96);
79. end;
80.  
81. procedure TMyPicturePanel.SetBorderWidth(AValue : Integer);
82. begin
83.   if fBorderWidth <> AValue then
84.     begin
85.       fBorderWidth := AValue;
86.       MyPaint(MyPanel);
87.       MyImage.Repaint;
88.     end;
89. end;
90.  
91. function TMyPicturePanel.GetBorderWidth : Integer;
92. begin
93.   Result := fBorderWidth;
94. end;
95.  
96. procedure TMyPicturePanel.SetBorderColor(AValue : TColor);
97. begin
98.   if fBorderColor <> AValue then
99.     begin
100.       fBorderColor := AValue;
101.       MyPaint(MyPanel);
102.       MyImage.Repaint;
103.     end;
104. end;
105.  
106. function TMyPicturePanel.GetBorderColor : TColor;
107. begin
108.   Result := fBorderColor;
109. end;
110.  
111. procedure TMyPicturePanel.SetStretch(AValue : Boolean);
112. begin
113.   if fStretch <> AValue then
114.     begin
115.       fStretch := AValue;
116.       MyImage.Stretch := fStretch;
117.       //MyImage.Repaint;
118.     end;
119. end;
120.  
121. function TMyPicturePanel.GetStretch : Boolean;
122. begin
123.   Result := fStretch;
124. end;
125.  
126. procedure TMyPicturePanel.SetPicture(AValue : TPicture);
127. begin
128.   if fPicture <> AValue then
129.     begin
130.       fPicture.Assign(AValue);
131.       MyPaint(MyPanel);
132.     end;
133. end;
134.  
135. function TMyPicturePanel.GetPicture : TPicture;
136. begin
137.   Result := fPicture;
138. end;
139.  
140. procedure TMyPicturePanel.MyPaint(Sender: TObject);
141. var
142.   iOFFSET : Integer;
143. begin
144.   iOFFSET := (fBorderWidth - 1) div 2;
145.  
146.   //MyImage.Picture.Assign(fPicture);
147.  
148.   with (Sender as TPanel) do
149.   begin
150.     Canvas.Pen.Color := fBorderColor;
151.     Canvas.Pen.Width := fBorderWidth;
152.     Canvas.Rectangle(iOFFSET, iOFFSET, (Width - iOFFSET), (Height - iOFFSET));
153.   end;
154.  
155.   MyImage.BorderSpacing.Around := fBorderWidth + iOFFSET + 1;
156. end;
157.  
158. procedure Register;
159. begin
160.   RegisterComponents('Misc', [TMyPicturePanel]);
161. end;
162.  
163. end.
164.  

[Handoko]

What was the problem?

I haven't tested your code but quickly read it, I guess you should pass the form to the component. So it should be:

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

1. constructor TMyPicturePanel.Create(anOwner : TComponent; theForm: TForm);
2. begin
3.   // ...
4.   MyPanel.Parent := theForm;
5.   // ...
6. end;

[pcurtis]

The problem  is when I assign a picture the component gets stuck in an infinite loop. I guess the problem is in the  Get/Set routines.

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

1. procedure TMyPicturePanel.SetPicture(AValue : TPicture);
2. begin
3.   if fPicture <> AValue then  // is this correct
4.     begin
5.       fPicture.Assign(AValue);  // is this correct
6.       MyPaint(MyPanel);
7.     end;
8. end;
9.  
10. function TMyPicturePanel.GetPicture : TPicture;
11. begin
12.   Result := fPicture;  // is this correct
13. end;
14.  

[Handoko]

You should not call the painting function or event directly. Use invalidate, it is for telling the system that the control needs to repaint itself and the system will decide what is the best time to do it.

https://delphiprogrammingdiary.blogspot.com/2013/01/difference-between-refresh-repaint.html

[pcurtis]

Do you mean :

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

1. procedure TMyPicturePanel.SetPicture(AValue : TPicture);
2. begin
3.   if fPicture <> AValue then
4.     begin
5.       fPicture.Assign(AValue);
6.       MyPanel.Invalidate;
7.     end;
8. end;
9.  

[Handoko]

Yes, try it. Maybe it can solve the issue.

[pcurtis]

I have, it didn't 

[Handoko]

This works on my test on Linux machine, it should work on Windows too:

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
9.  
10. type
11.  
12.   { TMyPicturePanel }
13.  
14.   TMyPicturePanel = class(TCustomControl)
15.   private
16.     fBorderWidth : Integer;
17.     fBorderColor : TColor;
18.     fStretch : Boolean;
19.     fPicture : TPicture;
20.     procedure SetBorderWidth(AValue : Integer);
21.     function GetBorderWidth : Integer;
22.     procedure SetBorderColor(AValue : TColor);
23.     function GetBorderColor : TColor;
24.     procedure SetStretch(AValue : Boolean);
25.     function GetStretch : Boolean;
26.     procedure SetPicture(AValue : TPicture);
27.     function GetPicture : TPicture;
28.   public
29.     MyImage : TImage;
30.     MyPanel : TPanel;
31.     constructor Create(AOwner : TComponent; theParent: TForm);
32.   published
33.     procedure MyPaint(Sender: TObject);
34.     property BorderWidth : Integer read GetBorderWidth write SetBorderWidth;
35.     property BorderColor : TColor read GetBorderColor write SetBorderColor;
36.     property Stretch : Boolean read GetStretch write SetStretch;
37.     property Picture : TPicture read GetPicture write SetPicture;
38.   end;
39.  
40.   { TForm1 }
41.  
42.   TForm1 = class(TForm)
43.     Button1: TButton;
44.     procedure Button1Click(Sender: TObject);
45.   private
46.     FPicturePanel: TMyPicturePanel;
47.   public
48.  
49.   end;
50.  
51. var
52.   Form1: TForm1;
53.  
54. implementation
55.  
56. {$R *.lfm}
57.  
58. { TForm1 }
59.  
60. procedure TForm1.Button1Click(Sender: TObject);
61. var
62.   APicture: TPicture;
63. begin
64.   FPicturePanel := TMyPicturePanel.Create(Self, Self);
65.   APicture := TPicture.Create;
66.   APicture.LoadFromFile('project1.ico');
67.   FPicturePanel.SetPicture(APicture);
68.   APicture.Free;
69. end;
70.  
71. { TMyPicturePanel }
72.  
73. constructor TMyPicturePanel.Create(AOwner: TComponent; theParent: TForm);
74. begin
75.   inherited Create(AOwner);
76.  
77.   fBorderColor := clBlack;
78.   fBorderWidth := 1;
79.   fStretch := False;
80.   fPicture := TPicture.Create;
81.  
82.   MyPanel := TPanel.Create(Self);
83.   with MyPanel do
84.     begin;
85.       Parent := theParent;
86.       Align := alClient;
87.       BorderStyle := bsNone;
88.       BevelInner := bvNone;
89.       BevelOuter := bvNone;
90.       Color := clLime;
91.       OnPaint := @MyPaint;
92.     end;
93.  
94.   MyImage := TImage.Create(Self);
95.   with MyImage do
96.     begin
97.       Align := alClient;
98.       BorderSpacing.Around := 8;
99.       Parent := MyPanel;
100.       Stretch := fStretch;
101.       Picture := fPicture;
102.     end;
103.  
104.   Constraints.MinHeight := 10;
105.   Constraints.MinWidth := 10;
106.   SetBounds(0, 0, 96, 96);
107. end;
108.  
109. procedure TMyPicturePanel.SetBorderWidth(AValue : Integer);
110. begin
111.   if fBorderWidth <> AValue then
112.     begin
113.       fBorderWidth := AValue;
114.       MyPaint(MyPanel);
115.       MyImage.Repaint;
116.     end;
117. end;
118.  
119. function TMyPicturePanel.GetBorderWidth : Integer;
120. begin
121.   Result := fBorderWidth;
122. end;
123.  
124. procedure TMyPicturePanel.SetBorderColor(AValue : TColor);
125. begin
126.   if fBorderColor <> AValue then
127.     begin
128.       fBorderColor := AValue;
129.       MyPaint(MyPanel);
130.       MyImage.Repaint;
131.     end;
132. end;
133.  
134. function TMyPicturePanel.GetBorderColor : TColor;
135. begin
136.   Result := fBorderColor;
137. end;
138.  
139. procedure TMyPicturePanel.SetStretch(AValue : Boolean);
140. begin
141.   if fStretch <> AValue then
142.     begin
143.       fStretch := AValue;
144.       MyImage.Stretch := fStretch;
145.       MyImage.Repaint;
146.     end;
147. end;
148.  
149. function TMyPicturePanel.GetStretch : Boolean;
150. begin
151.   Result := fStretch;
152. end;
153.  
154. procedure TMyPicturePanel.SetPicture(AValue : TPicture);
155. begin
156.   if fPicture <> AValue then
157.     begin
158.       fPicture.Assign(AValue);
159.       // MyPaint(MyPanel);
160.       Invalidate;
161.     end;
162. end;
163.  
164. function TMyPicturePanel.GetPicture : TPicture;
165. begin
166.   Result := fPicture;
167. end;
168.  
169. procedure TMyPicturePanel.MyPaint(Sender: TObject);
170. var
171.   iOFFSET : Integer;
172. begin
173.   iOFFSET := (fBorderWidth - 1) div 2;
174.  
175.   MyImage.Picture.Assign(fPicture);
176.  
177.   with (Sender as TPanel) do
178.   begin
179.     Canvas.Pen.Color := fBorderColor;
180.     Canvas.Pen.Width := fBorderWidth;
181.     Canvas.Rectangle(iOFFSET, iOFFSET, (Width - iOFFSET), (Height - iOFFSET));
182.   end;
183.  
184.   MyImage.BorderSpacing.Around := fBorderWidth + iOFFSET + 1;
185. end;
186.  
187. end.

I don't know why it did not work for you. I set the parent to the form, call invalidate and removed the comment that disables the picture assignment, then it works.

[pcurtis]

Still doesn't work. I can't close the test app by clicking the window close button. Also the components parent is not the form but self otherwise the component fills the form.

[Handoko]

I can't close the test app by clicking the window close button.

Did you meant it happen only on yours or my demo?

[pcurtis]

Both.

[Handoko]

Please also provide the source codes of:
- MyComponents
- pl_ExControls

I seemed I don't need them. Sorry.

[pcurtis]

They are not needed. Remove the requirements.

[Handoko]

Running your demo on my Linux computer, I got this.

What is the problem?

[pcurtis]

I get this