cmpbitmapeditor.pas

學習資料網上下載

unit cmpBitmapEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TDrawingTool = (dtNone, dtPencil, dtLine,
                  dtFrameRect, dtFillRect, dtRect,
                  dtFloodFill,
                  dtFrameRoundRect, dtFillRoundRect, dtRoundRect,
                  dtFrameEllipse, dtFillEllipse, dtEllipse,
                  dtMagnifier,
                  dtBrush,
                  dtSelectRect,
                  dtSelectArea,
                  dtDropper);

  TBitmapEditor = class(TCustomControl)
  private
    fPicture: TPicture;
    fMagnification: Integer;
    fGridLines: Integer;
    fBorderStyle: TBorderStyle;
    fDrawingTool: TDrawingTool;
    fLastDrawingTool: TDrawingTool;    // Reselect after using dropper
    fDrawBrush: TBrush;
    fDrawPen: TPen;
    fDrawBmp : TBitmap;
    fScratchBmp : TBitmap;
    fSelectionBmp : TBitmap;
    fPos : TPoint;
    fOnChange: TNotifyEvent;
    fTransparentColor : TColor;
    fOnDrawToolChange: TNotifyEvent;
    fCrossX, fCrossY : Integer;
    fSelectionRect : TRect;
    fLButtonIsDown : boolean;
    fMouseCaptured : boolean;
    fOnEndChange: TNotifyEvent;
    fCallEndChange : boolean;
    fOnSelectionRectChange: TNotifyEvent;
    fClipboardPalette: HPALETTE;
    fClipboardPixelFormat: TPixelFormat;

    procedure SetPicture(const Value: TPicture);
    procedure PaintBitmap (bmp : TBitmap);
    procedure SetMagnification(const Value: Integer);
    procedure SizeToPicture;
    procedure SetGridLines(const Value: Integer);
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetDrawBrush(const Value: TBrush);
    procedure SetDrawingTool(const Value: TDrawingTool);
    procedure SetDrawPen(const Value: TPen);
    procedure ChangeSelectionRect (const rect : TRect);
    procedure RedrawBitmap;
    procedure Initialize;
    procedure SetTransparentColor(const Value: TColor);
    procedure DisplayCrossHairs;
    function GetSelectionValid: boolean;
  protected
    procedure Paint; override;
    procedure CreateParams (var params : TCreateParams ); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    { Public declarations }
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    procedure ZoomIn;
    procedure ZoomOut;
    property DrawBmp : TBitmap read fDrawBmp;
    property SelectionValid : boolean read GetSelectionValid;
    property SelectionRect : TRect read fSelectionRect;
    property ClipboardPalette : HPALETTE read fClipboardPalette write fClipboardPalette;
    property ClipboardPixelFormat : TPixelFormat read fClipboardPixelFormat write fClipboardPixelFormat;
    procedure SelectAll;
    procedure DeleteSelection;
    procedure CopySelection;
    procedure CutSelection;
    procedure PasteSelection;
    procedure PictureChanged;

    procedure Rotate180;
    procedure Rotate90;
    procedure Rotate270;

    function GetDrawingChangeDescription : string;

  published
    { Published declarations }
    property Picture : TPicture read fPicture write SetPicture;
    property TransparentColor : TColor read fTransparentColor write SetTransparentColor default clTeal;
    property Magnification : Integer read fMagnification write SetMagnification default 4;
    property GridLines : Integer read fGridLines write SetGridLines default 4;
    property BorderStyle : TBorderStyle read fBorderStyle write SetBorderStyle default bsSingle;
    property DoubleBuffered;
    property PopupMenu;
    property TabStop;
    property DrawingTool : TDrawingTool read fDrawingTool write SetDrawingTool;
    property DrawPen : TPen read fDrawPen write SetDrawPen;
    property DrawBrush : TBrush read fDrawBrush write SetDrawBrush;
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
    property OnEndChange : TNotifyEvent read fOnEndChange write fOnEndChange;
    property OnDrawToolChange : TNotifyEvent read fOnDrawToolChange write fOnDrawToolChange;
    property OnSelectionRectChange : TNotifyEvent read fOnSelectionRectChange write fOnSelectionRectChange;
  end;

const
  crPencil = 1;
  crPotOPaint = 2;
  crMagnifier = 3;
  crDotCross = 4;
  crDropper = 5;

  DrawingCursors : array [TDrawingTool] of TCursor = (crArrow, crPencil, crCross, crCross, crCross, crCross, crPotOPaint, crCross, crCross, crCross, crCross, crCross, crCross, crMagnifier, crDotCross, crNone, crNone, crDropper);

implementation

{$R BitmapEditorCursors.res}

uses GraphFlip, Clipbrd;

{ TBitmapEditor }

procedure TBitmapEditor.ChangeSelectionRect(const rect: TRect);
var
  oldValid : Boolean;
begin
  oldValid := SelectionValid;

  if rect.Left <> -2 then fSelectionRect.Left := rect.Left;
  if rect.Top <> -2 then fSelectionRect.Top := rect.Top;
  if rect.Right <> -2 then fSelectionRect.Right := rect.Right;
  if rect.Bottom <> -2 then fSelectionRect.Bottom := rect.Bottom;

  if SelectionValid or oldValid then
    Invalidate;

  if Assigned (OnSelectionRectChange) then
    OnSelectionRectChange (Self)
end;

procedure TBitmapEditor.CopySelection;
var
  b : TBitmap;
  s : TMemoryStream;
  AData : THandle;
  p : PChar;
  Size : Integer;
  r : TRect;

begin
  s := nil;
  b := TBitmap.Create;
  try
    s := TMemoryStream.Create;
    b.PixelFormat := ClipboardPixelFormat;
    b.Palette := ClipboardPalette;
    b.Width := fSelectionRect.Right - fSelectionRect.Left + 1;
    b.Height := fSelectionRect.Bottom - fSelectionRect.Top + 1;

    r := fSelectionRect;
    Inc (r.Right);
    Inc (r.Bottom);

    b.Canvas.CopyRect (rect (0, 0, b.Width, b.Height), DrawBmp.Canvas, r);

    b.SaveToStream (s);
    Size := s.Size - SizeOf (TBitmapFileHeader);

    AData := GlobalAlloc (GMEM_DDESHARE, size);
    try
      p := GlobalLock (AData);
      Move ((PChar (s.Memory) + SizeOf (TBitmapFileHeader))^, p^, size);
      GlobalUnlock (AData);
      clipboard.SetAsHandle (CF_DIB, AData);
    except
      GlobalFree (AData);
      raise
    end
  finally
    b.Free;
    s.Free;
  end
end;

constructor TBitmapEditor.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  fSelectionRect.Right := -1;
  fSelectionRect.Bottom := -1;
  fPicture := TPicture.Create;
  fMagnification := 4;
  fGridLines := 4;
  fBorderStyle := bsSingle;
  fDrawBrush := TBrush.Create;
  fDrawPen := TPen.Create;

  fDrawBmp := TBitmap.Create;

  fScratchBmp := TBitmap.Create;
  fSelectionBmp := TBitmap.Create;
  fTransparentColor := clTeal;
  Screen.Cursors [crPencil] := LoadCursor (HInstance, 'CR_PENCIL');
  Screen.Cursors [crPotOPaint] := LoadCursor (HInstance, 'CR_POTOPAINT');
  Screen.Cursors [crMagnifier] := LoadCursor (HInstance, 'CR_MAGNIFIER');
  Screen.Cursors [crDotCross] := LoadCursor (HInstance, 'CR_DOTCROSS');
  Screen.Cursors [crDropper] := LoadCursor (HInstance, 'CR_DROPPER');
  Width := 32 * 4;
  Height := 32 * 4;
  Cursor := crArrow
end;

procedure TBitmapEditor.CreateParams(var params: TCreateParams);
begin
  inherited CreateParams (params);
  if BorderStyle = bsSingle then
    params.Style := params.Style or WS_BORDER;
end;

procedure TBitmapEditor.CutSelection;
begin
  CopySelection;
  DeleteSelection
end;

procedure TBitmapEditor.DeleteSelection;
var
  hrgn : THandle;
  Brush : TBrush;
begin
  Brush := nil;
  hrgn := CreateRectRgn (fSelectionRect.Left, fSelectionRect.Top, fSelectionRect.Right, fSelectionRect.Bottom);
  if hrgn = 0 then
    RaiseLastOSError;

  try
    Brush := TBrush.Create;
    Brush.Color := TransparentColor;
    FillRgn (DrawBmp.Canvas.Handle, hrgn, Brush.Handle);
  finally
    Brush.Free;
    DeleteObject (hrgn)
  end;
  RedrawBitmap
end;

destructor TBitmapEditor.Destroy;
begin
  fPicture.Free;
  fDrawPen.Free;
  fDrawBrush.Free;
  fDrawBmp.Free;
  fScratchBmp.Free;
  fSelectionBmp.Free;
  inherited
end;

procedure TBitmapEditor.DisplayCrossHairs;
var
  pt : TPoint;
  oldColor : TColor;
  oldMode : TPenMode;
begin
  GetCursorPos (pt);
  MapWindowPoints (HWND_DESKTOP, handle, pt, 1);
  pt.x := pt.x div Magnification;
  pt.y := pt.y div Magnification;

  if (pt.x <> fCrossX) or (pt.y <> fCrossY) then
  begin
    oldColor := Canvas.Pen.Color;
    oldMode := Canvas.Pen.Mode;
    Canvas.Pen.Color := clBlack;
    Canvas.Pen.Width := Magnification;
    Canvas.Pen.Mode := pmNotXor;

    try
      if pt.x <> fCrossX then
      begin
        fCrossX := pt.x;
        Canvas.MoveTo (fCrossX * Magnification + Magnification div 2, 0);
        Canvas.LineTo (fCrossX * Magnification + Magnification div 2, ClientHeight)
      end;
      if pt.y <> fCrossY then
      begin
        fCrossY := pt.y;
        Canvas.MoveTo (0, fCrossY * Magnification + Magnification div 2);
        Canvas.LineTo (ClientWidth, fCrossY * Magnification + Magnification div 2)
      end;
    finally
      Canvas.Pen.Color := oldColor;
      Canvas.Pen.Width := 1;
      Canvas.Pen.Mode := oldMode;
    end
  end
