Recent

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

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #15 on: May 16, 2021, 10:55:40 am »
No such issue happens on Linux. Give me some time, I will try it on Windows.

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #16 on: May 16, 2021, 11:00:46 am »
If I don't load the picture

Code: Pascal  [Select][+][-]
  1. procedure TForm1.FormCreate(Sender: TObject);
  2. begin
  3.   MyPicture := TMyPicturePanel.Create(self);
  4.   MyPicture.Left := 8;
  5.   MyPicture.Top := 8;
  6.   MyPicture.Parent := Form1;
  7.   MyPicture.BorderAround := SpinEdit1.Value;
  8.   //MyPicture.Picture.LoadFromFile('lll.jpg');
  9. end;
  10.  

I get this
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #17 on: May 16, 2021, 11:36:02 am »
I made some progress:

Code: Pascal  [Select][+][-]
  1. procedure TMyPicturePanel.MyPaint(Sender: TObject);
  2. var
  3.   iOFFSET : Integer;
  4. begin
  5.   iOFFSET := (fBorderWidth - 1) div 2;
  6.  
  7.   //MyImage.Picture.Assign(fPicture);
  8.  
  9.   with (Sender as TPanel) do
  10.   begin
  11.     Canvas.Pen.Color := fBorderColor;
  12.     Canvas.Pen.Width := fBorderWidth;
  13.     Canvas.Rectangle(iOFFSET, iOFFSET, (Width - iOFFSET), (Height - iOFFSET));
  14.   end;
  15.  
  16.   MyPanel.Canvas.Draw(iOFFSET, iOFFSET, fPicture.Bitmap);
  17.  
  18.   MyImage.BorderSpacing.Around := fBorderWidth + iOFFSET + fBorderAround;
  19. end;

OnPaint or paint event is for painting only, it should not contain any non-painting code. You made a mistake by assigning a picture there, which already done on the mainform OnCreate's event by calling MyPicture.Picture.LoadFromFile('lll.jpg'); .

Assigning a picture on the line #7 will make the control to indirectly call invalidate, so you got an endless loop.

You have to remove the line #7. For showing the picture you can use Canvas.Draw as on the line #16 or use other command. I cannot finished your code as I'm not very sure what you want it to look like.
« Last Edit: May 16, 2021, 11:41:36 am by Handoko »

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #18 on: May 16, 2021, 12:17:55 pm »
I found more issue.

On the line #18 in the (previous post) you set the border spacing, which should be removed.

Changing the component state or behavior or appearance should not be done inside OnPaint event.
« Last Edit: May 16, 2021, 12:20:37 pm by Handoko »

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #19 on: May 16, 2021, 12:38:23 pm »
So far thanks, but I need to put the image into MyImage not draw on the panel (so I can use stretch and borderspacing.around). Any ideas?
The final component should look like your image in post #13

Is this painting issue just a windows problem?

If so "Write once compile anywhere"?
« Last Edit: May 16, 2021, 12:46:04 pm by pcurtis »
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #20 on: May 16, 2021, 12:44:04 pm »
It hink your code will be better if you remove MyPicture, reasons:
- You already manually manage the picture, fPicture
- You manually do painting, MyPaint procedure

Because TImage is for automatically painting/showing the image to users and it has its own picture property, these features are overlapped with what you're doing: fPicture, MyPaint.

I need to put the image into MyImage not draw on the panel (so I can use stretch and borderspacing.around).

Give me some time, I'm having my dinner now.

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #21 on: May 16, 2021, 01:45:47 pm »
Done.

But I have no idea what the BorderAround for and it has a cosmetic issue when running on GTK2.

