⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dsnhandle.pas

📁 DELPHI编写的商场收银POS机源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      TSmallRect(SmallRects[i]).SetControl;
end;

procedure THandlerRect.ChangeColorMulti;
var
  i:integer;
begin
  for i:= 0 to SmallRects.Count -1 do
    TSmallRect(SmallRects[i]).ChangeColorMulti;
end;

{TSmallRect}
constructor TSmallRect.Create2(AControl:TControl;ASize,ACutSizeX,ACutSizeY:Integer;clMulti,clSingle:TColor);
begin
  inherited Create(nil);
  Control:= AControl;
  Size:= ASize;
  CutSizeX:= ACutSizeX;
  CutSizeY:= ACutSizeY;
  ColorMulti:= clMulti;
  ColorSingle:= clSingle;
  Color:=ColorSingle;
end;

destructor  TSmallRect.Destroy;
begin
  HandlerRect.ChildDeth:= True;
  inherited Destroy;
end;

procedure TSmallRect.Paint;
begin
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=Color;
  Canvas.Rectangle(0,0,Width,Height);
end;

procedure TSmallRect.ChangeColorMulti;
begin
  Color:= ColorMulti;
  Cursor := 0;
  Repaint;
end;

function TSmallRect.CreateRectShape:TMultiShape;
begin
  Result:= TMultiShape.Create;
end;

procedure TSmallRect.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                      X, Y: Integer);
var
  Point:TPoint;
begin
  if Color = ColorSingle then
  begin
    HandlerRect.SWidth:= Control.Width;
    HandlerRect.SHeight:= Control.Height;
    HandlerRect.SLeft:= Control.Left;
    HandlerRect.STop:= Control.Top;
    FX:= X;
    FY:= Y;
    Cutting(FX,FY);
    
    FShape:= CreateRectShape;
    FShape.Color:= ShapeColor;
    FShape.PenWidth:= PenWidth;
    Point.x:= Left;
    Point.y:= Top;
    Point:= Parent.ClientToScreen(Point);
    FShape.Point:= Point;
    FShape.Add(Control);
    FShape.DrowOn(Control.Parent);
    if Control is TWinControl then
      SendMessage(TWinControl(Control).Handle,RM_START,Integer(Control),0)
    else
      SendMessage(Control.Parent.Handle,RM_START,Integer(Control),0);
  end;
end;

procedure TSmallRect.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TSmallRect.MouseUp(Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FShape) then
  begin
    FShape.DrowUp;
    FShape.Free;
    FShape:= nil;
    if Control is TWinControl then
      SendMessage(TWinControl(Control).Handle,RM_FINISH,MakeLong(HandlerRect.SLeft,HandlerRect.STop),MakeLong(HandlerRect.SWidth,HandlerRect.SHeight))
    else
      SendMessage(Control.Parent.Handle,RM_FINISH,MakeLong(HandlerRect.SLeft,HandlerRect.STop),MakeLong(HandlerRect.SWidth,HandlerRect.SHeight));
    HandlerRect.SetControl;
    HandlerRect.SWidth:= Control.Width;
    HandlerRect.SHeight:= Control.Height;
    HandlerRect.SLeft:= Control.Left;
    HandlerRect.STop:= Control.Top;
  end;
end;

procedure TSmallRect.Cutting(var X, Y: Integer);
begin
  X:= (X div CutSizeX) * CutSizeX;
  Y:= (Y div CutSizeY) * CutSizeY;
end;

{/MouseMove/}
procedure TMigiueRect.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Point:TPoint;
begin
  if Color = ColorSingle then
    Cursor := crSizeNESW;

  if Assigned(FShape) then
  begin
    Cutting(X, Y);
    Point.x:= Left;
    Point.y:= Top + Y;
    Point:= Parent.ClientToScreen(Point);
    FShape.SetWidth(Control.Width - (FX-X));
    FShape.SetHeight(Control.Height - Y);
    FShape.Drow(Point);
  end;
end;

procedure TMigishitaRect.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Point:TPoint;
begin
  if Color = ColorSingle then
    Cursor := crSizeNWSE;

  if Assigned(FShape) then
  begin
    Cutting(X, Y);
    Point.x:= Left;
    Point.y:= Top;
    Point:= Parent.ClientToScreen(Point);
    FShape.SetWidth(Control.Width - (FX-X));
    FShape.SetHeight(Control.Height - (FY-Y));
    FShape.Drow(Point);
  end;
end;

procedure THidariueRect.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Point:TPoint;
begin
  if Color = ColorSingle then
    Cursor := crSizeNWSE;

  if Assigned(FShape) then
  begin
    Cutting(X, Y);
    Point.x:= Left + X;
    Point.y:= Top + Y;
    Point:= Parent.ClientToScreen(Point);
    FShape.SetWidth(Control.Width - X);
    FShape.SetHeight(Control.Height - Y);
    FShape.Drow(Point);
  end;
end;

