Forum > General
[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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit mypicturepanel; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, StdCtrls, ExtCtrls, ComCtrls, Dialogs, Buttons;type TMyPicturePanel = class(TCustomControl) private fBorderWidth : Integer; fBorderColor : TColor; fStretch : Boolean; fPicture : TPicture; procedure SetBorderWidth(AValue : Integer); function GetBorderWidth : Integer; procedure SetBorderColor(AValue : TColor); function GetBorderColor : TColor; procedure SetStretch(AValue : Boolean); function GetStretch : Boolean; procedure SetPicture(AValue : TPicture); function GetPicture : TPicture; protected public MyImage : TImage; MyPanel : TPanel; constructor Create(AOwner : TComponent); override; published procedure MyPaint(Sender: TObject); property BorderWidth : Integer read GetBorderWidth write SetBorderWidth; property BorderColor : TColor read GetBorderColor write SetBorderColor; property Stretch : Boolean read GetStretch write SetStretch; property Picture : TPicture read GetPicture write SetPicture; end; procedure Register; implementation constructor TMyPicturePanel.Create(AOwner : TComponent);begin inherited Create(AOwner); fBorderColor := clBlack; fBorderWidth := 1; fStretch := False; fPicture := TPicture.Create; MyPanel := TPanel.Create(Self); with MyPanel do begin; Parent := Self; Align := alClient; BorderStyle := bsNone; BevelInner := bvNone; BevelOuter := bvNone; Color := clLime; OnPaint := @MyPaint; end; MyImage := TImage.Create(Self); with MyImage do begin Align := alClient; BorderSpacing.Around := 8; Parent := MyPanel; Stretch := fStretch; Picture := fPicture; end; Constraints.MinHeight := 10; Constraints.MinWidth := 10; SetBounds(0, 0, 96, 96);end; procedure TMyPicturePanel.SetBorderWidth(AValue : Integer);begin if fBorderWidth <> AValue then begin fBorderWidth := AValue; MyPaint(MyPanel); MyImage.Repaint; end;end; function TMyPicturePanel.GetBorderWidth : Integer;begin Result := fBorderWidth;end; procedure TMyPicturePanel.SetBorderColor(AValue : TColor);begin if fBorderColor <> AValue then begin fBorderColor := AValue; MyPaint(MyPanel); MyImage.Repaint; end;end; function TMyPicturePanel.GetBorderColor : TColor;begin Result := fBorderColor;end; procedure TMyPicturePanel.SetStretch(AValue : Boolean);begin if fStretch <> AValue then begin fStretch := AValue; MyImage.Stretch := fStretch; //MyImage.Repaint; end;end; function TMyPicturePanel.GetStretch : Boolean;begin Result := fStretch;end; procedure TMyPicturePanel.SetPicture(AValue : TPicture);begin if fPicture <> AValue then begin fPicture.Assign(AValue); MyPaint(MyPanel); end;end; function TMyPicturePanel.GetPicture : TPicture;begin Result := fPicture;end; procedure TMyPicturePanel.MyPaint(Sender: TObject);var iOFFSET : Integer;begin iOFFSET := (fBorderWidth - 1) div 2; //MyImage.Picture.Assign(fPicture); with (Sender as TPanel) do begin Canvas.Pen.Color := fBorderColor; Canvas.Pen.Width := fBorderWidth; Canvas.Rectangle(iOFFSET, iOFFSET, (Width - iOFFSET), (Height - iOFFSET)); end; MyImage.BorderSpacing.Around := fBorderWidth + iOFFSET + 1;end; procedure Register;begin RegisterComponents('Misc', [TMyPicturePanel]);end; end.
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---constructor TMyPicturePanel.Create(anOwner : TComponent; theForm: TForm);begin // ... MyPanel.Parent := theForm; // ...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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TMyPicturePanel.SetPicture(AValue : TPicture);begin if fPicture <> AValue then // is this correct begin fPicture.Assign(AValue); // is this correct MyPaint(MyPanel); end;end; function TMyPicturePanel.GetPicture : TPicture;begin Result := fPicture; // is this correctend;
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TMyPicturePanel.SetPicture(AValue : TPicture);begin if fPicture <> AValue then begin fPicture.Assign(AValue); MyPanel.Invalidate; end;end;
Navigation
[0] Message Index
[#] Next page