end;

function TBitmapEditor.GetDrawingChangeDescription: string;
resourcestring
  rstFreeDraw       = 'freehand drawing';
  rstLine           = 'line';
  rstFrameRect      = 'frame';
  rstFillRect       = 'filled frame';
  rstRect           = 'rectangle';
  rstFloodFill      = 'flood fill';
  rstFrameRoundRect = 'rounded frame';
  rstFillRoundRect  = 'filled rounded frame';
  rstRoundRect      = 'rounded rectangle';
  rstFrameEllipse   = 'elliptical frame';
  rstFillEllipse    = 'filled ellipse';
  rstEllipse        = 'ellipse';
  rstBrushStroke    = 'brush stroke';

const
  DrawingToolDescription : array [TDrawingTool] of string = (
    '', rstFreeDraw, rstLine,
    rstFrameRect, rstFillRect, rstRect,
    rstFloodFill,
    rstFrameRoundRect, rstFillRoundRect, rstRoundRect,
    rstFrameEllipse, rstFillEllipse, rstEllipse,
    '',
    rstBrushStroke,
    '', '', '');
begin
  result := DrawingToolDescription [DrawingTool]
end;

function TBitmapEditor.GetSelectionValid: boolean;
begin
  result := (fSelectionRect.Right <> -1) and (fSelectionRect.Bottom <> -1);
end;

procedure TBitmapEditor.Initialize;
var
  r : TRect;
begin
  if Assigned (fPicture.Graphic) then
  begin
    fDrawBmp.Assign (fPicture.Graphic);
    if fDrawBmp.Transparent then
      fTransparentColor := fDrawBmp.TransparentColor
  end
  else
  begin
    r.Left := 0;
    r.top := 0;
    r.right := 32;
    r.bottom := 32;
    fDrawBmp.TransparentColor := TransparentColor;
    fDrawBmp.Width := r.right;
    fDrawBmp.Height := r.bottom;
    fDrawBmp.Canvas.pen.Color := clWhite;
    fDrawBmp.Canvas.FillRect (r)
  end;

  ChangeSelectionRect (rect (-1, -1, -1, -1));

  ClientWidth := fDrawBmp.Width * Magnification;
  ClientHeight := fDrawBmp.Height * Magnification;

  if fMouseCaptured then
  begin
    ReleaseCapture;
    fMouseCaptured := False
  end
end;

procedure TBitmapEditor.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p : TPoint;
begin
  SetFocus;
  fCallEndChange := DrawingTool in [dtPencil..dtEllipse, dtBrush];
  p.x := x div magnification;
  p.y := y div magnification;
  fScratchBmp.Assign (fDrawBmp);

  if Button = mbLeft then
  begin
    fLButtonIsDown := True;
    fPos := p;

    case DrawingTool of
      dtPencil, dtLine :
        begin
          fDrawBmp.Canvas.Pixels [p.x, p.y] := fDrawPen.Color;
          RedrawBitmap
        end;
      dtFloodFill :
        begin
          with fDrawBmp.Canvas do
          begin
            Brush := fDrawBrush;
            FloodFill (p.x, p.y, Pixels [p.x, p.y], fsSurface);
          end;
          RedrawBitmap
        end;
      dtMagnifier :
        ZoomIn;

      dtDropper :
        begin
          fDrawPen.Color := fDrawBmp.Canvas.Pixels [p.x, p.y];
          DrawingTool := fLastDrawingTool;
          ReleaseCapture;
          if Assigned (fOnDrawToolChange) and not (csDestroying in ComponentState) then
            OnDrawToolChange (self);
        end;

      dtSelectRect,
      dtSelectArea :
          ChangeSelectionRect (rect (p.x, p.y, -1, -1));
    end
  end
  else
    if Button = mbRight then
      case DrawingTool of
        dtMagnifier : ZoomOut;
        dtDropper :
          begin
            fDrawBrush.Color := fDrawBmp.Canvas.Pixels [p.x, p.y];
            DrawingTool := fLastDrawingTool;
            ReleaseCapture;
            if Assigned (fOnDrawToolChange) and not (csDestroying in ComponentState) then
              OnDrawToolChange (self);
          end
        end

end;

procedure TBitmapEditor.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  p : TPoint;
  hrgn : THandle;
  r : TRect;
  inRect : Boolean;
begin
  p.x := x;