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

类别:Delphi 点击:0 评论:0 推荐:
//我写的换肤的类,还很不完善.用于我作的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