Recent

Author Topic: [SOLVED] Custom control picture  (Read 1541 times)

pcurtis

  • Hero Member
  • *****
  • Posts: 634
[SOLVED] Custom control picture
« on: May 16, 2021, 06:42:53 am »
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.  
« Last Edit: May 16, 2021, 05:14:07 pm by pcurtis »
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #1 on: May 16, 2021, 07:43:23 am »
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

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #2 on: May 16, 2021, 09:13:46 am »
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.  
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #3 on: May 16, 2021, 09:31:58 am »
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

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #4 on: May 16, 2021, 09:35:54 am »
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.  
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #5 on: May 16, 2021, 09:39:45 am »
Yes, try it. Maybe it can solve the issue.

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #6 on: May 16, 2021, 09:45:02 am »
I have, it didn't  :(
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #7 on: May 16, 2021, 10:04:49 am »
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.
« Last Edit: May 16, 2021, 10:09:05 am by Handoko »

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #8 on: May 16, 2021, 10:25:20 am »
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.
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #9 on: May 16, 2021, 10:29:04 am »
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

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #10 on: May 16, 2021, 10:33:20 am »
Both.
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #11 on: May 16, 2021, 10:35:53 am »
Please also provide the source codes of:
- MyComponents
- pl_ExControls

I seemed I don't need them. Sorry.
« Last Edit: May 16, 2021, 10:39:37 am by Handoko »

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #12 on: May 16, 2021, 10:40:26 am »
They are not needed. Remove the requirements.
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4291
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #13 on: May 16, 2021, 10:42:40 am »
Running your demo on my Linux computer, I got this.

What is the problem?

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #14 on: May 16, 2021, 10:49:15 am »
I get this
« Last Edit: May 16, 2021, 10:51:04 am by pcurtis »
Windows 10
Laz 2.0.10
FPC 3.2.0

 

TinyPortal © 2005-2018