我写的换肤的类.应用于播放器中.

//我写的换肤的类,还很不完善.用于我作的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;

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;

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;

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 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 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;

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;

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 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;

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;

//设定按钮应显示哪种状态图.

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 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 max then n := max;

Slider.top := n;

FSliderPosition := Trunc((n)/(max-Slider.Height-min)*100);

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;

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;

EndPath(dc);

rgn := PathToRegion(dc);

ReleaseDC(hControl, dc);

Result := rgn;

end;

end.