?? mainfrm.pas
字號:
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('文件已經改變,是否保存?', 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;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -