Hello!
It will be perfect, if some video file can be played in TGraphObject.
Best regards,
VJS
unit SimpleGraph;
...
function WrapText(Canvas: TCanvas; const Text: String; MaxWidth: Integer): String;
var
DC: HDC;
TextExtent: TSize;
S, P, E: PChar;
Line: String;
IsFirstLine: Boolean;
begin
Result := '';
DC := Canvas.Handle;
IsFirstLine := True;
P := PChar(Text);
while P^ = ' ' do
Inc(P);
while P^ <> #0 do
begin
S := P;
E := nil;
while (P^ <> #0) and (P^ <> #13) and (P^ <> #10) do
begin
GetTextExtentPoint32(DC, S, P - S + 1, TextExtent);
if (TextExtent.CX > MaxWidth) and (E <> nil) then
begin
if (P^ <> ' ') and (P^ <> ^I) then
begin
while (E >= S) do
case E^ of
'.', ',', ';', '?', '!', '-', ':',
')', ']', '}', '>', '/', '\', ' ':
break;
else
Dec(E);
end;
if E < S then
E := P - 1;
end;
Break;
end;
E := P;
Inc(P);
end;
if E <> nil then
begin
// fix start
while (E >= S) and (E^{was: P^} = ' ') do
// fix finish
Dec(E);
end;
if E <> nil then
SetString(Line, S, E - S + 1)
else
SetLength(Line, 0);
if (P^ = #13) or (P^ = #10) then
begin
Inc(P);
if (P^ <> (P - 1)^) and ((P^ = #13) or (P^ = #10)) then
Inc(P);
if P^ = #0 then
Line := Line + #13#10;
end
else if P^ <> ' ' then
P := E + 1;
while P^ = ' ' do
Inc(P);
if IsFirstLine then
begin
Result := Line;
IsFirstLine := False;
end
else
Result := Result + #13#10 + Line;
end;
end;
TGraphLinkBezier = class(TGraphLink)
protected
procedure DrawBody(Canvas: TCanvas); override;
end;
procedure TGraphLinkBezier.DrawBody(Canvas: TCanvas);
var
OldPenStyle: TPenStyle;
OldBrushStyle: TBrushStyle;
ModifiedPolyline: TPoints;
Angle: Double;
PtRect: TRect;
begin
ModifiedPolyline := nil;
if PointCount = 1 then
begin
PtRect := MakeSquare(Points[0], Pen.Width div 2);
while not IsRectEmpty(PtRect) do
begin
Canvas.Ellipse(PtRect.Left, PtRect.Top, PtRect.Right, PtRect.Bottom);
InflateRect(PtRect, -1, -1);
end;
end
else if PointCount >= 2 then
begin
if (BeginStyle <> lsNone) or (EndStyle <> lsNone) then
begin
OldPenStyle := Canvas.Pen.Style;
Canvas.Pen.Style := psSolid;
try
if BeginStyle <> lsNone then
begin
if ModifiedPolyline = nil then
ModifiedPolyline := Copy(Polyline, 0, PointCount);
Angle := LineSlopeAngle(fPoints[1], fPoints[0]);
ModifiedPolyline[0] := DrawPointStyle(Canvas, fPoints[0],
Angle, BeginStyle, BeginSize);
end;
if EndStyle <> lsNone then
begin
if ModifiedPolyline = nil then
ModifiedPolyline := Copy(Polyline, 0, PointCount);
Angle := LineSlopeAngle(fPoints[PointCount - 2], fPoints[PointCount - 1]);
ModifiedPolyline[PointCount - 1] := DrawPointStyle(Canvas, fPoints[PointCount - 1],
Angle, EndStyle, EndSize);;
end;
finally
Canvas.Pen.Style := OldPenStyle;
end;
end;
OldBrushStyle := Canvas.Brush.Style;
try
Canvas.Brush.Style := bsClear;
if ModifiedPolyline <> nil then
[b]Canvas.PolyBezier(ModifiedPolyline)[/b] // Canvas.Polyline(ModifiedPolyline)
else
[b]Canvas.PolyBezier(Polyline)[/b]; // Canvas.Polyline(Polyline);
finally
Canvas.Brush.Style := OldBrushStyle;
end;
end;
ModifiedPolyline := nil;
end;
TGraphLinkBezier = class(TGraphLink)
protected
FCreateByMouse : Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; const Pt: TPoint); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; const Pt: TPoint); override;
procedure DrawBody(Canvas: TCanvas); override;
end;
procedure TGraphLinkBezier.MouseDown(Button: TMouseButton; Shift: TShiftState;
const Pt: TPoint);
begin
inherited;
if Owner.CommandMode = cmInsertLink then
FCreateByMouse := True;
end;
procedure TGraphLinkBezier.MouseUp(Button: TMouseButton; Shift: TShiftState;
const Pt: TPoint);
var
StartPt, EndPt, MidPt1, MidPt2 : TPoint;
begin
inherited;
if not FCreateByMouse then exit;
if Assigned(Source) and (EqualPoint(Points[0], fSource.FixHookAnchor)) then
StartPt := Points[1]
else
StartPt := points[0];
if Assigned(Target) and (PointsEqual(Points[PointCount -1],fTarget.FixHookAnchor)) then
EndPt := Points[PointCount -2]
else
EndPt := Points[PointCount -1];
MidPt1.X := (EndPT.X - StartPt.X) div 4;
MidPt1.Y := (EndPT.Y - StartPt.Y) div 4;
Midpt2.X := EndPt.X - MidPt1.X;
MidPt2.Y := EndPt.Y - MidPt1.Y;
MidPt1.X := StartPt.X + MidPt1.X;
MidPt1.Y := StartPt.Y + MidPt1.Y;
InsertPoint(1, MidPt1);
InsertPoint(2, MidPt2);
FCreateByMouse := False;
end;
TGraphLinkBezier = class(TGraphLink)
protected
FBezierPolyline : TPoints;
FCreateByMouse : Boolean;
function IndexOfNearestLine(const Pt: TPoint; Neighborhood: Integer): Integer; override;
function RelativeHookAnchor(RefPt: TPoint): TPoint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; const Pt: TPoint); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; const Pt: TPoint); override;
procedure Changed(Flags: TGraphChangeFlags); override;
procedure DrawBody(Canvas: TCanvas); override;
function QueryHitTest(const Pt: TPoint): DWORD; override;
procedure DrawHighlight(Canvas: TCanvas); override;
end;
procedure TGraphLinkBezier.Changed(Flags: TGraphChangeFlags);
begin
inherited;
if gcView in Flags then
FBezierPolyline := GetBezierPolyline(Polyline);
end;
procedure TGraphLinkBezier.DrawBody(Canvas: TCanvas);
var
OldPenStyle: TPenStyle;
OldBrushStyle: TBrushStyle;
ModifiedPolyline: TPoints;
Angle: Double;
PtRect: TRect;
Cntr : Integer;
BckPen : TPen;
begin
ModifiedPolyline := nil;
if PointCount = 1 then
begin
PtRect := MakeSquare(Points[0], Pen.Width div 2);
while not IsRectEmpty(PtRect) do
begin
Canvas.Ellipse(PtRect.Left, PtRect.Top, PtRect.Right, PtRect.Bottom);
InflateRect(PtRect, -1, -1);
end;
end
else if PointCount >= 2 then
begin
if (BeginStyle <> lsNone) or (EndStyle <> lsNone) then
begin
OldPenStyle := Canvas.Pen.Style;
Canvas.Pen.Style := psSolid;
try
if BeginStyle <> lsNone then
begin
if ModifiedPolyline = nil then
ModifiedPolyline := Copy(Polyline, 0, PointCount);
Angle := LineSlopeAngle(fPoints[1], fPoints[0]);
ModifiedPolyline[0] := DrawPointStyle(Canvas, fPoints[0],
Angle, BeginStyle, BeginSize);
end;
if EndStyle <> lsNone then
begin
if ModifiedPolyline = nil then
ModifiedPolyline := Copy(Polyline, 0, PointCount);
Angle := LineSlopeAngle(fPoints[PointCount - 2], fPoints[PointCount - 1]);
ModifiedPolyline[PointCount - 1] := DrawPointStyle(Canvas, fPoints[PointCount - 1],
Angle, EndStyle, EndSize);;
end;
finally
Canvas.Pen.Style := OldPenStyle;
end;
end;
OldBrushStyle := Canvas.Brush.Style;
BckPen := TPen.Create;
BckPen.Assign(Canvas.Pen);
try
Canvas.Brush.Style := bsClear;
// crtanje tangenti ako je selektirano
if Selected {and ( not Dragging) }then
begin
OldPenStyle := Canvas.Pen.Style;
try
Canvas.Pen.Style := psDash;
Canvas.Pen.Width := 1;
PtRect.TopLeft := Points[0];
PtRect.BottomRight := Points[1];
Canvas.MoveTo(PtRect.Left,PtRect.Top);
Canvas.LineTo(PtRect.Right,PtRect.Bottom);
PtRect.TopLeft := Points[PointCount -2];
PtRect.BottomRight := Points[PointCount -1];
Canvas.MoveTo(PtRect.Left,PtRect.Top);
Canvas.LineTo(PtRect.Right,PtRect.Bottom);
Cntr := 2;
while Cntr < PointCount - 3 do
begin
Canvas.MoveTo(Points[Cntr].X, Points[Cntr].Y);
Canvas.LineTo(Points[Cntr+1].X, Points[Cntr+1].Y);
Inc(Cntr, 1);
end;
finally
Canvas.Pen.Style := OldPenStyle;
end;
end;
Canvas.Pen.Width := BckPen.Width;
if ModifiedPolyline <> nil then begin
Canvas.PolyBezier(ModifiedPolyline);
end else begin
Canvas.PolyBezier(Polyline);
end;
finally
Canvas.Brush.Style := OldBrushStyle;
Canvas.Pen.Assign(BckPen);
BckPen.Free;
end;
end;
ModifiedPolyline := nil;
end;
procedure TGraphLinkBezier.DrawHighlight(Canvas: TCanvas);
var
PtRect: TRect;
First, Last: Integer;
begin
if PointCount > 1 then
begin
if (MovingPoint >= 0) and (MovingPoint < PointCount) then
begin
if MovingPoint > 0 then
First := MovingPoint - 1
else
First := MovingPoint;
if MovingPoint < PointCount - 1 then
Last := MovingPoint + 1
else
Last := MovingPoint;
Canvas.PolyBezier(Copy(Polyline, First, Last - First + 1));
end
else
Canvas.PolyBezier(Polyline)
end
else if PointCount = 1 then
begin
PtRect := MakeSquare(Points[0], Canvas.Pen.Width);
Canvas.Ellipse(PtRect.Left, PtRect.Top, PtRect.Right, PtRect.Bottom);
end;
end;
function TGraphLinkBezier.IndexOfNearestLine(const Pt: TPoint;
Neighborhood: Integer): Integer;
var
I: integer;
NearestDistance: double;
Distance: double;
begin
Result := -1;
NearestDistance := MaxDouble;
for I := 0 to Length(FBezierPolyline) - 2 do
begin
Distance := DistanceToLine(FBezierPolyline[I], FBezierPolyline[I + 1], Pt);
if (Trunc(Distance) <= Neighborhood) and (Distance < NearestDistance) then
begin
NearestDistance := Distance;
Result := I;
end;
end;
end;
procedure TGraphLinkBezier.MouseDown(Button: TMouseButton; Shift: TShiftState;
const Pt: TPoint);
begin
inherited;
if Owner.CommandMode = cmInsertLink then
FCreateByMouse := True;
end;
procedure TGraphLinkBezier.MouseUp(Button: TMouseButton; Shift: TShiftState;
const Pt: TPoint);
var
StartPt, EndPt, MidPt1, MidPt2 : TPoint;
begin
inherited;
if not FCreateByMouse then exit;
if Assigned(Source) and (EqualPoint(Points[0], fSource.FixHookAnchor)) then
StartPt := Points[1]
else
StartPt := points[0];
if Assigned(Target) and (PointsEqual(Points[PointCount -1],fTarget.FixHookAnchor)) then
EndPt := Points[PointCount -2]
else
EndPt := Points[PointCount -1];
MidPt1.X := (EndPT.X - StartPt.X) div 4;
MidPt1.Y := (EndPT.Y - StartPt.Y) div 4;
Midpt2.X := EndPt.X - MidPt1.X;
MidPt2.Y := EndPt.Y - MidPt1.Y;
MidPt1.X := StartPt.X + MidPt1.X;
MidPt1.Y := StartPt.Y + MidPt1.Y;
InsertPoint(1, MidPt1);
InsertPoint(2, MidPt2);
FCreateByMouse := False;
end;
function TGraphLinkBezier.QueryHitTest(const Pt: TPoint): DWORD;
var
Neighborhood : Integer;
Cntr : Integer;
PtCount : Integer;
begin
Neighborhood := NeighborhoodRadius;
for Cntr := PointCount - 1 downto 0 do
if PtInRect(MakeSquare(Points[Cntr], Neighborhood), Pt) then
begin
if Selected then
Result := GHT_POINT or (Cntr shl 16)
else
Result := GHT_CLIENT;
Exit;
end;
PtCount := Length(FBezierPolyline);
for Cntr := 0 to PtCount - 2 do
begin
if DistanceToLine(FBezierPolyline[Cntr], FBezierPolyline[Cntr + 1], Pt) <= Neighborhood then
begin
if Selected then
Result := GHT_LINE or (Cntr shl 16) or GHT_CLIENT
else
Result := GHT_CLIENT;
Exit;
end;
end;
if (TextRegion <> 0) and (goShowCaption in Options) and PtInRegion(TextRegion, Pt.X, Pt.Y) then
Result := GHT_CAPTION or GHT_CLIENT
else
Result := GHT_NOWHERE;
end;
function TGraphLinkBezier.RelativeHookAnchor(RefPt: TPoint): TPoint;
function ValidAnchor(Index: integer): boolean;
var
GraphObject: TGraphObject;
begin
GraphObject := HookedObjectOf(Index);
Result := not Assigned(GraphObject) or GraphObject.IsLink;
end;
var
Pt: TPoint;
Line: integer;
Index: integer;
begin
Line := IndexOfNearestLine(RefPt, MaxInt);
if Line >= 0 then
begin
Pt := NearestPointOnLine(FBezierPolyline[Line], FBezierPolyline[Line + 1], RefPt);
Index := IndexOfPoint(Pt, NeighborhoodRadius);
if Index < 0 then
Result := Pt
else if ValidAnchor(Index) then
Result := FBezierPolyline[Index]
else
begin
if (Index = 0) and ValidAnchor(Index + 1) then
Result := FBezierPolyline[Index + 1]
else if (Index = Length(FBezierPolyline) - 1) and ValidAnchor(Index - 1) then
Result := FBezierPolyline[Index - 1]
else
Result := FixHookAnchor;
end;
end
else if PointCount = 1 then
Result := fPoints[0]
else
Result := RefPt;
end;
Return to DELPHI AREA Projects
Users browsing this forum: No registered users and 22 guests