Code: Pascal  [Select][+][-]
  1. unit mypicturepanel;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, Controls, Graphics, ExtCtrls;
  9. type
  10.  
  11.   { TMyPicturePanel }
  12.  
  13.   TMyPicturePanel = class(TCustomControl)
  14.  
  15.   private
  16.     procedure SetBorderWidth(AValue : Integer);
  17.     function GetBorderWidth : Integer;
  18.     procedure SetBorderAround(AValue : Integer);
  19.     function GetBorderAround : Integer;
  20.     procedure SetBorderColor(AValue : TColor);
  21.     function GetBorderColor : TColor;
  22.     procedure SetStretch(AValue : Boolean);
  23.     function GetStretch : Boolean;
  24.     procedure SetPicture(AValue : TPicture);
  25.     function GetPicture : TPicture;
  26.   public
  27.     MyImage: TImage;
  28.     MyPanel: TPanel;
  29.     constructor Create(AOwner : TComponent); override;
  30.   published
  31.     property Color;
  32.     property BorderWidth: Integer read GetBorderWidth write SetBorderWidth;
  33.     property BorderAround: Integer read GetBorderAround write SetBorderAround;
  34.     property BorderColor: TColor read GetBorderColor write SetBorderColor;
  35.     property Stretch: Boolean read GetStretch write SetStretch;
  36.     property Picture: TPicture read GetPicture write SetPicture;
  37.   end;
  38.  
  39. procedure Register;
  40.  
  41. implementation
  42.  
  43. constructor TMyPicturePanel.Create(AOwner : TComponent);
  44. begin
  45.   inherited Create(AOwner);
  46.  
  47.   MyPanel := TPanel.Create(Self);
  48.   with MyPanel do
  49.   begin;
  50.     Parent      := Self;
  51.     Align       := alClient;
  52.     BevelOuter  := bvSpace;
  53.     BevelWidth  := 1;
  54.     Color       := clBlack;
  55.   end;
  56.  
  57.   MyImage := TImage.Create(Self);
  58.   with MyImage do
  59.   begin
  60.     Align   := alClient;
  61.     Parent  := MyPanel;
  62.     Stretch := False;
  63.   end;
  64.  
  65.   Color                 := clBtnFace;
  66.   Constraints.MinHeight := 10;
  67.   Constraints.MinWidth  := 10;
  68.   SetBounds(0, 0, 96, 96);
  69. end;
  70.  
  71. procedure TMyPicturePanel.SetBorderWidth(AValue : Integer);
  72. begin
  73.   if MyPanel.BevelWidth = AValue then Exit;
  74.   MyPanel.BevelWidth := AValue;
  75. end;
  76.  
  77. function TMyPicturePanel.GetBorderWidth : Integer;
  78. begin
  79.   Result := MyPanel.BevelWidth;
  80. end;
  81.  
  82. procedure TMyPicturePanel.SetBorderAround(AValue : Integer);
  83. begin
  84.   // Sorry I have idea what BorderAround for
  85. end;
  86.  
  87. function TMyPicturePanel.GetBorderAround : Integer;
  88. begin
  89.   // Sorry I have idea what BorderAround for
  90. end;
  91.  
  92. procedure TMyPicturePanel.SetBorderColor(AValue : TColor);
  93. begin
  94.   if MyPanel.BevelColor = AValue then Exit;
  95.   MyPanel.BevelColor := AValue;
  96. end;
  97.  
  98. function TMyPicturePanel.GetBorderColor : TColor;
  99. begin
  100.   Result := MyPanel.BevelColor;
  101. end;
  102.  
  103. procedure TMyPicturePanel.SetStretch(AValue : Boolean);
  104. begin
  105.   if MyImage.Stretch = AValue then Exit;
  106.   MyImage.Stretch := AValue;
  107. end;
  108.  
  109. function TMyPicturePanel.GetStretch : Boolean;
  110. begin
  111.   Result := MyImage.Stretch;
  112. end;
  113.  
  114. procedure TMyPicturePanel.SetPicture(AValue : TPicture);
  115. begin
  116.   if MyImage.Picture = AValue then Exit;
  117.   MyImage.Picture.Assign(AValue);
  118. end;
  119.  
  120. function TMyPicturePanel.GetPicture : TPicture;
  121. begin
  122.   Result := MyImage.Picture;
  123. end;
  124.  
  125. procedure Register;
  126. begin
  127.   RegisterComponents('Misc', [TMyPicturePanel]);
  128. end;
  129.  
  130. end.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Forms, Graphics, Dialogs, ComCtrls, StdCtrls, MyPicturePanel;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     btnColor: TButton;
  16.     cbxStretch: TCheckBox;
  17.     ColorDialog1: TColorDialog;
  18.     Label1: TLabel;
  19.     trbBorderWidth: TTrackBar;
  20.     procedure btnColorClick(Sender: TObject);
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure cbxStretchChange(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure SpinEdit1Change(Sender: TObject);
  25.     procedure trbBorderWidthChange(Sender: TObject);
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.   MyPicture : TMyPicturePanel;
  31.  
  32. implementation
  33.  
  34. {$R *.lfm}
  35.  
  36. { TForm1 }
  37.  
  38. procedure TForm1.FormCreate(Sender: TObject);
  39. begin
  40.   MyPicture        := TMyPicturePanel.Create(self);
  41.   MyPicture.Left   := 8;
  42.   MyPicture.Top    := 8;
  43.   MyPicture.Parent := Form1;
  44.   MyPicture.Picture.LoadFromFile('lll.jpg');
  45. end;
  46.  
  47. procedure TForm1.SpinEdit1Change(Sender: TObject);
  48. begin
  49.   MyPicture.Stretch := cbxStretch.Checked;
  50. end;
  51.  
  52. procedure TForm1.trbBorderWidthChange(Sender: TObject);
  53. begin
  54.   MyPicture.BorderWidth := trbBorderWidth.Position;
  55. end;
  56.  
  57. procedure TForm1.Button1Click(Sender: TObject);
  58. begin
  59.   MyPicture.BorderColor := clRed;
  60. end;
  61.  
  62. procedure TForm1.btnColorClick(Sender: TObject);
  63. begin
  64.   if not(ColorDialog1.Execute) then Exit;
  65.   MyPicture.BorderColor := ColorDialog1.Color;
  66. end;
  67.  
  68. procedure TForm1.cbxStretchChange(Sender: TObject);
  69. begin
  70.   MyPicture.Stretch := cbxStretch.Checked;
  71. end;
  72.  
  73. end.


edit:
I've just noticed line #65 in the mypicturepanel.pas is not needed, you should remove it.
« Last Edit: May 16, 2021, 01:51:43 pm by Handoko »

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #22 on: May 16, 2021, 03:10:32 pm »
OK Thanks. It's not exactly what  I had in mind, but a start. I'll look later.
Windows 10
Laz 2.0.10
FPC 3.2.0

jamie

  • Hero Member
  • *****
  • Posts: 4732
Re: Custom control picture
« Reply #23 on: May 16, 2021, 03:13:11 pm »
I think you are not taking advantage of the base control as it should be used..
here is a test code I just whipped up that draws an image on a custom control and ways to handle the drawing..
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,lclintf;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  TMyControl = Class(TCustomControl)
  14.   Private
  15.    FImage :TBitmap;
  16.    fBorderWidth:Integer;
  17.    fBorderColor:TColor;
  18.    Procedure fSetBorderColor(aColor:TColor);
  19.    Procedure  FsetBorderWidth(aWidth:Integer);
  20.    Procedure fSetImage(AImage:Tbitmap);
  21.    procedure Paint; Override;
  22.  Public
  23.    constructor Create(AOwner:TComponent); override;
  24.    Destructor Destroy;override;
  25.  Published
  26.     Property BorderColor:Tcolor read fBorderColor write fSetBorderColor;
  27.     Property  BorderWidth:integer read fBorderWidth write fSetBorderWidth;
  28.     Property TheImage:TBitmap read Fimage write fSetImage;
  29.  end;
  30.  
  31.   TForm1 = class(TForm)
  32.     procedure FormCreate(Sender: TObject);
  33.   private
  34.  
  35.   public
  36.    MyControl :TMyControl;
  37.   end;
  38.  
  39. var
  40.   Form1: TForm1;
  41.  
  42. implementation
  43.  
  44. {$R *.lfm}
  45. Procedure TmyControl.FSetBorderColor(aColor:TColor);
  46. begin
  47.  fBorderColor := aColor;
  48. end;
  49.  
  50. Procedure TmyControl.FsetBorderWidth(AWidth:Integer);
  51. begin
  52.  fBorderWidth := Awidth;
  53. End;
  54. Procedure TmyControl.fSetImage(AImage:TBitmap);
  55. begin
  56.  Fimage.Assign(AImage);
  57.  Invalidate;
  58. end;
  59.  
  60. Procedure TmyControl.Paint;
  61. var
  62.   R:Trect;
  63. begin
  64.   Inherited Paint;
  65.   R := ClientRect;
  66.   With self Do begin
  67.    if Fimage <> Nil Then
  68.    Begin
  69.      if FBorderWidth <> 0 Then
  70.        begin
  71.          Canvas.Pen.Color := fBorderColor;
  72.          Canvas.Pen.Width := fBorderWidth;
  73.          Canvas.Pen.EndCap := pecRound ;
  74.          Canvas.Rectangle(R);
  75.        end;
  76.      InflateRect(R,-fBorderWidth,-fBorderWidth);
  77.      canvas.StretchDraw(R, fImage);
  78.    end;
  79.   end;
  80. end;
  81. Constructor TMyControl.Create(Aowner:TComponent);
  82. Begin
  83.   Inherited Create(AOwner);
  84.   fImage := Tbitmap.Create;
  85. end;
  86. Destructor TmyControl.Destroy;
  87. begin
  88.   fImage.Free;
  89.   Inherited Destroy;
  90. end;
  91.  
  92. { TForm1 }
  93.  
  94. procedure TForm1.FormCreate(Sender: TObject);
  95. Var
  96.   B:TBitmap;
  97. begin
  98.  MyControl := TMyControl.Create(Self);
  99.  MyControl.Parent := Self;
  100.  MyControl.SetBounds(0,0,200,200);
  101.  MyControl.BorderWidth := 10;
  102.  MyControl.BorderColor := clRed;
  103.  B := TBitMap.Create;
  104.  B.LoadFromDevice(getDc(0));
  105.  MyControl.TheImage := B;
  106.  B.Free;
  107.  MyControl.Show;
  108. end;
  109.  
  110. end.
  111.  
  112.  

P.S.

 There is a BeginUpdateBounds you can use when changing a lot of parameters that will effect the bounds, this prevents rapid repaints.

 also you should be checking for the component state to ensure its not in the loading mode before painting to the screen etc.
The only true wisdom is knowing you know nothing

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: Custom control picture
« Reply #24 on: May 16, 2021, 04:00:48 pm »
Yes, your code is better. It is more lightweight.

After OP can understand my code, which is easier, he then should study your example.

pcurtis

  • Hero Member
  • *****
  • Posts: 634
Re: Custom control picture
« Reply #25 on: May 16, 2021, 05:12:42 pm »
OK HANDOKO I've modded your code and it woks fine.
Windows 10
Laz 2.0.10
FPC 3.2.0

Handoko

  • Hero Member
  • *****
  • Posts: 4310
  • My goal: build my own game engine using Lazarus
Re: [SOLVED] Custom control picture
« Reply #26 on: May 16, 2021, 05:47:41 pm »
Yes, I downloaded your latest version. It works on Linux. Glad to see you now understand the basic of component creation. It's fun, I do it a lot.

Previously, your mistake was doing the painting while that already handled automatically by TImage and TPanel themselves.

If you want to learn further, you should try to handle all the painting yourself just like showed in jamie's code.

Or maybe you want to try to create more visual components, Alextp has many useful and good looking components you can try to create some of them.
https://wiki.freepascal.org/User:Alextp#Components

 

TinyPortal © 2005-2018