发信人: delfan(你不疼我谁疼我)
整理人: teleme(2001-06-07 09:08:14), 站内信件
|
发信人：delfan
整理：Kingron
{
-------------------------------------------------------------------------------
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 [[email protected]]
Some functions come from Jscalco & Eddie Shipman, many thanks to them.
Thanks to Andre Inghillieri for his suggestions and improvements.
Thanks to Konrad Swart for his .dcr file.
Thanks to all people who give me a lot of encouragement and suggestions.
Description:
============
Are you bored by Windows95 UI? Do you want to create an application which
has a cool and changeable 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
1.01 Clean the code and make it compatible with Delphi 3
1.10 Add functions to manage the information of dispaly area
Reduce the action of refresh
Add an OnSkinChanged event
Many thanks to Andre Inghillieri for his suggestions and improvements
1.20 Add support of trackbar
Fixed bugs of displaying text
Reduce the blinking time
------------------------------------------------------------------------------}
unit SkinForm;
//if you use Delphi 3, please add "{$DEFINE DELPHI3}" as a new line
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, IniFiles, StdCtrls;
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;
DisplayInfoRec = record
ID : string;
x, y :integer;
Font : TFont;
Text : string;
end;
TrackBarInfoRec = record
ID : string;
UpBitmap, DownBitmap : TBitmap;
x, y, Length : integer;
Direction : Boolean;
Position : 0..100;
end;
{$IFDEF DELPHI3}
BITMAP = record
bmType : longint;
bmWidth : longint;
bmHeight : longint;
bmWidthBytes : longint;
bmPlanes : WORD;
bmBitsPixel : WORD;
bmBits : pointer;
end;
THotAreaInfoArray = array [0..127] of HotAreaInfoRec;
TDisplayInfoArray = array [0..63] of DisplayInfoRec;
TTrackBarInfoArray = array [0..7] of TrackBarInfoRec;
{$ELSE}
THotAreaInfoArray = array of HotAreaInfoRec;
TDisplayInfoArray = array of DisplayInfoRec;
TTrackBarInfoArray = array of TrackBarInfoRec;
{$ENDIF}
TSkinForm = class(TImage)
private
{ Private declarations }
FMaskBitmap : TBitmap;
FMouseUpBitmap : TBitmap;
FMouseOnBitmap: TBitmap;
FMouseDownBitmap : TBitmap;
FRegion : HRGN;
FKeyColor : TColor;
FTolerance : TColor;
FHotAreaInfoArray : THotAreaInfoArray;
FDisplayInfoArray : TDisplayInfoArray;
FTrackBarInfoArray : TTrackBarInfoArray;
FEnableMouseOnBitmap : Boolean;
FClassID : string;
FCharset : TFontCharset;
FbNeedRedraw : Boolean;
FbLastState, FbThisState : Boolean;
FOnMouseDownNotify : TMouseDownNotify;
FOnMouseUpNotify : TMouseUpNotify;
FOnMouseMoveNotify : TMouseMoveNotify;
FOnSkinChanged : TNotifyEvent;
{$IFDEF DELPHI3}
FHotAreaCount : integer;
FDisplayCount : integer;
FTrackBarCount : integer;
{$ENDIF}
bInHotArea : Boolean;
bDragTrackBar : Boolean;
iDragTrackBar : integer;
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 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);
procedure Refresh;
function GetHotAreaState(ID : string) : Boolean;
procedure SetCharset(Charset : TFontCharset);
procedure SetDisplayText(ID : string; Text : string);
function GetTrackBarPos(ID : string) : integer;
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;
property OnSkinChanged :TNotifyEvent
read FOnSkinChanged
write FOnSkinChanged;
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;
FCharset := DEFAULT_CHARSET;
FbNeedRedraw := TRUE;
end;
destructor TSkinForm.Destroy;
var
i : integer;
begin
FMaskBitmap.Free;
FMouseUpBitmap.Free;
FMouseOnBitmap.Free;
FMouseDownBitmap.Free;
{$IFDEF DELPHI3}
for i := 0 to FTrackBarCount - 1 do
{$ELSE}
for i := 0 to Length(FTrackBarInfoArray) - 1 do
{$ENDIF}
begin
FTrackBarInfoArray[i].UpBitmap.Free;
FTrackBarInfoArray[i].DownBitmap.Free;
end;
{$IFDEF DELPHI3}
for i := 0 to FDisplayCount - 1 do
{$ELSE}
for i := 0 to Length(FDisplayInfoArray) - 1 do
{$ENDIF}
begin
FDisplayInfoArray[i].Font.Free;
end;
{$IFNDEF DELPHI3}
SetLength(FHotAreaInfoArray, 0);
SetLength(FDisplayInfoArray, 0);
SetLEngth(FTrackBarInfoArray, 0);
{$ENDIF}
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);
{$IFDEF DELPHI3}
FHotAreaCount := Count;
{$ELSE}
SetLength(FHotAreaInfoArray, Count);
{$ENDIF}
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;
/////////////////
Count := SkinFile.ReadInteger('DISPLAYINFO', 'Count', 0);
FCharset := SkinFile.ReadInteger('DISPLAYINFO', 'Charset', DEFAULT_CHARSET);
{$IFDEF DELPHI3}
FDisplayCount := Count;
{$ELSE}
SetLength(FDisplayInfoArray, Count);
{$ENDIF}
for iLoop := 1 to Count do
begin
Strs.Clear;
s := SkinFile.ReadString('DISPLAYINFO', IntToStr(iLoop), 'NOT_DEFINED, Arial,
FALSE, FALSE, 0, clBlack, 0, 0, EMPTY');
CommaTextToStrs(Strs, s, ',');
FDisplayInfoArray[iLoop-1].ID := Strs.Strings[0];
if FDisplayInfoArray[iLoop-1].Font <> nil then
FDisplayInfoArray[iLoop-1].Font.Free;
FDisplayInfoArray[iLoop-1].Font := TFont.Create;
with FDisplayInfoArray[iLoop-1] do
begin
Font.Charset := FCharset;
Font.Name := Strs.Strings[1];
Font.Style := [];
if Strs.Strings[2] = 'TRUE' then
Font.Style := Font.Style + [fsBold];
if Strs.Strings[3] = 'TRUE' then
Font.Style := Font.Style + [fsItalic];
Font.Size := StrToInt(Strs.Strings[4]);
Font.Color := StrToInt(Strs.Strings[5]);
x := StrToInt(Strs.Strings[6]);
y := StrToInt(Strs.Strings[7]);
if Strs.Count = 9 then
Text := Strs.Strings[8]
else
Text := '';
end;
end;
///////////////
Count := SkinFile.ReadInteger('TRACKBARINFO', 'Count', 0);
{$IFDEF DELPHI3}
FTrackBarCount := Count;
{$ELSE}
SetLength(FTrackBarInfoArray, Count);
{$ENDIF}
for iLoop := 1 to Count do
begin
Strs.Clear;
s := SkinFile.ReadString('TRACKBARINFO', IntToStr(iLoop), 'NOT_DEFINED,
NOT_DEFINED, NOT_DEFINED, 0, 0, 0, H');
CommaTextToStrs(Strs, s, ',');
FTrackBarInfoArray[iLoop-1].ID := Strs.Strings[0];
if FTrackBarInfoArray[iLoop-1].UpBitmap <> nil then
FTrackBarInfoArray[iLoop-1].UpBitmap.Free;
FTrackBarInfoArray[iLoop-1].UpBitmap := TBitmap.Create;
FTrackBarInfoArray[iLoop-1].UpBitmap.LoadFromFile(BitmapPath + Strs.Strings[1]);
if FTrackBarInfoArray[iLoop-1].DownBitmap <> nil then
FTrackBarInfoArray[iLoop-1].DownBitmap.Free;
FTrackBarInfoArray[iLoop-1].DownBitmap := TBitmap.Create;
FTrackBarInfoArray[iLoop-1].DownBitmap.LoadFromFile(BitmapPath + Strs.Strings[2]);
FTrackBarInfoArray[iLoop-1].x := StrToInt(Strs.Strings[3]);
FTrackBarInfoArray[iLoop-1].y := StrToInt(Strs.Strings[4]);
FTrackBarInfoArray[iLoop-1].Length := StrToInt(Strs.Strings[5]) -
FTrackBarInfoArray[iLoop-1].UpBitmap.Width;
if Strs.Strings[6] = 'V' then
FTrackBarInfoArray[iLoop-1].Direction := FALSE
else
FTrackBarInfoArray[iLoop-1].Direction := TRUE;
if Strs.Count = 8 then
FTrackBarInfoArray[iLoop-1].Position := StrToInt(Strs.Strings[7])
else
FTrackBarInfoArray[iLoop-1].Position := 0;
end;
Strs.Free;
SkinFile.Free;
Refresh;
if Assigned(FOnSkinChanged) then FOnSkinChanged(Self);
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;
begin
FClassID := '';
bInHotArea := FALSE;
bDragTrackBar := FALSE;
iDragTrackBar := -1;
If Button = mbLeft then
begin
{$IFDEF DELPHI3}
for i := 0 to FHotAreaCount - 1 do
{$ELSE}
for i := 0 to Length(FHotAreaInfoArray) - 1 do
{$ENDIF}
begin
if PtInRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x + FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y + FHotAreaInfoArray[i].Height),
Point(X, Y)) then
begin
Canvas.CopyRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height));
bInHotArea := TRUE;
FClassID := FHotAreaInfoArray[i].ID;
if FHotAreaInfoArray[i].bLockable then
begin
FHotAreaInfoArray[i].bSwitchOn := not FHotAreaInfoArray[i].bSwitchOn;
if FHotAreaInfoArray[i].bSwitchOn then
Canvas.CopyRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height))
else
Canvas.CopyRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height),
FMouseUpBitmap.Canvas,
Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height));
end;
break;
end;
end;
///////////////
{$IFDEF DELPHI3}
for i := 0 to FTrackBarCount - 1 do
{$ELSE}
for i := 0 to Length(FTrackBarInfoArray) - 1 do
{$ENDIF}
begin
if PtInRect(Rect(FTrackBarInfoArray[i].x + (FTrackBarInfoArray[i].Length *
FTrackBarInfoArray[i].Position) div 100,
FTrackBarInfoArray[i].y,
FTrackBarInfoArray[i].x + ((FTrackBarInfoArray[i].Length *
FTrackBarInfoArray[i].Position) div 100) + FTrackBarInfoArray[i].UpBitmap.Width,
FTrackBarInfoArray[i].y +
FTrackBarInfoArray[i].UpBitmap.Height),
Point(X, Y)) then
begin
FClassID := FTrackBarInfoArray[i].ID;
bDragTrackBar := TRUE;
iDragTrackBar := i;
break;
end;
end;
end;
If ((Button = mbLeft) and (bInHotArea = FALSE) and (bDragTrackBar = 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
if FbNeedRedraw then Refresh;
FbLastState := FbThisState;
FClassID := '';
if bDragTrackBar = TRUE then
begin
{$IFDEF DELPHI3}
for i := 0 to FTrackBarCount - 1 do
{$ELSE}
for i := 0 to Length(FTrackBarInfoArray) - 1 do
{$ENDIF}
begin
if PtInRect(Rect(FTrackBarInfoArray[i].x,FTrackBarInfoArray[i].y,
FTrackBarInfoArray[i].x + FTrackBarInfoArray[i].Length,
FTrackBarInfoArray[i].y +
FTrackBarInfoArray[i].UpBitmap.Height),
Point(X, Y)) then
begin
if iDragTrackBar = i then
begin
FClassID := FTrackBarInfoArray[i].ID;
FTrackBarInfoArray[i].Position :=
Trunc(100*(X-FTrackBarInfoArray[i].x)/FTrackBarInfoArray[i].Length);
Refresh;
end;
end;
end;
end;
{$IFDEF DELPHI3}
for i := 0 to FHotAreaCount - 1 do
{$ELSE}
for i := 0 to Length(FHotAreaInfoArray) - 1 do
{$ENDIF}
begin
if PtInRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x + FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y + FHotAreaInfoArray[i].Height),
Point(X, Y)) then
begin
FbThisState := TRUE;
FClassID := FHotAreaInfoArray[i].ID;
if FEnableMouseOnBitmap = TRUE then
Canvas.CopyRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height),
FMouseOnBitmap.Canvas,
Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height));
break;
end;
FbThisState := FALSE;
end;
if FbLastState <> FbThisState then FbNeedRedraw := TRUE;
MouseMoveNotify(FClassID, Shift, X, Y);
end;
procedure TSkinForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i : integer;
begin
FClassID := '';
bDragTrackBar := FALSE;
iDragTrackBar := -1;
{$IFDEF DELPHI3}
for i := 0 to FHotAreaCount - 1 do
{$ELSE}
for i := 0 to Length(FHotAreaInfoArray) - 1 do
{$ENDIF}
begin
if PtInRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x + FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y + FHotAreaInfoArray[i].Height),
Point(X, Y)) then
begin
FClassID := FHotAreaInfoArray[i].ID;
break;
end;
end;
Refresh;
MouseUpNotify(FClassID, Button, Shift, X, Y);
end;
procedure TSkinForm.Refresh;
var
i, old: integer;
Offset : integer;
begin
Canvas.Draw(0, 0, FMouseUpBitmap);
{$IFDEF DELPHI3}
for i := 0 to FHotAreaCount - 1 do
{$ELSE}
for i := 0 to Length(FHotAreaInfoArray) - 1 do
{$ENDIF}
begin
if FHotAreaInfoArray[i].bLockable then
begin
if FHotAreaInfoArray[i].bSwitchOn then
Canvas.CopyRect(Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height),
FMouseDownBitmap.Canvas,
Rect(FHotAreaInfoArray[i].x, FHotAreaInfoArray[i].y,
FHotAreaInfoArray[i].x+FHotAreaInfoArray[i].Width,
FHotAreaInfoArray[i].y+FHotAreaInfoArray[i].Height));
end;
end;
{$IFDEF DELPHI3}
for i := 0 to FTrackBarCount - 1 do
{$ELSE}
for i := 0 to Length(FTrackBarInfoArray) - 1 do
{$ENDIF}
begin
Offset := FTrackBarInfoArray[i].Position * FTrackBarInfoArray[i].Length div 100;
if i = iDragTrackBar then
Canvas.Draw(FTrackBarInfoArray[i].x + Offset, FTrackBarInfoArray[i].y,
FTrackBarInfoArray[i].DownBitmap)
else
Canvas.Draw(FTrackBarInfoArray[i].x + Offset, FTrackBarInfoArray[i].y,
FTrackBarInfoArray[i].UpBitmap);
end;
{$IFDEF DELPHI3}
for i := 0 to FDisplayCount - 1 do
{$ELSE}
for i := 0 to Length(FDisplayInfoArray) - 1 do
{$ENDIF}
begin
old := GetBkMode(Canvas.Handle);
SetBkMode(Canvas.Handle,1);
Canvas.Font.Assign(FDisplayInfoArray[i].Font);
Canvas.Textout(FDisplayInfoArray[i].x, FDisplayInfoArray[i].y,
FDisplayInfoArray[i].Text);
SetBkMode(Canvas.Handle,old);
end;
FbNeedRedraw := FALSE;
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;
{$IFDEF DELPHI3}
for i := 0 to FHotAreaCount - 1 do
{$ELSE}
for i := 0 to Length(FHotAreaInfoArray) - 1 do
{$ENDIF}
begin
if FHotAreaInfoArray[i].ID = ID then
begin
result := FHotAreaInfoArray[i].bSwitchOn;
break;
end;
end;
end;
procedure TSkinForm.SetDisplayText(ID : string; Text : string);
var
i : integer;
begin
{$IFDEF DELPHI3}
for i := 0 to FDisplayCount - 1 do
{$ELSE}
for i := 0 to Length(FDisplayInfoArray) - 1 do
{$ENDIF}
begin
if FDisplayInfoArray[i].ID = ID then
begin
FDisplayInfoArray[i].Text := Text;
break;
end;
end;
Refresh;
end;
procedure TSkinForm.SetCharset(Charset : TFontCharset);
var
i : integer;
begin
FCharset := Charset;
{$IFDEF DELPHI3}
for i := 0 to FDisplayCount - 1 do
{$ELSE}
for i := 0 to Length(FDisplayInfoArray) - 1 do
{$ENDIF}
begin
FDisplayInfoArray[i].Font.Charset := Charset;
end;
Refresh;
end;
function TSkinForm.GetTrackBarPos(ID : string) : integer;
var
i : integer;
begin
result := 0;
{$IFDEF DELPHI3}
for i := 0 to FTrackBarCount - 1 do
{$ELSE}
for i := 0 to Length(FTrackBarInfoArray) - 1 do
{$ENDIF}
begin
if FTrackBarInfoArray[i].ID = ID then
begin
result := FTrackBarInfoArray[i].Position;
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 [email protected]
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.
|
|