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
| unit UPanels;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
Type
TTYpe = (tyUndefined, tyBMP, tyCircle, tyPaint, tyCP);
TPanelImage = class(TPanel)
BMP: TBitMap;
PB: TPaintBox;
Constructor Create(IOwner: TComponent);
Destructor Done;
Procedure SetCadre(IX1, IY1, IX2, IY2: integer);
Procedure SetColours(IColF, IColA, IcolG: TColor);
Procedure SetValues(Imin, Imax, Ival: integer);
Procedure SetTYpe(IType: TType);
Procedure SetParams(IX1, IY1, IX2, IY2: integer;
IColF, IColA, IcolG: TColor;
Imin, Imax, Ival: integer;
ITYpe: TType);
Procedure Draw;
private
X1, Y1, X2, Y2: integer;
Subtitle: String;
ColFond, ColAiguille, ColGraduation: TColor;
Min, Max, Valeur: Integer;
TypeDessin: TType;
Procedure TraceCircle;
Procedure PanelPaint;
end;
implementation
Constructor TPanelImage.Create(IOwner: TComponent);
Begin
inherited create(IOwner);
BMP:=TBitMap.Create;
PB:=TPaintBox.Create(self);
PB.Align:=alClient;
TypeDessin:=tyundefined;
end;
Destructor TPanelImage.Done;
Begin
BMP.Free;
PB.Free;
end;
Procedure TPanelImage.SetCadre(IX1, IY1, IX2, IY2: integer);
Begin
X1:=IX1; X2:=IX2; Y1:=IY1; Y2:=IY2;
Left:=X1; Top:=Y1;
Width:=X2-Left;
Height:=Y2-Top;
end;
Procedure TPanelImage.SetColours(IColF, IColA, IcolG: TColor);
Begin
ColFond:=IColF; ColAiguille:=IColA; ColGraduation:=IColG;
end;
Procedure TPanelImage.SetValues(Imin, Imax, Ival: integer);
Begin
Min:=IMin; Max:=IMax; Valeur:=IVal;
end;
Procedure TPanelImage.SetTYpe(IType: TType);
Begin
TYpeDessin:=ITYpe;
end;
Procedure TPanelImage.SetParams(IX1, IY1, IX2, IY2: integer;
IColF, IColA, IcolG: TColor;
Imin, Imax, Ival: integer;
ITYpe: TType);
Begin
SetCadre(Ix1, Iy1, Ix2, Iy2);
SetColours(IColF, IColA, IColG);
SetValues(IMin, IMax, IVal);
SetType(IType);
end;
Procedure TPanelImage.TraceCircle;
Begin
With PB.Canvas Do Begin
Pen.Color:=ColAiguille;
Brush.Color:=ColFond;
Rectangle(55, 55, Width-5, Height-5);
end;
End;
Procedure TPanelImage.PanelPaint;
Begin
With PB Do Begin
Color:=ColFond;
RePaint;
end;
end;
Procedure TPanelImage.Draw;
Begin
Case TypeDessin of
tyCircle: TraceCircle;
tyPaint: PanelPaint;
tyCP: Begin
PanelPaint;
Tracecircle;
end;
end;
end;
end. |
Partager