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

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

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

<>0 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.

标签:

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

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

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