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

📄 xsimageeffect.pas

📁 delphi图形程序开发,就是怎么样给图片加文字
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -