home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1143 / gepackt.exe / BSPQTSW.EXE / DEMPAINT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-09  |  16.2 KB  |  516 lines
  1. (***************************************
  2. * WG-VISION 1.0      DEMONSTRATION     *
  3. ****************************************
  4. *                                      *
  5. * Unit: Malprogramm                    *
  6. *                                      *
  7. *--------------------------------------*
  8. * Achtung: Nur VGA !                   *
  9. ****************************************
  10. * (c) 1993 Dipl.Phys. Mathias Scholz   *
  11. ***************************************)
  12.  
  13. {$I COMPILER.INC}
  14. {$F+,O+}
  15.  
  16. UNIT DEMPAINT;
  17.  
  18. INTERFACE
  19.  
  20. USES WDecl,
  21.      WViews,
  22.      WDlg,
  23.      WEvent,
  24.      WDriver,
  25.      WFileDlg,
  26.      WUtils,
  27.      WPCX,
  28.      dos,
  29.      graph;
  30.  
  31.  
  32. const cmLoadPic   = 40;  {Unterkommando Malprogramm}
  33.       cmSavePic   = 41;
  34.       cmClearPic  = 42;
  35.       cmPinsel    = 43;
  36.       cmBrush     = 44;
  37.       cmLine      = 45;
  38.       cmRectangle = 46;
  39.       cmDrawBar   = 47;
  40.       cmDrawCirc  = 48;
  41.       cmFillCirc  = 49;
  42.       cmSetParam  = 50;
  43.  
  44. type PPaint=^TPaint;
  45.      TPaint=object(TDlgWindow)
  46.        PicFile     : TPCXImage;              {PCX-Bilddatei}
  47.        Colors      : array[0..15] of TRect;  {Farbflächen}
  48.        Stift       : byte;                   {Stiftfarbe}
  49.        Radiergummi : byte;                   {Hintergrundfarbe}
  50.        PaintArea   : TRect;                  {Zeichenfläche}
  51.        xx,yy       : integer;                {letzte Mausposition}
  52.        constructor Init;
  53.        procedure SetPalette; virtual;
  54.        procedure InitBackground; virtual;
  55.        procedure CM_SaveAs;
  56.        procedure CM_LoadPCX;
  57.        procedure CM_SetParameters;
  58.        procedure HandleEvent; virtual;
  59.      private
  60.        Error:integer;
  61.      end;
  62.  
  63.      PPaintBgrd=^TPaintBgrd;
  64.      TPaintBgrd=object(TBackground)
  65.        procedure Draw;virtual;
  66.      end;
  67.  
  68.      PParameter=^TParameter;
  69.      TParameter=object(TDlgWindow)
  70.       constructor Init;
  71.       destructor Done; virtual;
  72.       procedure InitBackground; virtual;
  73.       procedure HandleEvent; virtual;
  74.      end;
  75.  
  76.      PParamBgrd=^TParamBgrd;
  77.      TParamBgrd=object(TBackground)
  78.       procedure Draw; virtual;
  79.      end;
  80.  
  81.      tParameterType=record
  82.                       Schalter:string[16];
  83.                       BType:string[2];
  84.                       Pencel:byte;
  85.                       Muster:byte;
  86.                     end;
  87.  
  88.  
  89.      tDrawMode=(NoMode,Brush,Pinsel,DrawLine,DrawRect,DrawBar,DrawCircle,FillCircle);
  90.  
  91. IMPLEMENTATION
  92.  
  93. var Param       : tParameterType;
  94.     Modi        : tDrawMode;
  95.     ActMode     : tDrawMode;
  96.     AktivPinsel : byte;
  97.     BrushType   : byte;
  98.     FuellMuster : byte;
  99.  
  100. {Implementation TPaint}
  101.  
  102. constructor TPaint.Init;
  103. var Bounds:TRect;
  104.     i:integer;
  105. begin
  106.   Bounds:=WorkArea; Bounds.A.y:=Bounds.A.y-25; Bounds.B.y:=Bounds.B.y+24;
  107.   TDlgWindow.Init(Bounds,'',winSingle);
  108.   SetPushButton(6,4,0,0,'#DEMO.I16/1',cmLoadPic);
  109.    ChangePalColor(8,LightGray);
  110.   SetPushButton(31,4,0,0,'#DEMO.I16/2',cmSavePic);
  111.    ChangePalColor(8,LightGray);
  112.   SetPushButton(56,4,0,0,'#DEMO.I16/3',cmClearPic);
  113.    ChangePalColor(8,LightGray);
  114.   SetPushButton(6,30,0,0,'#DEMO.I16/4',cmPinsel);
  115.    ChangePalColor(8,LightGray);
  116.   SetPushButton(31,30,0,0,'#DEMO.I16/5',cmBrush);
  117.    ChangePalColor(8,LightGray);
  118.   SetPushButton(56,30,0,0,'#DEMO.I16/6',cmLine);
  119.    ChangePalColor(8,LightGray);
  120.   SetPushButton(6,56,0,0,'#DEMO.I16/7',cmRectangle);
  121.    ChangePalColor(8,LightGray);
  122.   SetPushButton(31,56,0,0,'#DEMO.I16/8',cmDrawBar);
  123.    ChangePalColor(8,LightGray);
  124.   SetPushButton(56,56,0,0,'#DEMO.I16/9',cmDrawCirc);
  125.    ChangePalColor(8,LightGray);
  126.   SetPushButton(6,82,0,0,'#DEMO.I16/10',cmFillCirc);
  127.    ChangePalColor(8,LightGray);
  128.   SetPushButton(31,82,0,0,'#DEMO.I16/11',cmSetParam);
  129.    ChangePalColor(8,LightGray);
  130.   SetPushButton(56,82,0,0,'#DEMO.I16/12',cmCloseWindow);
  131.    ChangePalColor(8,LightGray);
  132.   with Bounds do
  133.    PaintArea.Assign(A.x+84,A.y+1,B.x-1,B.y-1);
  134.   PicFile.Init(PaintArea,'NONAME.PCX');
  135.   for i:=1 to 8 do
  136.    begin
  137.      Colors[i-1].Assign(7,132+i*32,45,160+i*32);
  138.      Colors[i+7].Assign(48,132+i*32,86,160+i*32);
  139.      Stift:=White; Radiergummi:=DarkGray;
  140.    end;
  141.   Modi:=Pinsel; ActMode:=Modi;
  142.   AktivPinsel:=0; BrushType:=25; FuellMuster:=SolidFill;
  143.   with Param do
  144.    begin
  145.      Schalter:='TSRrrLRrrrrrrrrr';
  146.      BType:='25';
  147.      Pencel:=0;
  148.      Muster:=1;
  149.    end;
  150. end;
  151.  
  152. procedure TPaint.SetPalette;
  153. begin
  154.   Palette:=Pal[palRed];
  155. end;
  156.  
  157. procedure TPaint.InitBackground;
  158. var RR:TRect;
  159. begin
  160.   RR:=Frame^.Area;
  161.   Bgrd:=new(PPaintBgrd, Init(RR));
  162.   List^.InsertItem(Bgrd);
  163. end;
  164.  
  165. procedure TPaint.CM_SaveAs;
  166. var ODlg:POutPutDialog;
  167. begin
  168.   ODlg:=New(POutPutDialog, Init('Bild sichern'));
  169.   FrameDeAktivated:=true;
  170.   DrawNewFrame;
  171.   ODlg^.Draw;
  172.   InsertChildWindow(ODlg);
  173. end;
  174.  
  175. procedure TPaint.CM_LoadPCX;
  176. var IDlg:PInputDialog;
  177. begin
  178.   IDlg:=New(PInputDialog, Init('PCX-Bild laden','*.PCX'));
  179.   FrameDeAktivated:=true;
  180.   DrawNewFrame;
  181.   IDlg^.Draw;
  182.   InsertChildWindow(IDlg);
  183. end;
  184.  
  185. procedure TPaint.CM_SetParameters;
  186. var IDlg:PParameter;
  187. begin
  188.   IDlg:=New(PParameter, Init);
  189.   FrameDeAktivated:=true;
  190.   DrawNewFrame;
  191.   IDlg^.Draw;
  192.   InsertChildWindow(IDlg);
  193. end;
  194.  
  195. procedure TPaint.HandleEvent;
  196. var i,xxp,yyp,xxm,yym,Radius:integer;
  197.     RR:TRect;
  198.     xp,yp:single;
  199.  
  200. procedure DrawColorView;
  201. begin
  202.   Mouse.HideMouse;
  203.   SetColor(Black);
  204.   SetFillStyle(SolidFill,Radiergummi);
  205.   Bar(7,429,86,472);
  206.   RectAngle(7,429,86,472);
  207.   SetFillStyle(SolidFill,Stift);
  208.   Bar(20,442,73,459);
  209.   RectAngle(20,442,73,459);
  210.   Mouse.ShowMouse;
  211. end;
  212.  
  213. {-------}
  214.  
  215. begin
  216.   TDlgWindow.HandleEvent;
  217.   case Event.Command of
  218.    cmLoadPic   : CM_LoadPCX;
  219.    cmSavePic   : CM_SaveAs;
  220.    cmClearPic  : begin
  221.                    Mouse.HideMouse;
  222.                    SetFillStyle(SolidFill,Radiergummi);
  223.                    with PaintArea do Bar(A.x,A.y,B.x,B.y);
  224.                    Mouse.ShowMouse;
  225.                    Event.Command:=cmNothing;
  226.                  end;
  227.    cmSetParam  : CM_SetParameters;
  228.    cmBrush     : Modi:=Brush;
  229.    cmPinsel    : Modi:=Pinsel;
  230.    cmLine      : Modi:=DrawLine;
  231.    cmRectangle : Modi:=DrawRect;
  232.    cmDrawBar   : Modi:=DrawBar;
  233.    cmDrawCirc  : Modi:=DrawCircle;
  234.    cmFillCirc  : Modi:=FillCircle;
  235.   end; {case}
  236.   case Event.Message of
  237.    msgLoadFile: begin
  238.                   RR:=PaintArea;
  239.                   RR.Move(-5,0);
  240.                   PicFile.Init(RR,Event.InfoString);
  241.                   Mouse.HideMouse;
  242.                   SetFillStyle(SolidFill,DarkGray);
  243.                   with PaintArea do Bar(A.x,A.y,B.x,B.y);
  244.                   PicFile.LoadPCXImage(0);
  245.                   Mouse.ShowMouse;
  246.                   Event.Command:=cmNothing;
  247.                   Event.Message:=msgNothing;
  248.                   Event.InfoString:='';
  249.                 end;
  250.    msgSaveFile: begin
  251.                   RR:=PaintArea;
  252.                   RR.Move(-5,0);
  253.                   Mouse.HideMouse;
  254.                   with PaintArea do Error:=SavePCXImage(A.x,A.y,B.x,B.y,Event.InfoString);
  255.                   Mouse.ShowMouse;
  256.                   if not Error=0 then Beep(400);
  257.                   Event.Command:=cmNothing;
  258.                   Event.Message:=msgNothing;
  259.                   Event.InfoString:='';
  260.                 end;
  261.   end; {case}
  262.   with Mouse do
  263.    begin
  264.      for i:=0 to 15 do
  265.       if Colors[i].Contains(Position) then
  266.        begin
  267.          if LButtonKlick then
  268.            begin
  269.              Stift:=i;
  270.              DrawColorView;
  271.            end;
  272.          if RButtonKlick then
  273.           begin
  274.             RadierGummi:=i;
  275.             DrawColorView;
  276.           end;
  277.        end;
  278.      if PaintArea.Contains(Position) then
  279.       begin
  280.         if CursorTyp<>1 then SetCursorTyp(1);
  281.         with PaintArea do
  282.          begin
  283.            SetViewPort(A.x,A.y,B.x,B.y,true);
  284.            if LeftButton then
  285.             begin
  286.               HideMouse;
  287.               SetColor(Stift);
  288.               SetFillStyle(SolidFill,Stift);
  289.               case Modi of
  290.                Brush  : repeat
  291.                           if Mouse.MouseHandler then;
  292.                           xp:=Random(BrushType)-(BrushType/2);
  293.                           yp:=Random(BrushType)-(BrushType/2);
  294.                           if sqrt(xp*xp+yp*yp)<=BrushType/2 then
  295.                            PutPixel(Position.X-A.x+trunc(xp),Position.Y-A.y+trunc(yp),Stift);
  296.                         until Mouse.LButtonRel;
  297.                Pinsel : case AktivPinsel of
  298.                          0,1 : repeat
  299.                                 xx:=Position.X-A.x; yy:=Position.Y-A.y;
  300.                                 if Mouse.MouseHandler then;
  301.                                 if AktivPinsel=1 then SetLineStyle(SolidLn,0,ThickWidth);
  302.                                 line(xx,yy,Position.X-A.x,Position.Y-A.y);
  303.                                 SetLineStyle(SolidLn,0,NormWidth);
  304.                               until Mouse.LButtonRel;
  305.                           2 : repeat
  306.                                 xx:=Position.X-A.x; yy:=Position.Y-A.y;
  307.                                 if Mouse.MouseHandler then;
  308.                                 SetLineStyle(SolidLn,0,ThickWidth);
  309.                                 line(xx,yy-2,Position.X-A.x,Position.Y-A.y-2);
  310.                                 line(xx,yy,Position.X-A.x,Position.Y-A.y);
  311.                                 line(xx,yy+2,Position.X-A.x,Position.Y-A.y+2);
  312.                                 SetLineStyle(SolidLn,0,NormWidth);
  313.                               until Mouse.LButtonRel;
  314.                         end; {case}
  315.              DrawRect,
  316.              DrawBar  : begin
  317.                           if AktivPinsel>0 then SetLineStyle(SolidLn,0,ThickWidth);
  318.                           xx:=Position.X-A.x; yy:=Position.Y-A.y;
  319.                           repeat
  320.                             xxp:=Position.X-A.x; yyp:=Position.Y-A.y;
  321.                             if Mouse.MouseHandler then;
  322.                             xxm:=Position.X-A.x; yym:=Position.Y-A.y;
  323.                             if (xxp<>xxm) or (yyp<>yym) then
  324.                              begin
  325.                                SetWriteMode(XOrPut);
  326.                                Mouse.HideMouse;
  327.                                RectAngle(xx,yy,xxp,yyp);
  328.                                RectAngle(xx,yy,xxm,yym);
  329.                                Mouse.ShowMouse;
  330.                              end;
  331.                           until Mouse.LButtonRel;
  332.                           SetWriteMode(CopyPut);
  333.                           SetFillStyle(FuellMuster,Stift);
  334.                           if Modi=DrawRect then RectAngle(xx,yy,xxm,yym)
  335.                            else Bar(xx,yy,Position.X-A.x,Position.Y-A.y);
  336.                           SetLineStyle(SolidLn,0,NormWidth);
  337.                         end;
  338.            DrawLine,
  339.            DrawCircle,
  340.            FillCircle : begin
  341.                           if AktivPinsel>0 then SetLineStyle(SolidLn,0,ThickWidth);
  342.                           xx:=Position.X-A.x; yy:=Position.Y-A.y;
  343.                           repeat
  344.                             xxp:=Position.X-A.x; yyp:=Position.Y-A.y;
  345.                             if Mouse.MouseHandler then;
  346.                             xxm:=Position.X-A.x; yym:=Position.Y-A.y;
  347.                             if (xxp<>xxm) or (yyp<>yym) then
  348.                              begin
  349.                                SetWriteMode(XOrPut);
  350.                                Mouse.HideMouse;
  351.                                line(xx,yy,xxp,yyp);
  352.                                line(xx,yy,xxm,yym);
  353.                                Mouse.ShowMouse;
  354.                              end;
  355.                           until Mouse.LButtonRel;
  356.                           line(xx,yy,xxm,yym);
  357.                           SetWriteMode(CopyPut);
  358.                           SetFillStyle(FuellMuster,Stift);
  359.                           xp:=xx-xxm; yp:=yy-yym;
  360.                           Radius:=trunc(sqrt(sqr(xp)+sqr(yp)));
  361.                           if Modi=DrawCircle then Circle(xx,yy,Radius)
  362.                            else if Modi=FillCircle then FillEllipse(xx,yy,Radius,Radius)
  363.                             else line(xx,yy,xxm,yym);
  364.                           SetLineStyle(SolidLn,0,NormWidth);
  365.                         end;
  366.               end; {case}
  367.             end;
  368.            if RightButton then
  369.             begin
  370.               HideMouse;
  371.               SetFillStyle(SolidFill,Radiergummi);
  372.               Bar(Position.X-4-A.x,Position.Y-4-A.y,Position.X+4-A.x,Position.Y+4-A.y);
  373.               ShowMouse;
  374.             end;
  375.            SetViewPort(0,0,GetMaxX,GetMaxY,true);
  376.            ShowMouse;
  377.          end;
  378.       end
  379.       else if CursorTyp<>10 then SetCursorTyp(10);
  380.      if Event.Command=cmCloseWindow then SetCursorTyp(1);
  381.    end;
  382. end;
  383.  
  384. {Implementation TPaintBgrd}
  385.  
  386. procedure TPaintBgrd.Draw;
  387. var i:integer;
  388. begin
  389.   with Border do
  390.    begin
  391.      SetFillStyle(SolidFill,DarkGray);
  392.      Bar(A.x+83,A.y,B.x,B.y);
  393.      SetFillStyle(SolidFill,LightGray);
  394.      Bar(A.x,A.y,A.x+83,B.y);
  395.      for i:=1 to 8 do
  396.       begin
  397.         SetFillStyle(SolidFill,i-1);
  398.         Bar(7,132+i*32,45,160+i*32);
  399.         RectAngle(7,132+i*32,45,160+i*32);
  400.         SetFillStyle(SolidFill,i+7);
  401.         Bar(48,132+i*32,86,160+i*32);
  402.         RectAngle(48,132+i*32,86,160+i*32);
  403.       end;
  404.      SetFillStyle(SolidFill,DarkGray);
  405.      Bar(7,429,86,472);
  406.      RectAngle(7,429,86,472);
  407.      SetFillStyle(SolidFill,White);
  408.      Bar(20,442,73,459);
  409.      RectAngle(20,442,73,459);
  410.    end;
  411. end;
  412.  
  413. {Implementation TParameter}
  414.  
  415. constructor TParameter.Init;
  416. var RR:TRect;
  417. begin
  418.   RR.Assign(120,80,420,420);
  419.   TDlgWindow.Init(RR,'Parameter',winDouble+winPanel+winMenu);
  420.   SetPushButton(110,300,80,22,'OK',cmCloseWindow);
  421.    ChangePalColor(8,LightGray);
  422.   SetStaticText(20,45,'Pinselstärke',LeftText);
  423.   SetRadioButton(25,85,'s~c~hmal',1);
  424.    ChangePalColor(2,LightGray);
  425.   SetRadioButton(115,85,'~m~ittel',1);
  426.    ChangePalColor(2,LightGray);
  427.   SetRadioButton(205,85,'~b~reit',1);
  428.    ChangePalColor(2,LightGray);
  429.   SetNumButton(55,137,2,'~B~rush Spot',2,2,5,95,5,2.0);
  430.    ChangePalColor(2,LightGray);
  431.   SetRadioButton(30,190,'S~o~lid',2);
  432.    ChangePalColor(2,LightGray);
  433.    SetTextPosition(80,184);
  434.   SetRadioButton(30,210,'~L~ine',2);
  435.    ChangePalColor(2,LightGray);
  436.    SetTextPosition(80,204);
  437.   SetRadioButton(30,230,'L~t~Slash',2);
  438.    ChangePalColor(2,LightGray);
  439.    SetTextPosition(80,224);
  440.   SetRadioButton(30,250,'~S~lash',2);
  441.    ChangePalColor(2,LightGray);
  442.    SetTextPosition(80,244);
  443.   SetRadioButton(30,270,'B~k~Slash',2);
  444.    ChangePalColor(2,LightGray);
  445.    SetTextPosition(80,264);
  446.   SetRadioButton(165,190,'LBSl~a~sh',2);
  447.    ChangePalColor(2,LightGray);
  448.    SetTextPosition(215,184);
  449.   SetRadioButton(165,210,'~H~atch',2);
  450.    ChangePalColor(2,LightGray);
  451.    SetTextPosition(215,204);
  452.   SetRadioButton(165,230,'~X~Hatch',2);
  453.    ChangePalColor(2,LightGray);
  454.    SetTextPosition(215,224);
  455.   SetRadioButton(165,250,'~I~nterl.',2);
  456.    ChangePalColor(2,LightGray);
  457.    SetTextPosition(215,244);
  458.   SetRadioButton(165,270,'~W~ideDot',2);
  459.    ChangePalColor(2,LightGray);
  460.    SetTextPosition(215,264);
  461.   SetData(Param);
  462.   ActMode:=Modi;
  463.   Modi:=NoMode;
  464. end;
  465.  
  466. destructor TParameter.Done;
  467. begin
  468.   TDlgWindow.Done;
  469.   Modi:=ActMode;
  470. end;
  471.  
  472. procedure TParameter.InitBackground;
  473. var RR:TRect;
  474. begin
  475.   RR:=Frame^.Area;
  476.   Bgrd:=new(PParamBgrd, Init(RR));
  477.   List^.InsertItem(Bgrd);
  478. end;
  479.  
  480. procedure TParameter.HandleEvent;
  481. var i:integer;
  482. begin
  483.   TDlgWindow.HandleEvent;
  484.   with Param do
  485.    begin
  486.      for i:=3 to 5 do
  487.       if Schalter[i]='R' then AktivPinsel:=i-3;
  488.      for i:=7 to 16 do
  489.       if Schalter[i]='R' then FuellMuster:=i-6;
  490.      val(BType,BrushType,i);
  491.    end;
  492. end;
  493.  
  494. {Implementation TParamBgrd}
  495.  
  496. procedure TParamBgrd.Draw;
  497. var i:integer;
  498. begin
  499.   with Border do
  500.    begin
  501.      FBar(A.x,A.y,B.x,B.y,LightGray);
  502.      D3Frame(A.x+10,A.y+40,B.x-10,A.y+80,Black,White);
  503.      D3Frame(A.x+10,A.y+150,B.x-10,A.y+261,Black,White);
  504.      for i:=0 to 4 do
  505.       begin
  506.         SetFillStyle(i+1,LightBlue);
  507.         Bar(A.x+47,A.y+158+i*20,A.x+70,A.y+173+i*20);
  508.         RectAngle(A.x+47,A.y+158+i*20,A.x+70,A.y+173+i*20);
  509.         SetFillStyle(i+6,LightBlue);
  510.         Bar(A.x+182,A.y+158+i*20,A.x+205,A.y+173+i*20);
  511.         RectAngle(A.x+182,A.y+158+i*20,A.x+205,A.y+173+i*20);
  512.       end;
  513.    end;
  514. end;
  515.  
  516. END.