home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / GRAPHWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-05-08  |  10KB  |  360 lines
  1. unit GraphWin;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus;
  8.  
  9. type
  10.   TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  11.   TForm1 = class(TForm)
  12.     Panel1: TPanel;
  13.     LineButton: TSpeedButton;
  14.     RectangleButton: TSpeedButton;
  15.     EllipseButton: TSpeedButton;
  16.     RoundRectButton: TSpeedButton;
  17.     PenButton: TSpeedButton;
  18.     BrushButton: TSpeedButton;
  19.     PenBar: TPanel;
  20.     BrushBar: TPanel;
  21.     SolidPen: TSpeedButton;
  22.     DashPen: TSpeedButton;
  23.     DotPen: TSpeedButton;
  24.     DashDotPen: TSpeedButton;
  25.     DashDotDotPen: TSpeedButton;
  26.     ClearPen: TSpeedButton;
  27.     PenWidth: TUpDown;
  28.     PenSize: TEdit;
  29.     StatusBar1: TStatusBar;
  30.     ScrollBox1: TScrollBox;
  31.     Image: TImage;
  32.     SolidBrush: TSpeedButton;
  33.     ClearBrush: TSpeedButton;
  34.     HorizontalBrush: TSpeedButton;
  35.     VerticalBrush: TSpeedButton;
  36.     FDiagonalBrush: TSpeedButton;
  37.     BDiagonalBrush: TSpeedButton;
  38.     CrossBrush: TSpeedButton;
  39.     DiagCrossBrush: TSpeedButton;
  40.     PenColor: TSpeedButton;
  41.     BrushColor: TSpeedButton;
  42.     ColorDialog1: TColorDialog;
  43.     MainMenu1: TMainMenu;
  44.     File1: TMenuItem;
  45.     New1: TMenuItem;
  46.     Open1: TMenuItem;
  47.     Save1: TMenuItem;
  48.     Saveas1: TMenuItem;
  49.     Print1: TMenuItem;
  50.     N1: TMenuItem;
  51.     Exit1: TMenuItem;
  52.     Edit1: TMenuItem;
  53.     Cut1: TMenuItem;
  54.     Copy1: TMenuItem;
  55.     Paste1: TMenuItem;
  56.     OpenDialog1: TOpenDialog;
  57.     SaveDialog1: TSaveDialog;
  58.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  59.       Shift: TShiftState; X, Y: Integer);
  60.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
  61.       Shift: TShiftState; X, Y: Integer);
  62.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  63.       Y: Integer);
  64.     procedure LineButtonClick(Sender: TObject);
  65.     procedure RectangleButtonClick(Sender: TObject);
  66.     procedure EllipseButtonClick(Sender: TObject);
  67.     procedure RoundRectButtonClick(Sender: TObject);
  68.     procedure PenButtonClick(Sender: TObject);
  69.     procedure BrushButtonClick(Sender: TObject);
  70.     procedure SetPenStyle(Sender: TObject);
  71.     procedure PenSizeChange(Sender: TObject);
  72.     procedure FormCreate(Sender: TObject);
  73.     procedure SetBrushStyle(Sender: TObject);
  74.     procedure PenColorClick(Sender: TObject);
  75.     procedure BrushColorClick(Sender: TObject);
  76.     procedure Exit1Click(Sender: TObject);
  77.     procedure Open1Click(Sender: TObject);
  78.     procedure Save1Click(Sender: TObject);
  79.     procedure Saveas1Click(Sender: TObject);
  80.     procedure New1Click(Sender: TObject);
  81.     procedure Copy1Click(Sender: TObject);
  82.     procedure Cut1Click(Sender: TObject);
  83.     procedure Paste1Click(Sender: TObject);
  84.   private
  85.     { Private declarations }
  86.   public
  87.     { Public declarations }
  88.     BrushStyle: TBrushStyle;
  89.     PenStyle: TPenStyle;
  90.     PenWide: Integer;
  91.     Drawing: Boolean;
  92.     Origin, MovePt: TPoint;
  93.     DrawingTool: TDrawingTool;
  94.     CurrentFile: string;
  95.     procedure SaveStyles;
  96.     procedure RestoreStyles;
  97.     procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  98.   end;
  99.  
  100. var
  101.   Form1: TForm1;
  102.  
  103. implementation
  104.  
  105. uses BMPDlg, Clipbrd;
  106.  
  107. {$R *.DFM}
  108.  
  109. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  110.   Shift: TShiftState; X, Y: Integer);
  111. begin
  112.   Drawing := True;
  113.   Image.Canvas.MoveTo(X, Y);
  114.   Origin := Point(X, Y);
  115.   MovePt := Origin;
  116.   StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
  117. end;
  118.  
  119. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  120.   Shift: TShiftState; X, Y: Integer);
  121. begin
  122.   if Drawing then
  123.   begin
  124.     DrawShape(Origin, Point(X, Y), pmCopy);
  125.     Drawing := False;
  126.   end;
  127. end;
  128.  
  129. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  130.   Y: Integer);
  131. begin
  132.   if Drawing then
  133.   begin
  134.     DrawShape(Origin, MovePt, pmNotXor);
  135.     MovePt := Point(X, Y);
  136.     DrawShape(Origin, MovePt, pmNotXor);
  137.   end;
  138.   StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
  139. end;
  140.  
  141. procedure TForm1.LineButtonClick(Sender: TObject);
  142. begin
  143.   DrawingTool := dtLine;
  144. end;
  145.  
  146. procedure TForm1.RectangleButtonClick(Sender: TObject);
  147. begin
  148.   DrawingTool := dtRectangle;
  149. end;
  150.  
  151. procedure TForm1.EllipseButtonClick(Sender: TObject);
  152. begin
  153.   DrawingTool := dtEllipse;
  154. end;
  155.  
  156. procedure TForm1.RoundRectButtonClick(Sender: TObject);
  157. begin
  158.   DrawingTool := dtRoundRect;
  159. end;
  160.  
  161. procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  162. begin
  163.   with Image.Canvas do
  164.   begin
  165.     Pen.Mode := AMode;
  166.     case DrawingTool of
  167.       dtLine:
  168.         begin
  169.           Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
  170.           Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
  171.         end;
  172.       dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
  173.         BottomRight.Y);
  174.       dtEllipse: Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
  175.         BottomRight.Y);
  176.       dtRoundRect: Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
  177.         BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
  178.         (TopLeft.Y - BottomRight.Y) div 2);
  179.     end;
  180.   end;
  181. end;
  182.  
  183. procedure TForm1.PenButtonClick(Sender: TObject);
  184. begin
  185.   PenBar.Visible := PenButton.Down;
  186. end;
  187.  
  188. procedure TForm1.BrushButtonClick(Sender: TObject);
  189. begin
  190.   BrushBar.Visible := BrushButton.Down;
  191. end;
  192.  
  193. procedure TForm1.SetPenStyle(Sender: TObject);
  194. begin
  195.   with Image.Canvas.Pen do
  196.   begin
  197.     if Sender = SolidPen then Style := psSolid
  198.     else if Sender = DashPen then Style := psDash
  199.     else if Sender = DotPen then Style := psDot
  200.     else if Sender = DashDotPen then Style := psDashDot
  201.     else if Sender = DashDotDotPen then Style := psDashDotDot
  202.     else if Sender = ClearPen then Style := psClear;
  203.   end;
  204. end;
  205.  
  206. procedure TForm1.PenSizeChange(Sender: TObject);
  207. begin
  208.   Image.Canvas.Pen.Width := PenWidth.Position;
  209. end;
  210.  
  211. procedure TForm1.FormCreate(Sender: TObject);
  212. var
  213.   Bitmap: TBitmap;
  214. begin
  215.   Bitmap := TBitmap.Create;
  216.   Bitmap.Width := 200;
  217.   Bitmap.Height := 200;
  218.   Image.Picture.Graphic := Bitmap;
  219. end;
  220.  
  221. procedure TForm1.SetBrushStyle(Sender: TObject);
  222. begin
  223.   with Image.Canvas.Brush do
  224.   begin
  225.     if Sender = SolidBrush then Style := bsSolid
  226.     else if Sender = ClearBrush then Style := bsClear
  227.     else if Sender = HorizontalBrush then Style := bsHorizontal
  228.     else if Sender = VerticalBrush then Style := bsVertical
  229.     else if Sender = FDiagonalBrush then Style := bsFDiagonal
  230.     else if Sender = BDiagonalBrush then Style := bsBDiagonal
  231.     else if Sender = CrossBrush then Style := bsCross
  232.     else if Sender = DiagCrossBrush then Style := bsDiagCross;
  233.   end;
  234. end;
  235.  
  236. procedure TForm1.PenColorClick(Sender: TObject);
  237. begin
  238.   ColorDialog1.Color := Image.Canvas.Pen.Color;
  239.   if ColorDialog1.Execute then
  240.     Image.Canvas.Pen.Color := ColorDialog1.Color;
  241. end;
  242.  
  243. procedure TForm1.BrushColorClick(Sender: TObject);
  244. begin
  245.   ColorDialog1.Color := Image.Canvas.Brush.Color;
  246.   if ColorDialog1.Execute then
  247.     Image.Canvas.Brush.Color := ColorDialog1.Color;
  248. end;
  249.  
  250. procedure TForm1.Exit1Click(Sender: TObject);
  251. begin
  252.   Close;
  253. end;
  254.  
  255. procedure TForm1.Open1Click(Sender: TObject);
  256. begin
  257.   if OpenDialog1.Execute then
  258.   begin
  259.     CurrentFile := OpenDialog1.FileName;
  260.     SaveStyles;
  261.     Image.Picture.LoadFromFile(CurrentFile);
  262.     RestoreStyles;
  263.   end;
  264. end;
  265.  
  266. procedure TForm1.Save1Click(Sender: TObject);
  267. begin
  268.   if CurrentFile <> EmptyStr then
  269.     Image.Picture.SaveToFile(CurrentFile)
  270.   else SaveAs1Click(Sender);
  271. end;
  272.  
  273. procedure TForm1.Saveas1Click(Sender: TObject);
  274. begin
  275.   if SaveDialog1.Execute then
  276.   begin
  277.     CurrentFile := SaveDialog1.FileName;
  278.     Save1Click(Sender);
  279.   end;
  280. end;
  281.  
  282. procedure TForm1.New1Click(Sender: TObject);
  283. var
  284.   Bitmap: TBitmap;
  285. begin
  286.   with NewBMPForm do
  287.   begin
  288.     ActiveControl := WidthEdit;
  289.     WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
  290.     HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
  291.     if ShowModal <> idCancel then
  292.     begin
  293.       Bitmap := TBitmap.Create;
  294.       Bitmap.Width := StrToInt(WidthEdit.Text);
  295.       Bitmap.Height := StrToInt(HeightEdit.Text);
  296.       SaveStyles;
  297.       Image.Picture.Graphic := Bitmap;
  298.       RestoreStyles;
  299.       CurrentFile := EmptyStr;
  300.     end;
  301.   end;
  302. end;
  303.  
  304. procedure TForm1.Copy1Click(Sender: TObject);
  305. begin
  306.   Clipboard.Assign(Image.Picture);
  307. end;
  308.  
  309. procedure TForm1.Cut1Click(Sender: TObject);
  310. var
  311.   ARect: TRect;
  312. begin
  313.   Copy1Click(Sender);
  314.   with Image.Canvas do
  315.   begin
  316.     CopyMode := cmWhiteness;
  317.     ARect := Rect(0, 0, Image.Width, Image.Height);
  318.     CopyRect(ARect, Image.Canvas, ARect);
  319.     CopyMode := cmSrcCopy;
  320.   end;
  321. end;
  322.  
  323. procedure TForm1.Paste1Click(Sender: TObject);
  324. var
  325.   Bitmap: TBitmap;
  326. begin
  327.   if Clipboard.HasFormat(CF_BITMAP) then
  328.   begin
  329.     Bitmap := TBitmap.Create;
  330.     try
  331.       Bitmap.Assign(Clipboard);
  332.       Image.Canvas.Draw(0, 0, Bitmap);
  333.     finally
  334.       Bitmap.Free;
  335.     end;
  336.   end;
  337. end;
  338.  
  339. procedure TForm1.SaveStyles;
  340. begin
  341.   with Image.Canvas do
  342.   begin
  343.     BrushStyle := Brush.Style;
  344.     PenStyle := Pen.Style;
  345.     PenWide := Pen.Width;
  346.   end;
  347. end;
  348.  
  349. procedure TForm1.RestoreStyles;
  350. begin
  351.   with Image.Canvas do
  352.   begin
  353.     Brush.Style := BrushStyle;
  354.     Pen.Style := PenStyle;
  355.     Pen.Width := PenWide;
  356.   end;
  357. end;
  358.  
  359. end.
  360.