Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ActnList, XPStyleActnCtrls, ActnMan, Menus, ExtDlgs,
StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
ActionManager1: TActionManager;
penColor_edit_act: TAction;
MainMenu1: TMainMenu;
N1: TMenuItem;
brushColor_edit_act: TAction;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
size_change_act: TAction;
N5: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure penColor_edit_actExecute(Sender: TObject);
procedure brushColor_edit_actExecute(Sender: TObject);
procedure size_change_actExecute(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure resizeBitmap(const nWidth, nHeight: integer);
procedure setProp;
function getBitmapX(const x: integer): integer;
function getBitmapY(const y: integer): integer;
function changeColor(const value: tColor): tColor;
end;
var
Form1: TForm1;
bitmap: tBitmap;
xProp, yProp: integer;
drowing: boolean;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
doubleBuffered := true;
bitmap := tBitmap.Create;
bitmap.Width := 32;
bitmap.Height := 32;
bitmap.Canvas.Pen.Color := clRed;
drowing := false;
setProp;
end;
procedure TForm1.resizeBitmap(const nWidth, nHeight: integer);
var
tempBitmap: tBitmap;
begin
tempBitmap := tBitmap.create;
tempBitmap.Assign(bitmap);
bitmap.Width := nWidth;
bitmap.Height := nHeight;
bitmap.Canvas.CopyRect(
rect(0, 0, nWidth, nHeight),
tempBitmap.Canvas, rect(0, 0, tempBitmap.Width, tempBitmap.Height));
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.CopyRect(
rect(0, 0, PaintBox1.Width, PaintBox1.Height),
bitmap.Canvas, rect(0, 0, bitmap.Width, bitmap.Height));
end;
procedure TForm1.setProp;
begin
xProp := PaintBox1.Width div bitmap.Width;
yProp := PaintBox1.Height div bitmap.Height;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
drowing := true;
bitmap.Canvas.MoveTo(getBitmapX(x), getBitmapY(y));
bitmap.Canvas.Pixels[getBitmapX(x), getBitmapY(y)] := bitmap.Canvas.Pen.Color;
PaintBox1.repaint;
end;
function TForm1.getBitmapX(const x: integer): integer;
begin
result := x div xProp;
end;
function TForm1.getBitmapY(const y: integer): integer;
begin
result := y div yProp;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not drowing then exit;
bitmap.Canvas.LineTo(getBitmapX(x), getBitmapY(y));
bitmap.Canvas.Pixels[getBitmapX(x), getBitmapY(y)] := bitmap.Canvas.Pen.Color;
PaintBox1.repaint;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
drowing := false;
end;
procedure TForm1.penColor_edit_actExecute(Sender: TObject);
begin
bitmap.Canvas.Pen.Color := changeColor(bitmap.Canvas.Pen.Color);
end;
function TForm1.changeColor(const value: tColor): tColor;
var
dlg: tColorDialog;
begin
dlg := tColorDialog.Create(self);
dlg.Options := dlg.Options + [cdFullOpen];
dlg.Color := value;
if dlg.Execute then
result := dlg.Color
else
result := value;
dlg.Free;
end;
procedure TForm1.brushColor_edit_actExecute(Sender: TObject);
begin
bitmap.Canvas.Brush.Color := changeColor(bitmap.Canvas.Brush.Color);
end;
procedure TForm1.size_change_actExecute(Sender: TObject);
var
curSize: string;
newSize: integer;
begin
curSize := intToStr(bitmap.Width);
if inputQuery('Èçìåíåíèå ðàçìåðà', 'Ââåäèòå íîâûé ðàçìåð', curSize) then
begin
newSize := strToInt(curSize);
resizeBitmap(newSize, newSize);
setProp;
PaintBox1.repaint;
end;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Form2.ShowModal
end;
end;
end.