|
|
 |
我写的换肤的类.应用于播放器中. |
热 ★★★★ |
|
我写的换肤的类.应用于播放器中. |
|
作者：闵涛 文章来源：闵涛的学习笔记 点击数：2256 更新时间：2009/4/23 18:27:03  |
|
|
//我写的换肤的类,还很不完善.用于我作的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 < 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] [2] [3] 下一页
没有相关教程
|
|
| 教程录入：mintao 责任编辑：mintao |
|
|
上一篇教程： delphi中实现黑标单据的打印（原创）
下一篇教程： 递归法选取树子节点 + 控件拖放 |
|
|
| 【字体：小 大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】 |
|
 注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] |
| 网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！） |
| |
|
|
|
|
|
 |
同类栏目 |
 |
|
赞助链接 |
|
|
500 - 内部服务器错误。
|
|
|
|
|
|
