Composant tmonpanel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 2 748 fois - Téléchargée 15 fois

Contenu du snippet

Composant dérivé de TPanel qui offre la possibilité de glisser sans code supplémentaire ,de pouvoir être caché ,et d'offrir une caption comme une TForm;
Il posséde de plus les propriétés Canvas et OnPaint;

Source / Exemple :


unit MonPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TMonPanel = class(TPanel)
  private
    { Déclarations privées }
    fx0,fy0:integer;
    fclCaption:Tcolor;
    fclFontCaption:TColor;
    fbmp:Tbitmap;
    fonpaint:TnotifyEvent;
    procedure DoPaint(sender:Tobject);
    procedure WMFermer(var message: TWMLButtonDown);message WM_LButtonDown;
    procedure WMglisser(var message: TWMmousemove);message WM_mousemove;
  protected
    { Déclarations protégées }
    procedure Paint;override;

  public
    { Déclarations publiques }
    property canvas;
    constructor create(aowner:Tcomponent);override;
    destructor destroy;override;

  published
     property clCaption:Tcolor read fclCaption write fclCaption;
     property clFontCaption:Tcolor read fclFontCaption write fclFontCaption;
     property OnPaint:TNotifyEvent read fonpaint write fonpaint;
    { Déclarations publiées }
  end;

procedure Register;

implementation

constructor TMonPanel.create(aowner:Tcomponent);
begin
 inherited create(aowner);
 borderStyle:=bssingle;
 height:=150;
 fbmp:=Tbitmap.Create;
 fbmp.Width:=18;
 fbmp.Height:=18;
 fclFontCaption:=clwhite;
 with fbmp.Canvas do begin
     brush.Color:=clltgray;
     pen.Width:=2;
     Rectangle(rect(1,1,18,18));
     moveto(4,4);
     lineto(13,13);
     moveto(4,13);
     lineto(13,4);
end;
end;

destructor TMonPanel.destroy;
begin
fbmp.Free;
inherited destroy;
end;

procedure TMonPanel.DoPaint;
begin
If assigned (fOnPaint) then fOnPaint(self);
end;

procedure TMonPanel.WMFermer(var message: TWMLButtonDown);
begin
inherited ;
fx0:=message.xpos;
fy0:=message.yPOS;
with message do if ptinrect(rect(width-25,5,width-7,23),point(xpos,ypos))then hide;
end;

procedure TMonPanel.Paint;
begin
canvas.brush.Color:=fclCaption ;
canvas.FillRect(rect(0,0,width,30));
canvas.font.Color:=fclFontCaption;
canvas.Font.Size:=12;
canvas.TextOut(50,1,caption);
canvas.brush.Color:=color;
canvas.FillRect(rect(0,30,width,height));
canvas.Draw(width-25,5,fbmp);
DOpaint(self);
end;

procedure TMonPanel.WMglisser(var message: TWMmousemove);
begin
 with message do begin
 if keys=MK_LBUTTON then if ypos<25 then
 SetBounds(Left+xpos-fx0,top+ypos-fY0,width,height);
 end;
end;

procedure Register;
begin
  RegisterComponents('PSL', [TMonPanel]);
end;

end.

Conclusion :


Plus économique en ressources qu'une TForm il peut être utilisé pour remplacer ToolWindow.

A voir également

Ajouter un commentaire

Commentaire

cs_MAURICIO
Messages postés
2233
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5 -
Salut,

ça me rappelle lorsque j' ai commencé à créer des compos ^^
Attention car on devient vite accro!

A+

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.