换肤功能-- 轻松实现

逍遥派掌门人

以下的代码，在不用换肤控件的情况下，轻松实现换肤的功能：

1.   unit Unit1;
4. {$mode objfpc}{$H+}
7. interface
10. uses
11.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons,
12.   ExtCtrls;
15. type
18.   { TForm1 }
21.   TForm1 = class(TForm)
22.     BitBtn1: TBitBtn;
23.     BitBtn2: TBitBtn;
24.     Image1: TImage;
25.     Image2: TImage;
26.     SpeedButton1: TSpeedButton;
27.     SpeedButton2: TSpeedButton;
28.     SpeedButton3: TSpeedButton;
29.     procedure BitBtn1Click(Sender: TObject);
30.     procedure BitBtn2Click(Sender: TObject);
31.     procedure FormCreate(Sender: TObject);
32.     procedure FormPaint(Sender: TObject);
33.     procedure SpeedButton3Click(Sender: TObject);
34.   private
35.     { private declarations }
36.   public
37.     { public declarations }
38.   end;
41. var
42.   Form1: TForm1;
45. implementation
48. {$R *.lfm}
51. { TForm1 }
54. var
55.   tc1,tc2:Trect;
58.   which_color:byte;
61.   which_status:byte;
64.   color_show:array [1..2,1..2] of Tcolor
65.             =(
66.                (cllime,clyellow),
67.                (claqua,clbtnface)
68.              );
71. procedure TForm1.FormPaint(Sender: TObject);
72. begin
73.   case which_status of
74.    1:
75.      begin
76.        tc1.Left:=0;
77.        tc1.Right:=self.Width;
78.        tc1.Top:=0;
79.        tc1.Bottom:=25;
82.        tc2.Top:=tc1.Bottom;
83.        tc2.Right:=tc1.Right;
84.        tc2.Left:=tc1.Left;
85.        tc2.Bottom:=self.Height;
88.        with self.Canvas do
89.        begin
90.          Brush.Color:=color_show[which_color][1];
91.          FillRect(tc1);
92.          Brush.Color:=color_show[which_color][2];
93.          FillRect(tc2);
94.        end;
95.      end;
96.    2:
97.      begin
98.        case which_color of
99.         1:
100.           begin
101.             image1.Visible:=true;
102.             image2.Visible:=false;
103.           end;
104.         2:
105.           begin
106.             image1.Visible:=false;
107.             image2.Visible:=true;
108.           end;
109.        end;
110.      end;
111.   end;
112. end;
115. procedure TForm1.SpeedButton3Click(Sender: TObject);
116. begin
117.   close;
118. end;
121. procedure TForm1.BitBtn1Click(Sender: TObject);
122. begin
123.   image1.Visible:=false;
124.   image2.Visible:=false;
127.   which_status:=1;
128.   if (which_color=1) then which_color:=2
129.   else which_color:=1;
130.   refresh;
131. end;
134. procedure TForm1.BitBtn2Click(Sender: TObject);
135. begin
136.   which_status:=2;
137.   if (which_color=1) then which_color:=2
138.   else which_color:=1;
139.   refresh;
140. end;
143. procedure TForm1.FormCreate(Sender: TObject);
144. begin
145.   self.BorderStyle:=bsnone;
146. end;
149. end.  

复制代码

效果图：

猫工

优秀文章，支持！n神马都是浮云！

东兰梦舞

社区有你就精彩……

loxer

不错！

zhanggangbz

Lazarus新手学习了

delphies

受教了，可以换多少种皮肤的啊

蓝妍志宇

可以换无限种皮肤的啊

richard9902

受教了，可以换多少种皮肤的啊,但不是很炫哦

逍遥派掌门人

Lazarus的自绘功能，对换肤功能帮助很大，请看：
http://wiki.freepascal.org/Lazarus_Custom_Drawn_Controls