graphic.pas

画图程序 通过DEPHI 实现画图板的功能

      image1.Canvas.Pen.Color :=itsLine^.lineColor ;
      drawLine(itsLine^.originP,itsLine^.finalP);
      dLine^.next :=itsLine^.next ;
      if itsLine=lastLine then
         lastLine:=dLine;
      dispose(itsLine);
      itsLine:=lastLine;
      ctrlRect:=false;
      ctrlEllips:=false;
      ctrlCircle:=false;
      exit;//
    end;
    dLine:=dLine^.next ;
    itsLine:=itsLine^.next ;
  end;
  if itsLine=nil then
     itsLine:=lastLine;   //

  if ctrlRect then
  begin
    dRect:=firstRect ;
    itsRect:=firstRect^.next ;
    while itsRect<>nil do
    begin
      if prepareRect(myPoint,itsRect^.originP,itsRect^.finalP) then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsRect^.rectColor;
        image1.Canvas.Brush.Color :=itsRect^.fillColor;
        drawRect(itsRect^.originP ,itsRect^.finalP);
        dRect^.next :=itsRect^.next ;
        if itsRect=lastRect then
           lastRect:=dRect;
        dispose(itsRect);
        itsRect:=lastRect;
        ctrlEllips:=false;
        ctrlCircle:=false;
        exit;//
      end;
      dRect:=dRect^.next ;
      itsRect:=itsRect^.next ;
    end;
    if itsRect=nil then
       itsRect:=lastRect;  //
  end;

  if ctrlEllips then
  begin
    dEllips:=firstEllips;
    itsEllips:=firstEllips^.next ;
    while itsEllips<>nil do
    begin
      if prepareEllips(myPoint,itsEllips^.originP ,itsEllips^.finalP) then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsEllips^.ellipsColor ;
        image1.Canvas.Brush.Color :=itsEllips^.fillColor ;
        drawEllips(itsEllips^.originP ,itsEllips^.finalP);
        dEllips^.next :=itsEllips^.next ;
        if itsEllips=lastEllips then
           lastEllips:=dEllips;
        dispose(itsEllips);
        itsEllips:=lastEllips;
        ctrlCircle:=false;
        exit;
      end;
      dEllips:=dEllips^.next ;
      itsEllips:=itsEllips^.next ;
    end;
    if itsEllips=nil then
       itsEllips:=lastEllips;
  end;

  if ctrlCircle then
  begin
    dCircle:=firstCircle;
    itsCircle:=firstCircle^.next ;
    while itsCircle<>nil do
    begin
      if prepareCircle(myPoint,itsCircle^.centreP ,itsCircle^.edgeP )then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsCircle^.circleColor ;
        image1.Canvas.Brush.Color :=itsCircle^.fillColor ;
        drawCircle(itsCircle^.centreP ,itsCircle^.edgeP );
        dCircle^.next :=itsCircle^.next ;
        if itsCircle=lastCircle then
           lastCircle:=dCircle;
        dispose(itsCircle);
        itsCircle:=lastCircle;
        exit;
      end;
      dCircle:=dCircle^.next ;
      itsCircle:=itsCircle^.next ;
    end;
    if itsCircle=nil then
       itsCircle:=lastCircle;
  end;

end;

//~~~~~~~~~~~~~~~~~~~ Fill Color ~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.preFill(myPoint:TPoint);
var
  ctrlEllips:boolean;
  ctrlCircle:boolean;
begin
  ctrlEllips:=true;
  ctrlCircle:=true;

  begin
    itsRect:=firstRect^.next ;
    while itsRect<>nil do
    begin
      if prepareRect(myPoint,itsRect^.originP,itsRect^.finalP) then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsRect^.rectColor;
        image1.Canvas.Brush.Color :=itsRect^.fillColor;
        drawRect(itsRect^.originP ,itsRect^.finalP);
        itsRect^.fillColor :=colorbox1.Selected ;
        image1.Canvas.Brush.Color :=itsRect^.fillColor ;
        drawRect(itsRect^.originP ,itsRect^.finalP);

        itsRect:=lastRect;
        ctrlEllips:=false;
        ctrlCircle:=false;
        exit;//
      end;
      itsRect:=itsRect^.next ;
    end;
    if itsRect=nil then
       itsRect:=lastRect;  //
  end;

  if ctrlEllips then
  begin
    itsEllips:=firstEllips^.next ;
    while itsEllips<>nil do
    begin
      if prepareEllips(myPoint,itsEllips^.originP ,itsEllips^.finalP) then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsEllips^.ellipsColor ;
        image1.Canvas.Brush.Color :=itsEllips^.fillColor ;
        drawEllips(itsEllips^.originP ,itsEllips^.finalP);
        itsEllips^.fillColor := colorbox1.Selected ;
        image1.Canvas.Brush.Color := itsEllips^.fillColor ;
        drawEllips(itsEllips^.originP ,itsEllips^.finalP);

        itsEllips:=lastEllips;
        ctrlCircle:=false;
        exit;
      end;
      itsEllips:=itsEllips^.next ;
    end;
    if itsEllips=nil then
       itsEllips:=lastEllips;
  end;

  if ctrlCircle then
  begin
    itsCircle:=firstCircle^.next ;
    while itsCircle<>nil do
    begin
      if prepareCircle(myPoint,itsCircle^.centreP ,itsCircle^.edgeP )then
      begin
        edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
        image1.Canvas.Pen.Color :=itsCircle^.circleColor ;
        image1.Canvas.Brush.Color :=itsCircle^.fillColor ;
        drawCircle(itsCircle^.centreP ,itsCircle^.edgeP );
        //image1.Canvas.FloodFill(itsCircle^.centreP.X ,itsCircle^.centreP.Y ,image1.Canvas.Brush.Color,fsBorder);
        itsCircle^.fillColor := colorbox1.Selected ;
        image1.Canvas.Brush.Color := itsCircle^.fillColor ;
        drawCircle(itsCircle^.centreP ,itsCircle^.edgeP );
        //image1.Canvas.FloodFill(itsCircle^.centreP.X ,itsCircle^.centreP.Y ,image1.Canvas.Brush.Color,fsBorder);
        itsCircle:=lastCircle;
         
        {
        image1.Canvas.Brush.Color := clTeal;
        image1.Canvas.Polygon([Point(10, 20), Point(30, 20),
        Point(130, 60), Point(240, 240)]);
        }

        exit;
      end;
      itsCircle:=itsCircle^.next ;
    end;
    if itsCircle=nil then
       itsCircle:=lastCircle;
  end;

end;





{
procedure TForm1.BitBtn_Click(Sender: TObject); //  Test
begin
  image1.Picture.SaveToFile('e:\my_CGSbmp.bmp');
  image1.Picture.SaveToFile('E:\my_CGSjpeg.jpeg');
end;
}

procedure TForm1.miTransportBmpClick(Sender: TObject);
begin
  saveDialog1.Title :='输出图形为BMP格式';
  saveDialog1.Filter :='位图文件(*.bmp)|*.bmp|所有文件(*.*)|*.*';
  saveDialog1.DefaultExt :='bmp';
  if savedialog1.Execute then
     image1.Picture.SaveToFile(savedialog1.FileName);
end;

procedure TForm1.miTransportJpegClick(Sender: TObject);
var
  myJpeg:TJpegImage;
begin
  saveDialog1.Title :='输出图形为JPEG格式';
  saveDialog1.Filter :='位图文件(*.jpeg)|*.jpeg|所有文件(*.*)|*.*';
  saveDialog1.DefaultExt :='jpeg';
  if savedialog1.Execute then
  begin
     //image1.Picture.SaveToFile(savedialog1.FileName);
     myJpeg:=TJpegImage.Create;
     myJpeg.Assign(image1.Picture.Bitmap);
     //myJpeg.CompressionQuality:=100; //
     //myJpeg.Compress;
     myJpeg.SaveToFile(savedialog1.FileName);
  end;
end;

procedure TForm1.miTransportSLClick(Sender: TObject);
begin
  saveDialog1.Title :='输出矢量图形（.bwh）';
  saveDialog1.Filter :='矢量图形(*.bwh)|*.bwh';
  saveDialog1.DefaultExt :='bwh';
  if saveDialog1.Execute then
     saveToMyFile(savedialog1.FileName);
end;

procedure TForm1.saveToMyFile(outFileName:string);
var
  outFile:TextFile;
  tempLine:string;
  tempColor:TColor;
begin
  assignFile(outFile,outFileName);
  rewrite(outFile);
  //tempLine:='bwh file starts';
  //writeLn(outFile,tempLine);

  tempLine:='myLine';
  //writeLn(outFile,tempLine);
  itsLine:=firstLine^.next ;
  while itsLine<>nil do
  begin
    tempColor:=-1;
    writeLn(outFile,tempLine:12,itsLine^.originP.x:6,itsLine^.originP.Y:6,itsLine^.finalP.X:6,itsLine^.finalP.Y:6,itsLine^.lineColor:12,tempColor:12);
    itsLine:=itsLine^.next ;
  end;
  itsLine:=lastLine;

  tempLine:='myRect';
  //writeLn(outFile,tempLine);
  itsRect:=firstRect^.next ;
  while itsRect<>nil do
  begin
    writeLn(outFile,tempLine:12,itsRect^.originP.x:6,itsRect^.originP.Y:6,itsRect^.finalP.X:6,itsRect^.finalP.Y:6,itsRect^.rectColor:12,itsRect^.fillColor:12);
    itsRect:=itsRect^.next ;
  end;
  itsRect:=lastRect;

  tempLine:='myEllips';
  //writeLn(outFile,tempLine);
  itsEllips:=firstEllips^.next ;
  while itsEllips<>nil do
  begin
    writeLn(outFile,tempLine:12,itsEllips^.originP.x:6,itsEllips^.originP.Y:6,itsEllips^.finalP.X:6,itsEllips^.finalP.Y:6,itsEllips^.ellipsColor:12,itsEllips^.fillColor:12);
    itsEllips:=itsEllips^.next ;
  end;
  itsEllips:=lastEllips;

  tempLine:='myCircle';
  //writeLn(outFile,tempLine);
  itsCircle:=firstCircle^.next ;
  while itsCircle<>nil do
  begin
    writeLn(outFile,tempLine:12,itsCircle^.centreP.x:6,itsCircle^.centreP.Y:6,itsCircle^.edgeP.X:6,itsCircle^.edgeP.Y:6,itsCircle^.circleColor:12,itsCircle^.fillColor:12);
    itsCircle:=itsCircle^.next ;
  end;
  itsCircle:=lastCircle;

  //tempLine:='bwh file ends';
  //writeLn(outFile,tempLine);
  closeFile(outFile);
end;


procedure TForm1.loadSLClick(Sender: TObject);
begin
  openDialog1.Title :='载入矢量图形文件（.bwh）';
  openDialog1.Filter:='矢量图形(*.bwh)|*.bwh';
  if openDialog1.Execute then
     loadFromMyFile(openDialog1.FileName);
end;

procedure TForm1.loadFromMyFile(inFileName:string);
var
  inFile:TextFile;
  tempString:string[12];
  objP1x,objP1y,objP2x,objP2y:integer;
  objColor,objFillColor:TColor;
begin
  image1.Canvas.Pen.Mode :=pmNotXor;  //
  image1.Canvas.Brush.Style :=bsClear;//

  assignFile(inFile,inFileName);
  reset(inFile);
  while not EoF(inFile) do
  begin
  readLn(inFile,tempString,objP1x,objP1y,objP2x,objP2y,objColor,objFillColor);
  tempString:=trim(tempString);

    if tempString='myLine' then
    begin
      new(itsLine^.next);
      itsLine:=itsLine^.next ;
      itsLine^.originP :=Point(objP1x,objP1y);
      itsLine^.finalP:=Point(objP2x,objP2y);
      itsLine^.lineColor:=objColor;
      itsLine^.next:=nil;
      lastLine:=itsLine;
      image1.Canvas.Pen.Color :=itsLine^.lineColor ;
      drawLine(itsLine^.originP ,itsLine^.finalP);
    end;
    if tempString='myRect' then
    begin
      new(itsRect^.next);
      itsRect:=itsRect^.next ;
      itsRect^.originP :=Point(objP1x,objP1y);
      itsRect^.finalP:=Point(objP2x,objP2y);
      itsRect^.rectColor:=objColor;
      itsRect^.fillColor:=objFillColor;
      itsRect^.next:=nil;
      lastRect:=itsRect;
      image1.Canvas.Pen.Color :=itsRect^.rectColor;
      image1.Canvas.Brush.Color:=itsRect^.fillColor;
      drawRect(itsRect^.originP ,itsRect^.finalP);
    end;
    if tempString='myEllips' then
    begin
      new(itsEllips^.next);
      itsEllips:=itsEllips^.next ;
      itsEllips^.originP :=Point(objP1x,objP1y);
      itsEllips^.finalP:=Point(objP2x,objP2y);
      itsEllips^.ellipsColor:=objColor;
      itsEllips^.fillColor:=objFillColor;
      itsEllips^.next:=nil;
      lastEllips:=itsEllips;
      image1.Canvas.Pen.Color :=itsEllips^.ellipsColor;
      image1.Canvas.Brush.Color:=itsEllips^.fillColor;
      drawEllips(itsEllips^.originP ,itsEllips^.finalP);
    end;
    if tempString='myCircle' then
    begin
      new(itsCircle^.next);
      itsCircle:=itsCircle^.next ;
      itsCircle^.centreP :=Point(objP1x,objP1y);
      itsCircle^.edgeP:=Point(objP2x,objP2y);
      itsCircle^.circleColor:=objColor;
      itsCircle^.fillColor:=objFillColor;
      itsCircle^.next:=nil;
      lastCircle:=itsCircle;
      image1.Canvas.Pen.Color :=itsCircle^.circleColor;
      image1.Canvas.Brush.Color:=itsCircle^.fillColor;
      drawCircle(itsCircle^.centreP ,itsCircle^.edgeP);
    end;

  end;
  closeFile(inFile);
