[Ooops]

Как сделать чтобы этот редактор сохранял иконки и рисовал их попиксельнно *??

[Ooops]

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, Menus, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    ColorBox1: TColorBox;
    ColorBox2: TColorBox;
    Label1: TLabel;
    Label2: TLabel;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TShape = (sPen, sRect, sEllipse, sPoly, sFill);
var
  Form1: TForm1;
  img, buffer: TBitmap;
  x0,y0: integer;
  nowdrawing: TShape;
  dwn: boolean;
  FileName : string;
  implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Img:=TBitmap.Create;
 buffer:=TBitmap.Create;
 img.Width:=Image1.ClientWidth;
 buffer.Width:=Image1.ClientWidth;
 img.Height:=Image1.ClientHeight;
 buffer.Height:=Image1.ClientHeight;
 nowdrawing:=sPen;
 dwn:=false;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then begin
 img.assign(buffer);
 x0:=x; y0:=y;
 if SpeedButton1.Down then
 begin
 nowdrawing:=sPen;
 img.canvas.MoveTo(x,y);
 end else
 if SpeedButton2.Down then
 nowdrawing:=sEllipse else
 if SpeedButton3.Down then
 nowdrawing:=sRect else
 if SpeedButton4.Down then
 nowdrawing:=sPoly else
 if SpeedButton5.Down then
 nowdrawing:=sFill;
 dwn:=true;
 img.Canvas.Pen.Color:=ColorBox1.Selected;
 img.Canvas.Brush.Color:=ColorBox2.Selected;

 if nowdrawing=sFill then
 begin
 img.Canvas.FloodFill(x0,y0,img.Canvas.Pixels[x,y],fsSurface);
 buffer.Assign(img);
 dwn:=false;
 end
 end else
 begin
 if (dwn)and(nowdrawing=sPoly) then begin
 x0:=x;
 y0:=y;
 buffer.Assign(img);
 end;
 end;

 Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if not dwn then exit;
 img.assign(buffer);
 case nowdrawing of
 sPen:begin
 img.Canvas.LineTo(x,y);
 buffer.Assign(img);
 end;
 sRect:begin
 img.Canvas.Rectangle(x0,y0,x,y);
 end;
 sEllipse:begin
 img.Canvas.Ellipse(x0,y0,x,y);
 end;
 sPoly:begin
 img.Canvas.MoveTo(x0,y0);
 img.Canvas.LineTo(x,y);
 end;
 sFill:begin
 //nothing.
 end;
 end;

 Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then dwn:=false;
 buffer.Assign(img);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  If OpenPictureDialog1.Execute then begin
  Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
 end;
procedure TForm1.N3Click(Sender: TObject);
begin
  SavePictureDialog1.Execute;
  Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

end.

lmikle: Ну все Ooops. За следующий такой пост - будет бан.

[Phedor]

Код:

img.Picture.Icon.SaveToFile()