仅贴出关键的代码部分
unit MainFrm;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Buttons, ExtCtrls, ColorGrd, StdCtrls, Menus, ComCtrls;
const
crMove = 1;
rate1 = 0.38;
rate2 = 0.19;
type
TDrawType = (dtLineDraw, dtRectangle, dtEllipse, dtRoundRect,
dtClipRect, dtCrooked, dtPolyLine, dtPolygon,
dtTriangle, dtFan);
{用于画三角形的record}
TTriangle = record
FStrtDot: TPoint;
FEndDot : TPoint;
FFrstDot: TPoint;
FScndDot: TPoint;
FThrdDot: TPoint;
FScndVal: Boolean;
end;
{用于画扇形的record}
TFan = record
FStrtDot: TPoint;
FOrgDot : TPoint;
FLstDot : TPoint;
FNFrst : Boolean;
end;
{用于画五角星的record，记录五个端点}
TStar = record
FTL: TPoint;
FBR: TPoint;
FFrstDot: TPoint;
FScndDot: TPoint;
FThrdDot: TPoint;
FFrthDot: TPoint;
FFfthDot: TPoint;
end;
TMainForm = class(TForm)
sbxMain: TScrollBox;
imgDrawingPad: TImage;
pnlToolBar: TPanel;
sbLine: TSpeedButton;
sbRectangle: TSpeedButton;
sbEllipse: TSpeedButton;
sbRoundRect: TSpeedButton;
pnlColors: TPanel;
cgDrawingColors: TColorGrid;
pnlFgBgBorder: TPanel;
pnlFgBgInner: TPanel;
Bevel1: TBevel;
mmMain: TMainMenu;
mmiFile: TMenuItem;
mmiExit: TMenuItem;
N2: TMenuItem;
mmiSaveAs: TMenuItem;
mmiSaveFile: TMenuItem;
mmiOpenFile: TMenuItem;
mmiNewFile: TMenuItem;
mmiEdit: TMenuItem;
mmiPaste: TMenuItem;
mmiCopy: TMenuItem;
mmiCut: TMenuItem;
sbRectSelect: TSpeedButton;
SaveDialog: TSaveDialog;
OpenDialog: TOpenDialog;
stbMain: TStatusBar;
pbPasteBox: TPaintBox;
sbFreeForm: TSpeedButton;
RgGrpFillOptions: TRadioGroup;
cbxBorder: TCheckBox;
sbPolyline: TSpeedButton;
sbPolygon: TSpeedButton;
sbTriangle: TSpeedButton;
sbFan: TSpeedButton;
dlgColor: TColorDialog;
btnBorder: TButton;
btnFill: TButton;
procedure FormCreate(Sender: TObject);
procedure sbLineClick(Sender: TObject);
procedure imgDrawingPadMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgDrawingPadMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure imgDrawingPadMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure cgDrawingColorsChange(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiSaveFileClick(Sender: TObject);
procedure mmiSaveAsClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure mmiNewFileClick(Sender: TObject);
procedure mmiOpenFileClick(Sender: TObject);
procedure mmiEditClick(Sender: TObject);
procedure mmiCutClick(Sender: TObject);
procedure mmiCopyClick(Sender: TObject);
procedure mmiPasteClick(Sender: TObject);
procedure pbPasteBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbPasteBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pbPasteBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbPasteBoxPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RgGrpFillOptionsClick(Sender: TObject);
procedure btnBorderClick(Sender: TObject);
procedure btnFillClick(Sender: TObject);
public
{ Public declarations }
MouseOrg: TPoint; // Stores mouse information
NextPoint: TPoint; // Stores mouse information
Drawing: Boolean; // Drawing is being performed flag
DrawType: TDrawType; // Holds the draw type information: TDrawType
FillSelected, // Fill shapes flag
BorderSelected: Boolean; // Draw Shapes with no border flag
EraseClipRect: Boolean; // Specifies whether or not to erase the
// clipping rectangle
Modified: Boolean; // Image modified flag
FileName: String; // Holds the filename of the image
OldClipViewHwnd: Hwnd; // Holds the old clipboard view window
{ Paste Image variables }
PBoxMoving: Boolean; // PasteBox is moving flag
PBoxMouseOrg: TPoint; // Stores mouse coordinates for moving PasteBox
PasteBitMap: TBitmap; // Stores a bitmap image of the pasted data
Pasted: Boolean; // Data pasted flag
LastDot: TPoint; // Hold the TPoint coordinate for performing
// free line drawing
procedure DrawToImage(TL, BR: TPoint; PenMode: TPenMode);
{ This procedure paints the image specified by the DrawType field
to imgDrawingPad }
procedure SetDrawingStyle;
{ This procedure sets various Pen/Brush styles based on values
specified by the form's controls. The Panels and color grid is
used to set these values }
procedure CopyPasteBoxToImage;
{ This procedure copies the data pasted from the Windows clipboard
onto the main image component imgDrawingPad }
procedure WMDrawClipBoard(var Msg: TWMDrawClipBoard);
message WM_DRAWCLIPBOARD;
{ This message handler captures the WM_DRAWCLIPBOARD messages
which is sent to all windows that have been added to the clipboard
viewer chain. An application can add itself to the clipboard viewer
chain by using the SetClipBoardViewer() Win32 API function as
is done in FormCreate() }
procedure CopyCut(Cut: Boolean);
{ This method copies a portion of the main image, imgDrawingPad, to the
Window's clipboard. }
end;
var
MainForm: TMainForm;
{用于画PolyLine的专用全局变量，Polyline随鼠标滑动而动态绘制
PLStart: TPoint，用于保存Polyline的起点，随着每次鼠标UP而动态更新
PLLast: TPoint，用于保存鼠标每滑动一次的终止点
PLDrawed: Boolean，用于鼠标滑动时检查是否已画了折线
true 则XOR掉起点到Move当前点上一点所绘制的折线并重画
false则直接重画
}
PLStart, PLLast: TPoint;
PLDrawed: Boolean;
{用于画Triangle的量，为TTriangle类型}
Trngl: TTriangle;
{用于画Fan的量，为TFan类型}
Fn: TFan;
implementation
uses ClipBrd, Math;
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
{ This method sets the form's field to their default values. It then
creates a bitmap for the imgDrawingPad. This is the image on which
drawing is done. Finally, it adds this application as part of the
Windows clipboard viewer chain by using the SetClipBoardViewer()
function. This makes enables the form to get WM_DRAWCLIPBOARD messages
which are sent to all windows in the clipboard viewer chain whenever
the clipboard data is modified. }
begin
Screen.Cursors[crMove] := LoadCursor(hInstance, 'MOVE');
FillSelected := False;
BorderSelected := True;
Modified := False;
FileName := '';
Pasted := False;
pbPasteBox.Enabled := False;
// Create a bitmap for imgDrawingPad and set its boundaries
with imgDrawingPad do
begin
SetBounds(0, 0, 600, 400);
Picture.Graphic := TBitMap.Create;
Picture.Graphic.Width := 600;
Picture.Graphic.Height := 400;
end;
// Now create a bitmap image to hold pasted data
PasteBitmap := TBitmap.Create;
pbPasteBox.BringToFront;
{ Add the form to the Windows clipboard viewer chain. Save the handle
of the next window in the chain so that it may be restored by the
ChangeClipboardChange() Win32 API function in this form's
FormDestroy() method. }
OldClipViewHwnd := SetClipBoardViewer(Handle);
end;
procedure TMainForm.WMDrawClipBoard(var Msg: TWMDrawClipBoard);
begin
{ This method will be called whenever the clipboard data
has changed. Because the main form was added to the clipboard
viewer chain, it will receive the WM_DRAWCLIPBOARD message
indicating that the clipboard's data was changed. }
inherited;
{ Make sure that the data contained on the clipboard is actually
bitmap data. }
if ClipBoard.HasFormat(CF_BITMAP) then
mmiPaste.Enabled := True
else
mmiPaste.Enabled := False;
Msg.Result := 0;
end;
procedure TMainForm.DrawToImage(TL, BR: TPoint; PenMode: TPenMode);
{ This method performs the specified drawing operation. The
drawing operation is specified by the DrawType field }
var
//用于画五角星的点
x1,y1,x2,x3: Integer;
begin
with imgDrawingPad.Canvas do
begin
Pen.Mode := PenMode;
case DrawType of
dtLineDraw, dtPolyLine, dtTriangle, dtFan:
begin
MoveTo(TL.X, TL.Y);
LineTo(BR.X, BR.Y);
end;
dtPolygon:
begin
//x1这一点前边别忘记加上TL.X，否则画出奇怪的图形啊！！！
x1 := TL.X + (BR.X - TL.X) div 2;
y1 := trunc(TL.Y+(BR.Y-TL.Y)*rate1);
x2 := trunc(TL.X+(BR.X-TL.X)*rate2);
x3 := trunc(BR.X-(BR.X-TL.X)*rate2);
MoveTo(x1, TL.Y);
LineTo(x2, BR.y);
LineTo(BR.X, y1);
LineTo(TL.X, y1);
LineTo(x3, BR.Y);
LineTo(x1, TL.Y);
x1 := 0;
y1 := 0;
x2 := 0;
x3 := 0;
end;
dtRectangle:
Rectangle(TL.X, TL.Y, BR.X, BR.Y);
dtEllipse:
Ellipse(TL.X, TL.Y, BR.X, BR.Y);
dtRoundRect:
RoundRect(TL.X, TL.Y, BR.X, BR.Y,
(TL.X - BR.X) div 2, (TL.Y - BR.Y) div 2);
dtClipRect:
Rectangle(TL.X, TL.Y, BR.X, BR.Y);
end;
end;
end;
procedure TMainForm.CopyPasteBoxToImage;
{ This method copies the image pasted from the Windows clipboard onto
imgDrawingPad. It first erases any bounding rectangle drawn by PaintBox
component, pbPasteBox. It then copies the data from pbPasteBox onto
imgDrawingPad at the location where pbPasteBox has been dragged
over imgDrawingPad. The reason we don't copy the contents of
pbPasteBox's canvas and use PasteBitmap's canvas instead, is because
when a portion of pbPasteBox is dragged out of the viewable area,
Windows does not paint the portion pbPasteBox not visible. Therefore,
it is necessary to the pasted bitmap from the off-screen bitmap }
var
SrcRect, DestRect: TRect;
begin
// First, erase the rectangle drawn by pbPasteBox
with pbPasteBox do
begin
Canvas.Pen.Mode := pmNotXOR;
Canvas.Pen.Style := psDot;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(0, 0, Width, Height);
DestRect := Rect(Left, Top, Left+Width, Top+Height);
SrcRect := Rect(0, 0, Width, Height);
end;
{ Here we must use the PasteBitmap instead of the pbPasteBox because
pbPasteBox will clip anything outside if the viewable area. }
imgDrawingPad.Canvas.CopyRect(DestRect, PasteBitmap.Canvas, SrcRect);
pbPasteBox.Visible := false;
pbPasteBox.Enabled := false;
Pasted := False; // Pasting operation is complete
end;
procedure TMainForm.imgDrawingPadMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Modified := True;
// Erase the clipping rectangle if one has been drawn
if (DrawType = dtClipRect) and EraseClipRect then
DrawToImage(MouseOrg, NextPoint, pmNotXOR)
else if (DrawType = dtClipRect) then
EraseClipRect := True; // Re-enable cliprect erasing
if Pasted then
CopyPasteBoxToImage;
Drawing := True;
// Save the mouse information
if (DrawType = dtPolyline) and (not PLDrawed) then
begin
PLStart := Point(X,Y);
PLLast := PLStart;
end ;
if (DrawType = dtTriangle) and (not Trngl.FScndVal) then
begin
Trngl.FFrstDot := Point(X,Y);
Trngl.FStrtDot := Point(X,Y);
Trngl.FEndDot := Trngl.FStrtDot;
end;
if (DrawType = dtFan) and (not Fn.FNFrst) then
begin
Fn.FStrtDot := Point(X,Y);
Fn.FOrgDot := Point(X,Y);
Fn.FLstDot := Point(X,Y);
end;
MouseOrg := Point(X, Y);
NextPoint := MouseOrg;
LastDot := NextPoint; // Lastdot is updated as the mouse moves
//将线的起点移动到鼠标按下的点
imgDrawingPad.Canvas.MoveTo(X, Y);
end;
procedure TMainForm.imgDrawingPadMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
{ This method determines the drawing operation to be performed and
either performs free form line drawing, or calls the
DrawToImage method which draws the specified shape }
begin
if Drawing then
begin
case DrawType of
dtCrooked:
begin
imgDrawingPad.Canvas.MoveTo(LastDot.X, LastDot.Y);
imgDrawingPad.Canvas.LineTo(X, Y);
LastDot := Point(X,Y);
end;
dtPolyLine:
begin
DrawToImage(PLStart, PLLast, pmNotXor);
PLLast := Point(X,Y);
DrawToImage(PLStart, PLLast, pmNotXor);
PLDrawed := True;
end;
dtTriangle:
begin
DrawToImage(Trngl.FStrtDot, Trngl.FEndDot, pmNotXor);
Trngl.FEndDot := Point(X,Y);
DrawToImage(Trngl.FStrtDot, Trngl.FEndDot, pmNotXor);
end;
dtFan:
if not Fn.FNFrst then
begin
DrawToImage(Fn.FStrtDot, Fn.FOrgDot, pmNotXor);
Fn.FOrgDot := Point(X, Y);
DrawToImage(Fn.FStrtDot, Fn.FOrgDot, pmNotXor);
end
else begin
///:~@@@@@@@使用了pmCopy后扇形的前一条边就不会消失，为什么？？
DrawToImage(Fn.FStrtDot, Fn.FOrgDot, pmCopy);
DrawToImage(Fn.FOrgDot, Fn.FLstDot, pmNotXor);
DrawToImage(Fn.FStrtDot, Fn.FLstDot, pmNotXor);
Fn.FLstDot := Point(X,Y);
DrawToImage(Fn.FOrgDot, Fn.FLstDot, pmNotXor);
DrawToImage(Fn.FStrtDot, Fn.FLstDot, pmNotXor);
end
else begin
DrawToImage(MouseOrg, NextPoint, pmNotXor);
NextPoint := Point(X, Y);
DrawToImage(MouseOrg, NextPoint, pmNotXor)
end;
end;
end;
// Update the status bar with the current mouse location
stbMain.Panels[1].Text := Format('X: %d, Y: %D', [X, Y]);
end;
procedure TMainForm.imgDrawingPadMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
{ Prevent the clipping rectangle from destroying the images already
on the image }
case DrawType of
dtPolyLine:
begin
DrawToImage(PLStart, Point(X,Y), pmCopy);
PLStart := Point(X,Y);
end;
dtTriangle:
begin
if not Trngl.FScndVal then
begin
Trngl.FScndDot := Point(X,Y);
DrawToImage(Trngl.FStrtDot, Trngl.FEndDot, pmCopy);
Trngl.FStrtDot := Trngl.FScndDot;
Trngl.FScndVal := True;
end
else begin
Trngl.FThrdDot := Point(X,Y);
DrawToImage(Trngl.FStrtDot, Trngl.FEndDot, pmCopy);
DrawToImage(Trngl.FThrdDot, Trngl.FFrstDot, pmNotXor);
Trngl.FScndVal := False;
end;
end;
dtFan:
if not Fn.FNFrst then
begin
DrawToImage(Fn.FStrtDot, Fn.FLstDot, pmCopy);
Fn.FNFrst := True;
end
else begin
DrawToImage(Fn.FStrtDot, Fn.FOrgDot, pmCopy);
DrawToImage(Fn.FStrtDot, Fn.FLstDot, pmCopy);
DrawToImage(Fn.FOrgDot, Fn.FLstDot, pmCopy);
Fn.FOrgDot := Point(X,Y);
end;
dtLineDraw, dtRectangle, dtEllipse, dtRoundRect, dtCrooked:
DrawToImage(MouseOrg, Point(X, Y), pmCopy);
end;
Drawing := False;
end;
procedure TMainForm.sbLineClick(Sender: TObject);
begin
// First erase the cliprect if current drawing type
if DrawType = dtClipRect then
DrawToImage(MouseOrg, NextPoint, pmNotXOR);
{ Now set the DrawType field to that specified by the TSpeedButton
invoking this method. The TSpeedButton's Tag values match a
specific TDrawType value which is why the typecasting below
successfully assigns a valid TDrawType value to the DrawType field. }
if Sender is TSpeedButton then
DrawType := TDrawType(TSpeedButton(Sender).Tag);
// Now make sure the dtClipRect style doesn't erase previous drawings
if DrawType = dtClipRect then begin
EraseClipRect := False;
end;
// Set the drawing style
SetDrawingStyle;
end;
procedure TMainForm.cgDrawingColorsChange(Sender: TObject);
{ This method draws the rectangle representing fill and border colors
to indicate the users selection of both colors. pnlFgBgInner and
pnlFgBgBorder are TPanels arranged one on to of the other for the
desired effect }
begin
pnlFgBgBorder.Color := cgDrawingColors.ForeGroundColor;
pnlFgBgInner.Color := cgDrawingColors.BackGroundColor;
SetDrawingStyle;
end;
procedure TMainForm.SetDrawingStyle;
{ This method sets the various drawing styles based on the selections
on the pnlFillStyle TPanel for Fill and Border styles }
begin
with imgDrawingPad do
begin
if DrawType = dtClipRect then
begin
Canvas.Pen.Style := psDot;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clBlack;
end
else if FillSelected then
Canvas.Brush.Style := bsSolid
else
Canvas.Brush.Style := bsClear;
if BorderSelected then
Canvas.Pen.Style := psSolid
else
Canvas.Pen.Style := psClear;
if FillSelected and (DrawType <> dtClipRect) then
Canvas.Brush.Color := pnlFgBgInner.Color;
if DrawType <> dtClipRect then
Canvas.Pen.Color := pnlFgBgBorder.Color;
end;
end;
procedure TMainForm.mmiExitClick(Sender: TObject);
begin
Close; // Terminate application
end;
procedure TMainForm.mmiSaveFileClick(Sender: TObject);
{ This method saves the image to the file specified by FileName. If
FileName is blank, however, SaveAs1Click is called to get a filename.}
begin
if FileName = '' then
mmiSaveAsClick(nil)
else begin
imgDrawingPad.Picture.SaveToFile(FileName);
stbMain.Panels[0].Text := FileName;
Modified := False;
end;
end;
procedure TMainForm.mmiSaveAsClick(Sender: TObject);
{ This method launches SaveDialog to get a file name to which
the image's contents will be saved. }
begin
if SaveDialog.Execute then
begin
FileName := SaveDialog.FileName; // Store the filename
mmiSaveFileClick(nil)
end;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{ If the user attempts to close the form before saving the image, they
are prompted to do so in this method. }
var
Rslt: Word;
begin
CanClose := False; // Assume fail.
if Modified then begin
Rslt := MessageDlg('File has changed, save?', mtConfirmation, mbYesNOCancel, 0);
case Rslt of
mrYes: mmiSaveFileClick(nil);
mrNo: ; // no need to do anything.
mrCancel: Exit;
end
end;
CanClose := True; // Allow use to close application
end;
procedure TMainForm.mmiNewFileClick(Sender: TObject);
{ This method erases any drawing on the main image after prompting the
user to save it to a file in which case the mmiSaveFileClick event handler
is called. }
var
Rslt: Word;
begin
if Modified then begin
Rslt := MessageDlg('File has changed, save?', mtConfirmation, mbYesNOCancel, 0);
case Rslt of
mrYes: mmiSaveFileClick(nil);
mrNo: ; // no need to do anything.
mrCancel: Exit;
end
end;
with imgDrawingPad.Canvas do begin
Brush.Style := bsSolid;
Brush.Color := clWhite; // clWhite erases the image
FillRect(ClipRect); // Erase the image
FileName := '';
stbMain.Panels[0].Text := FileName;
end;
SetDrawingStyle; // Restore the previous drawing style
Modified := False;
end;
procedure TMainForm.mmiOpenFileClick(Sender: TObject);
{ This method opens a bitmap file specified by OpenDialog.FileName. If
a file was already created, the user is prompted to save
the file in which case the mmiSaveFileClick event is called. }
var
Rslt: Word;
begin
if OpenDialog.Execute then
begin
if Modified then begin
Rslt := MessageDlg('File has changed, save?', mtConfirmation, mbYesNOCancel, 0);
case Rslt of
mrYes: mmiSaveFileClick(nil);
mrNo: ; // no need to do anything.
mrCancel: Exit;
end
end;
imgDrawingPad.Picture.LoadFromFile(OpenDialog.FileName);
FileName := OpenDialog.FileName;
stbMain.Panels[0].Text := FileName;
Modified := false;
end;
end;
procedure TMainForm.mmiEditClick(Sender: TObject);
{ The timer is used to determine if an area on the main image is
surrounded by a bounding rectangle. If so, then the Copy and Cut
menu items are enabled. Otherwise, they are disabled. }
var
IsRect: Boolean;
begin
IsRect := (MouseOrg.X <> NextPoint.X) and (MouseOrg.Y <> NextPoint.Y);
if (DrawType = dtClipRect) and IsRect then
begin
mmiCut.Enabled := True;
mmiCopy.Enabled := True;
end
else begin
mmiCut.Enabled := False;
mmiCopy.Enabled := False;
end;
end;
procedure TMainForm.CopyCut(Cut: Boolean);
{ This method copies a portion of the main image to the clipboard.
The portion copied is specified by a bounding rectangle
on the main image. If Cut is true, the area in the bounding rectandle
is erased. }
var
CopyBitMap: TBitmap;
DestRect, SrcRect: TRect;
OldBrushColor: TColor;
begin
CopyBitMap := TBitMap.Create;
try
{ Set CopyBitmap's size based on the coordinates of the
bounding rectangle }
CopyBitMap.Width := Abs(NextPoint.X - MouseOrg.X);
CopyBitMap.Height := Abs(NextPoint.Y - MouseOrg.Y);
DestRect := Rect(0, 0, CopyBitMap.Width, CopyBitmap.Height);
SrcRect := Rect(Min(MouseOrg.X, NextPoint.X)+1,
Min(MouseOrg.Y, NextPoint.Y)+1,
Max(MouseOrg.X, NextPoint.X)-1,
Max(MouseOrg.Y, NextPoint.Y)-1);
{ Copy the portion of the main image surrounded by the bounding
rectangle to the Windows clipboard }
CopyBitMap.Canvas.CopyRect(DestRect, imgDrawingPad.Canvas, SrcRect);
{ Previous versions of Delphi required the bitmap's Handle property
to be touched for the bitmap to be made available. This was due to
Delphi's caching of bitmapped images. The step below may not be
required. }
CopyBitMap.Handle;
// Assign the image to the clipboard.
ClipBoard.Assign(CopyBitMap);
{ If cut was specified the erase the portion of the main image
surrounded by the bounding Rectangle }
if Cut then
with imgDrawingPad.Canvas do
begin
OldBrushColor := Brush.Color;
Brush.Color := clWhite;
try
FillRect(SrcRect);
finally
Brush.Color := OldBrushColor;
end;
end;
finally
CopyBitMap.Free;
end;
end;
procedure TMainForm.mmiCutClick(Sender: TObject);
begin
CopyCut(True);
end;
procedure TMainForm.mmiCopyClick(Sender: TObject);
begin
CopyCut(False);
end;
procedure TMainForm.mmiPasteClick(Sender: TObject);
{ This method pastes the data contained in the clipboard to the
paste bitmap. The reason it is pasted to the PasteBitmap, an off-
screen bitmap, is so that the user can relocate the pasted image
elsewhere on to the main image. This is done by having the pbPasteBox,
a TPaintBox component, draw the contents of PasteImage. When the
user if done positioning the pbPasteBox, the contents of TPasteBitmap
is drawn to imgDrawingPad at the location specified by pbPasteBox's location.}
begin
{ Clear the bounding rectangle }
pbPasteBox.Enabled := True;
if DrawType = dtClipRect then
begin
DrawToImage(MouseOrg, NextPoint, pmNotXOR);
EraseClipRect := False;
end;
PasteBitmap.Assign(ClipBoard); // Grab the data from the clipboard
Pasted := True;
// Set position of pasted image to top left
pbPasteBox.Left := 0;
pbPasteBox.Top := 0;
// Set the size of pbPasteBox to match the size of PasteBitmap
pbPasteBox.Width := PasteBitmap.Width;
pbPasteBox.Height := PasteBitmap.Height;
pbPasteBox.Visible := True;
pbPasteBox.Invalidate;
end;
procedure TMainForm.pbPasteBoxMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{ This method set's up pbPasteBox, a TPaintBox for being moved by the
user when the left mouse button is held down }
begin
if Button = mbLeft then
begin
PBoxMoving := True;
Screen.Cursor := crMove;
PBoxMouseOrg := Point(X, Y);
end
else
PBoxMoving := False;
end;
procedure TMainForm.pbPasteBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
{ This method moves pbPasteBox if the PBoxMoving flag is true indicating
that the user is holding down the left mouse button and is dragging
PaintBox }
begin
if PBoxMoving then
begin
pbPasteBox.Left := pbPasteBox.Left + (X - PBoxMouseOrg.X);
pbPasteBox.Top := pbPasteBox.Top + (Y - PBoxMouseOrg.Y);
end;
end;
procedure TMainForm.pbPasteBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{ This method disables moving of pbPasteBox when the user lifts the left
mouse button }
if PBoxMoving then
begin
PBoxMoving := False;
Screen.Cursor := crDefault;
end;
pbPasteBox.Refresh; // Redraw the pbPasteBox.
end;
procedure TMainForm.pbPasteBoxPaint(Sender: TObject);
{ The paintbox is drawn whenever the user selects the Paste option
form the menu. pbPasteBox draws the contents of PasteBitmap which
holds the image gotten from the clipboard. The reason for drawing
PasteBitmap's contents in pbPasteBox, a TPaintBox class, is so that
the user can also move the object around on top of the main image.
In other words, pbPasteBox can be moved, and hidden when necessary. }
var
DestRect, SrcRect: TRect;
begin
// Display the paintbox only if a pasting operation occurred.
if Pasted then
begin
{ First paint the contents of PasteBitmap using canvas's CopyRect
but only if the paintbox is not being moved. This reduces
flicker }
if not PBoxMoving then
begin
DestRect := Rect(0, 0, pbPasteBox.Width, pbPasteBox.Height);
SrcRect := Rect(0, 0, PasteBitmap.Width, PasteBitmap.Height);
pbPasteBox.Canvas.CopyRect(DestRect, PasteBitmap.Canvas, SrcRect);
end;
{ Now copy a bounding rectangle to indicate that pbPasteBox is
a moveable object. We use a pen mode of pmNotXOR because we
must erase this rectangle when the user copies PaintBox's
contents to the main image and we must preserve the original
contents. }
pbPasteBox.Canvas.Pen.Mode := pmNotXOR;
pbPasteBox.Canvas.Pen.Style := psDot;
pbPasteBox.Canvas.Brush.Style := bsClear;
pbPasteBox.Canvas.Rectangle(0, 0, pbPasteBox.Width, pbPasteBox.Height);
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
// Remove the form from the clipboard chain
ChangeClipBoardChain(Handle, OldClipViewHwnd);
PasteBitmap.Free; // Free the PasteBitmap instance
end;
procedure TMainForm.RgGrpFillOptionsClick(Sender: TObject);
begin
FillSelected := RgGrpFillOptions.ItemIndex = 0;
BorderSelected := cbxBorder.Checked;
SetDrawingStyle;
end;
procedure TMainForm.btnBorderClick(Sender: TObject);
begin
dlgColor.Execute;
pnlFgBgBorder.Color := dlgColor.Color;
SetDrawingStyle;
end;
procedure TMainForm.btnFillClick(Sender: TObject);
begin
dlgColor.Execute;
pnlFgBgInner.Color := dlgColor.Color;
SetDrawingStyle;
end;
end.
关键的几个函数是DrawToImage, 还有
procedure imgDrawingPadMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgDrawingPadMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure imgDrawingPadMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
这三个函数用来跟踪画图面板上的鼠标消息
在其中加入处理函数可以实现与画图程序一样的绘图效果
注意，procedure TMainForm.DrawToImage(TL, BR: TPoint; PenMode: TPenMode);
最后一个PenMode如果要实现动态绘制（即鼠标移到哪线就画到哪）
就必须用pmNotXor用来动态擦除再动态画上新的
而如果鼠标左键点下（代表确定要画在那），则要使用pmCopy把最终一条线画上去
Posts