end;


{
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if MessageBox(Form1.Handle ,'是否保存为矢量图形文件?','系统提示',Mb_YesNoCancel)=IDYES then
  begin
    saveDialog1.Title :='输出矢量图形（.bwh）';
    saveDialog1.Filter :='矢量图形(*.bwh)|*.bwh';
    saveDialog1.DefaultExt :='bwh';
    if saveDialog1.Execute then
     saveToMyFile(savedialog1.FileName);
  end;
end;
}

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  myQuery:integer;
begin
  myQuery:=MessageBox(Form1.Handle ,'是否保存为矢量图形文件?','系统提示',Mb_YesNoCancel);
  if myQuery=IDYES then
  begin
    CanClose:=false;
    saveDialog1.Title :='输出矢量图形（.bwh）';
    saveDialog1.Filter :='矢量图形(*.bwh)|*.bwh';
    saveDialog1.DefaultExt :='bwh';
    if saveDialog1.Execute then
    begin
      saveToMyFile(savedialog1.FileName);
      CanClose:=true;
    end;
  end
  else if myQuery=IDCANCEL then
    CanClose:=false
  else if myQuery=IDNO then
    CanClose:=true;

end;

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



procedure TForm1.miOpenClick(Sender: TObject);
begin
  loadSLClick(self);
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
begin
  loadSLClick(self);
end;

procedure TForm1.miNewClick(Sender: TObject);
var
  myQuery:integer;
  canNew:boolean;
begin
  myQuery:=MessageBox(Form1.Handle ,'是否保存为矢量图形文件?','系统提示',Mb_YesNoCancel);
  if myQuery=IDYES then
  begin
    canNew:=false;
    saveDialog1.Title :='输出矢量图形（.bwh）';
    saveDialog1.Filter :='矢量图形(*.bwh)|*.bwh';
    saveDialog1.DefaultExt :='bwh';
    if saveDialog1.Execute then
    begin
      saveToMyFile(savedialog1.FileName);
      canNew:=true;
    end;
  end
  else if myQuery=IDCANCEL then
    canNew:=false
  else if myQuery=IDNO then
    canNew:=true;

  if canNew=true then
     realClear;
end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
  miNewClick(self);
end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
  miTransportSLClick(self);
end;

procedure TForm1.miSaveYClick(Sender: TObject);
begin
  miTransportSLClick(self);
end;

procedure TForm1.miSaveZClick(Sender: TObject);
begin
  miTransportSLClick(self);
end;

procedure TForm1.L1Click(Sender: TObject);
begin
  BitBtn_lineClick(self);
end;

procedure TForm1.R1Click(Sender: TObject);
begin
  BitBtn_RectClick(self);
end;

procedure TForm1.E1Click(Sender: TObject);
begin
  BitBtn_EllipsClick(self);
end;

procedure TForm1.C1Click(Sender: TObject);
begin
  BitBtn_circleClick(self);
end;

procedure TForm1.F1Click(Sender: TObject);
begin
  BitBtn_fillClick(self);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  BitBtn_delClick(self);
end;

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

procedure TForm1.N7Click(Sender: TObject);
begin
  BitBtn_moveClick(self);
end;

procedure TForm1.ToolButton10Click(Sender: TObject);
begin
  miTransportBmpClick(self);
end;

procedure TForm1.ToolButton11Click(Sender: TObject);
begin
  miTransportJpegClick(self);
end;

procedure TForm1.A1Click(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
  A1Click(self);
end;

end.