frmmainu.pas

简单的画图软件

// This Is A Easy Code
// For More Infomation Mail To:
//  [e-mail]
// I am Aref

unit frmMainU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, Menus, ExtCtrls, ExtDlgs, StdCtrls, ImgList,
  idGlobal, Spin, StrUtils, Types;

type
  TfrmMain = class(TForm)
    ColorDialog: TColorDialog;
    ToolBar2: TToolBar;
    lblWhiteBord: TLabel;
    ImageList: TImageList;
    tbtnSp: TToolButton;
    tbtnBros: TToolButton;
    tbtnPen: TToolButton;
    tbtnDefCl: TToolButton;
    tbtnEraser: TToolButton;
    tbtnColorMixer: TToolButton;
    Panel12: TPanel;
    Panel13: TPanel;
    pnlClR: TPanel;
    pnlClL: TPanel;
    Panel16: TPanel;
    Panel17: TPanel;
    Panel18: TPanel;
    Panel19: TPanel;
    Panel20: TPanel;
    Panel21: TPanel;
    Panel22: TPanel;
    Panel23: TPanel;
    Panel24: TPanel;
    Panel25: TPanel;
    Panel26: TPanel;
    Panel28: TPanel;
    Panel29: TPanel;
    Panel30: TPanel;
    Panel31: TPanel;
    Panel32: TPanel;
    Panel33: TPanel;
    Panel34: TPanel;
    pnlTempCl1: TPanel;
    pnlTempCl2: TPanel;
    pnlTypeDock: TPanel;
    shpType1: TShape;
    shpType2: TShape;
    shpType3: TShape;
    shpType4: TShape;
    lblType1: TLabel;
    lblType2: TLabel;
    lblType3: TLabel;
    lblType4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Panel17MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure mnuFileExitClick(Sender: TObject);
    procedure tbtnRecEClick(Sender: TObject);
    procedure lblWhiteBordMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lblWhiteBordMouseLeave(Sender: TObject);
    procedure lblWhiteBordMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblWhiteBordMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1Click(Sender: TObject);
    procedure pnlTempCl2DblClick(Sender: TObject);
  private
    { Private declarations }
    procedure DownUpButton(ToolButton:  TToolButton);
    procedure ShowType(ToolButton:  TToolButton);
    procedure EraserTypeShow(EraserTypeIndex: Integer);
    procedure BrosTypeShow(BrosTypeIndex: Integer);
    procedure ColorMixerWorking(X,  Y: Integer; Button:  TMouseButton);
    procedure  SpTypeShow(SpTypeIndex: Integer);
    procedure  MoveTypeLabel;
    procedure  CircleRandomInt(var  X, Y: Integer; r: Integer);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

var
  WhoIsDown:  String;
  PenWidth, LoopCount: Integer;
  CanStart, CanContinue: Boolean;

//************************************************

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  pnlClL.Color:=  clBlack;
  pnlClR.Color:=  clWhite;

  WhoIsDown:='tbtnPen';
  CanStart:=  False;

end;

//************************************************

procedure TfrmMain.Panel17MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Case  Button  of
    mbLeft: pnlClL.Color:=  TPanel(Sender).Color;
    mbRight:  pnlClR.Color:=  TPanel(Sender).Color;
  end;

end;

//*************************************************

procedure TfrmMain.mnuFileExitClick(Sender: TObject);
begin
  Close;

end;

//*************************************************

procedure TfrmMain.tbtnRecEClick(Sender: TObject);
begin
  DownUpButton(TToolButton(Sender));

end;

//**************************************************

procedure TfrmMain.DownUpButton(ToolButton: TToolButton);
begin
  if  ToolButton.Name <>  WhoIsDown then
  begin
    ToolButton.Down:= True;
    TToolButton(FindComponent(WhoIsDown)).Down:= False;
    WhoIsDown:= ToolButton.Name;
  end
  else
  begin
    ToolButton.Down:= True;
  end;

  ShowType(ToolButton);

end;

//**************************************************

procedure TfrmMain.lblWhiteBordMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
   I, RandomX, RandomY: Integer;
