I was feeling bored today so I wrote a component to do Venn Diagrams (as
you do when bored) - now can anybody find a use for it?
I did have in the back of my mind that it could be a way for the users
of my software to select stuff out of a database. If tomorrow is
equally exciting I may extend it to 3 sets and have it create some SQL
along similar lines to the LogicString property (although with 3 sets
the number of combinations would be huge)
Anyway Comments...
unit VennDiagram;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;
type
TVennDiagram = class(TGraphicControl)
private
FSelectedOutside: boolean;
FSelectedMiddle: boolean;
FSelectedLeft: boolean;
FSelectedRight: boolean;
FRightDescription: string;
FLeftDescription: string;
FShowDescriptions: boolean;
FOnChange: TNotifyEvent;
function GetCircleRadius: integer;
function GetLeftCircleCenter: TPoint;
function GetRightCircleCenter: TPoint;
procedure SetSelectedLeft(const Value: boolean);
procedure SetSelectedMiddle(const Value: boolean);
procedure SetSelectedOutside(const Value: boolean);
procedure SetSelectedRight(const Value: boolean);
procedure VennDiagramMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetLeftDescription(const Value: string);
procedure SetRightDescription(const Value: string);
procedure SetShowDescriptions(const Value: boolean);
function GetLogicString: string;
{ Private declarations }
protected
{ Protected declarations }
property OnMouseDown;
public
{ Public declarations }
procedure Paint; override;
function InCircle(aPoint, Center: TPoint; Radius: integer): boolean;
function InsideLeftCircle(aPoint : TPoint) : boolean;
function InsideRightCircle(aPoint : TPoint) : boolean;
function InsideMiddle(aPoint : TPoint) : boolean;
constructor Create(AOwner: TComponent); override;
property LogicString : string read GetLogicString;
published
{ Published declarations }
Property SelectedOutside : boolean read FSelectedOutside write
SetSelectedOutside;
Property SelectedLeft : boolean read FSelectedLeft write
SetSelectedLeft;
Property SelectedRight : boolean read FSelectedRight write
SetSelectedRight;
Property SelectedMiddle : boolean read FSelectedMiddle write
SetSelectedMiddle;
Property LeftCircleCenter : TPoint read GetLeftCircleCenter;
Property RightCircleCenter : TPoint read GetRightCircleCenter;
property CircleRadius : integer read GetCircleRadius;
property LeftDescription : string read FLeftDescription write
SetLeftDescription;
Property RightDescription : string read FRightDescription write
SetRightDescription;
Property ShowDescriptions : boolean read FShowDescriptions write
SetShowDescriptions;
Property Font;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TVennDiagram]);
end;
{ TVennDiagram }
constructor TVennDiagram.Create(AOwner: TComponent);
begin
inherited;
Canvas.Font.Assign(Font);
Canvas.Brush.Color := clBtnFace;
OnMouseDown := VennDiagramMouseDown;
FSelectedOutside := FALSE;
FSelectedMiddle := FALSE;
FSelectedLeft := FALSE;
FSelectedRight := FALSE;
end;
function TVennDiagram.GetCircleRadius: integer;
begin
result := Width div 4;
end;
function TVennDiagram.GetLeftCircleCenter: TPoint;
begin
result.X := Width div 3;
result.Y := Height div 2;
end;
function TVennDiagram.GetLogicString: string;
begin
//all things selected
if SelectedOutside and SelectedLeft and SelectedMiddle and
SelectedRight then
result := 'TRUE'
//3 things selected
else if SelectedLeft and SelectedMiddle and SelectedRight then
result := LeftDescription + ' or ' + RightDescription
else if SelectedOutside and SelectedLeft and SelectedMiddle then
result := LeftDescription + ' and not ' + RightDescription
else if SelectedOutside and SelectedMiddle and SelectedRight then
result := 'not ' + LeftDescription + ' and ' + RightDescription
else if SelectedOutside and SelectedLeft and SelectedRight then
result := 'not (' + LeftDescription + ' and ' + RightDescription + ')'
//2 things selected
else if SelectedOutside and SelectedLeft then
result := 'not ' + RightDescription
else if SelectedOutside and SelectedRight then
result := 'not ' + LeftDescription
else if SelectedOutside and SelectedMiddle then
result := 'not (' + LeftDescription + ' xor ' + RightDescription + ')'
else if SelectedMiddle and SelectedLeft then
result := LeftDescription
else if SelectedMiddle and SelectedRight then
result := RightDescription
else if SelectedRight and SelectedLeft then
result := LeftDescription + ' xor ' + RightDescription
//1 thing Selected
else if SelectedOutside then
result := 'not (' + LeftDescription + ' or ' + RightDescription + ')'
else if SelectedLeft then
result := LeftDescription + ' and not ' + RightDescription
else if SelectedRight then
result := 'not ' + LeftDescription + ' and ' + RightDescription
else if SelectedMiddle then
result := LeftDescription + ' xor ' + RightDescription
else
//only possibility remaining
result := 'FALSE';
end;
function TVennDiagram.GetRightCircleCenter: TPoint;
begin
result.X := 2 * Width div 3;
result.Y := Height div 2;
end;
function TVennDiagram.InCircle(aPoint, Center: TPoint;
Radius: integer): boolean;
var
DistanceFromCenter : TPoint;
begin
DistanceFromCenter.X := abs(aPoint.X-Center.X);
DistanceFromCenter.Y := abs(aPoint.Y-Center.Y);
result := Sqrt(Sqr(DistanceFromCenter.X) +
Sqr(DistanceFromCenter.Y)) < radius;
end;
function TVennDiagram.InsideLeftCircle(aPoint: TPoint): boolean;
begin
result := InCircle(aPoint, LeftCircleCenter, CircleRadius)
end;
function TVennDiagram.InsideMiddle(aPoint: TPoint): boolean;
begin
result := InsideRightCircle(aPoint) and InsideLeftCircle(aPoint)
end;
function TVennDiagram.InsideRightCircle(aPoint: TPoint): boolean;
begin
result := InCircle(aPoint, RightCircleCenter, CircleRadius)
end;
procedure TVennDiagram.Paint;
procedure CenterCircle(C : TCanvas; X, Y, R : Integer);
begin
C.Ellipse(x-r, y-r, x+r, y+r);
end;
begin
inherited;
Canvas.Brush.Color := clBtnFace;
Canvas.Rectangle(0,0,width, height);
Canvas.Brush.Style := bsClear;
CenterCircle(Canvas, LeftCircleCenter.X, LeftCircleCenter.Y,
CircleRadius);
CenterCircle(Canvas, RightCircleCenter.X, RightCircleCenter.Y,
CircleRadius);
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clRed;
if FSelectedOutside then
Canvas.FloodFill(2, 2, clBlack, fsBorder);
if FSelectedLeft then
Canvas.FloodFill(LeftCircleCenter.X, LeftCircleCenter.Y, clBlack,
fsBorder);
if FSelectedMiddle then
Canvas.FloodFill(width div 2, Height div 2, clBlack, fsBorder);
if FSelectedRight then
Canvas.FloodFill(RightCircleCenter.X, RightCircleCenter.Y, clBlack,
fsBorder);
if ShowDescriptions then
begin
Canvas.Font := Font;
Canvas.Brush.Style := bsClear;
Canvas.TextOut(2,2,LeftDescription);
Canvas.TextOut(width - Canvas.TextWidth(RightDescription)-2
,2,RightDescription);
end;
end;
procedure TVennDiagram.SetLeftDescription(const Value: string);
begin
FLeftDescription := Value;
Invalidate;
end;
procedure TVennDiagram.SetRightDescription(const Value: string);
begin
FRightDescription := Value;
Invalidate;
end;
procedure TVennDiagram.SetSelectedLeft(const Value: boolean);
begin
FSelectedLeft := Value;
invalidate;
end;
procedure TVennDiagram.SetSelectedMiddle(const Value: boolean);
begin
FSelectedMiddle := Value;
invalidate;
end;
procedure TVennDiagram.SetSelectedOutside(const Value: boolean);
begin
FSelectedOutside := Value;
invalidate;
end;
procedure TVennDiagram.SetSelectedRight(const Value: boolean);
begin
FSelectedRight := Value;
invalidate;
end;
procedure TVennDiagram.SetShowDescriptions(const Value: boolean);
begin
FShowDescriptions := Value;
Invalidate;
end;
procedure TVennDiagram.VennDiagramMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if DebugHook <> -1 then
begin
if InsideMiddle(Point(X,Y)) then
FSelectedMiddle := not FSelectedMiddle
else if InsideLeftCircle(Point(X,Y)) then
FSelectedLeft := not FSelectedLeft
else if InsideRightCircle(Point(X,Y)) then
FSelectedRight := not FSelectedRight
else
FSelectedOutside := not FSelectedOutside;
end;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end.
--
Alister Christie
Computers for People
Ph: 04 471 1849 Fax: 04 471 1266
http://www.salespartner.co.nz
PO Box 13085
Johnsonville
Wellington
_______________________________________________
Delphi mailing list
[email protected]
http://ns3.123.co.nz/mailman/listinfo/delphi
