unit1.pas

Delphi7编程80例(完全版)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst,INIFILES;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Edit1: TEdit;
    Label1: TLabel;
    ListBox1: TListBox;
    Label2: TLabel;
    ListBox2: TListBox;
    ListBox3: TListBox;
    CheckBox1: TCheckBox;
    Label3: TLabel;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    CheckBox2: TCheckBox;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dir:string;

implementation

{$R *.dfm}

Procedure GetTextFile(var str:String);
begin
str:=ExtractFilePath(Paramstr(0))+'text.ini';  //自定义一个读取INI文件的函数
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  begin
Case ListBox1.ItemIndex Of
0:Begin
  Caption:='当前图层是线条层';
  Image1.Canvas.LineTo(x,y);
  Image1.Canvas.LineTo(x,y);  //将点移动到鼠标点击处，准备画线
  End;
1:Begin
  Caption:='当前图层是文本层';
  Image1.Canvas.Brush.Color:=clWhite;    //这两句的作用是清空画布
  Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));

  GetTextFile(dir);
  Image1.canvas.Font:=Edit1.Font;
  Image1.Canvas.TextOut(x,y,Edit1.text);
  GetTextFile(dir);
  WritePrivateProfileString('text','x1',pchar(IntToStr(x)),pchar(dir));
  WritePrivateProfileString('text','y1',pchar(IntToStr(y)),pchar(dir));
  WritePrivateProfileString('text','string',PChar(Edit1.text),pchar(dir));
  End;
Else;  //不做任何操作
End;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
If ListBox1.ItemIndex=0 Then
Begin
listBox2.Items.Add(IntToStr(x));
listBox3.Items.Add(IntToStr(y));  End
Else;   //其他的条件则不进行任何操作
End;

procedure TForm1.ListBox1Click(Sender: TObject);
  Var i,x_text,y_text:Integer;
      text:Array [1..16] of char;
begin
Case ListBox1.ItemIndex Of
0:Begin
  Caption:='当前图层是线条层';
  Image1.Canvas.Brush.Color:=clWhite;    //这两句的作用是清空画布
  Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
  Image1.Canvas.MoveTo(0,0);    //从起点开始绘画
  For i:=0 To ListBox2.Items.Count-1 Do
   Image1.Canvas.LineTo(StrToInt(ListBox2.Items.strings[i]),StrToInt(ListBox3.Items.strings[i]));
  End;
1:Begin
  Caption:='当前图层是文本层';
  Image1.Canvas.Brush.Color:=clWhite;    //这两句的作用是清空画布
  Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));

   GetTextFile(dir);
   x_text:=GetPrivateProfileInt('text','x1',0,pchar(dir));
   y_text:=GetPrivateProfileInt('text','y1',0,pchar(dir));
   GetPrivateProfileString('text','string','',@text,length(text),pchar(dir));
   Image1.Canvas.TextOut(x_text,y_text,text);

  End;
Else;  //不做任何操作
End;

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 If Checkbox1.Checked Then
 Begin        //显示鼠标记录
  Label3.Visible:=True;
  ListBox2.Visible:=True;
  ListBox3.Visible:=True
 end
 Else
 Begin   //隐藏鼠标记录
  Label3.Visible:=False;
  ListBox2.Visible:=False;
  ListBox3.Visible:=False;;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
If SaveDialog1.Execute Then
 Image1.Picture.SaveToFile(SaveDialog1.FileName);  //保存文件
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
var i,x_text,y_text:Integer;
     text:Array [1..16] of char;
begin
 If Checkbox2.Checked Then
 Begin        //显示鼠标记录
  Caption:='当前图层是线条层+文本层';
  Image1.Canvas.Brush.Color:=clWhite;    //这两句的作用是清空画布
  Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
  Image1.Canvas.MoveTo(0,0);    //从起点开始绘画
  For i:=0 To ListBox2.Items.Count-1 Do
   Image1.Canvas.LineTo(StrToInt(ListBox2.Items.strings[i]),StrToInt(ListBox3.Items.strings[i]));
   //下面是显示文本层
   GetTextFile(dir);
   x_text:=GetPrivateProfileInt('text','x1',0,pchar(dir));
   y_text:=GetPrivateProfileInt('text','y1',0,pchar(dir));
   GetPrivateProfileString('text','string','',@text,length(text),pchar(dir));
   Image1.Canvas.TextOut(x_text,y_text,text);
 end
 Else
 Begin   //填充画布
 Image1.Canvas.Brush.Color:=clWhite;
 Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
 end;
end;

end.