1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
| { ****************************************************************** }
{ }
{ VCL component TMosaic }
{ }
{ Code generated by Component Create for Delphi }
{ }
{ Generated from source file c:\documents and settings\admin\mes documents\delphi\objets\mosaic.cd }
{ on 1 Jan 2002 at 3:03 }
{ }
{ Copyright © 2010 by Deconchat }
{ }
{ ****************************************************************** }
unit Mosaic;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Extctrls, Jpeg, Dialogs;
{ Unit-wide declarations }
type TPublicGraphicControl=class(TGraphicControl);
{ var }
{ . . . }
type
TMosaic = class(TImage)
private
{ Private fields of TMosaic }
{ Storage for property Mosaic }
FMosaic : Boolean;
{ Private methods of TMosaic }
{ Method to set variable and property values and create objects }
procedure AutoInitialize;
{ Method to free any objects created by AutoInitialize }
procedure AutoDestroy;
{ Read method for property Mosaic }
function GetMosaic : Boolean;
{ Write method for property Mosaic }
procedure SetMosaic(Value : Boolean);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
{ Protected fields of TMosaic }
Mosaic_faite : Boolean;
{ Protected methods of TMosaic }
procedure Loaded; override;
procedure Paint; override;
public
{ Public fields and properties of TMosaic }
{ Public methods of TMosaic }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published properties of TMosaic }
property OnDblClick;
property OnDragDrop;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Mosaic : Boolean read GetMosaic write SetMosaic default False;
end;
procedure Register;
implementation
procedure Register;
begin
{ Register TMosaic with Deconchat as its
default page on the Delphi component palette }
RegisterComponents('Deconchat', [TMosaic]);
end;
{ Method to set variable and property values and create objects }
procedure TMosaic.AutoInitialize;
begin
Mosaic_faite := False;
FMosaic := False;
end; { of AutoInitialize }
{ Method to free any objects created by AutoInitialize }
procedure TMosaic.AutoDestroy;
begin
{ No objects from AutoInitialize to free }
end; { of AutoDestroy }
{ Read method for property Mosaic }
function TMosaic.GetMosaic : Boolean;
begin
Result := FMosaic;
end;
{ Write method for property Mosaic }
procedure TMosaic.SetMosaic(Value : Boolean);
var change : boolean;
begin
change:=fmosaic;
FMosaic := Value;
{ If changing this property affects the appearance of
the component, call Invalidate here so the image will be
updated. }
{ Invalidate; }
Mosaic_faite:=change=fmosaic;
paint;
end;
constructor TMosaic.Create(AOwner: TComponent);
begin
{ Call the Create method of the parent class }
inherited Create(AOwner);
{ AutoInitialize sets the initial values of variables and }
{ properties; also, it creates objects for properties of }
{ standard Delphi object types (e.g., TFont, TTimer, }
{ TPicture) and for any variables marked as objects. }
{ AutoInitialize method is generated by Component Create. }
AutoInitialize;
{ Code to perform other tasks when the component is created }
end;
destructor TMosaic.Destroy;
begin
{ AutoDestroy, which is generated by Component Create, frees any }
{ objects created by AutoInitialize. }
AutoDestroy;
{ Here, free any other dynamic objects that the component methods }
{ created but have not yet freed. Also perform any other clean-up }
{ operations needed before the component is destroyed. }
{ Last, free the component by calling the Destroy method of the }
{ parent class. }
inherited Destroy;
end;
procedure TMosaic.Loaded;
begin
inherited Loaded;
{ Perform any component setup that depends on the property
values having been set }
Mosaic_faite:=false;
end;
procedure TMosaic.Paint;
Var bmp : TBitmap;
n, max : integer;
begin
{ Make this component look like its parent component by calling
its parent's Paint method. }
inherited Paint;
{ To change the appearance of the component, use the methods
supplied by the component's Canvas property (which is of
type TCanvas). For example, }
if (fmosaic) then
begin // Mosaïc à faire
if (not(Mosaic_faite)) then
begin
bmp:= TBitmap.Create;
try
bmp.width:=Picture.Graphic.Width;
bmp.Height:=Picture.Graphic.Height;
bmp.Canvas.draw(0,0,picture.Graphic);
if width/bmp.width>height/bmp.height then
begin
max:=trunc(bmp.width*height/bmp.height);
for n:=0 to trunc(width/max) do
begin
TPublicGraphicControl(self).Canvas.StretchDraw(rect(n*max,0,(n+1)*max,height),bmp);
end;
end else
begin
max:=trunc(bmp.height*width/bmp.width);
for n:=0 to trunc(height/max) do
begin
TPublicGraphicControl(self).Canvas.StretchDraw(rect(0,n*max,width,(n+1)*max),bmp);
end;
end;
finally
bmp.free
end;
Mosaic_faite:=true;
end;
end else
begin // pas de mosaïc
With TPublicGraphicControl(self).Canvas do
begin
Pen.Width:=1;
Pen.Color := clRed;
Pen.Style:=psclear;
Brush.style := bsclear;
Rectangle(0,0,Width+1,Height+1);
end;
end;
end;
procedure TMosaic.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
Mosaic_faite:=false;
inherited;
{ Copy the new width and height of the component
so we can use SetBounds to change both at once }
W := Width;
H := Height;
{ Code to check and adjust W and H }
{ Update the component size if we adjusted W or H }
if (W <> Width) or (H <> Height) then
inherited SetBounds(Left, Top, W, H);
{ Code to update dimensions of any owned sub-components
by reading their Height and Width properties and updating
via their SetBounds methods }
Message.Result := 0;
paint;
end;
end. |
Partager