AL_Hotmap

Top  Previous  Next

(*

TalHotMap : Delphi5 komponent, which connect to a TImage and contain a

             contours (closed areas) with special counters.

Copyright : StellaSOFT : Agócs László 2006

*)

unit AL_Hotmap;

 

interface

 

Uses

   Windows, SysUtils, Classes, Graphics, Controls, StdCtrls,

   Extctrls, Messages, Geom;

 

Type

 

TFloat = Double;

Str32 = string[32];

 

TRect2d = record

   Left,Top,Right,Bottom : TFloat;

end;

 

TMode = (gmNone, gmDraw, gmMove, gmInsert, gmDelete, gmCursor,

          gmPolyline, gmPolygon, gmBegin,

          gmMoveCurve, gmRotateCurve, gmDeleteCurve );

 

TDrawMode = (dmNone, dmPoint, dmLine, dmRectangle, dmPolyline, dmPolygon,

              dmCircle, dmEllipse, dmArc, dmChord, dmSpline);

 

TInCode = (icIn,        // Cursor in Curve

            icOnLine,    // Cursor on Curve's line

            icOnPoint,   // Cursor is on any Point;

            icOut        // Cursor out of Curve

            );

 

 

 

// What will appear in component?

TVisibility = (vsImage,vsCurves,vsAll,vsNot);

 

// Record of Curve's points

PPointRec = ^TPointRec;

TPointRec = record

            X: TFloat;

            Y: TFloat;

          end;

 

PPointArray = ^TPointArray;

TPointArray = array[0..0] of TPoint;

 

TCurve = class(TPersistent)

private

   FID  : integer;

   FName: Str32;

   FEnabled: Boolean;

   PPoint: PPointRec;

   fClosed: boolean;

   fSelected: boolean;

   FVisible: Boolean;

   FBrush: TBrush;

   FPen: TPen;

   FFont: TFont;

   fShape: TDrawMode;

   procedure SetSelected(const Value: boolean);

   function GetBoundsRect: TRect2d;

   procedure SetShape(const Value: TDrawMode);

public

   FPoints: TList;

   CPIndex       : Integer;        // Matching point index

   constructor Create;

   destructor Destroy; override;

   procedure ClearPoints;

   procedure AddPoint(Ax,Ay: TFloat);

   procedure GetPoint(AIndex: Integer; var Ax,Ay: TFloat);

   procedure ChangePoint(AIndex: Integer; Ax,Ay: TFloat);

   procedure InsertPoint(AIndex: Integer; Ax,Ay: TFloat);

   procedure DeletePoint(AIndex: Integer);

 

   function IsInBoundRect(Ax, Ay: TFloat): boolean;

   function IsOnPoint(Ax, Ay, delta: TFloat): Integer;

   function IsInCurve(Ax, Ay: TFloat): TInCode;

//    function  GetCurveData: TCurveData;

//    procedure SetCurveData(Data: TCurveData);

 

   property BoundsRect: TRect2d read GetBoundsRect;

public

   property ID: Integer read FID write FID;

   property Name: Str32 read FName write FName;

   property Pen: TPen read FPen Write FPen;

   property Brush: TBrush read FBrush Write FBrush;

   property Font: TFont read FFont Write FFont;

   property Enabled: Boolean read FEnabled write FEnabled;

   property Visible: Boolean read FVisible write FVisible;

   property Closed: boolean read fClosed write fClosed;

   property Selected: boolean read fSelected write SetSelected;

   property Shape: TDrawMode read fShape write SetShape;

end;

 

TalHotMap = class(TCustomPanel)

private

   FCurve: TCurve;          // Cuve for general purpose

   FImageFile: TFileName;

   FHotmapFile: TFileName;

   FSensitiveRadius: TFloat;

   FTransparentColor: TColor;

   FVisibility: TVisibility;

   FShowPoints: boolean;

   FMode: TMode;

   FBlinking: boolean;

   FDrawMode: TDrawMode;

   FPointSize: integer;

   fHinted: boolean;

   Hint1   : THintWindow;

   HintActive : boolean;

   oldHintStr: string;

//    fChangeMode: TChangeMode;

   procedure SetImageFile(const Value: TFileName);

   procedure SetHotmapFile(const Value: TFileName);

   procedure SetSensitiveRadius(const Value: TFloat);

   procedure SetTransparentColor(const Value: TColor);

   procedure SetVisibility(const Value: TVisibility);

   procedure SetShowPoints(const Value: boolean);

   procedure SetMode(const Value: TMode);

   procedure SetBlinking(const Value: boolean);

   procedure SetDrawMode(const Value: TDrawMode);

protected

   // The original image storage to here and copy to screen if needed

   BackBMP       : TBitmap;

   oldVisibility : TVisibility;

   NewPaint      : boolean;

   Origin        : TPoint;     // Bigin point for drawing

   oldOrigin     : TPoint;

   MovePt        : TPoint;     // Moving point for drawing

   oldMovePt     : TPoint;

   h             : integer;    // New Curve handle

   rrect         : TRect2d;    // Rectangle for rect or window

   pFazis        : integer;    // Drawing phase

   First         : boolean;

   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;

   procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;

   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;

public

   FCurveList    : TList;      // List of vectorial curves

   newCurve      : TCurve;

   CPMatch       : Boolean;    // Matching point

   CurveMatch    : Boolean;    // Matching curve

   CurveIn       : boolean;    // point in curve

   CPCurve       : Integer;

   LastCPCurve   : Integer;

   CPIndex       : Integer;

   LastCPIndex   : Integer;

   CPx           : TFloat;

   CPy           : TFloat;

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   procedure Paint; override;

   procedure Update; override;

   procedure ClearImage;

   procedure DrawImage;

   procedure DrawCurves;

 

   function MakeCurve(const AName: Str32; ID: integer; Shape: TDrawMode;

                           APen: TPen; ABrush: TBrush;

                           AEnabled, AClosed, AVisible: Boolean): Integer;

   function AddCurve(ACurve: TCurve):integer;

   procedure DeleteCurve(AItem: Integer);

   procedure AddPoint(AIndex: Integer; X, Y: TFloat);

   procedure GetPoint(AIndex,APosition: Integer; var X,Y: TFloat);

   function GetMaxPoints: Integer;

   procedure InversCurve(AIndex: Integer);

 

   procedure CheckCurvePoints(X, Y: Integer);

//    procedure ShowHintPanel(Show: Boolean);

 

   property Canvas;

 

published

   property Blinking: boolean read FBlinking write SetBlinking;

   property DrawMode: TDrawMode read FDrawMode write SetDrawMode;

   property ImageFile: TFileName read FImageFile write SetImageFile;

   // Picture file name for draw picture onto the image (drawing surface)

   property Hinted: boolean read fHinted write fHinted;

   property HotmapFile: TFileName read FHotmapFile write SetHotmapFile;

   // Vectorgrafic file for image: contains the curves

   property Mode: TMode read FMode write SetMode;

   property PointSize: integer read FPointSize write FPointSize;

   property SensitiveRadius: TFloat read FSensitiveRadius write SetSensitiveRadius;

   // Cursor sensitive radius of circle around of curves' points

   property TransparentColor: TColor read FTransparentColor write SetTransparentColor;

   property Visibility: TVisibility read FVisibility write SetVisibility;

   property ShowPoints: boolean read FShowPoints write SetShowPoints;

//    property OnChangeMode: TChangeMode read fChangeMode write fChangeMode;

   property Borderstyle;

   property OnClick;

   property OnDblClick;

   property OnEnter;

   property OnExit;

   property OnKeyPress;

   property OnKeyDown;

   property OnKeyUp;

   property OnMouseMove;

   property OnMouseDown;

   property OnMouseUp;

end;

 

 

Var delta: TFloat;       // Sensitive radius around of points

 

procedure Register;

function InRange(Test,Min,Max: Integer): Boolean;

procedure InitPen(Pen: TPen; pColor: TColor; pWidth: integer; pStyle: TPenStyle; pMode: TPenMode);

procedure InitBrush(Brush: TBrush; bColor: TColor;  bStyle: TBrushStyle);

procedure DrawShape(Canvas: TCanvas; T,B: TPoint; DrawMode: TDrawMode;

                           AMode: TPenMode);

 

implementation

 

procedure Register;

begin

RegisterComponents('AL',[TalHotMap]);

end;

 

function InRange(Test,Min,Max: Integer): Boolean;

begin

Result:=(Test >= Min) and (Test <= Max);

end;

 

procedure InitPen(Pen: TPen; pColor: TColor; pWidth: integer; pStyle: TPenStyle; pMode: TPenMode);

begin

With Pen do begin

    Color := pColor;

    Width := pWidth;

    Style := pStyle;

    Mode  := pMode;

end;

end;

 

procedure InitBrush(Brush: TBrush; bColor: TColor;  bStyle: TBrushStyle);

begin

With Brush do begin

    Color := bColor;

    Style := bStyle;

end;

end;

 

{ TCurve = Closed or Opened Curve Obeject's Datas}

 

constructor TCurve.Create;

begin

inherited Create;

FPoints    :=TList.Create;

FPen       :=TPen.Create;

FBrush     :=TBrush.Create;

FFont      :=TFont.Create;

FFont.Name :='small font';

FFont.Size :=7;

FFont.Style:=[];

FEnabled   :=True;

FVisible   :=True;

FClosed    :=True;

FSelected  :=False;

end;

 

destructor TCurve.Destroy;

var

I: Integer;

begin

for I:=0 to Pred(FPoints.Count) do FreeMem(FPoints.Items[I],SizeOf(TPointRec));

FPoints.Free;

FFont.Free;

inherited Destroy;

end;

 

procedure TCurve.AddPoint(Ax, Ay: TFloat);

begin

GetMem(PPoint,SizeOf(TPointRec));

PPoint^.X:=Ax;

PPoint^.Y:=Ay;

FPoints.Add(PPoint);

end;

 

procedure TCurve.ChangePoint(AIndex: Integer; Ax, Ay: TFloat);

begin

if InRange(AIndex,0,Pred(FPoints.Count)) then

begin

   PPoint:=FPoints.Items[AIndex];

   PPoint^.X:=Ax;

   PPoint^.Y:=Ay;

end;

end;

 

procedure TCurve.ClearPoints;

begin

FPoints.Clear;

end;

 

procedure TCurve.DeletePoint(AIndex: Integer);

begin

if InRange(AIndex,0,Pred(FPoints.Count)) then

begin

   FreeMem(FPoints.Items[AIndex],SizeOf(TPointRec));

   FPoints.Delete(AIndex);

end;

end;

 

procedure TCurve.GetPoint(AIndex: Integer; var Ax, Ay: TFloat);

begin

if InRange(AIndex,0,Pred(FPoints.Count)) then

begin

   PPoint:=FPoints.Items[AIndex];

   Ax:=PPoint^.X;

   Ay:=PPoint^.Y;

end;

end;

 

procedure TCurve.InsertPoint(AIndex: Integer; Ax, Ay: TFloat);

begin

if AIndex > -1 then

begin

   GetMem(PPoint,SizeOf(TPointRec));

   PPoint^.X:=Ax;

   PPoint^.Y:=Ay;

   FPoints.Insert(AIndex,PPoint);

end;

end;

 

 

procedure TCurve.SetSelected(const Value: boolean);

begin

FSelected := Value;

end;

 

function TCurve.IsInCurve(Ax, Ay: TFloat): TInCode;

{Examine that point is in curve or in a point or out of curve}

Var e: TEgyenes;

   i,N: integer;

   arr  : array of TPoint;

 

function InSide (const x,y : integer; Polygon: array of TPoint): boolean;

var

    PolyHandle: HRGN;

begin

  PolyHandle := CreatePolygonRgn(Polygon[0],length(Polygon)-1,Winding);

  result     := PtInRegion(PolyHandle,X,Y);

  DeleteObject(PolyHandle);

end;

 

function PointInPolygonTest(x, y, N: Integer; aList: Array of TPoint): Boolean;

Type

  PPoint = ^TPoint;

var

  I, J : Integer;

 

  Function xp(aVal:Integer):Integer;

  Begin

    Result:= PPoint(@aList[aVal]).X;

  end;

 

  Function yp(aVal:Integer):Integer;

  Begin

    Result:= PPoint(@aList[aVal]).Y;

  end;

 

begin

  Result := False;

  {L := Length(aList);}

  if (N = 0) then exit;

  J := N-1;

  for I := 0 to N-1 do

  begin

    if ((((yp(I) <= y) and (y < yp(J))) or

         ((yp(J) <= y) and (y < yp(I)))) and

        (x < (xp(J)-xp(I))*(y-yp(I))/(yp(J)-yp(I))+xp(I)))

    then Result := not Result;

    J:=I;

  end;

end;

 

function IsPointInPoligon(aList: Array of TPoint; p: TPoint2D):boolean;

Type

  PPoint = ^TPoint2d;

var j  : longint;

   pCrossPoint: TPoint2d;

   p1,p2: TPoint2d;

   E: TEgyenesFgv;

   AboveCount : integer;

begin

  Result := False;

  AboveCount := 0;

  p1 := PPoint(@aList[0])^;

  For j:=Low(Alist)+1 to High(aList) do begin

      p2 := PPoint(@aList[j])^;

      If Kozben(p1.x,p2.x,p.x,0) then begin

         E := KetpontonAtmenoEgyenes(p1.x,p1.y,p2.x,p2.y);

         pCrossPoint.y := E.a*p.x+E.b;

         If pCrossPoint.y > p.y then Inc(AboveCount);

      end;

      p1 := p2;

  end;

  Result := (AboveCount mod 2)=1;

end;

 

 

begin

Result := icOut;

if IsInBoundRect(Ax,Ay) then begin

 

    // Finds a point

    if IsOnPoint(Ax,Ay,delta)>-1 then begin

       Result := icOnPoint;

    end;

 

    if FPoints.Count>1 then begin

       // Fills the arr array with the curve points

       N := FPoints.Count;

       If Closed then N:=N+1;

       SetLength(arr,N);

       For i:=0 to FPoints.Count-1 do begin

          PPoint:=FPoints.Items[i];

          arr[i]:=Point(Trunc(PPoint^.x),Trunc(PPoint^.y));

       end;

       If Closed then begin

          PPoint:=FPoints.Items[0];

          arr[High(arr)]:=Point(Trunc(PPoint^.x),Trunc(PPoint^.y));

       end;

 

       // Finds a line

       For i:=0 to High(arr)-1 do begin

          if NearLine2P(Point2D(Ax,Ay),FloatPoint(arr[i]),FloatPoint(arr[i+1]),2)

          then begin

             Result := icOnLine;

             Exit;

          end;

       end;

 

       //Point in poligon

       If Closed then begin

       if InSide(Trunc(Ax),Trunc(Ay),arr) then

             Result := icIn;

       end;

 

    end;

 

end;

end;

 

 

function TCurve.IsInBoundRect(Ax, Ay: TFloat): boolean;

begin

With BoundsRect do

   Result := ((Left-delta)<=Ax) and ((Right+delta)>=Ax) and

          ((Bottom-delta)<=Ay) and ((Top+delta)>=Ay)

end;

 

function TCurve.GetBoundsRect: TRect2d;

var

I: Integer;

x1,y1,x2,y2: TFloat;

begin

x1:=1E+10;

y1:=1E+10;

x2:=-1E+10;

y2:=-1E+10;

for I:=0 to Pred(FPoints.Count) do begin

     PPoint:=FPoints.Items[i];

     if PPoint^.x<x1 then x1:=PPoint^.x;

     if PPoint^.x>x2 then x2:=PPoint^.x;

     if PPoint^.y<y1 then y1:=PPoint^.y;

     if PPoint^.y>y2 then y2:=PPoint^.y;

end;

With Result do begin

     Left   := x1;

     Top    := y2;

     Right  := x2;

     Bottom := y1;

end;

end;

 

function TCurve.IsOnPoint(Ax, Ay, delta: TFloat): Integer;

(* Result = Point index : if P(Ax,Ay) point in delta radius circle;

  Result = -1          : other else *)

var

I: Integer;

begin

Result := -1;

for I:=0 to Pred(FPoints.Count) do begin

     PPoint:=FPoints.Items[i];

     if (Abs(Ax-PPoint^.x)<=delta) and (Abs(Ay-PPoint^.y)<=delta)

     then begin

          CPIndex := i;

          Result := i;

          exit;

     end;

end;

end;

 

{------------------------------------------------------------------------------}

 

{ TalHotMap }

 

constructor TalHotMap.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FCurveList        := TList.Create;

BackBMP           := TBitmap.Create;

FTransparentColor := clWhite;

NewPaint          := True;

FShowPoints       := True;

FPointSize        := 2;

FSensitiveRadius  := 8;

FVisibility       := vsAll;

CPMatch           := False;

Hinted            := True;

Hint1             := THintWindow.Create(Self);

First             := True;

end;

 

destructor TalHotMap.Destroy;

var

I: Integer;

begin

if Self <> nil then begin

for I:=0 to Pred(FCurveList.Count) do

begin

   FCurve:=FCurveList.Items[I];

   FCurve.Free;

end;

FCurveList.Free;

BackBMP.Free;

Hint1.Free;

inherited Destroy;

end;

end;

 

procedure TalHotMap.SetDrawMode(const Value: TDrawMode);

begin

FDrawMode := Value;

pFazis    := 0;

if Value<>dmNone then

   Visibility := vsAll;

invalidate;

end;

 

procedure TalHotMap.ClearImage;

begin

Cls(Canvas,TransparentColor);

end;

 

procedure TalHotMap.DrawImage;

begin

//  Picture.Bitmap.Assign(BackBMP);

   Canvas.Draw(0,0,BackBMP);

end;

 

// Draws all curves onto the image

procedure TalHotMap.DrawCurves;

var

I,H,N: Integer;

X,Y: TFloat;

PA: Array of TPoint;

p0: TPoint;

dx,dy: integer;

lb: longbool;

begin

Try

With Canvas do begin

for H:=0 to Pred(FCurveList.Count) do

begin

   FCurve:=FCurveList.Items[H];

      Pen   := FCurve.FPen;

      Brush := FCurve.Brush;

   N := FCurve.FPoints.Count;

   SetLength(PA,N);

   if FCurve.Visible and (N > 0) then

     for I:=0 to Pred(N) do

     begin

       FCurve.GetPoint(I,X,Y);

       PA[I] := Point( Trunc(X), Trunc(Y));

       If ShowPoints then

          Ellipse(PA[I].x-PointSize,PA[I].y-PointSize,PA[I].x+PointSize,PA[I].y+PointSize);

     end;

     if Ord(FCurve.Shape)<6 then begin

     if FCurve.Closed then

        Polygon(PA)

     else

        PolyLine(PA)

//         lb:=PolyDraw(Canvas.Handle,PA,[PT_LINETO],N);

     end;

     if (FCurve.Shape in [dmCircle,dmEllipse]) and (N>1) then begin

           dx := Abs(PA[0].X-PA[1].X);

           dy := Abs(PA[0].Y-PA[1].Y);

           if FCurve.Shape=dmCircle then begin

              dx:=Trunc(sqrt(dx*dx+dy*dy));

              dy:=dx;

           end;

           Ellipse(PA[0].X-dx, PA[0].Y-dy, PA[0].X+dx, PA[0].Y+dy);

     end;

end;

end;

finally

SetLength(PA,0);

end;

end;

 

procedure TalHotMap.InversCurve(AIndex: Integer);

var

I,H,N: Integer;

X,Y: TFloat;

Size: Word;

PA: Array[0..1000] of TPoint;

p0: TPoint;

R : HRgn;

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

Try

     FCurve:=FCurveList.Items[AIndex];

     N := FCurve.FPoints.Count+1;

     for I:=0 to Pred(N) do

     begin

       FCurve.GetPoint(I,X,Y);

       PA[I].x:=Trunc(X);

       PA[I].y:=Trunc(Y);

     end;

       FCurve.GetPoint(0,X,Y);

       PA[i+1].x:=Trunc(X);

       PA[i+1].y:=Trunc(Y);

       R := CreatePolygonRgn(PA,N,ALTERNATE);

       InvertRgn(Canvas.Handle,R);

finally

    DeleteObject(R);

end;

end;

end;

 

 

procedure TalHotMap.Paint;

begin

if First then begin

    InitPen(Canvas.Pen,clBlue,1,psSolid,pmCopy);

    InitBrush(Canvas.Brush,clRed,bsClear);

    First:=False;

end;

 

Case FVisibility of

vsNot    : ClearImage;

vsImage  : DrawImage;

vsCurves : begin

              ClearImage;

              DrawCurves;

            end;

vsAll    : begin

              DrawImage;

              DrawCurves;

            end;

end;

oldVisibility:= Visibility;

NewPaint     := False;

end;

 

procedure TalHotMap.SetHotmapFile(const Value: TFileName);

begin

FHotmapFile := Value;

end;

 

procedure TalHotMap.SetImageFile(const Value: TFileName);

var ext: string;

begin

FImageFile := Value;

if FileExists(Value) then begin

    ext := UpperCase(ExtractFileExt(Value));

    BackBMP.LoadFromFile(Value);

    Width := BackBMP.Width;

    Height := BackBMP.Height;

end else BackBMP.FreeImage;

    Invalidate;

end;

 

procedure TalHotMap.SetSensitiveRadius(const Value: TFloat);

begin

FSensitiveRadius := Value;

delta := Value;

end;

 

procedure TalHotMap.SetTransparentColor(const Value: TColor);

begin

FTransparentColor := Value;

invalidate;

end;

 

function TalHotMap.MakeCurve(const AName: Str32; ID: integer; Shape: TDrawMode;

                           APen: TPen; ABrush: TBrush;

                           AEnabled, AClosed, AVisible: Boolean): Integer;

begin

Try

FCurve:=TCurve.Create;

FCurve.Name:=AName;

FCurve.Pen.Assign(APen);

FCurve.Brush.Assign(ABrush);

FCurve.Enabled := AEnabled;

FCurve.Closed  := AClosed;

FCurve.Visible := AVisible;

FCurve.Shape   := Shape;

FCurveList.Add(FCurve);

Result:=FCurveList.IndexOf(FCurve);

except

Result := -1;

end;

end;

 

function TalHotMap.AddCurve(ACurve: TCurve):integer;

begin

Try

FCurveList.Pack;

FCurveList.Add(ACurve);

Result := FCurveList.Count-1;

except

Result := -1;

end;

end;

 

procedure TalHotMap.DeleteCurve(AItem: Integer);

begin

if AItem < FCurveList.Count then

begin

   FCurve:=FCurveList.Items[AItem];

   FCurveList.Delete(AItem);

   FCurve.Destroy;

end;

end;

 

 

procedure TalHotMap.AddPoint(AIndex: Integer; X,Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   FCurve.AddPoint(X,Y);

   Update;

end;

end;

 

procedure TalHotMap.GetPoint(AIndex,APosition: Integer; var X,Y: TFloat);

begin

if InRange(AIndex,0,Pred(FCurveList.Count)) then

begin

   FCurve:=FCurveList.Items[AIndex];

   if InRange(APosition,0,Pred(FCurve.FPoints.Count)) then

     FCurve.GetPoint(APosition,X,Y);

end;

end;

 

procedure TalHotMap.SetVisibility(const Value: TVisibility);

begin

FVisibility := Value;

Update;

end;

 

procedure TalHotMap.SetShowPoints(const Value: boolean);

begin

FShowPoints := Value;

Update;

end;

 

function TalHotMap.GetMaxPoints: Integer;

var

I,Max: Integer;

begin

Max:=0;

for I:=0 to Pred(FCurveList.Count) do

begin

   FCurve:=FCurveList.Items[I];

   if FCurve.FPoints.Count > Max then Max:=FCurve.FPoints.Count;

end;

Result:=Max;

end;

 

// Forces repaint the component

procedure TalHotMap.Update;

begin

NewPaint := True;

invalidate;

end;

 

procedure TalHotMap.SetMode(const Value: TMode);

begin

FMode := Value;

pFazis:=1;

Cursor := crCross;

case FMode of

   gmNone:

       begin

           Cursor := crDefault;

//            If Blinking then StopBlinkingCurve;

(*            if Assigned(FControls.FModeNone) then

             FControls.FModeNone.Checked:=True; *)

       end;

(*    gmMove: if Assigned(FControls.FModeMove) then

             FControls.FModeMove.Checked:=True;

   gmInsert: if Assigned(FControls.FModeInsert) then

               FControls.FModeInsert.Checked:=True;

   gmDelete: if Assigned(FControls.FModeDelete) then

               FControls.FModeDelete.Checked:=True;

   gmCursor: if Assigned(FControls.FModeCursor) then

               FControls.FModeCursor.Checked:=True;

   gmPolyLine, gmPolygon: FirstPoly := True;*)

end;

//  if Assigned(fChangeMode) then fChangeMode(Self,Mode);

end;

 

procedure TalHotMap.MouseDown(Button: TMouseButton; Shift: TShiftState; X,

Y: Integer);

var pr: TPointRec;

begin

inherited;

 

if Button=mbRight then begin

    DrawShape(Canvas,Origin,oldMovePt,DrawMode,pmNotXor);

    if (DrawMode=dmPolygon) then begin

         FCurve := FCurveList.Items[h];

         if FCurve.FPoints.Count>2 then begin

         FCurve.GetPoint(0,pr.x,pr.y);

         DrawShape(Canvas,Point(Trunc(pr.x),Trunc(pr.y)),oldMovePt,DrawMode,pmNotXor);

         end;

    end;

    DrawImage;

    DrawCurves;

    pFazis := 0;

end;

 

Origin := Point(x,y);

MovePt := Point(x,y);

If pFazis=0 then oldOrigin := Origin;

 

if (DrawMode<>dmNone) then begin

 

if Button=mbLeft then begin

 

    Case DrawMode of

 

    dmPoint :

    Case pFazis of

    0:

    begin

      h:=MakeCurve('Pont',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,True,True);

      pFazis := -1;

    end;

    end;

 

    dmLine :

    Case pFazis of

    0: h:=MakeCurve('Vonal',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,True,True);

    1: pFazis := -1;

    end;

 

    dmRectangle :

    Case pFazis of

    0: h:=MakeCurve('Rectangle',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,True,True);

    1: begin

         FCurve := FCurveList.Items[h];

         FCurve.GetPoint(0,pr.x,pr.y);

         FCurve.ClearPoints;

         // Circle From left botton corner

         AddPoint(h,pr.x,y);

         AddPoint(h,pr.x,pr.y);

         AddPoint(h,x,pr.y);

         pFazis := -1;

       end;

    end;

 

    dmPolyLine  :

    Case pFazis of

    0: h:=MakeCurve('PolyLine',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,False,True);

 

    end;

 

    dmPolygon  :

    Case pFazis of

    0: h:=MakeCurve('PolyLine',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,True,True);

 

    end;

 

    dmCircle,dmEllipse   :

    Case pFazis of

    0: h:=MakeCurve('Circle',1,DrawMode,Canvas.Pen,Canvas.Brush,

                     True,True,True);

 

    1: pFazis := -1;

    end;

 

    end;

    AddPoint(h,x,y);

    Inc(pFazis);

end;

 

end// End of if (DrawMode<>dmNone)

oldMovePt := Origin;

end;

 

procedure TalHotMap.MouseMove(Shift: TShiftState; X, Y: Integer);

var pr: TPointRec;

Hintstr: string;

HintRect: TRect;

p: TPoint;

w,he: integer;

begin

MovePt := Point(x,y);

CheckCurvePoints(X,Y);

if CPMatch then Cursor:=crHandPoint else Cursor := crDefault;

if CurveMatch then Cursor:=crDrag;

if CurveIn then Cursor:=crSizeAll;

 

 

if (DrawMode<>dmNone) and (pFazis>0) then begin

    DrawShape(Canvas,Origin,oldMovePt,DrawMode,pmNotXor);

    DrawShape(Canvas,Origin,MovePt,DrawMode,pmNotXor);

    if (DrawMode=dmPolygon) then begin

         FCurve := FCurveList.Items[h];

         if FCurve.FPoints.Count>2 then begin

         FCurve.GetPoint(0,pr.x,pr.y);

         DrawShape(Canvas,Point(Trunc(pr.x),Trunc(pr.y)),oldMovePt,DrawMode,pmNotXor);

         DrawShape(Canvas,Point(Trunc(pr.x),Trunc(pr.y)),MovePt,DrawMode,pmNotXor);

         end;

    end;

end;

// Searching point, line or inside area

if (DrawMode=dmNone) then begin

end;

{Hint ablak rajzolása}

If Hinted then begin

//    DoCheckCP(x,y);

If CPMatch then begin

//        ClearMarkBox;

    Hint1.Font.Size:=4;

    Hintstr := fCurve.Name+' ['+IntToStr(CPIndex+1)+']   ';

    p := ClientToScreen(point(x+8,y-18));

    w := Hint1.Canvas.TextWidth(Hintstr);

    he := Hint1.Canvas.TextHeight(Hintstr)+2;

    HintRect := Rect(p.x,p.y,p.x+w,p.y+he);

    If (not HintActive) or (Hintstr<>oldHintstr) then begin

       Hint1.ActivateHint(HintRect,Hintstr);

       oldHintstr := Hintstr;

       HintActive:=True;

    end;

end else

   If HintActive then begin

      Hint1.ReleaseHandle;

//       ClearMarkBox;

      HintActive := False;

   end;

end;

oldMovePt := Point(x,y);

inherited;

end;

 

procedure TalHotMap.MouseUp(Button: TMouseButton; Shift: TShiftState; X,

Y: Integer);

begin

inherited;

end;

 

procedure TalHotMap.SetBlinking(const Value: boolean);

begin

FBlinking := Value;

end;

 

// Draw a shape to Canvas

procedure DrawShape(Canvas: TCanvas; T,B: TPoint; DrawMode: TDrawMode;

                           AMode: TPenMode);

var DC:HDC;

   DX,DY : integer;

begin

DC := GetDC(Canvas.Handle);

With Canvas do

begin

   Pen.Mode    := AMode;

   Brush.Color := clWhite;

   Brush.style := bsClear;

   If (T.X<>B.x) OR (T.Y<>B.Y) then

   begin

       case DrawMode of

       dmPoint:

           Rectangle(T.X-2,T.Y-2,T.X+2,T.Y+2);

       dmLine,dmPolyline,dmPolygon:

       begin

           MoveTo(T.X, T.Y); LineTo(B.X, B.Y);

       end;

       dmRectangle : Rectangle(T.X, T.Y, B.X, B.Y);

       dmCircle,dmEllipse :

       begin

           dx := Abs(T.X-B.X);

           dy := Abs(T.Y-B.Y);

           if DrawMode=dmCircle then begin

              dx:=Trunc(sqrt(dx*dx+dy*dy));

              dy:=dx;

           end;

           Ellipse(T.X-dx, T.Y-dy, T.X+dx, T.Y+dy);

       end;

       end;

   end;

end;

RestoreDC(Canvas.Handle,DC);

end;

 

procedure TalHotMap.CheckCurvePoints(X,Y: Integer);

var i,J,K,L: integer;

   Lx,Ly : TFloat;

   InCode : TInCode;

begin

   CPMatch:=False;

   CurveMatch:=False;

   CurveIn:=False;

 

   J:=Pred(FCurveList.Count);

   for I:=0 to J do

   begin

     FCurve:=FCurveList.Items[I];

     if FCurve.FEnabled then

     begin

       InCode := FCurve.IsInCurve(x,y);

       if InCode=icOnLine then begin

          CurveMatch:=True;

          CPCurve:=I;

       end;

       if InCode=icIn then begin

          CurveIn:=True;

          CPCurve:=I;

       end;

       K:=Pred(FCurve.FPoints.Count);

       for L:=0 to K do

       begin

         GetPoint(I,L,Lx,Ly);

         CPMatch:=(Abs(x-Lx)<=SensitiveRadius) and (Abs(y-Ly)<=SensitiveRadius);

           if CPMatch then

           begin

             CPx:=Lx;

             CPy:=Ly;

             CPCurve:=I;

             CPIndex:=L;

             exit;

           end;

        end;

     end;

   end;

end;

 

procedure TCurve.SetShape(const Value: TDrawMode);

begin

fShape := Value;

end;

 

end.