Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Программа для рисования (Paint)
unit
GraphWin;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, ToolWin, ExtDlgs, ImgList;
type
TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect, dtBezier);
TForm1 = class
(TForm) StatusBar1: TStatusBar; ScrollBox1: TScrollBox; Image: TImage; ColorDialog1: TColorDialog; MainMenu1: TMainMenu; File1: TMenuItem; New1: TMenuItem; Open1: TMenuItem; Save1: TMenuItem; Saveas1: TMenuItem; Print1: TMenuItem; N1: TMenuItem; Exit1: TMenuItem; Edit1: TMenuItem; Cut1: TMenuItem; Copy1: TMenuItem; Paste1: TMenuItem; InstrImageList: TImageList; PenImageList: TImageList; BrushImageList: TImageList; PenMenu: TPopupMenu; BrushMenu: TPopupMenu; SolidItem: TMenuItem; DashItem: TMenuItem; DotItem: TMenuItem; DashDotItem: TMenuItem; DashDotDotItem: TMenuItem; ClearItem: TMenuItem; SolidBrushItem: TMenuItem; ClearBrushItem: TMenuItem; HorizBrushItem: TMenuItem; VertBrushItem: TMenuItem; FDiagBrushItem: TMenuItem; BDiagBrushItem: TMenuItem; CrossBrushItem: TMenuItem; DiagCrossBrushItem: TMenuItem; OpenPictureDialog1: TOpenPictureDialog; SavePictureDialog1: TSavePictureDialog; ControlBar1: TControlBar; InstrToolBar: TToolBar; LineToolButton: TToolButton; RectangleButton: TToolButton; EllipseButton: TToolButton; RoundRectButton: TToolButton; BezierButton: TToolButton; ToolButton1: TToolButton; PenButton: TToolButton; BrushButton: TToolButton; PenToolBar: TToolBar; ClearPen: TToolButton; SolidPen: TToolButton; DashPen: TToolButton; PenColor: TToolButton; DotPen: TToolButton; DashDotPen: TToolButton; PenSize: TEdit; PenWidth: TUpDown; DashDotDotPen: TToolButton; BrushToolBar: TToolBar; SolidBrush: TToolButton; BrushColor: TToolButton; ToolButton6: TToolButton; ClearBrush: TToolButton; BDiagonalBrush: TToolButton; HorizontalBrush: TToolButton; CrossBrush: TToolButton; VerticalBrush: TToolButton; DiagCrossBrush: TToolButton; FDiagonalBrush: TToolButton; ToolButton2: TToolButton; procedure
FormMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure
FormMouseUp(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure
FormMouseMove(Sender: TObject; Shift:
TShiftState; X,
Y: Integer);
procedure
LineButtonClick(Sender: TObject); procedure
RectangleButtonClick(Sender: TObject); procedure
EllipseButtonClick(Sender: TObject); procedure
RoundRectButtonClick(Sender: TObject); procedure
SetPenStyle(Sender: TObject); procedure
PenSizeChange(Sender: TObject); procedure
FormCreate(Sender: TObject); procedure
SetBrushStyle(Sender: TObject); procedure
PenColorClick(Sender: TObject); procedure
BrushColorClick(Sender: TObject); procedure
Exit1Click(Sender: TObject); procedure
Open1Click(Sender: TObject); procedure
Save1Click(Sender: TObject); procedure
Saveas1Click(Sender: TObject); procedure
New1Click(Sender: TObject); procedure
Copy1Click(Sender: TObject); procedure
Cut1Click(Sender: TObject); procedure
Paste1Click(Sender: TObject); procedure
BezierButtonClick(Sender: TObject); private
{ Private declarations }
public
{ Public declarations }
BrushStyle: TBrushStyle;
PenStyle: TPenStyle;
PenWide: Integer;
Drawing: Boolean;
Origin, MovePt: TPoint;
DrawingTool: TDrawingTool;
CurrentFile: string
; procedure
SaveStyles; procedure
RestoreStyles; procedure
DrawShape(TopLeft, BottomRight: TPoint;
AMode: TPenMode);
end
;
var
Form1: TForm1;
implementation
uses
BMPDlg, Clipbrd, jpeg;
{$R *.DFM}
procedure
TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin
Drawing := True;
Image.Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
end
;
procedure
TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin
if
Drawing then
begin
DrawShape(Origin, Point(X, Y), pmCopy);
Drawing := False;
end
;
end
;
procedure
TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if
Drawing then
begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end
;
StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
end
;
procedure
TForm1.LineButtonClick(Sender: TObject); begin
DrawingTool := dtLine;
end
;
procedure
TForm1.RectangleButtonClick(Sender: TObject); begin
DrawingTool := dtRectangle;
end
;
procedure
TForm1.EllipseButtonClick(Sender: TObject); begin
DrawingTool := dtEllipse;
end
;
procedure
TForm1.RoundRectButtonClick(Sender: TObject); begin
DrawingTool := dtRoundRect;
end
;
procedure
TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode:
TPenMode);
begin
with
Image.Canvas do
begin
Pen.Mode := AMode;
case
DrawingTool of
dtLine: begin
Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y); Image.Canvas.LineTo(BottomRight.X, BottomRight.Y); end
; dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y); dtEllipse: Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X, BottomRight.Y); dtRoundRect: Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y, (TopLeft.X - BottomRight.X) div
2, (TopLeft.Y - BottomRight.Y) div
2); dtBezier: Image.Canvas.PolyBezier([TopLeft, Point(TopLeft.X, BottomRight.Y), Point(BottomRight.X, TopLeft.Y), BottomRight]); end
; end
;
end
;
procedure
TForm1.SetPenStyle(Sender: TObject); var
i: Integer;
begin
with
Image.Canvas.Pen do
Style := TPenStyle((Sender as
TComponent).Tag - 1); if
Sender is
TMenuItem then
with
PenToolBar do
begin
(Sender as
TMenuItem).Checked := True; for
i := 0 to
ButtonCount - 1 do
with
Buttons[i] do
if
Tag = (Sender as
TComponent).Tag then
Down := True
else
if
(Style = tbsCheck) and
Grouped then
Down := False; end
else
PenMenu.Items[(Sender as
TComponent).Tag - 1].Checked
:= True;
end
;
procedure
TForm1.PenSizeChange(Sender: TObject); begin
Image.Canvas.Pen.Width := PenWidth.Position;
end
;
procedure
TForm1.FormCreate(Sender: TObject); var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.Width := 200;
Bitmap.Height := 200;
Image.Picture.Graphic := Bitmap;
end
;
procedure
TForm1.SetBrushStyle(Sender: TObject); var
i: Integer;
begin
with
Image.Canvas.Brush do
Style := TBrushStyle((Sender as
TComponent).Tag - 1); if
Sender is
TMenuItem then
begin
(Sender as
TMenuItem).Checked := True; with
BrushToolBar do
for
i := 0 to
ButtonCount - 1 do
with
Buttons[i] do
if
Tag = (Sender as
TComponent).Tag then
Down := True
else
if
(Style = tbsCheck) and
Grouped then
Down := False; end
;
end
;
procedure
TForm1.PenColorClick(Sender: TObject); begin
ColorDialog1.Color := Image.Canvas.Pen.Color;
if
ColorDialog1.Execute then
Image.Canvas.Pen.Color := ColorDialog1.Color; end
;
procedure
TForm1.BrushColorClick(Sender: TObject); begin
ColorDialog1.Color := Image.Canvas.Brush.Color;
if
ColorDialog1.Execute then
Image.Canvas.Brush.Color := ColorDialog1.Color; end
;
procedure
TForm1.Exit1Click(Sender: TObject); begin
Close;
end
;
procedure
TForm1.Open1Click(Sender: TObject); begin
if
OpenPictureDialog1.Execute then
begin
CurrentFile := OpenPictureDialog1.FileName;
SaveStyles;
Image.Picture.LoadFromFile(CurrentFile);
RestoreStyles;
end
;
end
;
procedure
TForm1.Save1Click(Sender: TObject); begin
if
CurrentFile <> EmptyStr then
Image.Picture.SaveToFile(CurrentFile) else
SaveAs1Click(Sender); end
;
procedure
TForm1.Saveas1Click(Sender: TObject); begin
if
SavePictureDialog1.Execute then
begin
CurrentFile := SavePictureDialog1.FileName;
Save1Click(Sender);
end
;
end
;
procedure
TForm1.New1Click(Sender: TObject); var
Bitmap: TBitmap;
begin
with
NewBMPForm do
begin
ActiveControl := WidthEdit;
WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
if
ShowModal <> idCancel then
begin
Bitmap := TBitmap.Create; Bitmap.Width := StrToInt(WidthEdit.Text); Bitmap.Height := StrToInt(HeightEdit.Text); SaveStyles; Image.Picture.Graphic := Bitmap; RestoreStyles; CurrentFile := EmptyStr; end
; end
;
end
;
procedure
TForm1.Copy1Click(Sender: TObject); begin
Clipboard.Assign(Image.Picture);
end
;
procedure
TForm1.Cut1Click(Sender: TObject); var
ARect: TRect;
begin
Copy1Click(Sender);
with
Image.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect(0, 0, Image.Width, Image.Height);
CopyRect(ARect, Image.Canvas, ARect);
CopyMode := cmSrcCopy;
end
;
end
;
procedure
TForm1.Paste1Click(Sender: TObject); var
Bitmap: TBitmap;
begin
if
Clipboard.HasFormat(CF_BITMAP) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(Clipboard); Image.Canvas.Draw(0, 0, Bitmap); finally
Bitmap.Free; end
; end
;
end
;
procedure
TForm1.SaveStyles; begin
with
Image.Canvas do
begin
BrushStyle := Brush.Style;
PenStyle := Pen.Style;
PenWide := Pen.Width;
end
;
end
;
procedure
TForm1.RestoreStyles; begin
with
Image.Canvas do
begin
Brush.Style := BrushStyle;
Pen.Style := PenStyle;
Pen.Width := PenWide;
end
;
end
;
procedure
TForm1.BezierButtonClick(Sender: TObject); begin
DrawingTool := dtBezier;
end
;
end
.