📄 xsimageeffect.pas
字号:
Picture.Assign(Bitmap1);
ModifyPicture:= True;
Bitmap1.Free;
Bitmap2.Free;
end;
end;
destructor TXsImageEffect.Destroy;
begin
AntsTimer.Free;
MOrgBitmap.Free;
inherited Destroy;
end;
procedure TXsImageEffect.DragFormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not DMD then
begin
DMD:= True;
DX:= X;
DY:= Y;
end;
end;
procedure TXsImageEffect.DragFormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
cx, cy: Integer;
begin
if DMD then
begin
cy:= Y-DY;
cx:= X-DX;
if cy > 0 then
SendMessage(FPForm.Handle,WM_VSCROLL,SB_LINEUP,0)
else if cy < 0 then
SendMessage(FPForm.Handle,WM_VSCROLL,SB_LINEDOWN,0);
if cx > 0 then
SendMessage(FPForm.Handle,WM_HSCROLL,SB_LINELEFT,0)
else if cx < 0 then
SendMessage(FPForm.Handle,WM_HSCROLL,SB_LINERIGHT,0);
end;
end;
procedure TXsImageEffect.DragFormMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if DMD then
DMD:= False;
end;
procedure TXsImageEffect.DrawTheRect;
begin
// Determines starting pixel color of Rect
Counter := CounterStart;
// Use LineDDA to draw each of the 4 edges of the rectangle
LineDDA(X1, Y1, X2, Y1, @MovingDots, LongInt(FPForm.Canvas));
LineDDA(X2, Y1, X2, Y2, @MovingDots, LongInt(FPForm.Canvas));
LineDDA(X2, Y2, X1, Y2, @MovingDots, LongInt(FPForm.Canvas));
LineDDA(X1, Y2, X1, Y1, @MovingDots, LongInt(FPForm.Canvas));
end;
procedure TXsImageEffect.GetPictureContent;
var
ob: TBitmap;
Bitmap1, Bitmap2: TBitmap;
x, y: Integer;
P, T: PByteArray;
R, G, B: Integer;
begin
ob:= ChangeToBitmap(Picture.Graphic);
Bitmap1:= TBitmap.Create;
Bitmap2:= TBitmap.Create;
Bitmap1.Assign(ob);
Bitmap1.PixelFormat:= pf24bit;
Bitmap2.PixelFormat:= pf24bit;
Bitmap1.Canvas.Brush.Color:= Color;
Bitmap2.Canvas.Brush.Color:= Color;
Bitmap2.Width:= Bitmap1.Width;
Bitmap2.Height:= Bitmap1.Height;
ob.Free;
for y:=0 to Bitmap1.Height-1 do
begin
P:= Bitmap1.ScanLine[y];
T:= Bitmap2.ScanLine[y];
for x:=0 to Bitmap1.Width-1 do
begin
R:= P[x * 3];
G:= P[x * 3 + 1];
B:= P[x * 3 + 2];
if AnalysisColorArea(R, G, B, FBaseColor, FColorArea) then
begin
T[x * 3]:= R;
T[x * 3 + 1]:= G;
T[x * 3 + 2]:= B;
end;
end;
Picture.Assign(Bitmap2);
ModifyPicture:= True;
end;
end;
procedure TXsImageEffect.LeftRightMirror(Bitmap: TBitmap);
var
bmp1, bmp2: TBitmap;
T, P: pByteArray;
X, Y: integer;
begin
bmp1 := TBitmap.Create;
bmp2 := TBitmap.Create;
bmp2.Canvas.Brush.Color:= Color;
bmp2.Assign(bitmap);
bmp1.Width := bitmap.Width;
bmp1.Height := bitmap.Height;
bmp1.Canvas.Brush.Color:= Color;
bmp1.PixelFormat := pf24bit;
bmp2.PixelFormat := pf24bit;
for Y := 0 to bmp2.Height - 1 do
begin
T := bmp2.ScanLine[Y];
P := bmp1.ScanLine[Y];
for X := 0 to bmp2.Width - 1 do
begin
P[3 * X + 2] := T[3 * (bmp2.Width - 1 - X) + 2];
P[3 * X + 1] := T[3 * (bmp2.Width - 1 - X) + 1];
P[3 * X] := T[3 * (bmp2.Width - 1 - X)];
end;
end;
bmp2.Canvas.Draw(0, 0, bmp1);
bmp2.PixelFormat := pf24bit;
Picture.Assign(bmp2);
ModifyPicture:= True;
bmp1.Free;
bmp2.Free;
end;
procedure TXsImageEffect.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if FSelectArea then
AntsMouseDown(Self,Button,Shift,X,Y);
if FDragInForm then
DragFormMouseDown(Self,Button,Shift,X,Y);
end;
procedure TXsImageEffect.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if FSelectArea then
AntsMouseMove(Self,Shift,X,Y);
if FDragInForm then
DragFormMouseMove(Self,Shift,X,Y);
end;
procedure TXsImageEffect.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if FSelectArea then
AntsMouseUp(Self,Button,Shift,X,Y);
if FDragInForm then
DragFormMouseUp(Self,Button,Shift,X,Y);
end;
procedure TXsImageEffect.RemoveTheRect;
var
R: TRect;
begin
R := NormalizeRect(Rect(X1, Y1, X2, Y2)); // Rectangle might be flipped
InflateRect(R, 1, 1); // Make the rectangle 1 pixel larger , 其实是left-1,right+1,故而widht加2 ,top和bottom相似
InvalidateRect(FPForm.Handle, @R, True); // Mark the area as invalid
InflateRect(R, -2, -2); // Now shrink the rectangle 2 pixels
ValidateRect(FPForm.Handle, @R); // And validate this new rectangle.
// This leaves a 2 pixel band all the way around
// the rectangle that will be erased & redrawn
UpdateWindow(FPForm.Handle);
end;
procedure TXsImageEffect.SelectAll;
begin
SetSelectArea(True);
X1:= Left;
Y1:= Top;
X2:= ClientWidth + Left-1;
Y2:= ClientHeight + Top-1;
DrawTheRect;
end;
procedure TXsImageEffect.SetDegree(Value: Integer);
var
Rb, ob: TBitmap;
begin
FDegree:= Value;
if not Picture.Graphic.Empty then
begin
FDegree:= Value;
if ((Value mod 90)=0) or ModifyPicture then
ob:= ChangeToBitmap(Picture.Graphic)
else
begin
ob:= TBitmap.Create;
ob.Assign(MOrgBitmap);
end;
if Value <> 0 then
Rb:= CreateRotatedBitmap(ob,Value,Color)
else
begin
Rb:= TBitmap.Create;
Rb.Assign(MOrgBitmap);
end;
ob.Free;
Picture.Assign(Rb);
ModifyPicture:= False;
Rb.Free;
end;
end;
procedure TXsImageEffect.SetDragInForm(Value: Boolean);
begin
FDragInForm:= Value;
if Value then
begin
Cursor:= crHandPoint;
if SelectArea then
SelectArea:= False;
end else
Cursor:= crDefault;
end;
procedure TXsImageEffect.SetLeftRightMirror;
var
ob: TBitmap;
begin
if not Picture.Graphic.Empty then
begin
ob:= ChangeToBitmap(Picture.Graphic);
LeftRightMirror(ob);
ob.Free;
end;
end;
procedure TXsImageEffect.SetModifyPicture(Value: Boolean);
var
ob: TBitmap;
begin
FModifyPicture:= Value;
if Value then
begin
ob:= ChangeToBitmap(Picture.Graphic);
MOrgBitmap.Assign(ob);
ob.Free;
end;
end;
procedure TXsImageEffect.SetSelectArea(Value: Boolean);
begin
FSelectArea:= Value;
if Value then
begin
if DragInForm then
DragInForm:= False;
X1 := 0;
Y1 := 0;
X2 := 0;
Y2 := 0;
FPForm.Canvas.Pen.Color := Color;
FPForm.Canvas.Brush.Color := Color;
CounterStart := 128;
AntsTimer.Interval := 100;
AntsTimer.OnTimer:= AntsTimerEvent;
AntsTimer.Enabled := True;
Looper := 0;
FPForm.DoubleBuffered := true;
FPForm.ControlStyle := FPForm.ControlStyle + [csOpaque];
end else
begin
AntsTimer.Enabled:= False;
AntsTimer.OnTimer:= nil;
RemoveTheRect;
end;
end;
procedure TXsImageEffect.SetTopBottomMirror;
var
ob: TBitmap;
begin
if not Picture.Graphic.Empty then
begin
ob:= ChangeToBitmap(Picture.Graphic);
TopBottomMirror(ob);
ob.Free;
end;
end;
procedure TXsImageEffect.TopBottomMirror(Bitmap: TBitmap);
var
bmp1, bmp2: Tbitmap;
i, j: integer;
p, p1: pbyteArray;
begin
bmp1 := Tbitmap.Create;
bmp2 := Tbitmap.Create;
bmp2.Canvas.Brush.Color:= Color;
bmp2.Assign(Bitmap);
bmp1.Width := Bitmap.Width;
bmp1.Height := Bitmap.Height;
bmp1.Canvas.Brush.Color:= Color;
bmp1.PixelFormat := pf24bit;
bmp2.PixelFormat := pf24bit;
for j := 0 to Bitmap.Height - 1 do
begin
p := bmp1.ScanLine[j];
p1 := bmp2.ScanLine[Bitmap.Height - 1 - j];
for i := 0 to Bitmap.Width - 1 do
begin
p[3 * i] := p1[3 * i];
p[3 * i + 1] := p1[3 * i + 1];
p[3 * i + 2] := p1[2 + 3 * i];
end;
end;
bmp2.Canvas.Draw(0, 0, bmp1);
bmp2.PixelFormat := pf24bit;
Picture.Assign(bmp2);
ModifyPicture:= True;
bmp1.Free;
bmp2.Free;
end;
end.
{
procedure TXsImageEffect.DragMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FDragImage then
begin
if not Stretch then
begin
if not md then
begin
StartX := X;
StartY := Y;
mx := ClientWidth - Picture.Width;
my := ClientHeight - Picture.Height;
md:= True;
end;
end;
end;
end;
procedure TXsImageEffect.DragMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDragImage then
begin
if md then
begin
Dec(px, StartX - X);
Dec(py, StartY - Y);
if px > 0 then px := 0;
if px < mx then px := mx;
if py > 0 then py := 0;
if py < my then py := my;
StartX := X;
StartY := Y;
Picture:=nil;
Canvas.Draw(px, py, Picture.Graphic);
end;
end;
end;
procedure TXsImageEffect.DragMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if FDragImage then
begin
if md then
begin
md:= False;
end;
end;
end;
}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -