Delphi實現圖片+文字圖層效果，仿Photoshop的圖層效果，可選定圖層，自定義文字，並最終保存合成的效果為圖片。
001
unit Unit1;
002
interface
003
uses
004
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
005
Dialogs, ExtCtrls, StdCtrls, CheckLst,INIFILES;
006
type
007
TForm1 = class(TForm)
008
Image1: TImage;
009
Edit1: TEdit;
010
Label1: TLabel;
011
ListBox1: TListBox;
012
Label2: TLabel;
013
ListBox2: TListBox;
014
ListBox3: TListBox;
015
CheckBox1: TCheckBox;
016
Label3: TLabel;
017
Button1: TButton;
018
SaveDialog1: TSaveDialog;
019
CheckBox2: TCheckBox;
020
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
021
Shift: TShiftState; X, Y: Integer);
022
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
023
Shift: TShiftState; X, Y: Integer);
024
procedure ListBox1Click(Sender: TObject);
025
procedure CheckBox1Click(Sender: TObject);
026
procedure Button1Click(Sender: TObject);
027
procedure CheckBox2Click(Sender: TObject);
028
private
029
{ Private declarations }
030
public
031
{ Public declarations }
032
end;
033
var
034
Form1: TForm1;
035
dir:string;
036
implementation
037
{$R *.dfm}
038
Procedure GetTextFile(var str:String);
039
begin
040
str:=ExtractFilePath(Paramstr(0))+'text.ini'; //自定義一個讀取INI文件的函數
041
end;
042
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
043
Shift: TShiftState; X, Y: Integer);
044
begin
045
Case ListBox1.ItemIndex Of
046
0:Begin
047
Caption:='當前圖層是線條層';
048
Image1.Canvas.LineTo(x,y);
049
Image1.Canvas.LineTo(x,y); //將點移動到鼠標點擊處，准備畫線
050
End;
051
1:Begin
052
Caption:='當前圖層是文本層';
053
Image1.Canvas.Brush.Color:=clWhite; //這兩句的作用是清空畫布
054
Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
055
GetTextFile(dir);
056
Image1.canvas.Font:=Edit1.Font;
057
Image1.Canvas.TextOut(x,y,Edit1.text);
058
GetTextFile(dir);
059
WritePrivateProfileString('text','x1',pchar(IntToStr(x)),pchar(dir));
060
WritePrivateProfileString('text','y1',pchar(IntToStr(y)),pchar(dir));
061
WritePrivateProfileString('text','string',PChar(Edit1.text),pchar(dir));
062
End;
063
Else; //不做任何操作
064
End;
065
end;
066
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
067
Shift: TShiftState; X, Y: Integer);
068
begin
069
If ListBox1.ItemIndex=0 Then
070
Begin
071
listBox2.Items.Add(IntToStr(x));
072
listBox3.Items.Add(IntToStr(y)); End
073
Else; //其他的條件則不進行任何操作
074
End;
075
procedure TForm1.ListBox1Click(Sender: TObject);
076
Var i,x_text,y_text:Integer;
077
text:Array [1..16] of char;
078
begin
079
Case ListBox1.ItemIndex Of
080
0:Begin
081
Caption:='當前圖層是線條層';
082
Image1.Canvas.Brush.Color:=clWhite; //這兩句的作用是清空畫布
083
Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
084
Image1.Canvas.MoveTo(0,0); //從起點開始繪畫
085
For i:=0 To ListBox2.Items.Count-1 Do
086
Image1.Canvas.LineTo(StrToInt(ListBox2.Items.strings[i]),StrToInt(ListBox3.Items.strings[i]));
087
End;
088
1:Begin
089
Caption:='當前圖層是文本層';
090
Image1.Canvas.Brush.Color:=clWhite; //這兩句的作用是清空畫布
091
Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
092
GetTextFile(dir);
093
x_text:=GetPrivateProfileInt('text','x1',0,pchar(dir));
094
y_text:=GetPrivateProfileInt('text','y1',0,pchar(dir));
095
GetPrivateProfileString('text','string','',@text,length(text),pchar(dir));
096
Image1.Canvas.TextOut(x_text,y_text,text);
097
End;
098
Else; //不做任何操作
099
End;
100
end;
101
procedure TForm1.CheckBox1Click(Sender: TObject);
102
begin
103
If Checkbox1.Checked Then
104
Begin //顯示鼠標記錄
105
Label3.Visible:=True;
106
ListBox2.Visible:=True;
107
ListBox3.Visible:=True
108
end
109
Else
110
Begin //隱藏鼠標記錄
111
Label3.Visible:=False;
112
ListBox2.Visible:=False;
113
ListBox3.Visible:=False;;
114
end;
115
end;
116
procedure TForm1.Button1Click(Sender: TObject);
117
begin
118
If SaveDialog1.Execute Then
119
Image1.Picture.SaveToFile(SaveDialog1.FileName); //保存文件
120
end;
121
procedure TForm1.CheckBox2Click(Sender: TObject);
122
var i,x_text,y_text:Integer;
123
text:Array [1..16] of char;
124
begin
125
If Checkbox2.Checked Then
126
Begin //顯示鼠標記錄
127
Caption:='當前圖層是線條層+文本層';
128
Image1.Canvas.Brush.Color:=clWhite; //這兩句的作用是清空畫布
129
Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
130
Image1.Canvas.MoveTo(0,0); //從起點開始繪畫
131
For i:=0 To ListBox2.Items.Count-1 Do
132
Image1.Canvas.LineTo(StrToInt(ListBox2.Items.strings[i]),StrToInt(ListBox3.Items.strings[i]));
133
//下面是顯示文本層
134
GetTextFile(dir);
135
x_text:=GetPrivateProfileInt('text','x1',0,pchar(dir));
136
y_text:=GetPrivateProfileInt('text','y1',0,pchar(dir));
137
GetPrivateProfileString('text','string','',@text,length(text),pchar(dir));
138
Image1.Canvas.TextOut(x_text,y_text,text);
139
end
140
Else
141
Begin //填充畫布
142
Image1.Canvas.Brush.Color:=clWhite;
143
Image1.Canvas.FillRect(Rect(0,0,Image1.width,Image1.height));
144
end;
145
end;
146
end.
