下面是个构件,
{
-------------------------------------------------------------------------------
SkinForm Component for Delphi 3 and 4
Copyright 1999 FriendSoft All Rights Reserved.
http://friendsoft.yeah.net
This component can be freely used and distributed in commercial and private
products, if you like it, please drop me an e-mail and send your screenshots.
Please feel free to contact me if you have any comments or suggestions.
Author: Xue Huai Qing [xhq@writeme.com]
Some functions come from Jscalco & Eddie Shipman, many thanks to them.
Description:
============
Are you bored by Windows95 UI? Do you wanted to create an application which
has a cool and custom UI just like WPlay and WinAmp?
If so, SkinForm might be the thing that you want. This component can help
you to change the visual appearance of your project and make non-rectangular
windows forms quite easily.
Usage:
======
1.Make the skins of your applications, they are must be in bitmap format.
2.Make a skin file just like the skin file in the demo.The file format is
described in the readme file.
3.Use LoadSkinFile to load a skin file.
4.Add your own code to catch the following events:
OnMouseDownNotify, OnMouseMoveNotify, OnMouseUpNotify
History:
========
1.00 Initial release
------------------------------------------------------------------------------}
unit SkinForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, IniFiles;
type
TMouseDownNotify = Procedure (ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
TMouseUpNotify = Procedure (ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
TMouseMoveNotify = Procedure (ID : string; Shift: TShiftState; X, Y: Integer) of object;
HotAreaInfoRec = record
ID : string;
x, y : integer;
Width, Height : integer;
bLockable, bSwitchOn : Boolean;
end;
THotAreaInfoArray = array of HotAreaInfoRec;
TSkinForm = class(TImage)
private
{ Private declarations }
FMaskBitmap : TBitmap;
FMouseUpBitmap : TBitmap;
FMouseOnBitmap: TBitmap;
FMouseDownBitmap : TBitmap;
FRegion : HRGN;
FKeyColor : TColor;
FTolerance : TColor;
FHotAreaInfoArray : THotAreaInfoArray;
FEnableMouseOnBitmap : Boolean;
FClassID : string;
FOnMouseDownNotify : TMouseDownNotify;
FOnMouseUpNotify : TMouseUpNotify;
FOnMouseMoveNotify : TMouseMoveNotify;
protected
{ Protected declarations }
procedure LoadBitmapFile(var Bitmap : TBitmap; const FileName : string);
procedure LoadBitmapResource(var Bitmap : TBitmap; const ResourceName : string);
procedure SetParent(Value:TWinControl);override;
procedure Refresh;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
public
{ Public declarations }
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure SetKeyColor(KeyColor : TColor);
procedure SetTolerance(Tolerance : TColor);
procedure LoadAllBitmap(FromResource : Boolean; const Mask, MouseUp, MouseDown, MouseOn : string);
procedure LoadSkinFile(const Skin : string);
procedure MouseDownNotify(ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseUpNotify(ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MouseMoveNotify(ID : string; Shift: TShiftState; X, Y: Integer);
function GetHotAreaState(ID : string) : Boolean;
published
{ Published declarations }
property KeyColor : TColor
read FKeyColor
write SetKeyColor;
property Tolerance : TColor
read FTolerance
write SetTolerance;
property OnMouseDownNotify : TMouseDownNotify
read FOnMouseDownNotify
write FOnMouseDownNotify;
property OnMouseUpNotify : TMouseUpNotify
read FOnMouseUpNotify
write FOnMouseUpNotify;
property OnMouseMoveNotify : TMouseMoveNotify
read FOnMouseMoveNotify
write FOnMouseMoveNotify;
end;
function MinByte(B1, B2: byte): byte;
function Bitmap2Region( hBmp: TBitmap; TransColor: TColor; Tolerance: TColor): HRGN;
procedure CommaTextToStrs( AStrs: TStrings; const Value: string ; const AchDelim : Char );
procedure Register;
implementation
constructor TSkinForm.Create(Aowner : TComponent);
begin
inherited Create(Aowner);
FMaskBitmap := TBitmap.Create;
FMouseUpBitmap := TBitmap.Create;
FMouseOnBitmap := TBitmap.Create;
FMouseDownBitmap := TBitmap.Create;
Align := alClient;
FKeyColor := clWhite;
FTolerance := $00000000;
FRegion := 0;
FEnableMouseOnBitmap := TRUE;
end;
destructor TSkinForm.Destroy;
begin
FMaskBitmap.Free;
FMouseUpBitmap.Free;
FMouseOnBitmap.Free;
FMouseDownBitmap.Free;
SetLength(FHotAreaInfoArray, 0);
Inherited Destroy;
end;
procedure TSkinForm.SetParent(Value : TWinControl);
begin
inherited SetParent(Value);
if Value<>nil then
if (Value is TForm) then
TForm(Value).BorderStyle:=bsNone
else
raise Exception.Create('Please Drop on a Form')
end;
procedure TSkinForm.SetKeyColor(KeyColor : TColor);
begin
if FKeyColor <> KeyColor then FKeyColor := KeyColor;
end;
procedure TSkinForm.SetTolerance(Tolerance : TColor);
begin
if FTolerance <> Tolerance then FTolerance := Tolerance;
end;
procedure TSkinForm.LoadBitmapResource(var Bitmap : TBitmap; const ResourceName : string);
begin
Bitmap.LoadFromResourceName(hInstance, ResourceName);
end;
procedure TSkinForm.LoadBitmapFile(var Bitmap : TBitmap; const FileName : string);
begin
Bitmap.LoadFromFile(FileName);
end;
procedure TSkinForm.LoadSkinFile(const Skin : string);
var
SkinFile : TIniFile;
Count, iLoop : integer;
s : string;
Strs : TStringList;
strMask, strMouseUp, strMouseOn, strMouseDown : string;
BitmapPath : string;
begin
Align := alClient;
FRegion := 0;
FEnableMouseOnBitmap := TRUE;
BitmapPath := ExtractFilePath(Skin);
SkinFile := TIniFile.Create(Skin);
strMask := SkinFile.ReadString('BITMAPINFO', 'MaskBitmap', 'ERROR');
strMouseUp := SkinFile.ReadString('BITMAPINFO', 'MouseUpBitmap', strMask);
strMouseDown := SkinFile.ReadString('BITMAPINFO', 'MouseDownBitmap', strMouseUp);
strMouseOn := SkinFile.ReadString('BITMAPINFO', 'MouseOnBitmap', strMouseDown);
if strMouseOn = strMouseDown then FEnableMouseOnBitmap := FALSE;
strMask := BitmapPath + strMask;
strMouseUp := BitmapPath + strMouseUp;
strMouseDown := BitmapPath + strMouseDown;
strMouseOn := BitmapPath + strMouseOn;
Count := SkinFile.ReadInteger('HOTAREAINFO', 'Count', 0);
SetLength(FHotAreaInfoArray, Count);
Strs := TStringList.Create;
LoadAllBitmap(FALSE, strMask, strMouseUp, strMouseDown, strMouseOn);
for iLoop := 1 to Count do
begin
Strs.Clear;
s := SkinFile.ReadString('HOTAREAINFO', IntToStr(iLoop), 'NOT_DEFINED, 0, 0, 0, 0');
CommaTextToStrs(Strs, s, ',');
FHotAreaInfoArray[iLoop-1].ID := Strs.Strings[0];
FHotAreaInfoArray[iLoop-1].x := StrToInt(Strs.Strings[1]);
FHotAreaInfoArray[iLoop-1].y := StrToInt(Strs.Strings[2]);
FHotAreaInfoArray[iLoop-1].Width := StrToInt(Strs.Strings[3]);
FHotAreaInfoArray[iLoop-1].Height := StrToInt(Strs.Strings[4]);
FHotAreaInfoArray[iLoop-1].bLockable := FALSE;
if Strs.Count = 6 then
begin
FHotAreaInfoArray[iLoop-1].bLockable := TRUE;
if Strs.Strings[5] = 'FALSE' then
FHotAreaInfoArray[iLoop-1].bSwitchOn := FALSE
else
FHotAreaInfoArray[iLoop-1].bSwitchOn := TRUE;
end;
end;
Strs.Free;
SkinFile.Free;
end;
procedure TSkinForm.LoadAllBitmap(FromResource : Boolean; const Mask, MouseUp, MouseDown, MouseOn : string);
begin
if (FromResource = TRUE) then
begin
LoadBitmapResource(FMaskBitmap, Mask);
LoadBitmapResource(FMouseUpBitmap, MouseUp);
LoadBitmapResource(FMouseOnBitmap, MouseOn);
LoadBitmapResource(FMouseDownBitmap, MouseDown);
end
else
begin
LoadBitmapFile(FMaskBitmap, Mask);
LoadBitmapFile(FMouseUpBitmap, MouseUp);
LoadBitmapFile(FMouseOnBitmap, MouseOn);
LoadBitmapFile(FMouseDownBitmap, MouseDown);
end;
Parent.Width := FMaskBitmap.Width;
Parent.Height := FMaskBitmap.Height;
Parent.ClientWidth := FMaskBitmap.Width;
Parent.ClientHeight := FMaskBitmap.Height;
Picture := nil;
Width := FMaskBitmap.Width;
Height := FMaskBitmap.Height;
FRegion := Bitmap2Region(FMaskBitmap, FKeyColor, FTolerance);
SetWindowRgn(Parent.Handle, FRegion, TRUE);
Refresh;
end;
procedure TSkinForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i : integer;
bInHotArea : Boolean;
begin
FClassID := '';
bInHotArea := FALSE;
If Button = mbLeft then
begin
for i := 0 to Length(FHotAreaInfoArray) - 1 do
begin
if PtInRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x + FHotAreaInfoArray.Width,
FHotAreaInfoArray.y + FHotAreaInfoArray.Height),
Point(X, Y)) then
begin
Canvas.CopyRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height));
bInHotArea := TRUE;
FClassID := FHotAreaInfoArray.ID;
if FHotAreaInfoArray.bLockable then
begin
FHotAreaInfoArray.bSwitchOn := not FHotAreaInfoArray.bSwitchOn;
if FHotAreaInfoArray.bSwitchOn then
Canvas.CopyRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height))
else
Canvas.CopyRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height),
FMouseUpBitmap.Canvas,
Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height));
end;
break;
end;
end;
end;
If ((Button = mbLeft) and (bInHotArea = FALSE)) then
begin
ReleaseCapture;
TWincontrol (Parent).Perform (WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
end;
MouseDownNotify(FClassID, Button, Shift, X, Y);
end;
procedure TSkinForm.MouseMove(Shift: TShiftState; X, Y: Integer);
var
i : integer;
begin
Refresh;
FClassID := '';
for i := 0 to Length(FHotAreaInfoArray) - 1 do
begin
if PtInRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x + FHotAreaInfoArray.Width,
FHotAreaInfoArray.y + FHotAreaInfoArray.Height),
Point(X, Y)) then
begin
FClassID := FHotAreaInfoArray.ID;
if FEnableMouseOnBitmap = TRUE then
Canvas.CopyRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height),
FMouseOnBitmap.Canvas,
Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height));
break;
end;
end;
MouseMoveNotify(FClassID, Shift, X, Y);
end;
procedure TSkinForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i : integer;
begin
FClassID := '';
for i := 0 to Length(FHotAreaInfoArray) - 1 do
begin
if PtInRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x + FHotAreaInfoArray.Width,
FHotAreaInfoArray.y + FHotAreaInfoArray.Height),
Point(X, Y)) then
begin
FClassID := FHotAreaInfoArray.ID;
break;
end;
end;
Refresh;
MouseUpNotify(FClassID, Button, Shift, X, Y);
end;
procedure TSkinForm.Refresh;
var
i : integer;
begin
Canvas.Draw(0, 0, FMouseUpBitmap);
for i := 0 to Length(FHotAreaInfoArray) - 1 do
begin
if FHotAreaInfoArray.bLockable then
begin
if FHotAreaInfoArray.bSwitchOn then
Canvas.CopyRect(Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray.x, FHotAreaInfoArray.y,
FHotAreaInfoArray.x+FHotAreaInfoArray.Width, FHotAreaInfoArray.y+FHotAreaInfoArray.Height));
end;
end;
end;
procedure TSkinForm.MouseDownNotify(ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if assigned(FOnMouseDownNotify) then FOnMouseDownNotify(ID, Button, Shift, X, Y);
end;
procedure TSkinForm.MouseUpNotify(ID : string; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if assigned(FOnMouseUpNotify) then FOnMouseUpNotify(ID, Button, Shift, X, Y);
end;
procedure TSkinForm.MouseMoveNotify(ID : string; Shift: TShiftState; X, Y: Integer);
begin
if assigned(FOnMouseMoveNotify) then FOnMouseMoveNotify(ID, Shift, X, Y);
end;
function TSkinForm.GetHotAreaState(ID : string) : Boolean;
var
i : integer;
begin
result := FALSE;
for i := 0 to Length(FHotAreaInfoArray) - 1 do
begin
if FHotAreaInfoArray.ID = ID then
begin
result := FHotAreaInfoArray.bSwitchOn;
break;
end;
end;
end;
function MinByte(B1, B2: byte): byte;
begin
if B1 < B2 then
Result := B1
else
Result := B2;
end;
// This function programmed by Eddie Shipman
function Bitmap2Region( hBmp: TBitmap; TransColor: TColor; Tolerance: TColor): HRGN;
const
ALLOC_UNIT = 100;
var
MemDC, DC: HDC;
BitmapInfo: TBitmapInfo;
hbm32, holdBmp, holdMemBmp: HBitmap;
pbits32 : Pointer;
bm32 : BITMAP;
maxRects: DWORD;
hData: HGLOBAL;
pData: PRgnData;
b, LR, LG, LB, HR, HG, HB: Byte;
p32: pByte;
x, x0, y: integer;
p: pLongInt;
pr: PRect;
h: HRGN;
begin
Result := 0;
if hBmp <> nil then
begin
{ Create a memory DC inside which we will scan the bitmap contents }
MemDC := CreateCompatibleDC(0);
if MemDC <> 0 then
begin
{ Create a 32 bits depth bitmap and select it into the memory DC }
with BitmapInfo.bmiHeader do
begin
biSize := sizeof(TBitmapInfoHeader);
biWidth := hBmp.Width;
biHeight := hBmp.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB; { (0) uncompressed format }
biSizeImage := 0;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
hbm32 := CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, pbits32,0, 0);
if hbm32 <> 0 then
begin
holdMemBmp := SelectObject(MemDC, hbm32);
{
Get how many bytes per row we have for the bitmap bits
(rounded up to 32 bits)
}
GetObject(hbm32, SizeOf(bm32), @bm32);
while (bm32.bmWidthBytes mod 4) > 0 do
inc(bm32.bmWidthBytes);
DC := CreateCompatibleDC(MemDC);
{ Copy the bitmap into the memory DC }
holdBmp := SelectObject(DC, hBmp.Handle);
BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 0, 0, SRCCOPY);
{
For better performances, we will use the ExtCreateRegion() function
to create the region. This function take a RGNDATA structure on
entry. We will add rectangles by
amount of ALLOC_UNIT number in this structure
}
maxRects := ALLOC_UNIT;
hData := GlobalAlloc(GMEM_MOVEABLE, sizeof(TRgnDataHeader) +
SizeOf(TRect) * maxRects);
pData := GlobalLock(hData);
pData^.rdh.dwSize := SizeOf(TRgnDataHeader);
pData^.rdh.iType := RDH_RECTANGLES;
pData^.rdh.nCount := 0;
pData^.rdh.nRgnSize := 0;
SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
{ Keep on hand highest and lowest values for the "transparent" pixel }
LR := GetRValue(ColorToRGB(TransColor));
LG := GetGValue(ColorToRGB(TransColor));
LB := GetBValue(ColorToRGB(TransColor));
{ Add the value of the tolerance to the "transparent" pixel value }
HR := MinByte($FF, LR + GetRValue(ColorToRGB(Tolerance)));
HG := MinByte($FF, LG + GetGValue(ColorToRGB(Tolerance)));
HB := MinByte($FF, LB + GetBValue(ColorToRGB(Tolerance)));
{
Scan each bitmap row from bottom to top,
the bitmap is inverted vertically
}
p32 := bm32.bmBits;
inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes);
for y := 0 to hBmp.Height-1 do
begin
{ Scan each bitmap pixel from left to right }
x := -1;
while x+1 < hBmp.Width do
begin
inc(x);
{ Search for a continuous range of "non transparent pixels" }
x0 := x;
p := PLongInt(p32);
inc(PChar(p), x * SizeOf(LongInt));
while x < hBmp.Width do
begin
b := GetBValue(p^); // Changed from GetRValue(p^)
if (b >= LR) and (b <= HR) then
begin
b := GetGValue(p^); // Left alone
if (b >= LG) and (b <= HG) then
begin
b := GetRValue(p^); // Changed from GetBValue(p^)
if (b >= LB) and (b <= hb) then
{ This pixel is "transparent" }
break;
end;
end;
inc(PChar(p), SizeOf(LongInt));
inc(x);
end;
if x > x0 then
begin
{
Add the pixels (x0, y) to (x, y+1) as a new rectangle in
the region
}
if pData^.rdh.nCount >= maxRects then
begin
GlobalUnlock(hData);
inc(maxRects, ALLOC_UNIT);
hData := GlobalReAlloc(hData, SizeOf(TRgnDataHeader) +
SizeOf(TRect) * maxRects, GMEM_MOVEABLE);
pData := GlobalLock(hData);
Assert(pData <> NIL);
end;
pr := @pData^.Buffer[pData^.rdh.nCount * SizeOf(TRect)];
SetRect(pr^, x0, y, x, y+1);
if x0 < pData^.rdh.rcBound.Left then
pData^.rdh.rcBound.Left := x0;
if y < pData^.rdh.rcBound.Top then
pData^.rdh.rcBound.Top := y;
if x > pData^.rdh.rcBound.Right then
pData^.rdh.rcBound.Left := x;
if y+1 > pData^.rdh.rcBound.Bottom then
pData^.rdh.rcBound.Bottom := y+1;
inc(pData^.rdh.nCount);
{
On Windows98, ExtCreateRegion() may fail if the number of
rectangles is too large (ie: > 4000). Therefore, we have to
create the region by multiple steps
}
if pData^.rdh.nCount = 2000 then
begin
h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
(SizeOf(TRect) * maxRects), pData^);
Assert(h <> 0);
if Result <> 0 then
begin
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end else
Result := h;
pData^.rdh.nCount := 0;
SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
end;
end;
end;
{
Go to next row (remember, the bitmap is inverted vertically)
that is why we use DEC!
}
Dec(PChar(p32), bm32.bmWidthBytes);
end;
{ Create or extend the region with the remaining rectangle }
h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
(SizeOf(TRect) * maxRects), pData^);
Assert(h <> 0);
if Result <> 0 then
begin
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end else
Result := h;
{ Clean up }
GlobalFree(hData);
SelectObject(DC, holdBmp);
DeleteDC(DC);
DeleteObject(SelectObject(MemDC, holdMemBmp));
end;
end;
DeleteDC(MemDC);
end;
end;
// This function programmed by jscalco@idealsw.com
procedure CommaTextToStrs( AStrs: TStrings;
const Value: string ;
const AchDelim : Char );
var
P, P1 : PChar;
S : string;
chDelim : char ;
begin
chDelim := AchDelim ;
AStrs.BeginUpdate;
try
AStrs.Clear;
P := PChar(Value);
while P^ in [#1..' '] do
P := CharNext(P);
while P^ <> #0 do
begin
if ( P^ = '"' ) then
S := AnsiExtractQuotedStr(P, '"')
else
begin
P1 := P;
while (P^ > ' ') and ( P^ <> chDelim ) do
P := CharNext(P);
SetString(S, P1, P - P1);
end;
AStrs.Add(S);
while P^ in [#1..' '] do
P := CharNext(P);
if P^ = chDelim then // P^ = ',' then
repeat
P := CharNext(P);
until not (P^ in [#1..' ']);
end; // while
finally
AStrs.EndUpdate;
end;
end;
procedure Register;
begin
RegisterComponents('My Favorites', [TSkinForm]);
end;
end.
----------------------------------
Demo如下
procedure TForm1.FormCreate(Sender: TObject);
begin
//Load a skin file
SkinForm1.LoadSkinFile('./skins/default/skin.ini');
end;
procedure TForm1.SkinForm1MouseUpNotify(ID: String; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pos : TPoint;
begin
if (Button = mbLeft) then
begin
if ID = 'BUTTON_EXIT' then
Close;
if ID = 'BUTTON_MINIMIZE' then
Form1.Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
if ID = 'BUTTON_MENU' then
begin
pos := ClientToScreen(Point(X, Y));
PopupMenu1.Popup(pos.x, pos.y);
end;
if ID = 'BUTTON_REPEAT' then
begin
if SkinForm1.GetHotAreaState(ID) = TRUE then
ShowMessage('Repeat button enabled.')
else
ShowMessage('Repeat button disabled.');
end;
end;
if (Button = mbRight) then
begin
pos := ClientToScreen(Point(X, Y));
PopupMenu1.Popup(pos.x, pos.y);
end;
end;
procedure TForm1.cmExitClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.cmSkinClick(Sender: TObject);
var
SkinsDlg : TOpenDialog;
begin
SkinsDlg := TOpenDialog.Create(self);
SkinsDlg.InitialDir := ExtractFilePath(Application.ExeName) + 'skins';
SkinsDlg.Filter := 'Skin files (*.ini)|*.ini';
if SkinsDlg.Execute then
SkinForm1.LoadSkinFile(SkinsDlg.FileName); //Change the skin
SkinsDlg.Free;
end;
///
skin.ini如下:
[BITMAPINFO]
MaskBitmap=mainmask.bmp
MouseUpBitmap=main.bmp
MouseDownBitmap=selected.bmp
MouseOnBimap=selected.bmp
[HOTAREAINFO]
Count=11
1=BUTTON_PLAY, 29, 249, 26, 18
2=BUTTON_STOP, 92, 246, 28, 20
3=BUTTON_PAUSE, 60, 271, 29, 16
4=BUTTON_PREV, 60, 220, 26, 17
5=BUTTON_NEXT, 60, 237, 28, 17
6=BUTTON_EJECT, 25, 318, 25, 17
7=BUTTON_MINIMIZE, 24, 340, 24, 16
8=BUTTON_EXIT, 101, 68, 19, 25
9=BUTTON_MENU, 31, 215, 27, 23
10=BUTTON_REPEAT, 99, 293, 24, 17, FALSE
11=BUTTON_SHUFFLE, 60, 293, 30, 18, FALSE