main.pas

ODAC 6 最新版的﹐網上找了好久才找到﹐不太好找啊﹐大家一起共享

  begin
    with FigurePaintBox.Canvas do begin
      Pen.Style := psSolid;
      Pen.Color := FFigureColor;
    end;

    i := posStart;
    while i + 5 <= posEnd do begin
      OrdinatesToPixels(FGeometry.Ordinates[i], FGeometry.Ordinates[i + 1], sx1, sy1);
      OrdinatesToPixels(FGeometry.Ordinates[i + 4], FGeometry.Ordinates[i + 5], sx2, sy2);

      try
        CalcBoundRect(FGeometry.Ordinates[i], FGeometry.Ordinates[i + 1],
          FGeometry.Ordinates[i + 2], FGeometry.Ordinates[i + 3],
          FGeometry.Ordinates[i + 4], FGeometry.Ordinates[i + 5], RectX1, RectY1, RectX2, RectY2);
      except
        Inc(i, 4);
        continue;
      end;

      FigurePaintBox.Canvas.Arc(RectX1, RectY1, RectX2, RectY2, sx1, sy1, sx2, sy2);
      Inc(i, 4);
    end;
  end;

var
  GType, i, j, elem0, elem1, elem2, CompoundCount, CompoundLimit, PosEnd: integer;
  Point: TSdoPoint;
  Compound: boolean;
begin
  DrawAxes;

  if FGeometry.IsNull or (FGeometry.GType div 1000 <> 2) then
    exit;

  GType := FGeometry.GType mod 100;

  if (GType = 1) and not FGeometry.Point.IsNull then begin
    Point := FGeometry.Point;
    DrawPoint(Point.X, Point.Y);
    exit;
  end;

  case GType of
    1, 2, 3: begin
      Compound := False;
      CompoundCount := 0;
      CompoundLimit := 0;
      for i := 0 to FGeometry.ElemInfoCount div 3 - 1 do begin

        j := i * 3;
        elem0 := FGeometry.ElemInfo[j] - 1;
        elem1 := FGeometry.ElemInfo[j + 1];
        elem2 := FGeometry.ElemInfo[j + 2];

        if Compound then begin
          Inc(CompoundCount);
          if CompoundCount >= CompoundLimit then
            Compound := False;
        end;

        case elem1 of
          1:
            if elem2 <= 1 then
              DrawPoints(elem0, 1)
            else
              DrawPoints(elem0, elem2);
          2, 1003, 2003:
            case elem2 of
              1, 2: begin
                if i + 1 < FGeometry.ElemInfoCount div 3 then begin
                  PosEnd := FGeometry.ElemInfo[(i + 1) * 3] - 1;
                  if Compound then
                    PosEnd := PosEnd + 2;
                end
                else
                  PosEnd := FGeometry.OrdinatesCount - 1;
                if elem2 = 1 then
                  DrawLine(elem0, PosEnd)
                else
                  DrawArc(elem0, PosEnd);
              end;
              3:
                if elem1 <> 2 then
                  DrawRect(elem0);
              4:
                if elem1 <> 2 then
                  DrawCircle(elem0);
            end;
          4, 1005, 2005: begin
            Compound := True;
            CompoundCount := 0;
            CompoundLimit := elem2;
          end;
        end;
      end;
    end;
  end;
end;

procedure TfmMain.OrdinatesToPixels(XOrd, YOrd: double; var X, Y: integer);
begin
  X := Round(XOrd * FScaleX + 20);
  Y := Round(FigurePaintBox.Height - YOrd * FScaleY - 20);
end;

procedure TfmMain.PixelsToOrdinates(X, Y: integer; var XOrd, YOrd: double);
begin
  XOrd := (X - 20) / FScaleX;
  YOrd := (FigurePaintBox.Height - 20 - Y) / FScaleY;
end;

procedure TfmMain.SaveFigure;
var
  i: integer;
begin
  try
    OraQuery.Edit;
    // We need to edit some field to DBGrid call Post for OraQuery
    OraQuery.FieldByName('GEOMETRY_OBJECT.SDO_GTYPE').AsInteger := -1;

    // SQLUpdate property of OraQuery is not empty because changes in
    // GEOMETRY_OBJECT not always are detected
    FGeometry.Save(OraQuery.GetObject('GEOMETRY_OBJECT'));
  finally
    FOperation := coNone;
    FFigureColor := clBlack;
    for i := 0 to pnPalette.ControlCount - 1 do
      if pnPalette.Controls[i] is TSpeedButton then
        TSpeedButton(pnPalette.Controls[i]).Down := False;
    FigurePaintBox.Invalidate;
  end;
end;

procedure TfmMain.btCreateFigureClick(Sender: TObject);
begin
  if TSpeedButton(Sender).Down then begin
    FGeometry.IsNull := True;
    FFigureColor := clRed;
    FigurePaintBox.Invalidate;
    
    if Sender = btCreatePoint then
      FOperation := coPoint
    else
    if Sender = btCreateLine then
      FOperation := coLine
    else
    if Sender = btCreatePoligon then
      FOperation := coPoligon
    else
    if Sender = btCreateRectangle then
      FOperation := coRectangle
    else
    if Sender = btCreateCircle then
      FOperation := coCircle;
  end
  else
    SaveFigure;
end;

procedure TfmMain.UpdateFigure(X, Y: integer);

  function Sign(Value: double): double;
  begin
    if Value < 0 then
      Result := -1
    else
      Result := 1;
  end;

var
  x1, y1, x2, y2, d1, d2, r: double;
begin
  case FOperation of
    coNone, coPoint:
      exit;
  end;

  PixelsToOrdinates(X, Y, x2, y2);
  case FOperation of
    coRectangle: begin
      FGeometry.Ordinates[2] := x2;
      FGeometry.Ordinates[3] := y2;
    end;
    coCircle: begin
      x1 := FPoint.X;
      y1 := FPoint.Y;
      d1 := abs(x2 - x1);
      d2 := abs(y2 - y1);
      if d1 <= d2 then
        r := d1 / 2
      else
        r := d2 / 2;
      FGeometry.Ordinates[0] := x1;
      FGeometry.Ordinates[1] := y1 + r * sign(y2 - y1);
      FGeometry.Ordinates[2] := x1 + r * sign(x2 - x1);
      FGeometry.Ordinates[3] := y1;
      FGeometry.Ordinates[4] := x1 + 2 * r * sign(x2 - x1);
      FGeometry.Ordinates[5] := y1 + r * sign(y2 - y1);
    end;
    coLine, coPoligon: begin
      FGeometry.Ordinates[FGeometry.OrdinatesCount - 2] := x2;
      FGeometry.Ordinates[FGeometry.OrdinatesCount - 1] := y2;
    end;
  end;
end;

procedure TfmMain.FigurePaintBoxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  APoint: TSdoPoint;
  x1, y1: double;
  FirstPoint: boolean;
begin
  if FOperation = coNone then
    exit;

  if Button = mbLeft then begin
    PixelsToOrdinates(X, Y, x1, y1);
    case FOperation of
      coPoint: begin
        FGeometry.IsNull := False;
        FGeometry.GType := 2001;
        FGeometry.SRID := 0;
        APoint.IsNull := False;
        APoint.X := x1;
        APoint.Y := y1;
        APoint.Z := 0;
        FGeometry.Point := APoint;
        FGeometry.ElemInfoCount := 0;
        FGeometry.OrdinatesCount := 0;
        SaveFigure;
      end;
      coRectangle, coCircle: begin
        FirstPoint := FGeometry.IsNull;
        if FirstPoint then begin
          FGeometry.IsNull := False;
          FGeometry.GType := 2003;
          FGeometry.SRID := 0;
          APoint.IsNull := True;
          FGeometry.Point := APoint;
          FGeometry.ElemInfoCount := 3;
          FGeometry.ElemInfo[0] := 1;
          FGeometry.ElemInfo[1] := 1003;
          if FOperation = coRectangle then begin
            FGeometry.ElemInfo[2] := 3;
            FGeometry.OrdinatesCount := 4;
            FGeometry.Ordinates[0] := x1;
            FGeometry.Ordinates[1] := y1;
          end
          else begin
            FGeometry.ElemInfo[2] := 4;
            FGeometry.OrdinatesCount := 6;
            FPoint.X := x1;
            FPoint.Y := y1;
          end;
        end;
        UpdateFigure(X, Y);

        if not FirstPoint then
          SaveFigure;
      end;
      coLine: begin
        if FGeometry.IsNull then begin
          FGeometry.IsNull := False;
          FGeometry.GType := 2002;
          FGeometry.SRID := 0;
          APoint.IsNull := True;
          FGeometry.Point := APoint;
          FGeometry.ElemInfoCount := 3;
          FGeometry.ElemInfo[0] := 1;
          FGeometry.ElemInfo[1] := 2;
          FGeometry.ElemInfo[2] := 1;
          FGeometry.OrdinatesCount := 4;
          FGeometry.Ordinates[0] := x1;
          FGeometry.Ordinates[1] := y1;
        end
        else begin
          FGeometry.OrdinatesCount := FGeometry.OrdinatesCount + 2;
        end;
        UpdateFigure(X, Y);
      end;
      coPoligon: begin
        if FGeometry.IsNull then begin
          FGeometry.IsNull := False;
          FGeometry.GType := 2003;
          FGeometry.SRID := 0;
          APoint.IsNull := True;
          FGeometry.Point := APoint;
          FGeometry.ElemInfoCount := 3;
          FGeometry.ElemInfo[0] := 1;
          FGeometry.ElemInfo[1] := 1003;
          FGeometry.ElemInfo[2] := 1;
          FGeometry.OrdinatesCount := 4;
          FGeometry.Ordinates[0] := x1;
          FGeometry.Ordinates[1] := y1;
        end
        else begin
          FGeometry.OrdinatesCount := FGeometry.OrdinatesCount + 2;
        end;
        UpdateFigure(X, Y);
      end;
    end;
  end
  else
    if Button = mbRight then begin
      if FOperation = coPoligon then begin // close the poligon
        FGeometry.OrdinatesCount := FGeometry.OrdinatesCount + 2;
        FGeometry.Ordinates[FGeometry.OrdinatesCount - 2] := FGeometry.Ordinates[0];
        FGeometry.Ordinates[FGeometry.OrdinatesCount - 1] := FGeometry.Ordinates[1];
      end;
      SaveFigure;
    end;
end;

procedure TfmMain.OraQueryAfterClose(DataSet: TDataSet);
begin
  FGeometry.IsNull := True;
  FigurePaintBox.Invalidate;
end;

procedure TfmMain.FigurePaintBoxMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if FGeometry.IsNull or (FOperation = coNone) then
    exit;

  UpdateFigure(X, Y);
  FigurePaintBox.Invalidate;
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
  FScaleX := (FigurePaintBox.Width - 50) / 15;
  FScaleY := (FigurePaintBox.Height - 25) / 15;
end;

end.