0

下午好。对不起我的英语不好。我正在使用 RAD Studio XE。在 Graphics32 中，我需要完全禁用橡皮擦的 RubberbandLayer。尝试禁用牙龈缩放的方法。我不能。试过 RBLayer.Scaled: = False; 它对我不起作用。我使用图层将小的“标记”渲染到屏幕上。如果你编译我的代码，你可以显示两种标记——“屏蔽”和“点”。为此，请按下鼠标右键并选择一个标记。通过滚动鼠标滚轮，您可以更改图片的大小。我不想调整标记的大小，但调整了 RubberbandLayer 的大小。不幸的是，我无法摆脱它。我的代码：

unit Unit1;

interface

uses
  Windows, Graphics,Controls, Forms, GR32_Image, GR32_Layers, GR32, 
  Menus, Classes, ExtCtrls;

type
  TForm1 = class(TForm)
    ImgView: TImgView32;
    PopupMenu1: TPopupMenu;
    A3: TMenuItem;
    A1: TMenuItem;
    procedure ActivateLayerMenu(X,Y: Integer);
    procedure ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer; Layer: TCustomLayer);
    procedure ImgViewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure NewPuntoOpen(PLoad: Boolean; MarkTxt: String);
    procedure A3Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    MouseDragging: Boolean;
    OldScrollPosVert, OldScrollPosHorth,
    MouseX, MouseY: Integer;
    FSelection: TPositionedLayer;
    OldMousePos: TPoint;
    MyMouse: TMouse;
    procedure SetSelection(Value: TPositionedLayer);
    procedure WheelDown;
    procedure WheelUp;
  protected
    RBLayer: TRubberbandLayer;
    function CreatePositionedPunto: TPositionedLayer;
    procedure PaintPunto(Sender: TObject; Buffer: TBitmap32);
    procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintShield(Sender: TObject; Buffer: TBitmap32);
  public
    { Public declarations }
    procedure CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
    property Selection: TPositionedLayer read FSelection write SetSelection;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.NewPuntoOpen(PLoad: Boolean; MarkTxt: String);
var
  L: TPositionedLayer;
begin
  Selection := nil;
  L := CreatePositionedPunto;
  L.OnPaint := PaintPunto;
 // L.MarkerText := MarkTxt;
  if PLoad Then L.Location := FloatRect(OldMousePos.X, OldMousePos.Y, OldMousePos.X  + 40, OldMousePos.Y + 40);
end;

function TForm1.CreatePositionedPunto: TPositionedLayer;
var
  P: TPoint;
  x1, y1: Single;
begin
  // get coordinates of the center of viewport
  with ImgView.GetViewportRect do
     P := ImgView.ControlToBitmap(GR32.Point((OldMousePos.X*2) div 2,
                                             (OldMousePos.Y*2) div 2));
  Result := TPositionedLayer.Create(ImgView.Layers);
  Result.Location := FloatRect(P.X - 20, P.Y - 8, P.X  + 20, P.Y + 32);
  Result.Scaled := True;
  Result.MouseEvents := True;
  Result.OnMouseDown := LayerMouseDown;
end;

procedure TForm1.PaintPunto(Sender: TObject; Buffer: TBitmap32);
var
  Cx, Cy, Cx2, Cy2,
  W2, H2: Single;
  FontCoef: Single;
  Q, S: String;
  P: TPoint;
  n, n5: Integer;
begin
  n := 0;
  n5:= 5;
  FontCoef := 1;
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;
      Cx := Left + W2;
      Cy := Top + H2;

      Buffer.MoveToF(Cx,Cy);
      Buffer.Font.Name := 'Tahoma';
      Buffer.Font.Style := [fsBold];
      Q := Chr($25CF);
      Buffer.Font.Size := 25+n;
      Buffer.Font.Color := clAqua;
      Buffer.Textout( Round(Cx-12), Round(Cy-30), Q);
      Buffer.Font.Size := 15+n;
      Buffer.Font.Color := clWhite;
      Buffer.Textout( Round(Cx-7), Round(Cy-19), Q);

      Buffer.Font.Color := clBlack;
      Buffer.Font.Size := 10+n;
      Buffer.Textout( Round(Cx-n5), Round(Cy-13), Q);
   end;
end;

procedure TForm1.ActivateLayerMenu(X,Y: Integer);
  begin
   MouseX := MyMouse.CursorPos.X;
   MouseY := MyMouse.CursorPos.Y;
   OldMousePos := Point(X, Y);
   PopupMenu1.Popup(MouseX, MouseY);
end;

procedure TForm1.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Sender <> nil then
   begin
    Selection := TPositionedLayer(Sender);
    if Sender.ClassType = TPositionedLayer then
    begin
     RBLayer.Handles := [rhCenter, rhFrame];
   end;
end;
end;

procedure TForm1.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  MyMouse: TMouse;
begin
    if Layer = nil then Selection := nil;
    if Button = mbLeft then
    begin
      OldMousePos := Point(X, Y);
      MouseDragging := True;
    end;
    if Button = mbRight then ActivateLayerMenu(X,Y);
end;

procedure TForm1.ImgViewMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer; Layer: TCustomLayer);
  var e: String;
  P: TPoint;
  begin
  if Selection <> nil then Exit;
  if MouseDragging then
  begin
   ImgView.Scroll(OldMousePos.X - X, OldMousePos.Y - Y);
   OldMousePos := Point(X, Y);
  end;
end;

procedure TForm1.ImgViewMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Button = mbLeft then
  begin
   MouseDragging := False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CreateNewImage(500, 300, clWhite);
end;

procedure TForm1.ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  WheelDown;
end;

procedure TForm1.WheelDown;
var
  s: Single;
begin
  s := ImgView.Scale / 1.01;
  if s < 0.2 then s := 0.2;
  ImgView.Scale := s;
end;

procedure TForm1.ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  WheelUp;
end;

procedure TForm1.WheelUp;
var
  s: Single;
begin
  s := ImgView.Scale * 1.01;
  if s > 5 then s := 5;
  ImgView.Scale := s;
end;

procedure TForm1.A1Click(Sender: TObject);
var
  L: TPositionedLayer;
begin
  Selection := nil;
  L := CreatePositionedPunto;
  L.OnPaint := PaintShield;
end;

procedure TForm1.PaintShield(Sender: TObject; Buffer: TBitmap32);
var
  Cx, Cy, W2, H2: Single;
  G: char;
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;
      Cx := Left + W2;
      Cy := Top + H2;
      Buffer.MoveToF(Cx,Cy);
      Buffer.Font.Name := 'Webdings';
      Buffer.Font.Style := Buffer.Font.Style-[fsBold];
      G := 'd';
      Buffer.Font.Size := 26;
      Buffer.Font.Color := clBlack;
      Buffer.Textout( Round(Cx-22), Round(Cy-24), G);
      Buffer.Font.Size := 20;
      Buffer.Font.Color := clAqua;
      Buffer.Textout( Round(Cx-17), Round(Cy-18), G);
    end;
end;

procedure TForm1.A3Click(Sender: TObject);
begin
  NewPuntoOpen(False, '');
 // showmessage(FloatToStr( ImgView.Scale ));
end;

procedure TForm1.CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
begin
  with ImgView do
  begin
    Selection := nil;
    RBLayer := nil;
    Layers.Clear;
    Scale := 1;
    Bitmap.SetSize(AWidth, AHeight);
    Bitmap.Clear(FillColor);
  end;
end;

procedure TForm1.SetSelection(Value: TPositionedLayer);
begin
  if Value <> Selection then
  begin
    if RBLayer <> nil then
    begin
      RBLayer.ChildLayer := nil;
      RBLayer.LayerOptions := LOB_NO_UPDATE;
      ImgView.Invalidate;
    end;
    FSelection := Value;
    if Value <> nil then
    begin
      if RBLayer = nil then
      begin
        RBLayer := TRubberBandLayer.Create(ImgView.Layers);
        RBLayer.MinHeight := 10;
        RBLayer.MinWidth := 10;
        RBLayer.MaxHeight := 12;
        RBLayer.MaxWidth := 12;
        RBLayer.Scaled := False;
      end
      else RBLayer.BringToFront;
      RBLayer.ChildLayer := Value;
      RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
    end;
  end;
end;

end.
4

0 回答 0