procedure THidarishitaRect.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Point:TPoint;
begin
  if Color = ColorSingle then
    Cursor := crSizeNESW;

  if Assigned(FShape) then
  begin
    Cutting(X, Y);
    Point.x:= Left + X;
    Point.y:= Top;
    Point:= Parent.ClientToScreen(Point);
    FShape.SetWidth(Control.Width - X);
    FShape.SetHeight(Control.Height - (FY-Y));
    FShape.Drow(Point);
  end;
end;

{/MouseUp/}
procedure TMigiueRect.MouseUp(Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
var
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
begin
  Cutting(X, Y);
  NewLeft:= Control.Left;
  NewWidth:= Control.Width + (X - FX);
  NewTop:= Control.Top + (Y - FY);
  NewHeight:= Control.Height - (Y - FY);
  if (NewWidth >=0) and (NewHeight >=0) then
    Control.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  if (NewWidth <0) and (NewHeight >=0) then
    Control.SetBounds(Control.Left + NewWidth, NewTop, -NewWidth, NewHeight);
  if (NewWidth >=0) and (NewHeight <0) then
    Control.SetBounds(NewLeft, Control.Top + Control.Height, NewWidth, -NewHeight);
  if (NewWidth <0) and (NewHeight <0) then
    Control.SetBounds(Control.Left + NewWidth, Control.Top + Control.Height, -NewWidth, -NewHeight);
  inherited;
end;

procedure TMigishitaRect.MouseUp(Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
var
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
begin
  Cutting(X, Y);
  NewLeft:= Control.Left;
  NewWidth:= Control.Width + (X - FX);
  NewTop:= Control.Top;
  NewHeight:= Control.Height + (Y - FY);
  if (NewWidth >=0) and (NewHeight >=0) then
    Control.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  if (NewWidth <0) and (NewHeight >=0) then
    Control.SetBounds(Control.Left + NewWidth, NewTop, -NewWidth, NewHeight);
  if (NewWidth >=0) and (NewHeight <0) then
    Control.SetBounds(NewLeft, Control.Top + NewHeight, NewWidth, -NewHeight);
  if (NewWidth <0) and (NewHeight <0) then
    Control.SetBounds(Control.Left + NewWidth, Control.Top + NewHeight, -NewWidth, -NewHeight);
  inherited;
end;

procedure THidariueRect.MouseUp(Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
var
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
begin
  Cutting(X, Y);
  NewLeft:= Control.Left + (X - FX);
  NewWidth:= Control.Width - (X - FX);
  NewTop:= Control.Top + (Y - FY);
  NewHeight:= Control.Height - (Y - FY);
  if (NewWidth >=0) and (NewHeight >=0) then
    Control.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  if (NewWidth <0) and (NewHeight >=0) then
    Control.SetBounds(Control.Left + Control.Width, NewTop, -NewWidth, NewHeight);
  if (NewWidth >=0) and (NewHeight <0) then
    Control.SetBounds(NewLeft, Control.Top + Control.Height, NewWidth, -NewHeight);
  if (NewWidth <0) and (NewHeight <0) then
    Control.SetBounds(Control.Left + Control.Width, Control.Top + Control.Height, -NewWidth, -NewHeight);
  inherited;
end;

procedure THidarishitaRect.MouseUp(Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
var
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
begin
  Cutting(X, Y);
  NewLeft:= Control.Left + (X - FX);
  NewWidth:= Control.Width - (X - FX);
  NewTop:= Control.Top;
  NewHeight:= Control.Height + (Y - FY);
  if (NewWidth >=0) and (NewHeight >=0) then
    Control.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  if (NewWidth <0) and (NewHeight >=0) then
    Control.SetBounds(Control.Left + Control.Width, NewTop, -NewWidth, NewHeight);
  if (NewWidth >=0) and (NewHeight <0) then
    Control.SetBounds(NewLeft, Control.Top + NewHeight, NewWidth, -NewHeight);
  if (NewWidth <0) and (NewHeight <0) then
    Control.SetBounds(Control.Left + Control.Width, Control.Top + NewHeight, -NewWidth, -NewHeight);
  inherited;
end;



{/SetControl/}
procedure TMigiueRect.SetControl;
var
  NewLeft, NewTop: Integer;
begin
  NewLeft:= Control.Left + Control.Width - Size +2;
  NewTop:= Control.Top -2;
  SetBounds(NewLeft,NewTop,Size,Size);
end;

procedure TMigiShitaRect.SetControl;
var
  NewLeft, NewTop: Integer;
begin
  NewLeft:= Control.Left + Control.Width - Size +2;
  NewTop:= Control.Top + Control.Height - Size +2;
  SetBounds(NewLeft,NewTop,Size,Size);
end;

procedure THidariueRect.SetControl;
var
  NewLeft, NewTop: Integer;
begin
  NewLeft:= Control.Left -2;
  NewTop:= Control.Top -2;
  SetBounds(NewLeft,NewTop,Size,Size);
end;

procedure THidarishitaRect.SetControl;
var
  NewLeft, NewTop: Integer;
begin
  NewLeft:= Control.Left -2;
  NewTop:= Control.Top + Control.Height - Size +2;
  SetBounds(NewLeft,NewTop,Size,Size);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -