home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 January / Pcwk0198.iso / Dcomplib / BARESIZE.LZH / CUS_BAS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-03-30  |  2KB  |  96 lines

  1. unit Cus_Bas;
  2.  
  3. interface
  4.  
  5. uses Classes, Controls, winprocs,SysUtils, Messages, WinTypes, Forms, Graphics ;
  6.  
  7. type
  8.   PCustomControl_Base = ^TCustomControl_Base ;
  9.   TCustomControl_Base = class(TCustomControl)
  10.     private
  11.     protected
  12.       procedure DessinerOmbre(MyRectangle:TRect;IsUp,IsFond,IsContour:Boolean;Epaisseur:Integer) ;
  13.       procedure DessinerBitmap(Canvas : TCanvas;Bitmap : TBitmap;Zone : TRect) ;
  14.     public
  15.       procedure Redraw ;
  16.     published
  17.   end;
  18.  
  19. implementation
  20.  
  21. procedure TCustomControl_Base.Redraw ;
  22. begin
  23.   InvalidateRect(Handle,nil,TRUE) ;
  24. end ;
  25.  
  26. procedure TCustomControl_Base.DessinerBitmap(Canvas : TCanvas;Bitmap : TBitmap;Zone : TRect) ;
  27. begin
  28.   with Zone,Canvas do
  29.     Draw(left+((right-left-Bitmap.Width) DIV 2),
  30.          top+((bottom-top-Bitmap.Height) DIV 2),
  31.          Bitmap) ;
  32. end ;
  33.  
  34. procedure TCustomControl_Base.DessinerOmbre(MyRectangle:TRect;IsUp,IsFond,IsContour:Boolean;Epaisseur:Integer) ;
  35. var
  36.   i       : Integer ;
  37. begin
  38.   with Canvas,MyRectangle do
  39.   begin
  40.     if IsFond then
  41.     begin
  42.          Pen.Color:=RGB(192,192,192) ;
  43.          Brush.Color:=RGB(192,192,192) ;
  44.          Rectangle(left,top,right,bottom) ;
  45.     end ;
  46.  
  47.     Pen.Color:=RGB(0,0,0) ;
  48.  
  49.     if IsContour then
  50.     begin
  51.       MoveTo(left,top) ;
  52.       LineTo(right,top) ;
  53.       MoveTo(left,top) ;
  54.       LineTo(left,bottom) ;
  55.     end ;
  56.  
  57.     if IsUp then
  58.       Pen.Color:=RGB(255,255,255)
  59.     else
  60.       Pen.Color:=RGB(128,128,128) ;
  61.  
  62.     for i:=1 to Epaisseur do
  63.     begin
  64.       MoveTo(left+1,top+i) ;
  65.       LineTo(right-i,top+i) ;
  66.       MoveTo(left+i,top+1) ;
  67.       LineTo(left+i,bottom-i) ;
  68.     end ;
  69.  
  70.     Pen.Color:=RGB(0,0,0) ;
  71.  
  72.     if IsContour then
  73.     begin
  74.       MoveTo(right-1,top+1) ;
  75.       LineTo(right-1,bottom) ;
  76.       MoveTo(left,bottom-1) ;
  77.       LineTo(right,bottom-1) ;
  78.     end ;
  79.  
  80.     if not IsUp then
  81.       Pen.Color:=RGB(255,255,255)
  82.     else
  83.       Pen.Color:=RGB(128,128,128) ;
  84.  
  85.     for i:=1 to Epaisseur do
  86.     begin
  87.       MoveTo(left+Epaisseur-i,bottom-Epaisseur-2+i) ;
  88.       LineTo(right-1,bottom-Epaisseur-2+i) ;
  89.       MoveTo(right-Epaisseur-2+i,top+Epaisseur+1-i) ;
  90.       LineTo(right-Epaisseur-2+i,bottom-1) ;
  91.     end ;
  92.   end ;
  93. end ;
  94.  
  95. end.
  96.