begin
  if CanStart then
  begin
    With  lblWhiteBord.Canvas  do
    begin
      if  WhoIsDown = 'tbtnPen'  then
      begin
         Pen.Width:=1;
         LineTo(X, Y);
      end;

      if WhoIsDown  = 'tbtnBros'  then
      begin
         Pen.Width:= PenWidth;
         LineTo(X,  Y);
      end;

      if  WhoIsDown = 'tbtnEraser'  then
      begin
         with  lblWhiteBord.Canvas  do
         begin
            Pen.Width:=  1;
            Brush.Style:=   bsSolid;
            Pen.Color:=  clWhite;
            Rectangle(X  -  PenWidth,  Y  -  PenWidth,  X  +  PenWidth,  Y  +  PenWidth);
         end;
      end;

      if WhoIsDown   =  'tbtnSp' then
      begin
         for   I:=   1  to LoopCount   do
         begin
         CircleRandomInt(RandomX,   RandomY, PenWidth);
         Pixels[X  -  PenWidth  +  RandomX, Y  -  PenWidth  +  RandomY]:=  Pen.Color;
         end;
      end;

    end;//End Of With
  end;//End Of if

end;

//**************************************************

procedure TfrmMain.lblWhiteBordMouseLeave(Sender: TObject);
begin
  CanStart:=  False;

end;

//*****************************************************

procedure TfrmMain.lblWhiteBordMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   I, RandomX, RandomY: Integer;
begin
   lblWhiteBord.Canvas.MoveTo(X, Y);

   if WhoIsDown   =  'tbtnDefCl' then
   begin
      Case  Button   of
         mbLeft:  pnlClL.Color:= lblWhiteBord.Canvas.Pixels[X, Y];
         mbRight: pnlClR.Color:= lblWhiteBord.Canvas.Pixels[X, Y];
      end;
      Exit;
   end;

   Case Button  of
      mbLeft: lblWhiteBord.Canvas.Pen.Color:= pnlClL.Color;
      mbRight:  lblWhiteBord.Canvas.Pen.Color:= pnlClR.Color;
   end;

   if WhoIsDown = 'tbtnPen' then
   begin
      lblWhiteBord.Canvas.Pixels[X, Y]:=  lblWhiteBord.Canvas.Pen.Color;
   end;

   if WhoIsDown   = 'tbtnBros'  then
   begin
      lblWhiteBord.Canvas.Pen.Width:=  PenWidth;
      lblWhiteBord.Canvas.Ellipse(X,   Y, X+1,  Y+1);
   end;

   if WhoIsDown   =  'tbtnEraser'   then
   begin
      with  lblWhiteBord.Canvas  do
      begin
         Pen.Width:=  1;
         Brush.Style:=   bsSolid;
         Pen.Color:=  clWhite;
         Rectangle(X  -  PenWidth,  Y  -  PenWidth,  X  +  PenWidth,  Y  +  PenWidth);
      end;
   end;

   if WhoIsDown   =  'tbtnColorMixer'   then
   begin
      ColorMixerWorking(X, Y, Button);
   end;

   if WhoIsDown   =  'tbtnSp' then
   begin
      for   I:=   1  to LoopCount   do
      begin
         CircleRandomInt(RandomX,   RandomY, PenWidth);
         lblWhiteBord.Canvas.Pixels[X  -  PenWidth  +  RandomX, Y  -  PenWidth  +  RandomY]:=  lblWhiteBord.Canvas.Pen.Color;
      end;
   end;

   CanStart:=  True;

end;

//****************************************************

procedure TfrmMain.lblWhiteBordMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    CanStart:=  False;
    CanContinue:= False;

end;

//****************************************************

procedure TfrmMain.ShowType(ToolButton: TToolButton);
begin
  if ToolButton.Name =  'tbtnPen'   then
  begin
    pnlTypeDock.Hide;
  end;

  if ToolButton.Name =  'tbtnClDef' then
  begin
    pnlTypeDock.Hide;
  end;

  if  ToolButton.Name = 'tbtnBros'  then
  begin
    pnlTypeDock.Show;
    BrosTypeShow(2);
  end;

  if  ToolButton.Name = 'tbtnEraser' then
  begin
    pnlTypeDock.Show;
    EraserTypeShow(2);
  end;

  if  ToolButton.Name  =  'tbtnSp' then
  begin
    pnlTypeDock.Show;
    SpTypeShow(2);
  end;

end;

//***************************************************

procedure TfrmMain.EraserTypeShow(EraserTypeIndex: Integer);
begin
  With   shpType1 do
  begin
    Show;
    Pen.Color:=   clBlack;
    Brush.Color:= clWhite;
    Brush.Style:= bsSolid;
    Shape:= stSquare;
    Width:= 7;
    Left:=  25;
  end;

  With   shpType2 do
  begin
    Show;
    Pen.Color:=   clBlack;
    Brush.Color:= clWhite;
    Brush.Style:= bsSolid;
    Shape:= stSquare;