home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / GRAPHWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  9KB  |  331 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.     Drawing: Boolean;
  89.     Origin, MovePt: TPoint;
  90.     DrawingTool: TDrawingTool;
  91.     CurrentFile: string;
  92.     procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  93.   end;
  94.  
  95. var
  96.   Form1: TForm1;
  97.  
  98. implementation
  99.  
  100. uses BMPDlg, Clipbrd;
  101.  
  102. {$R *.DFM}
  103.  
  104. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  105.   Shift: TShiftState; X, Y: Integer);
  106. begin
  107.   Drawing := True;
  108.   Image.Canvas.MoveTo(X, Y);
  109.   Origin := Point(X, Y);
  110.   MovePt := Origin;
  111.   StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
  112. end;
  113.  
  114. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  115.   Shift: TShiftState; X, Y: Integer);
  116. begin
  117.   if Drawing then
  118.   begin
  119.     DrawShape(Origin, Point(X, Y), pmCopy);
  120.     Drawing := False;
  121.   end;
  122. end;
  123.  
  124. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  125.   Y: Integer);
  126. begin
  127.   if Drawing then
  128.   begin
  129.     DrawShape(Origin, MovePt, pmNotXor);
  130.     MovePt := Point(X, Y);
  131.     DrawShape(Origin, MovePt, pmNotXor);
  132.   end;
  133.   StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
  134. end;
  135.  
  136. procedure TForm1.LineButtonClick(Sender: TObject);
  137. begin
  138.   DrawingTool := dtLine;
  139. end;
  140.  
  141. procedure TForm1.RectangleButtonClick(Sender: TObject);
  142. begin
  143.   DrawingTool := dtRectangle;
  144. end;
  145.  
  146. procedure TForm1.EllipseButtonClick(Sender: TObject);
  147. begin
  148.   DrawingTool := dtEllipse;
  149. end;
  150.  
  151. procedure TForm1.RoundRectButtonClick(Sender: TObject);
  152. begin
  153.   DrawingTool := dtRoundRect;
  154. end;
  155.  
  156. procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  157. begin
  158.   with Image.Canvas do
  159.   begin
  160.     Pen.Mode := AMode;
  161.     case DrawingTool of
  162.       dtLine:
  163.         begin
  164.           Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
  165.           Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
  166.         end;
  167.       dtRectangle: Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
  168.         BottomRight.Y);
  169.       dtEllipse: Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
  170.         BottomRight.Y);
  171.       dtRoundRect: Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
  172.         BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
  173.         (TopLeft.Y - BottomRight.Y) div 2);
  174.     end;
  175.   end;
  176. end;
  177.  
  178. procedure TForm1.PenButtonClick(Sender: TObject);
  179. begin
  180.   PenBar.Visible := PenButton.Down;
  181. end;
  182.  
  183. procedure TForm1.BrushButtonClick(Sender: TObject);
  184. begin
  185.   BrushBar.Visible := BrushButton.Down;
  186. end;
  187.  
  188. procedure TForm1.SetPenStyle(Sender: TObject);
  189. begin
  190.   with Image.Canvas.Pen do
  191.   begin
  192.     if Sender = SolidPen then Style := psSolid
  193.     else if Sender = DashPen then Style := psDash
  194.     else if Sender = DotPen then Style := psDot
  195.     else if Sender = DashDotPen then Style := psDashDot
  196.     else if Sender = DashDotDotPen then Style := psDashDotDot
  197.     else if Sender = ClearPen then Style := psClear;
  198.   end;
  199. end;
  200.  
  201. procedure TForm1.PenSizeChange(Sender: TObject);
  202. begin
  203.   Image.Canvas.Pen.Width := PenWidth.Position;
  204. end;
  205.  
  206. procedure TForm1.FormCreate(Sender: TObject);
  207. var
  208.   Bitmap: TBitmap;
  209. begin
  210.   Bitmap := TBitmap.Create;
  211.   Bitmap.Width := 200;
  212.   Bitmap.Height := 200;
  213.   Image.Picture.Graphic := Bitmap;
  214. end;
  215.  
  216. procedure TForm1.SetBrushStyle(Sender: TObject);
  217. begin
  218.   with Image.Canvas.Brush do
  219.   begin
  220.     if Sender = SolidBrush then Style := bsSolid
  221.     else if Sender = ClearBrush then Style := bsClear
  222.     else if Sender = HorizontalBrush then Style := bsHorizontal
  223.     else if Sender = VerticalBrush then Style := bsVertical
  224.     else if Sender = FDiagonalBrush then Style := bsFDiagonal
  225.     else if Sender = BDiagonalBrush then Style := bsBDiagonal
  226.     else if Sender = CrossBrush then Style := bsCross
  227.     else if Sender = DiagCrossBrush then Style := bsDiagCross;
  228.   end;
  229. end;
  230.  
  231. procedure TForm1.PenColorClick(Sender: TObject);
  232. begin
  233.   ColorDialog1.Color := Image.Canvas.Pen.Color;
  234.   if ColorDialog1.Execute then
  235.     Image.Canvas.Pen.Color := ColorDialog1.Color;
  236. end;
  237.  
  238. procedure TForm1.BrushColorClick(Sender: TObject);
  239. begin
  240.   ColorDialog1.Color := Image.Canvas.Brush.Color;
  241.   if ColorDialog1.Execute then
  242.     Image.Canvas.Brush.Color := ColorDialog1.Color;
  243. end;
  244.  
  245. procedure TForm1.Exit1Click(Sender: TObject);
  246. begin
  247.   Close;
  248. end;
  249.  
  250. procedure TForm1.Open1Click(Sender: TObject);
  251. begin
  252.   if OpenDialog1.Execute then
  253.   begin
  254.     CurrentFile := OpenDialog1.FileName;
  255.     Image.Picture.LoadFromFile(CurrentFile);
  256.   end;
  257. end;
  258.  
  259. procedure TForm1.Save1Click(Sender: TObject);
  260. begin
  261.   if CurrentFile <> EmptyStr then
  262.     Image.Picture.SaveToFile(CurrentFile)
  263.   else SaveAs1Click(Sender);
  264. end;
  265.  
  266. procedure TForm1.Saveas1Click(Sender: TObject);
  267. begin
  268.   if SaveDialog1.Execute then
  269.   begin
  270.     CurrentFile := SaveDialog1.FileName;
  271.     Save1Click(Sender);
  272.   end;
  273. end;
  274.  
  275. procedure TForm1.New1Click(Sender: TObject);
  276. var
  277.   Bitmap: TBitmap;
  278. begin
  279.   with NewBMPForm do
  280.   begin
  281.     ActiveControl := WidthEdit;
  282.     WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
  283.     HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
  284.     if ShowModal <> idCancel then
  285.     begin
  286.       Bitmap := TBitmap.Create;
  287.       Bitmap.Width := StrToInt(WidthEdit.Text);
  288.       Bitmap.Height := StrToInt(HeightEdit.Text);
  289.       Image.Picture.Graphic := Bitmap;
  290.       CurrentFile := EmptyStr;
  291.     end;
  292.   end;
  293. end;
  294.  
  295. procedure TForm1.Copy1Click(Sender: TObject);
  296. begin
  297.   Clipboard.Assign(Image.Picture);
  298. end;
  299.  
  300. procedure TForm1.Cut1Click(Sender: TObject);
  301. var
  302.   ARect: TRect;
  303. begin
  304.   Copy1Click(Sender);
  305.   with Image.Canvas do
  306.   begin
  307.     CopyMode := cmWhiteness;
  308.     ARect := Rect(0, 0, Image.Width, Image.Height);
  309.     CopyRect(ARect, Image.Canvas, ARect);
  310.     CopyMode := cmSrcCopy;
  311.   end;
  312. end;
  313.  
  314. procedure TForm1.Paste1Click(Sender: TObject);
  315. var
  316.   Bitmap: TBitmap;
  317. begin
  318.   if Clipboard.HasFormat(CF_BITMAP) then
  319.   begin
  320.     Bitmap := TBitmap.Create;
  321.     try
  322.       Bitmap.Assign(Clipboard);
  323.       Image.Canvas.Draw(0, 0, Bitmap);
  324.     finally
  325.       Bitmap.Free;
  326.     end;
  327.   end;
  328. end;
  329.  
  330. end.
  331.