//我写的换肤的类,还很不完善.用于我作的D-FLASHER 中的皮肤更换中.
//单元名称:实现皮肤更换的类:SkinUnit.
//可以实现窗体按钮,滚动条的点击,移动,以及读取滚动条的百分比.
//类还实现了皮肤自定义的设置.
//只要准备了3幅图片,并编写 INI 文件.就可以做到换肤!
//完成日期:2004/12/03 ending722.
unit SkinUnit;
interface
uses Controls, Types, ExtCtrls, SysUtils, StrUtils,
Windows, Messages, Graphics, Forms, Classes, ComCtrls;
//TRAYICON_EVENT=WM_USER+100; //托盘图标消息. in:MainFrm.
Const MYSKIN_BUTTONUP = WM_USER+101; //按钮抬起.
Const MYSKIN_SLIDERPOS = WM_USER+102; //滚动条移动.
Const MYSKIN_RDOWNTEXT = WM_USER+103; //右击文本框
Const MYSKIN_LDOWNTEXT = WM_USER+104; //左击文本框
Const MYSKIN_DOWNBACKRECT = WM_USER+105; //点击背景区域
//Const MYSKIN_CLICKFLIST = WM_USER+106; //双击列表项.
Const MYSKIN_SLIDERMOUSEUP = WM_USER+107; //鼠标从滚动条抬起.
Const MYSKIN_MOVEFORM = WM_USER+111; //移动窗体.
//MYSKIN_CHANGE = WM_USER+108; //换肤消息. in:Option.dll.
//MYSKIN_TIMERENABLED = WM_USER+109; //激活,禁止文本滚动. in:Option.dll.
//MYSKIN_SCROLLTEXTRATE = WM_USER+110;//文本滚动速度. in:Option.dll.
type
TCtrlRec = record //定义按钮.
Ctrl : TImage;
Require : String; //要执行的命令.
end;
TSliderRec = record //定义滚动条
Slider : TImage;
min : Integer; //最小值(防止越界)
max : Integer;
style : String; //水平 , 竖立.
Require : String; //要执行的命令.
end;
TTextRec = record //定义显示框
EText : TImage; //显示区域
Require : String; //要执行的命令.
end;
TSkin = class (TComponent)
private
Frm : TForm; //调用窗体.
MinState : Boolean; //是否最小化.
ScrollTimer : TTimer;
FrmAnySapecolor:TColor; //异型窗体时使用.
//滚动条------------------------------
SliderCount : Integer; //总数.
Sliders : Array of TSliderRec; //用动态数组记录每个 Slider.
Isdown : Boolean; //是否按下一个 Slider.
SliderMousePos : Integer; //鼠标按在 Slider 上的位置(偏移).
FSliderPosition : integer; //Slider 位置(百分比).
//按钮---------------------------------
CtrlCount : Integer;
Ctrls : Array of TCtrlRec;
BackImage : TImage; //窗口的背景图片.
BKGImage : Array [0..2] of TPicture; //存放3张替换图片.
Current : Integer; //记录哪个按钮要还原到 A 图.
//文字---------------------------------
TextCount : Integer;
Texts : Array of TTextRec;
//时钟 -------------------------------
FText1Text : String; //得到 Text1.Text .
FTimerEnabled : Boolean; //用于滚动显示 Text1 的内容.
FTextScrollTimer : Integer;
procedure SetTimerEnabled(const Value: Boolean);
procedure SetTextScrollTimer(const Value: Integer);
procedure TextTimer(Sender: TObject);
//------------------------
function CreateCtrl: Integer; //创建按钮并返回编号.
function CreateSlider: Integer; //创建 slider 并返回编号.
function CreateText: Integer; //创建 text 框并返回编号.
function inCtrl(vIndex, X, Y: Integer): Boolean;
//鼠标是否在按钮上.
function ReadFile(var F: TextFile; var KeyStr, ValStr : String): Boolean;
procedure SetImageIndex(Index: Integer; const Value: Integer);
//设定按钮应显示哪种状态图.
procedure SliderOnMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SliderOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
procedure SliderOnMouseUp(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
//鼠标在 Slider 上.
procedure CtrlOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
procedure CtrlOnMouseUp(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
procedure CtrlOnMouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
//鼠标在 Button 上.
procedure BackOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
//鼠标在背景上右击
procedure ETextOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);//鼠标在文字区域上右击
function CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
public
constructor Create(TFrm:TForm);
destructor Destroy; override;
procedure ClearSkin;
function LoadSkin(vFile : String): Boolean; //载入皮肤.
function ReLoadSkin(vFile : String):Boolean; //转换:Min\Normal.
property ImageIndex[Index : Integer] : Integer write SetImageIndex;
function SliderSeek(Index : Integer; Offset : Real) : Boolean;
//设置 Slider 的位置,Offset 为百分比:1.00-0.00
function SliderPositon(Index : Integer) : integer;
//得到 Slider 的位置:0-100.
function SetText(Index : Integer; str : String) : Boolean;
//设置信息提示框文字.
property TextScrollTimer:Integer read FTextScrollTimer
write SetTextScrollTimer default 200;
property TimerEnabled:Boolean read FTimerEnabled
write SetTimerEnabled default True;
end;
implementation
{ TSkin }
//RGB(255,000,255) to TColor.
function RGBToColor(s:string):TColor;
var ColorString:string;
Red,Green,Blue:string;
begin
if (Length(s)>11) or (Length(s)0 then
s:=copy(s,0,pos(',',s)-1);
Blue:=IntToHex(StrToInt(copy(s,0,length(s))),2);
ColorString:='$00'+Blue+Green+Red;
RGBToColor:=strtoint(ColorString); //StringToColor(ColorString);
end;
procedure TSkin.ClearSkin;
var a : Integer;
begin
for a := 0 to CtrlCount - 1 do Ctrls[a].Ctrl.Free;
for a := 0 to SliderCount - 1 do Sliders[a].Slider.Free;
for a := 0 to TextCount - 1 do Texts[a].EText.Free;
for a := 0 to 2 do BKGImage[a].Graphic := nil;
BackImage.Picture := nil;
end;
constructor TSkin.Create(TFrm:TForm);
var a : Integer;
begin
Frm:=TFrm;
CtrlCount := 0;
SliderCount := 0;
TextCount := 0;
Isdown := false;
MinState := false;
for a := 0 to 2 do BKGImage[a] := TPicture.Create;
BackImage := TImage.Create(nil);
BackImage.Parent := Frm;
BackImage.Align := alClient;
BackImage.OnMouseDown := BackOnMouseDown;
//鼠标在文字区域或背景上右击
ScrollTimer:=TTimer.Create(self);//用于滚动显示 Text1 的内容.
ScrollTimer.Interval:=1000;
SetTimerEnabled(False);
ScrollTimer.OnTimer:=TextTimer;
end;
function TSkin.CreateCtrl: Integer;
begin
Result := CtrlCount;
CtrlCount := CtrlCount + 1;
SetLength(Ctrls, CtrlCount);
with Ctrls[Result] do begin
Ctrl := TImage.Create(nil);
Ctrl.Parent := Frm;
Ctrl.Tag := Result;
Require := '';
Ctrl.OnMouseDown := CtrlOnMouseDown;
Ctrl.OnMouseUp := CtrlOnMouseUp;
Ctrl.OnMouseMove := CtrlOnMouseMove;
end;
end;
function TSkin.CreateSlider: Integer;
begin
Result := SliderCount;
SliderCount := SliderCount + 1;
SetLength(Sliders, SliderCount);
with Sliders[Result] do begin
Slider := TImage.Create(nil);
Slider.Parent := Frm;
Slider.Tag := Result;
Require := '';
min := 0;
max := 0;
Slider.OnMouseDown := SliderOnMouseDown;
Slider.OnMouseUp := SliderOnMouseUp;
Slider.OnMouseMove := SliderOnMouseMove;
end;
end;
function TSkin.CreateText: Integer;
begin
Result := TextCount;
TextCount := TextCount + 1;
SetLength(Texts, TextCount);
with Texts[Result] do begin
EText := TImage.Create(nil);
EText.Parent := Frm;
EText.Tag := Result;
Require := '';
EText.Canvas.Font.Style := [fsBold];
EText.Canvas.Brush.Color:=clwhite;
EText.Transparent:=True; {背景色透明.与: clwhile 异或}
EText.OnMouseDown := ETextOnMouseDown;
end;
end;
destructor TSkin.Destroy;
var a : Integer;
begin
ClearSkin;
BackImage.Free;
for a := 0 to 2 do BKGImage[a].Free;
inherited;
end;
procedure TSkin.SliderOnMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
P : TPoint;
n : Integer;
begin
if Current > -1 then ImageIndex[Current] := 0;
if Sender = BackImage then Exit;
if Isdown then
with Sliders[Current] do
begin
GetCursorPos(P);
ScreenToClient(Frm.Handle,P);
if style='H' then //水平.
begin
n := P.x - SliderMousePos;
// P 转化为窗体客户区坐标,再减去 SliderMousePos.
if n < min then n := min;
if n > max-Slider.Width then n := max - Slider.Width;
Slider.Left := n; //移动图片 防止 P 移出.
n := n-min;
FSliderPosition := Trunc(n/(max-Slider.Width-min)*100);
end else begin
n := P.y - SliderMousePos;
// P 转化为窗体客户区坐标,再减去 SliderMousePos.
if n < min then n := min;
if n > max-Slider.Height then n := max - Slider.Height;
Slider.Top := n; //移动图片 防止 P 移出.
n := n-min;
FSliderPosition := Trunc(n/(max-Slider.Height-min)*100);
end;
SendMessage(Frm.Handle,MYSKIN_SLIDERPOS,
Integer(PChar(Require)),FSliderPosition);
end; //向调用程序发送滚动条当前位置的消息
end;
procedure TSkin.SliderOnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Current := (Sender as TImage).Tag;
Isdown := true; //Mouse is down, Now!
if Sliders[Current].style='H' then //水平.
SliderMousePos := X // Slider 移动以 Slider.left 为基准,所以要计算
else SliderMousePos := Y; // 鼠标点击时的位置所产生的偏移量.
end;
procedure TSkin.SliderOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then Isdown := false;
SendMessage(Frm.Handle,MYSKIN_SLIDERMOUSEUP,
Integer(PChar(Sliders[Current].Require)),FSliderPosition);
Current:=-1;
end;
procedure TSkin.CtrlOnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Current := (Sender as TImage).Tag;
if Button = mbLeft then ImageIndex[Current] := 2;
if (InCtrl(Current, X, Y)) and (Ctrls[Current].Require='#title') then
begin //鼠标进入标题栏,移动窗体.
SendMessage(Frm.Handle,MYSKIN_MOVEFORM,0,0);
end;
end;
procedure TSkin.CtrlOnMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Current > -1 then ImageIndex[Current] := 0;
if Sender = BackImage then Exit;
if inCtrl((Sender as TImage).Tag, X, Y) then begin
SetText(1,(Sender as TImage).Hint); //设置提示.
Current := (Sender as TImage).Tag;
if ssLeft in Shift then ImageIndex[Current] := 2 else ImageIndex[Current] := 1;
end else begin
Current := -1;
ImageIndex[(Sender as TImage).Tag] := 1;
end;
end;
procedure TSkin.CtrlOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then ImageIndex[(Sender as TImage).Tag] := 0;
if InCtrl((Sender as TImage).Tag, X, Y) then
SendMessage(Frm.Handle,MYSKIN_BUTTONUP,
Integer(PChar(Ctrls[(Sender as TImage).Tag].Require)),0);
Current := -1;
end;
//鼠标在背景上点击
procedure TSkin.BackOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
begin
if (Sender = BackImage)then
if (Button = mbLeft) then //左击.
SendMessage(Frm.Handle,MYSKIN_DOWNBACKRECT,1,0)
else
SendMessage(Frm.Handle,MYSKIN_DOWNBACKRECT,2,0);
end;
//鼠标在文字区域上右击
procedure TSkin.ETextOnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
begin
if (Button = mbRight) then
SendMessage(Frm.Handle,MYSKIN_RDOWNTEXT,
Integer(Pchar(Texts[(Sender as TImage).Tag].Require)),0);
if (Button = mbLeft) then
SendMessage(Frm.Handle,MYSKIN_LDOWNTEXT,
Integer(Pchar(Texts[(Sender as TImage).Tag].Require)),0);
end;
//设置 Text1 滚动速度.
procedure TSkin.SetTextScrollTimer(const Value: Integer);
begin
If Value < 50 then FTextScrollTimer := 50
else
FTextScrollTimer := Value;
ScrollTimer.Interval:=FTextScrollTimer;
end;
//禁止/激活 Text1 文字滚动.
procedure TSkin.SetTimerEnabled(const Value: Boolean);
begin
FTimerEnabled := Value;
ScrollTimer.Enabled := FTimerEnabled;
end;
//Timer.OnTimer 事件.
procedure TSkin.TextTimer(Sender: TObject);
var m,s : string;
begin
if length(FText1Text) Min.
begin
StrMin:= vFile+'min\skin.ini'; //得到皮肤路径.
if LoadSkin(StrMin) then //可以转换.
begin
MinState := not MinState;
Result := True;
end else LoadSkin(vFile+'skin.ini');
end else begin //Min -> Normal.
LoadSkin(vFile+'skin.ini');
MinState := not MinState;
Result := True;
end;
for a:=0 to TextCount-1 do Settext(a,t[a]);//重置.
end;
function TSkin.LoadSkin(vFile: String): Boolean;
var
F : TextFile;
vStr, Key, KeyStr, ValStr : String;
a, vIndex, sIndex,eIndex : Integer;
w1:TBitmap;
rgn: HRGN;
begin
Result := False;
if not FileExists(vFile) then Exit;
ClearSkin;
AssignFile(F, vFile);
Key := '';
vIndex := -1; sIndex := -1; eIndex:=-1;
try
Reset(F);
while not EOF(F) do begin
if ReadFile(F, KeyStr, ValStr) then
begin
Key := LowerCase(Trim(KeyStr));
if Key='button' then vIndex := CreateCtrl;
if Key='slider' then sIndex := CreateSlider;
if Key='text' then eIndex := CreateText;
Continue;
end;
KeyStr := Trim(LowerCase(KeyStr));
if (Key = 'frm') then
begin
if KeyStr = 'width' then frm.Width := StrToIntDef(ValStr, 0);
if KeyStr = 'height'then frm.height := StrToIntDef(ValStr, 0);
if KeyStr = 'frmanysapecolor' then FrmAnySapeColor:=RGBtoColor(ValStr);
end; {窗体使用异型样式.}
if (Key = 'button') then begin
if vIndex = -1 then Continue;
if KeyStr = 'left' then Ctrls[vIndex].Ctrl.Left := StrToIntDef(ValStr, 0);
if KeyStr = 'top' then Ctrls[vIndex].Ctrl.Top := StrToIntDef(ValStr, 0);
if KeyStr = 'width' then Ctrls[vIndex].Ctrl.Width := StrToIntDef(ValStr, 0);
if KeyStr = 'height' then Ctrls[vIndex].Ctrl.Height := StrToIntDef(ValStr, 0);
if KeyStr = 'hint' then Ctrls[vIndex].Ctrl.Hint := ValStr;
if KeyStr = 'require' then Ctrls[vIndex].Require := ValStr;
end;
if (Key = 'slider') then begin
if sIndex = -1 then Continue;
if KeyStr = 'left' then sliders[sIndex].Slider.Left := StrToIntDef(ValStr, 0);
if KeyStr = 'top' then sliders[sIndex].Slider.Top := StrToIntDef(ValStr, 0);
if KeyStr = 'width' then sliders[sIndex].Slider.Width := StrToIntDef(ValStr, 0);
if KeyStr = 'height' then sliders[sIndex].Slider.Height := StrToIntDef(ValStr, 0);
if KeyStr = 'min' then sliders[sIndex].min := StrToIntDef(ValStr, 0);
if KeyStr = 'max' then sliders[sIndex].max := StrToIntDef(ValStr, 0);
if KeyStr = 'style' then sliders[sIndex].Style := ValStr;
if KeyStr = 'hint' then sliders[sIndex].Slider.Hint := ValStr;
if KeyStr = 'require' then sliders[sIndex].Require := ValStr;
end;
if (Key = 'text') then begin
if eIndex = -1 then Continue;
if KeyStr = 'left' then Texts[eIndex].EText.Left := StrToIntDef(ValStr, 0);
if KeyStr = 'top' then Texts[eIndex].EText.Top := StrToIntDef(ValStr, 0);
if KeyStr = 'width' then Texts[eIndex].EText.Width := StrToIntDef(ValStr, 0);
if KeyStr = 'height' then Texts[eIndex].EText.Height := StrToIntDef(ValStr, 0);
if KeyStr = 'fcolor' then Texts[eIndex].EText.Canvas.Font.Color := RGBtoColor(ValStr);
if KeyStr = 'fheight' then Texts[eIndex].EText.Canvas.Font.Height := StrToIntDef(ValStr, 0);
if KeyStr = 'fname' then Texts[eIndex].EText.Canvas.Font.Name := ValStr;
if KeyStr = 'hint' then Texts[eIndex].EText.Hint := ValStr;
if KeyStr = 'require' then Texts[eIndex].Require := ValStr;
end;
end;
CloseFile(F);
except
Exit;
end;
try
vStr := ExtractFilePath(vFile);
BKGImage[0].LoadFromFile(vStr + 'normal.bmp');
BKGImage[1].LoadFromFile(vStr + 'enter.bmp');
BKGImage[2].LoadFromFile(vStr + 'click.bmp');
BackImage.Picture := BKGImage[0];
{实现异型窗体.}
w1:=TBitmap.Create;
w1.Assign(BackImage.Picture.Bitmap);
rgn := CreateRegion(w1,FrmAnySapeColor,frm.Handle);
if rgn0 then SetWindowRgn(frm.Handle, rgn, true);
w1.Free; {令窗体区域外颜色设置为:TransparentColorValue 即可.}
except {即便是矩形窗口也要执行,好将上一skin还原回矩形样式.}
Exit;
end;
//加载 Button 图片.
for a := 0 to CtrlCount - 1 do ImageIndex[a] := 0;
for a := 0 to SliderCount - 1 do //滚动条.
begin
Sliders[a].Slider.Canvas.CopyRect(Sliders[a].Slider.ClientRect,
BKGImage[1].Bitmap.Canvas,Rect(Sliders[a].Slider.Left, Sliders[a].Slider.Top,
Sliders[a].Slider.Left+Sliders[a].Slider.Width, Sliders[a].Slider.Top+Sliders[a].Slider.Height));
end;
//文字框初始化.
for a := 0 to textCount - 1 do SetText(a,Texts[a].EText.Hint);
Result := True;
end;
function TSkin.ReadFile(var F: TextFile; var KeyStr,
ValStr: String): Boolean;
var vStr : String;
a : Integer;
begin
Readln(F, vStr);
KeyStr := '';
ValStr := '';
Result := False;
vStr := Trim(vStr);
if vStr '' then begin
if (Copy(vStr, 1, 2) = '//') then exit;//注释文本.
if (Copy(vStr, 1, 1) = '[') and (Copy(vStr, Length(vStr), 1) = ']') then begin
Result := True;
KeyStr := Copy(vStr, 2, Length(vStr) - 2);
Exit;
end;
a := Pos('=', vStr);
if a > 0 then begin
KeyStr := UpperCase(Trim(Copy(vStr, 1, a - 1)));
ValStr := Trim(Copy(vStr, a + 1, Length(vStr)));
end;
end;
end;
//设定按钮应显示哪种状态图.
procedure TSkin.SetImageIndex(Index: Integer; const Value: Integer);
begin
Ctrls[Index].Ctrl.Canvas.CopyRect(Ctrls[Index].Ctrl.ClientRect,
BKGImage[Value].Bitmap.Canvas, Rect(Ctrls[Index].Ctrl.Left, Ctrls[Index].Ctrl.Top,
Ctrls[Index].Ctrl.Left + Ctrls[Index].Ctrl.Width, Ctrls[Index].Ctrl.Top + Ctrls[Index].Ctrl.Height));
end;
//设置 Slider 的位置.
function TSkin.SliderSeek(Index : Integer;Offset : Real) : Boolean;
var n : Integer;
begin //Offset 为百分比:1.00-0.00
Result :=False;
if (Index >= SliderCount) then exit;
with Sliders[Index] do
begin
if style='H' then begin //水平
n := Trunc(Offset*(max-Slider.Width-min))+min;
if n < min then n := min;
if n > max then n := max;
Slider.Left := n;
FSliderPosition := Trunc((n)/(max-Slider.Width-min)*100);
end else begin //
n := Trunc(Offset*(max-Slider.Height-min))+min;
if n < min then n := min;
if n > max then n := max;
Slider.top := n;
FSliderPosition := Trunc((n)/(max-Slider.Height-min)*100);
end;
end;
Result := True;
end;
//得到 Slider 的位置.
function TSkin.SliderPositon(Index : Integer) : Integer;
begin
Result := 0;
if (Index > SliderCount) then exit;
with Sliders[Index] do
if style='H' then
FSliderPosition := Trunc((Slider.Left-min)/(max-Slider.Width-min)*100)
else
FSliderPosition := Trunc((Slider.top-min)/(max-Slider.height-min)*100);
Result := FSliderPosition;
end;
//设置文本显示.
function TSkin.SetText(Index : Integer; Str : String) : Boolean;
begin
Result := False;
if (Index >= TextCount) then Exit;
Texts[Index].EText.Hint:=Str; //暂存当前文字.
with Texts[Index].EText.Canvas do
TextRect(ClipRect,0,0,Str);
if Index=0 then FText1Text := Str;
//得到 Text1.text 的文本,由于滚动显示.
Result := True; //刷新时有闪烁现象出现 !!!
end;
{实现异型窗体.}
function TSkin.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
dc, dc_c: HDC;
rgn: HRGN;
x, y: integer;
coord: TPoint;
line: boolean;
color: TColor;
begin
dc := GetWindowDC(hControl);
dc_c := CreateCompatibleDC(dc);
SelectObject(dc_c, wMask.Handle);
BeginPath(dc);
for x:=0 to wMask.Width-1 do
begin
line := false;
for y:=0 to wMask.Height-1 do
begin
color := GetPixel(dc_c, x, y);
if not (color = wColor) then
begin
if not line then
begin
line := true;
coord.x := x;
coord.y := y;
end;
end;
if (color = wColor) or (y=wMask.Height-1) then
begin
if line then
begin
line := false;
MoveToEx(dc, coord.x, coord.y, nil);
LineTo(dc, coord.x, y);
LineTo(dc, coord.x + 1, y);
LineTo(dc, coord.x + 1, coord.y);
CloseFigure(dc);
end;
end;
end;
end;
EndPath(dc);
rgn := PathToRegion(dc);
ReleaseDC(hControl, dc);
Result := rgn;
end;
end.
本文地址：http://com.8s8s.com/it/it4232.htm