Results 1 to 10 of 10

Thread: Automatisch painten van een nieuwe component. Verschil Component Palette en Runtime

  1. #1
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106

    Automatisch painten van een nieuwe component. Verschil Component Palette en Runtime

    Hallo,

    Ik heb een component gemaakt die ik vanaf het componentpalette op mijn form kan plaatsen. Direct bij plaatsen wordt de Paint method aangeroepen zonder dat ik dat expliciet moet opgeven in de code.(Dat is ook de bedoeling).

    Als ik hetzelfde component aanmaak met code in runtime dan moet ik in de CreateWnd de paint method aanroepen, anders wordt er niets zichtbaar, ook al heb ik de parent goed ingesteld.

    Ik denk dat ik iets verkeerd doe, want paint wordt al aangeroepen als het component uit de componentpalette komt, en dan is het dubbelop.

    Ik wil dat het gedrag hetzelfde is als bij een TButton, namelijk zodra je de parent insteld is hij zichtbaar wordt ongeacht of hij wel of niet op het form gesleept is.

    Hoe los ik dit op een goede manier op zonder overbodige Paint aanroepen te doen?

    Dit is de aanroep om het component te tonen in runtime, werkt goed als de // voor Paint; weer weggehaald worden in CreateWnd:

    Code:
    procedure TForm1.btnToonTekstClick(Sender: TObject);
    var
      Tekst: TTekst;
    begin
      Tekst := TTekst.Create(Self);
      Tekst.Parent := Form1;
    end;
    Dit is de code voor de component:

    Code:
    unit unitTekst;
    
    interface
    
    uses
      Classes, Vcl.Controls, Vcl.Graphics, System.Types;
    
    type
    
      TTekst = class(TCustomControl)
      private
        FTekst: string;
      protected
        function getTekst: string; virtual;
        procedure setTekst(oTekst: string);
      public
        constructor Create(Owner: TComponent); override;
        destructor Destroy; override;
        procedure Paint; override;
        procedure CreateWnd; override;
      published
        property Color;
        property Tekst:string read getTekst write setTekst;
      end;
    
    procedure Register;
    
    implementation
    
    constructor TTekst.Create(Owner: TComponent);
    begin
      inherited Create(Owner);
    
      Color := clGreen;
      FTekst:='Tekst';
    end;
    
    procedure TTekst.CreateWnd;
    begin
      inherited;
    
     // Paint;  //Dit is niet nodig als het een VCL Component is uit het palette
                //maar is wel nodig als ik deze component in runtime aanmaak
    end;
    
    destructor TTekst.Destroy;
    begin
      inherited Destroy;
    end;
    
    
    function TTekst.getTekst: string;
    begin
      Result := FTekst;
    end;
    
    procedure TTekst.setTekst(oTekst: string);
    begin
      FTekst := oTekst;
      Invalidate;
    end;
    
    procedure TTekst.Paint;
    begin
      Width := Canvas.TextWidth(Tekst) + 20;
      Height := Canvas.TextHeight(Tekst) + 20;
    
      Canvas.TextOut(10, 10, Tekst);
    end;
    
    procedure Register;
    begin
      RegisterComponents('Tekst', [TTekst]);
    end;
    
    end.

  2. #2
    Dit stukje code tekent bij mij gewoon een TCustomControl op het form @runtime:
    Delphi Code:
    1. procedure TForm1.Button1Click(Sender: TObject);
    2. var
    3.   C: TCustomControl;
    4. begin
    5.   C := TCustomControl.Create(Self);
    6.   C.Top := 5;
    7.   C.Left := 150;
    8.   C.Width := 150;
    9.   C.Height := 50;
    10.   C.Color := 0;
    11.   C.Parent := Self;
    12. end;

    Bart

  3. #3
    Volgens mij komt het omdat je de width pas in de Paint method zet. Zet die eens in de SetText method. Standaard heeft ie nu een Width en Height van 0, en wellicht krijgt ie daardoor geen Paint message.

    Overigens, ik neem aan dat dit alleen een oefening is? Als je daadwerkelijk een text control met Window handle nodig hebt, dan is er al TStaticText (ook om in de code te gluren hoe het werkt).
    1+1=b

  4. #4
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Bedankt voor de reactie, het bracht me op een idee.

    Bij het constructen van de component heb ik de Width aangepast zodat de Paint afgaat, nu werkt alles naar behoren.

    In de setTekst wordt Invalidate aangeroepen, zodat de paint afgaat, dat was al goed.


    Code:
    constructor TTekst.Create(Owner: TComponent);
    begin
      inherited Create(Owner);
      Width := 1; //<== Dit zorgt dat het werkt
      Height := 1;//<==
    
      Color := clGreen;
      FTekst := 'Tekst';
    end;
    Het is inderdaad een oefening om een hele primitieve component te bouwen, die zichzelf repaint als er een property wordt aangepast.

  5. #5
    Reader
    Join Date
    May 2002
    Location
    Holland
    Posts
    3,382
    Verander geen Width of Height in de Paint method.
    Maar zoals @Golez zegt in de SetText method.
    Als een repaint nodig is, roep dan Invalidate() aan.

  6. #6
    Eric,

    Je zegt : "Verander geen Width en Height in de Paint procedure", maar waar dan wel?

    H.G. Frans

  7. #7
    Quote Originally Posted by EricLang View Post
    Maar zoals @Golez zegt in de SetText method.
    Kan overigens ook wel in Paint, maar het is wel ongebruikelijk, en zou voor onnodig geknipper kunnen zorgen. In basis is het alleen nodig als de tekst wijzigt, of het font. Ik zou het dus in de setters daarvan zetten. En al je dan Tekst zet i.p.v. FTekst in de constructor, dan is dat ook meteen ondervangen.
    1+1=b

  8. #8
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Bedankt voor de tips. Ik heb Width en Height vervangen door SetBounds. Omdat er dan maar 1 keer invalidate wordt aangeroepen i.p.v 2 keer.
    Ik heb Width en Height uit Paint gehaald en in de vorm van SetBounds in SetTekst gezet.

    Het setten van Width en Height roept SetBounds aan vandaar dat ik direct Setbounds aanroep

    Om SetTekst ook bij het Createn van de component af te laten gaan, moest ik Tekst := 'Tekst'; in CreateWnd zetten, want in Create kan het niet omdat er nog geen parent window is.

    Als het nog efficienter kan, dan hoor ik het graag van jullie.

    Code:
    constructor TTekst.Create(Owner: TComponent);
    begin
      inherited Create(Owner);
      SetBounds(0,0,1,1);
    
      Color := clGreen;
    end;
    
    procedure TTekst.CreateWnd;
    begin
      inherited;
      Tekst := 'Tekst';
    end;
    
    function TTekst.getTekst: string;
    begin
      Result := FTekst;
    end;
    
    procedure TTekst.setTekst(oTekst: string);
    begin
      FTekst := oTekst;
    
      SetBounds(Left,Top,(Canvas.TextWidth(FTekst) + 20),(Canvas.TextHeight(FTekst) + 20));
    end;
    
    procedure TTekst.Paint;
    begin
      Canvas.TextOut(10, 10, FTekst);
    end;

  9. #9
    Silly member NGLN's Avatar
    Join Date
    Aug 2004
    Location
    Werkendam
    Posts
    5,133
    Nice job, je bent al een heel eind.

    Nog enkele opmerkingen:
    - Een afmeting van 1x1 pixel zou niet nodig hoeven zijn om de zichtbaarheid initieel te forceren. Deze regel kan weg.
    - SetBounds/Width/Height gebruik je alleen in de constructor als jouw control/component een (afwijkende) standaardafmeting dient te hebben die niet uit de rest van de properties resulteert. Dat is hier niet van toepassing, want jouw control heeft eigenlijk een AutoSize feature waarmee de afmetingen wél uit de rest van de properties blijkt, namelijk de tekst.
    - Paint is nu public, maar dat wil je niet, want dan zou de gebruiker jouw overriden routine rechtstreeks kunnen aanroepen. Paint in TGraphicControl is protected, dus laat dat maar zo.
    - De standaardtekst is blijkbaar 'Tekst'. Een dergelijk instelling dient absoluut in de constructor plaats te vinden, en bij voorkeur met een constante. Verwijder dit uit CreateWnd.
    - In CreateWnd heeft het control een handle zodat de afmetingen uitgelezen en aangepast kunnen worden. Eigenlijk dezelfde code als in SetTekst. Oftewel, verplaats dat dan maar naar een aparte routine: AdjustBounds (stiekem "gejat" uit de code van TCustomLabel).
    - Alleen SetBounds in SetTekst is niet voldoende: stel dat de nieuwe tekst in exact dezelfde afmetingen resulteert? Dus ook nog invalidate erbij.
    - Als je ervoor kiest om GetTekst virtual te declareren, waarvoor gebruikers van jouw component dankbaar zullen zijn, maak SetTekst dan ook virtual.

    Alles bij elkaar zou het er dan zou uit kunnen komen te zien:

    Delphi Code:
    1. type
    2.   TTekst = class(TCustomControl)
    3.   const
    4.     DefMargin = 10;
    5.     DefTekst = 'Tekst';
    6.   private
    7.     FTekst: string;
    8.   protected
    9.     procedure AdjustBounds; virtual;
    10.     procedure CreateWnd; override;
    11.     function GetTekst: string; virtual;
    12.     procedure Paint; override;
    13.     procedure SetTekst(Value: string); virtual;
    14.   public
    15.     constructor Create(Owner: TComponent); override;
    16.   published
    17.     property Color;
    18.     property Tekst: string read getTekst write setTekst;
    19.   end;
    20.  
    21. procedure TTekst.AdjustBounds;
    22. begin
    23.   if HandleAllocated then
    24.   begin
    25.     SetBounds(Left, Top, Canvas.TextWidth(FTekst) + 2 * DefMargin,
    26.       Canvas.TextHeight(FTekst) + 2 * DefMargin);
    27.   end;
    28. end;
    29.  
    30. constructor TTekst.Create(Owner: TComponent);
    31. begin
    32.   inherited Create(Owner);
    33.   Color := clGreen;
    34.   FTekst := DefTekst;
    35. end;
    36.  
    37. procedure TTekst.CreateWnd;
    38. begin
    39.   inherited CreateWnd;
    40.   AdjustBounds;
    41. end;
    42.  
    43. function TTekst.GetTekst: string;
    44. begin
    45.   Result := FTekst;
    46. end;
    47.  
    48. procedure TTekst.SetTekst(Value: string);
    49. begin
    50.   if FTekst <> Value then
    51.   begin
    52.     FTekst := Value;
    53.     AdjustBounds;
    54.     Invalidate;
    55.   end;
    56. end;
    57.  
    58. procedure TTekst.Paint;
    59. begin
    60.   Canvas.TextOut(DefMargin, DefMargin, FTekst);
    61. end;
    Last edited by NGLN; 16-Nov-20 at 17:30.
    (Sender as TNLDUser).Signature := 'Groeten van Albert';

  10. #10
    Senior Member
    Join Date
    Aug 2003
    Location
    Vlaardingen
    Posts
    106
    Bedankt voor het meedenken. Ik heb nu een mooie basis voor ingewikkeldere componenten.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •