Solved

Drawing an a bitmap

Posted on 2004-09-13
14
474 Views
Last Modified: 2013-12-03
Hello!

I'm working on a projekt where the user should be able to draw (lines, dots etc.) on a bitmap (TImage). Then these
drawings (parameters) should be stored in a database, so the they can be retrieved at a later state. Observe that I do
NOT want to store the whole bitmap, only the additional drawings made by the user. I don't know which  is the best way
to approach this, so I'm open for ideas and comments. I will increase the points to 500 for a working sample (snap of code).

Hokki
0
Comment
Question by:hakanfa
  • 5
  • 3
  • 3
  • +1
14 Comments
 
LVL 12

Expert Comment

by:esoftbg
ID: 12041999
For a 500 points I am going to develop an example about to drawing on the TImage ....
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 12042353
Hokki,
  Here's an outline of what you can do.
  1. Create a class which contains variables to store StartPosition, EndPosition, DrawingType...
  2. Depending on what the user selects to draw (line, point etc.), create a new object each time.
  3. Create a TList/TObjectList which stores all objects created.
  4. You can use mouse down, mouse move and mouse up to get the start and end coordinates of the drawing.

  5. On mouse up,
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 12042385
Wow!
It got posted while I was typing!

Let me finish it quickly...

    4.1. On mouse down, create the object of class defined in #1 and update the start position in that object.
    4.2. On mouse move, update the end position in that object
    4.3. On mouse up, update the end position and also add the object to the list.
5. When you need (like  on press of a save button), go through the list and move all values from the list to the database.


That's a basic outline of how I do it for some of my applications.
Hope that helps.
...Shu
0
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12042576
There's one nice graphical format that supports remembering the drawings and that's the Windows metafile. (*.WMF) What you could do is let the user draw on a metafile canvas. What you display to the user is a combination of the bitmap with the metafile drawon over it. The metafile allows you to walk through all the lines and circles and other objects inside it, although this isn't very easy. All you then have to do to store the user drawing is store the metafile. (Which you can later open again for modifications.)

The functionality you're looking for exists in the Windows metafile format, which is already available in Delphi. There are other graphical formats but they would require 3rd-party components.
0
 

Author Comment

by:hakanfa
ID: 12042639
Hmm..yes..well...

Emil: looking forward to see an working example..

Shu: Excellent work, but.. to be honest, I fell of the track half way. An example would be good..?


Hokki
 
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 12042985
Hokki,
  Here's an example that can demonstrate what I mean.
  It has a TImage control, a button to enable drawing a rectangle on the image, a listbox to display the objects draw and a button to save the contents of the drawing objects from the list to the listbox. It works for BMPs.

Here goes...
unit edtrunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Contnrs;

type
  TForm1 = class(TForm)
    DrawRectBtn: TButton;
    Image1: TImage;
    SaveBtn: TButton;
    ListBox1: TListBox;
    procedure DrawRectBtnClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SaveBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMyImgObjs = Class
  public
    MyStartPoint, MyEndPoint: TPoint;
    MyDrawingType: Integer;//1 represents point, 2 represents line, 3 a rectangle etc.
//this class can have points as private members and have checks based on MyDrawing type,
// a line line has only start point, a triangle may need 3 points etc.

    end;
var
  Form1: TForm1;
  Rubberbanding: Boolean = false;//Indicates that an object is being drawn
  MyDrawingList: TObjectList;
  CurDrawingType: integer;
  CurImgObj: TMyImgObjs;

implementation

{$R *.dfm}

procedure TForm1.DrawRectBtnClick(Sender: TObject);
begin
  Rubberbanding := true;
  CurDrawingType := 3;//3 signifies rectangle;
  CurImgObj := TMyImgObjs.Create;
  CurImgObj.MyDrawingType := CurDrawingType;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Mouse down event of TImage- Save start coordinates
  If Rubberbanding then
  begin
    CurImgObj.MyStartPoint.X := X;
    CurImgObj.MyStartPoint.Y := Y;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyDrawingList := TObjectList.Create(true);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyDrawingList.Free;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
//Mouse move event of TImage- Update end coordinates
  If Rubberbanding then
  begin
    CurImgObj.MyEndPoint.X := X;
    CurImgObj.MyEndPoint.Y := Y;

  end;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Mouse up event of TImage- Update end coordinates and draw the object
  If Rubberbanding then
  begin
    Rubberbanding := false;
    CurImgObj.MyEndPoint.X := X;
    CurImgObj.MyEndPoint.Y := Y;

    //Add to list
    MyDrawingList.Add(CurImgObj);
    //Can set Image1.Canvas.Pen.Color etc. here
    //Draw on picture for user to see the effect
    if CurImgObj.MyDrawingType = 3 then
      Image1.Canvas.Rectangle(CurImgObj.MyStartPoint.X, CurImgObj.MyStartPoint.Y, CurImgObj.MyEndPoint.X, CurImgObj.MyEndPoint.Y);

  end;

end;

procedure TForm1.SaveBtnClick(Sender: TObject);
Var
  i: integer;
  curobjdesc: string;
begin
//Copy the contents of the drawing object list to the list box
  ListBox1.Items.Clear;
  For i := 0 to MyDrawingList.Count-1 Do
  Begin
    CurImgObj := TMyImgObjs(MyDrawingList[i]);
    curobjdesc := Format('object %d, Type: %d, Sx= %d, Sy = %d, Ex = %d, Ey = %d',
    [i, CurImgObj.MyDrawingType, CurImgObj.MyStartPoint.X, CurImgObj.MyStartPoint.Y, CurImgObj.MyEndPoint.X, CurImgObj.MyEndPoint.Y]);
    ListBox1.Items.Add(curobjdesc);

  End;
end;

end.



HTH,
...Shu
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:hakanfa
ID: 12043308
Shu,

Works like a charm, but how do I load these objects from the objectlist?
And one other thing, when drawing, is it possible to see what you are drawing when
you are drawing it? I know, a little bit outside the "main" question but...


Hokki
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 12046923
Hokki,
  It's almost midnight, so I won't think of posting code sor "seeing" the object while it is being drawn now. I'll try to do it in the morning.
  For loading the objects from the object list ( by which I think you mean drawing them back on the image), I guess the code is already there. The for loop in "SaveBtnClick" procedure shows how to access different drawing objects. And, to draw any particular object, you can use the statement from the MouseUp procedure.

So, the loop would be:
  For i := 0 to MyDrawingList.Count-1 Do
  Begin
    CurImgObj := TMyImgObjs(MyDrawingList[i]);
    if CurImgObj.MyDrawingType = 3 then
      Image1.Canvas.Rectangle(CurImgObj.MyStartPoint.X, CurImgObj.MyStartPoint.Y, CurImgObj.MyEndPoint.X, CurImgObj.MyEndPoint.Y);
  End;

...Shu
0
 
LVL 5

Accepted Solution

by:
snehanshu earned 100 total points
ID: 12052275
The following code draws a focus rectangle while you are dragging.
Hope that helps...

unit edtrunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Contnrs;

type
  TForm1 = class(TForm)
    DrawRectBtn: TButton;
    Image1: TImage;
    SaveBtn: TButton;
    ListBox1: TListBox;
    procedure DrawRectBtnClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SaveBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMyImgObjs = Class
  public
    MyStartPoint, MyEndPoint: TPoint;
    MyDrawingType: Integer;//1 represents point, 2 represents line, 3 a rectangle etc.
//this class can have points as private members and have checks based on MyDrawing type,
// a line line has only start point, a triangle may need 3 points etc.

    end;
var
  Form1: TForm1;
  Rubberbanding: Boolean = false;//Indicates that an object is being drawn
  Drawing: boolean = false;
  MyDrawingList: TObjectList;
  CurDrawingType: integer;
  CurImgObj: TMyImgObjs;
  currect: TRect;

implementation

{$R *.dfm}

procedure TForm1.DrawRectBtnClick(Sender: TObject);
begin
  Rubberbanding := true;
  CurDrawingType := 3;//3 signifies rectangle;
  CurImgObj := TMyImgObjs.Create;
  CurImgObj.MyDrawingType := CurDrawingType;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Mouse down event of TImage- Save start coordinates
  If Rubberbanding then
  begin
    Drawing := true;
    CurImgObj.MyStartPoint.X := X;
    CurImgObj.MyStartPoint.Y := Y;
    CurImgObj.MyEndPoint := CurImgObj.MyStartPoint;
    if CurImgObj.MyDrawingType = 3 then
    begin
      CurRect.TopLeft := CurImgObj.MyStartPoint;
      CurRect.BottomRight := CurImgObj.MyEndPoint;
      Image1.Canvas.DrawFocusRect(CurRect);
    end;

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyDrawingList := TObjectList.Create(true);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyDrawingList.Free;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
//Mouse move event of TImage- Update end coordinates
  If Rubberbanding AND Drawing then
  begin
    CurImgObj.MyEndPoint.X := X;
    CurImgObj.MyEndPoint.Y := Y;
    if CurImgObj.MyDrawingType = 3 then
    begin
      Image1.Canvas.DrawFocusRect(CurRect);
      CurRect.BottomRight := CurImgObj.MyEndPoint;
      Image1.Canvas.DrawFocusRect(CurRect);
    end;
  end;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//Mouse up event of TImage- Update end coordinates and draw the object
  If Rubberbanding And Drawing then
  begin
    Rubberbanding := false;
    CurImgObj.MyEndPoint.X := X;
    CurImgObj.MyEndPoint.Y := Y;

    //Add to list
    MyDrawingList.Add(CurImgObj);
    //Can set Image1.Canvas.Pen.Color etc. here
    //Draw on picture for user to see the effect
    if CurImgObj.MyDrawingType = 3 then
    begin
      Image1.Canvas.DrawFocusRect(CurRect);
      CurRect.BottomRight := CurImgObj.MyEndPoint;
      Image1.Canvas.Rectangle(CurRect);
    end;
    Drawing := false;
  end;


end;

procedure TForm1.SaveBtnClick(Sender: TObject);
Var
  i: integer;
  curobjdesc: string;
begin
//Copy the contents of the drawing object list to the list box
  ListBox1.Items.Clear;
  For i := 0 to MyDrawingList.Count-1 Do
  Begin
    CurImgObj := TMyImgObjs(MyDrawingList[i]);
    curobjdesc := Format('object %d, Type: %d, Sx= %d, Sy = %d, Ex = %d, Ey = %d',
    [i, CurImgObj.MyDrawingType, CurImgObj.MyStartPoint.X, CurImgObj.MyStartPoint.Y, CurImgObj.MyEndPoint.X, CurImgObj.MyEndPoint.Y]);
    ListBox1.Items.Add(curobjdesc);

   
  End;
end;

end.
0
 
LVL 12

Expert Comment

by:esoftbg
ID: 12076500
The example is not completed yet, but:

unit Unit1_Q_21128446;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, Math, Spin, ExtDlgs, JPEG,
  DBTables, DB, Grids, DBGrids;

type
  TEnterMode = (smCoordinates, smMouse);
  TShapeMode = (smNone, smLine, smTriangle, sm4Angle, smEllipse);
  TShapeRec = record
    P:       array[1..4] of TPoint;
    CL:      TColor;
  end;
  TShapeArr = array[TShapeMode] of TShapeRec;
  TForm1 = class(TForm)
    spbClearCanvas: TSpeedButton;
    pnlTriangle: TPanel;
    spbTriangle: TSpeedButton;
    spe3X1: TSpinEdit;
    spe3Y1: TSpinEdit;
    spe3X2: TSpinEdit;
    spe3Y2: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    spe3X3: TSpinEdit;
    Label6: TLabel;
    spe3Y3: TSpinEdit;
    pnlEllipse: TPanel;
    spbEllipse: TSpeedButton;
    Label7: TLabel;
    Label8: TLabel;
    speeX1: TSpinEdit;
    speeY1: TSpinEdit;
    Img_Ellipse: TImage;
    clDlg: TColorDialog;
    Panel1: TPanel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    spe4X1: TSpinEdit;
    spe4Y1: TSpinEdit;
    spe4X2: TSpinEdit;
    spe4Y2: TSpinEdit;
    spe4X3: TSpinEdit;
    spe4Y3: TSpinEdit;
    spb4Angle: TSpeedButton;
    Label16: TLabel;
    spe4X4: TSpinEdit;
    Label17: TLabel;
    spe4Y4: TSpinEdit;
    Label9: TLabel;
    speeX2: TSpinEdit;
    Label18: TLabel;
    speeY2: TSpinEdit;
    ScrollBox: TScrollBox;
    ImgCoord: TImage;
    Img: TImage;
    spbClearPic: TSpeedButton;
    spbLoadPic: TSpeedButton;
    OpenPicDlg: TOpenPictureDialog;
    qryIMAGES: TQuery;
    dsqIMAGES: TDataSource;
    tblSHAPES: TTable;
    dstSHAPES: TDataSource;
    tblPOINTS: TTable;
    dstPOINTS: TDataSource;
    dbgIMAGES: TDBGrid;
    dbgSHAPES: TDBGrid;
    DBGrid1: TDBGrid;
    DB: TDatabase;
    GroupBox1: TGroupBox;
    rbtCoordinates: TRadioButton;
    RadioButton1: TRadioButton;
    GroupBox2: TGroupBox;
    rbtLine: TRadioButton;
    rbtTriangle: TRadioButton;
    rbt4Angle: TRadioButton;
    rbtEllipse: TRadioButton;
    pnlLine: TPanel;
    spbLine: TSpeedButton;
    Label19: TLabel;
    Label20: TLabel;
    spelX1: TSpinEdit;
    spelY1: TSpinEdit;
    Label21: TLabel;
    spelX2: TSpinEdit;
    Label22: TLabel;
    spelY2: TSpinEdit;
    spbExample: TSpeedButton;
    ImgPicture: TImage;
    pnlLineColor: TPanel;
    spbColorLine: TSpeedButton;
    pnl3AngleColor: TPanel;
    spbColor3Angle: TSpeedButton;
    pnl4AngleColor: TPanel;
    spbColor4Angle: TSpeedButton;
    pnlEllipseColor: TPanel;
    spbColorEllipse: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure spbClearCanvasClick(Sender: TObject);
    procedure spb4AngleClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure spe3X1Exit(Sender: TObject);
    procedure spbTriangleClick(Sender: TObject);
    procedure spe3X1Enter(Sender: TObject);
    procedure spbColor3AngleClick(Sender: TObject);
    procedure spbColor4AngleClick(Sender: TObject);
    procedure spbColorEllipseClick(Sender: TObject);
    procedure spbEllipseClick(Sender: TObject);
    procedure spbClearPicClick(Sender: TObject);
    procedure spbLoadPicClick(Sender: TObject);
    procedure ImgMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure rbtCoordinatesClick(Sender: TObject);
    procedure rbtLineClick(Sender: TObject);
    procedure rbtTriangleClick(Sender: TObject);
    procedure rbt4AngleClick(Sender: TObject);
    procedure rbtEllipseClick(Sender: TObject);
    procedure spbLineClick(Sender: TObject);
    procedure spbExampleClick(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure spbColorLineClick(Sender: TObject);
  private   { Private declarations }
    ShapeArr: TShapeArr;
    ShapeCnt: array[TShapeMode] of Cardinal;
    ShapeMode:TShapeMode;
    EnterMode:TEnterMode;
    procedure Draw_Coord_System;
  public    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure Draw_Canvas_Arrow(Canvas: TCanvas; P1, P2: TPoint; Degrees: Extended; Side: Integer; Cl: TColor);
var
  P3:     TPoint;
  P4:     TPoint;
  DX:     Integer;
  DY:     Integer;
  T:      Extended;
  ALPHA:  Extended;
  SHARP:  Extended;
  ALPHA3: Extended;
  ALPHA4: Extended;
begin
  ALPHA := 0;
  DX := P1.X - P2.X;
  DY := P1.Y - P2.Y;
  SHARP := Degrees/(360/2/PI);
  if ((DX=0) and (DY<>0)) then
  begin
    if (DY>0) then
      ALPHA := PI/2
    else
      ALPHA := PI + PI/2;
  end
  else
  if ((DY=0) and (DX<>0)) then
  begin
    if (DX>0) then
      ALPHA := 0
    else
      ALPHA := PI;
  end
  else
  if (DX<>0) then
  begin
    T := DY / DX;
    ALPHA := ArcTan(T);
    if (DX<0) and (DY<=0) then
      ALPHA := ALPHA + PI
    else
    if (DX<0) and (DY>=0) then
      ALPHA := ALPHA + PI
    else
    if (DX>0) and (DY<0) then
      ALPHA := 2*PI - ABS(ALPHA);
  end;
  ALPHA3 := ALPHA - SHARP/2;
  ALPHA4 := ALPHA + SHARP/2;
  DX := Round(Side * COS(ALPHA3));
  DY := Round(Side * SIN(ALPHA3));
  P3.X := P2.X + DX;
  P3.Y := P2.Y + DY;
  DX := Round(Side * COS(ALPHA4));
  DY := Round(Side * SIN(ALPHA4));
  P4.X := P2.X + DX;
  P4.Y := P2.Y + DY;
  Canvas.Pen.Color := Cl;
  Canvas.Brush.Color := Cl;
  Canvas.Polygon([Point(P2.X, P2.Y),
                  Point(P3.X, P3.Y),
                  Point(P4.X, P4.Y)]);
end;

procedure Draw_Canvas_Line(Canvas: TCanvas; P1, P2: TPoint; Cl: TColor);
begin
  Canvas.Pen.Color := Cl;
  Canvas.MoveTo(P1.X, P1.Y);
  Canvas.LineTo(P2.X, P2.Y);
end;

procedure Draw_Canvas_3angle(Canvas: TCanvas; P1, P2, P3: TPoint; CL: TColor);
begin
  Canvas.Pen.Color := Cl;
  Canvas.Brush.Color := clNone;
  Draw_Canvas_Line(Canvas, Point(P1.X, P1.Y), Point(P2.X, P2.Y), CL);
  Draw_Canvas_Line(Canvas, Point(P2.X, P2.Y), Point(P3.X, P3.Y), CL);
  Draw_Canvas_Line(Canvas, Point(P3.X, P3.Y), Point(P1.X, P1.Y), CL);
  (*
  Canvas.Polygon([Point(P1.X, P1.Y),
                  Point(P2.X, P2.Y),
                  Point(P3.X, P3.Y)]);
  *)
end;

procedure Draw_Canvas_4angle(Canvas: TCanvas; P1, P2, P3, P4: TPoint; CL: TColor);
begin
  Canvas.Pen.Color := Cl;
  Canvas.Brush.Color := clNone;

  Draw_Canvas_Line(Canvas, Point(P1.X, P1.Y), Point(P2.X, P2.Y), CL);
  Draw_Canvas_Line(Canvas, Point(P2.X, P2.Y), Point(P3.X, P3.Y), CL);
  Draw_Canvas_Line(Canvas, Point(P3.X, P3.Y), Point(P4.X, P4.Y), CL);
  Draw_Canvas_Line(Canvas, Point(P4.X, P4.Y), Point(P1.X, P1.Y), CL);

  (*
  Canvas.Polygon([Point(P1.X, P1.Y),
                  Point(P2.X, P2.Y),
                  Point(P3.X, P3.Y),
                  Point(P4.X, P4.Y)
                 ]);
  *)
end;

procedure Draw_Canvas_Ellipse(Canvas: TCanvas; P1, P2: TPoint; Cl: TColor);
begin
  Canvas.Pen.Color := Cl;
  Canvas.Brush.Color := clNone;
  Canvas.Ellipse(P1.X, P1.Y, P2.X, P2.Y);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S:      string;
begin
  ShapeMode := smNone;
  EnterMode := smCoordinates;
 
  pnlLineColor.Color := clSkyBlue;
  pnl3AngleColor.Color := clRed;
  pnl4AngleColor.Color := clYellow;
  pnlEllipseColor.Color := clAqua;

  DB.Connected := False;
  S := ExtractFilePath(Application.ExeName);
  DB.Params.Values['PATH'] := S;
  DB.Connected := True;
  qryIMAGES.Active := True;
  qryIMAGES.FieldByName('ID').Visible := False;
  tblSHAPES.Active := True;
  tblSHAPES.FieldByName('ID').Visible := False;
  tblSHAPES.FieldByName('IMAGE_ID').Visible := False;
  tblPOINTS.Active := True;
  tblPOINTS.FieldByName('SHAPE_ID').Visible := False;
end;

procedure TForm1.spb4AngleClick(Sender: TObject);
var
  CL:     TColor;
begin
  if (pnl4AngleColor.Color<>clNone) then
    CL := pnl4AngleColor.Color
  else
    CL := $00E0EEFE;
  Draw_Canvas_4angle(Img.Canvas, Point(spe4X1.Value, spe4Y1.Value), Point(spe4X2.Value, spe4Y2.Value), Point(spe4X3.Value, spe4Y3.Value), Point(spe4X4.Value, spe4Y4.Value), CL);
end;

procedure TForm1.Draw_Coord_System;
begin
  Draw_Canvas_Ellipse(ImgCoord.Canvas, Point(0,0), Point(48,48), clBlue);

  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(40,0), Point(48,24), 32, 12, clBlue);
  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(48,40), Point(24,48), 32, 12, clBlue);

  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(8,48), Point(0,24), 32, 12, clBlue);
  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(0,8), Point(24,0), 32, 12, clBlue);

  Draw_Canvas_Line(ImgCoord.Canvas, Point(0,24), Point(512,24), clBlue);
  Draw_Canvas_Line(ImgCoord.Canvas, Point(24,0), Point(24, 600), clBlue);
  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(0,24), Point(512,24), 32, 16, clBlue);
  Draw_Canvas_Arrow(ImgCoord.Canvas, Point(24,0), Point(24,600), 32, 16, clBlue);
  ImgCoord.Canvas.Pen.Color := clBlue;
  ImgCoord.Canvas.Brush.Color := clWhite; // clNone;
  ImgCoord.Canvas.TextOut(472, 10, ' + X ');
  ImgCoord.Canvas.TextOut(1, 570, ' + Y ');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ImgCoord.Canvas.Brush.Color := clNone; // clWhite;
  ImgCoord.Canvas.Polygon([Point(0, 0),
                      Point(0, ImgCoord.Height),
                      Point(ImgCoord.Width, ImgCoord.Height),
                      Point(ImgCoord.Width, 0), Point(0, 0)]);
  Draw_Coord_System;
end;

procedure TForm1.spbClearCanvasClick(Sender: TObject);
begin
  Img.Canvas.Pen.Color := clBlack;
  Img.Canvas.Brush.Color := clNone; // clWhite;
  Img.Canvas.Polygon([Point(0, 0),
                      Point(0, Img.Height),
                      Point(Img.Width, Img.Height),
                      Point(Img.Width, 0), Point(0, 0)]);
  FormShow(Self);                    
end;

procedure TForm1.spe3X1Enter(Sender: TObject);
begin
  if (Sender.ClassType=TSpinEdit) then
    if ((Sender as TSpinEdit).Text='0') then
      (Sender as TSpinEdit).Text := '';
end;

procedure TForm1.spe3X1Exit(Sender: TObject);
begin
  if (Sender.ClassType=TSpinEdit) then
  begin
    if ((Sender as TSpinEdit).Text='') then
      (Sender as TSpinEdit).Value := 0;
  end;
end;

procedure TForm1.spbTriangleClick(Sender: TObject);
var
  CL:     TColor;
begin
  if (pnl3AngleColor.Color<>clNone) then
    CL := pnl3AngleColor.Color
  else
    CL := $00E0EEFE;
  Draw_Canvas_3angle(Img.Canvas, Point(spe3X1.Value, spe3Y1.Value), Point(spe3X2.Value, spe3Y2.Value), Point(spe3X3.Value, spe3Y3.Value), CL);
end;

procedure TForm1.spbColor3AngleClick(Sender: TObject);
begin
  if clDlg.Execute then
    pnl3AngleColor.Color := clDlg.Color;
end;

procedure TForm1.spbColor4AngleClick(Sender: TObject);
begin
  if clDlg.Execute then
    pnl4AngleColor.Color := clDlg.Color;
end;

procedure TForm1.spbColorEllipseClick(Sender: TObject);
begin
  if clDlg.Execute then
    pnlEllipseColor.Color := clDlg.Color;
end;

procedure TForm1.spbEllipseClick(Sender: TObject);
begin
  Draw_Canvas_Ellipse(Img.Canvas, Point(speeX1.Value, speeY1.Value), Point(speeX2.Value, speeY2.Value), pnlEllipseColor.Color);
end;

procedure TForm1.spbClearPicClick(Sender: TObject);
begin
  ImgPicture.Picture.Bitmap := nil;
  Draw_Coord_System;
end;

procedure TForm1.spbLoadPicClick(Sender: TObject);
begin
  if OpenPicDlg.Execute then
    ImgPicture.Picture.Bitmap.LoadFromFile(OpenPicDlg.FileName);
  Draw_Coord_System;
end;

procedure TForm1.ImgMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (EnterMode=smMouse) then
  begin
    if rbtLine.Checked then
    begin
      if (ShapeCnt[smLine]<=2) then
      begin
        Inc(ShapeCnt[smLine]);
        ShapeArr[smLine].P[ShapeCnt[smLine]].X := X;
        ShapeArr[smLine].P[ShapeCnt[smLine]].Y := Y;
        ShapeArr[smLine].CL := pnlLineColor.Color;
        if (ShapeCnt[smLine]=2) then
        begin
          Draw_Canvas_Line(Img.Canvas,
                           Point(ShapeArr[smLine].P[1].X, ShapeArr[smLine].P[1].Y),
                           Point(ShapeArr[smLine].P[2].X, ShapeArr[smLine].P[2].Y),
                           ShapeArr[smLine].CL);
          ShapeCnt[smLine] := 0;
        end;
      end;
    end
    else
    if rbtTriangle.Checked then
    begin
      if (ShapeCnt[smTriangle]<=3) then
      begin
        Inc(ShapeCnt[smTriangle]);
        ShapeArr[smTriangle].P[ShapeCnt[smTriangle]].X := X;
        ShapeArr[smTriangle].P[ShapeCnt[smTriangle]].Y := Y;
        ShapeArr[smTriangle].CL := pnl3AngleColor.Color;
        if (ShapeCnt[smTriangle]=3) then
        begin
          Draw_Canvas_3angle(Img.Canvas,
                             Point(ShapeArr[smTriangle].P[1].X, ShapeArr[smTriangle].P[1].Y),
                             Point(ShapeArr[smTriangle].P[2].X, ShapeArr[smTriangle].P[2].Y), Point(ShapeArr[smTriangle].P[3].X, ShapeArr[smTriangle].P[3].Y),
                             ShapeArr[smTriangle].CL);
          ShapeCnt[smTriangle] := 0;
        end;
      end;
    end
    else
    if rbt4Angle.Checked then
    begin
      if (ShapeCnt[sm4Angle]<=3) then
      begin
        Inc(ShapeCnt[sm4Angle]);
        ShapeArr[sm4Angle].P[ShapeCnt[sm4Angle]].X := X;
        ShapeArr[sm4Angle].P[ShapeCnt[sm4Angle]].Y := Y;
        ShapeArr[sm4Angle].CL := pnl4AngleColor.Color;
        if (ShapeCnt[sm4Angle]=4) then
        begin
          Draw_Canvas_4angle(Img.Canvas,
                             Point(ShapeArr[sm4Angle].P[1].X, ShapeArr[sm4Angle].P[1].Y),
                             Point(ShapeArr[sm4Angle].P[2].X, ShapeArr[sm4Angle].P[2].Y),
                             Point(ShapeArr[sm4Angle].P[3].X, ShapeArr[sm4Angle].P[3].Y),
                             Point(ShapeArr[sm4Angle].P[4].X, ShapeArr[sm4Angle].P[4].Y),
                             ShapeArr[sm4Angle].CL);
          ShapeCnt[sm4Angle] := 0;
        end;
      end;
    end
    else
    if rbtEllipse.Checked then
    begin
      if (ShapeCnt[smEllipse]<=2) then
      begin
        Inc(ShapeCnt[smEllipse]);
        ShapeArr[smEllipse].P[ShapeCnt[smEllipse]].X := X;
        ShapeArr[smEllipse].P[ShapeCnt[smEllipse]].Y := Y;
        ShapeArr[smEllipse].CL := pnlEllipseColor.Color;
        if (ShapeCnt[smEllipse]=2) then
        begin
          Draw_Canvas_Ellipse(Img.Canvas,
                              Point(ShapeArr[smEllipse].P[1].X, ShapeArr[smEllipse].P[1].Y),
                              Point(ShapeArr[smEllipse].P[2].X, ShapeArr[smEllipse].P[2].Y),
                              ShapeArr[smEllipse].CL);
          ShapeCnt[smEllipse] := 0;
        end;
      end;
    end;
  end;
end;

procedure TForm1.rbtCoordinatesClick(Sender: TObject);
begin
  EnterMode := smCoordinates;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  EnterMode := smMouse;
end;

procedure TForm1.rbtLineClick(Sender: TObject);
begin
  if (ShapeMode<>smLine) then
    ShapeCnt[smLine] := 0;
  ShapeMode := smLine;
end;

procedure TForm1.rbtTriangleClick(Sender: TObject);
begin
  if (ShapeMode<>smTriangle) then
    ShapeCnt[smTriangle] := 0;
  ShapeMode := smTriangle;
end;

procedure TForm1.rbt4AngleClick(Sender: TObject);
begin
  if (ShapeMode<>sm4Angle) then
    ShapeCnt[sm4Angle] := 0;
  ShapeMode := sm4Angle;
end;

procedure TForm1.rbtEllipseClick(Sender: TObject);
begin
  if (ShapeMode<>smEllipse) then
    ShapeCnt[smEllipse] := 0;
  ShapeMode := smEllipse;
end;

procedure TForm1.spbLineClick(Sender: TObject);
begin
  Draw_Canvas_Line(Img.Canvas, Point(spelX1.Value, spelY1.Value), Point(spelX2.Value, spelY2.Value), pnlLineColor.Color);
end;

procedure TForm1.spbColorLineClick(Sender: TObject);
begin
  if clDlg.Execute then
  begin
    pnlLineColor.Color := clDlg.Color;
  end;
end;

procedure TForm1.spbExampleClick(Sender: TObject);
begin
  spbClearCanvasClick(Self);
  spelX1.Value := 64;
  spelY1.Value := 448;
  spelX2.Value := 480;
  spelY2.Value := 224;
  pnlLineColor.Color := clSkyBlue;
  spe3X1.Value := 64;
  spe3Y1.Value := 64;
  spe3X2.Value := 64;
  spe3Y2.Value := 128;
  spe3X3.Value := 112;
  spe3Y3.Value := 96;
  pnl3AngleColor.Color := clRed;
  spe4X1.Value := 144;
  spe4Y1.Value := 208;
  spe4X2.Value := 144;
  spe4Y2.Value := 384;
  spe4X3.Value := 312;
  spe4Y3.Value := 296;
  spe4X4.Value := 320;
  spe4Y4.Value := 208;
  pnl4AngleColor.Color := clYellow;
  speeX1.Value := 128;
  speeY1.Value := 64;
  speeX2.Value := 320;
  speeY2.Value := 192;
  pnlEllipseColor.Color := clAqua;

  spbLineClick(Self);
  spbTriangleClick(Self);
  spb4AngleClick(Self);
  spbEllipseClick(Self);

  //   Draw Circle and Radius Line
  Draw_Canvas_Ellipse(Img.Canvas, Point(320, 320), Point(448, 448), clFuchsia);
  Draw_Canvas_Line(Img.Canvas, Point(384, 384), Point(448, 384), clLime);
  Draw_Canvas_Arrow(Img.Canvas, Point(384, 384), Point(448, 384), 32, 12, clLime);
  Img.Canvas.TextOut(392, 368, ' R = 64 ');
end;

end.
0
 
LVL 12

Assisted Solution

by:esoftbg
esoftbg earned 150 total points
ID: 12076705
Hi hakanfa,
download above example from:
page:        http://www.geocities.com/esoftbg/
  link:        Q_21128446.zip
if you like it I will complete database storing of the image shapes ....
0
 

Author Comment

by:hakanfa
ID: 13405928
Sorry guys, been away for a while, i got i working as planned.
Thanks,
Hokki
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now