mainfrm.pas

Java实例入门

   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.