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

2008-04-10 02:56:34来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

//我写的换肤的类,还很不完善.用于我作的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)<5) then begin RGBToColor:=StringToColor(''''$00FF0000''''); exit; end; Red:=IntToHex(StrToInt(copy(s,0,pos('''','''',s)-1)),2); s:=copy(s,pos('''','''',s) 1,length(s)-1); Green:=IntToHex(StrToInt(copy(s,0,pos('''','''',s)-1)),2); s:=copy(s,pos('''','''',s) 1,length(s)-1); if pos('''','''',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

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:通用查询组件设计

下一篇:P2P 之 UDP穿透NAT的原理与实现