?? bsskinmenus.pas
字號:
begin
SpecRect := GetAnimationFrameRect;
CreateItemImage(B, AD, True);
end
else
if not EnableMorphing or
((AD and (MorphKf = 1)) or (not AD and (MorphKf = 0)))
then
CreateItemImage(B, AD, False)
else
begin
CreateItemImage(B, False, False);
AB := TBitMap.Create;
CreateItemImage(AB, True, False);
EffB := TbsEffectBmp.CreateFromhWnd(B.Handle);
EffAB := TbsEffectBmp.CreateFromhWnd(AB.Handle);
case MI.MorphKind of
mkDefault: EffB.Morph(EffAB, MorphKf);
mkGradient: EffB.MorphGrad(EffAB, MorphKf);
mkLeftGradient: EffB.MorphLeftGrad(EffAB, MorphKf);
mkRightGradient: EffB.MorphRightGrad(EffAB, MorphKf);
mkLeftSlide: EffB.MorphLeftSlide(EffAB, MorphKf);
mkRightSlide: EffB.MorphRightSlide(EffAB, MorphKf);
mkPush: EffB.MorphPush(EffAB, MorphKf);
end;
EffB.Draw(B.Canvas.Handle, 0, 0);
AB.Free;
EffB.Free;
EffAB.Free;
end;
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, B);
B.Free;
end;
//================TbsSkinPopupWindow======================//
constructor TbsSkinPopupWindow.CreateEx;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
ParentMenu := AParentMenu;
FPaintBuffer := nil;
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
ItemList := TList.Create;
MouseTimer := TTimer.Create(Self);
MouseTimer.Enabled := False;
MouseTimer.OnTimer := TestMouse;
MouseTimer.Interval := MouseTimerInterval;
MorphTimer := TTimer.Create(Self);
MorphTimer.Enabled := False;
MorphTimer.OnTimer := TestMorph;
MorphTimer.Interval := MorphTimerInterval;
FRgn := 0;
WindowPicture := nil;
MaskPicture := nil;
if (AData = nil) or (AData.WindowPictureIndex = -1)
then
begin
PW := nil;
SD := nil;
end
else
begin
PW := AData;
SD := ParentMenu.SkinData;
with PW do
begin
if (WindowPictureIndex <> - 1) and
(WindowPictureIndex < SD.FActivePictures.Count)
then
WindowPicture := SD.FActivePictures.Items[WindowPictureIndex];
if (MaskPictureIndex <> - 1) and
(MaskPictureIndex < SD.FActivePictures.Count)
then
MaskPicture := SD.FActivePictures.Items[MaskPictureIndex];
end;
end;
ActiveItem := -1;
OldActiveItem := -1;
OMX := -1;
OMY := -1;
DSMI := nil;
ScrollCode := 0;
Scroll2 := False;
end;
destructor TbsSkinPopupWindow.Destroy;
var
i: Integer;
begin
for i := 0 to ItemList.Count - 1 do
TbsSkinMenuItem(ItemList.Items[i]).Free;
ItemList.Clear;
ItemList.Free;
MouseTimer.Free;
MorphTimer.Free;
if FPaintBuffer <> nil then FPaintBuffer.Free;
inherited Destroy;
if FRgn <> 0 then DeleteObject(FRgn);
end;
procedure TbsSkinPopupWindow.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
if PW = nil then Exit;
StopMorph := True;
for i := 0 to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if EnableMorphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end
else
if EnableAnimation
then
begin
if Active and (CurrentFrame <= MI.FrameCount)
then
begin
Inc(CurrentFrame);
Draw(Canvas);
StopMorph := False;
end
else
if not Active and (CurrentFrame > 0)
then
begin
Dec(CurrentFrame);
Draw(Canvas);
StopMorph := False;
end;
end;
end;
if StopMorph then MorphTimer.Enabled := False;
end;
function TbsSkinPopupWindow.CanScroll;
begin
Result := False;
case AScrollCode of
1: Result := VisibleStartIndex > 0;
2: Result := VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1;
end;
end;
procedure TbsSkinPopupWindow.WMTimer;
begin
inherited;
case ScrollCode of
1: if CanScroll(1) then ScrollUp(False) else StopScroll;
2: if CanScroll(2) then ScrollDown(False) else StopScroll;
end;
end;
procedure TbsSkinPopupWindow.DrawScrollArea(Cnvs: TCanvas; R: TRect);
var
Buffer, Buffer2: TBitMap;
MI: TbsDataSkinMenuItem;
I: Integer;
ActivePicture: TBitMap;
begin
I := SD.GetIndex('menuitem');
if I = -1 then SD.GetIndex('MENUITEM');
if I = -1 then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R);
Buffer.Height := RectHeight(R);
MI := TbsDataSkinMenuItem(SD.ObjectList[I]);
ActivePicture := TBitMap(SD.FActivePictures.Items[MI.ActivePictureIndex]);
if DSMI.InActiveTransparent and (FPaintBuffer <> nil)
then
begin
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
FPaintBuffer.Canvas, R);
end
else
CreateHSkinImage(MI.ItemLO, MI.ItemRO,
Buffer, ActivePicture, MI.SkinRect,
RectWidth(R), RectHeight(MI.SkinRect), MI.InActiveStretchEffect);
Buffer.Height := RectHeight(R);
Cnvs.Draw(R.Left, R.Top, Buffer);
Buffer.Free;
end;
procedure TbsSkinPopupWindow.DrawUpMarker;
var
R: TRect;
C: TColor;
begin
if PW <> nil
then
begin
R := Rect(NewItemsRect.Left, NewItemsRect.Top,
NewItemsRect.Right, NewItemsRect.Top + MarkerItemHeight);
if ScrollCode = 1
then C := PW.ScrollMarkerActiveColor
else C := PW.ScrollMarkerColor;
end
else
begin
R := Rect(3, 3, Width - 3, 3 + MarkerItemHeight);
if ScrollCode = 1
then C := clBtnText
else C := clBtnShadow;
end;
if PW <> nil then DrawScrollArea(Cnvs, R);
DrawArrowImage(Cnvs, R, C, 3);
end;
procedure TbsSkinPopupWindow.DrawDownMarker;
var
R: TRect;
C: TColor;
begin
if PW <> nil
then
begin
R := Rect(NewItemsRect.Left, NewItemsRect.Bottom - MarkerItemHeight,
NewItemsRect.Right, NewItemsRect.Bottom);
if ScrollCode = 2
then C := PW.ScrollMarkerActiveColor
else C := PW.ScrollMarkerColor;
end
else
begin
R := Rect(3, Height - MarkerItemHeight, Width - 3, Height - 3);
if ScrollCode = 2
then C := clBtnText
else C := clBtnShadow;
end;
if PW <> nil then DrawScrollArea(Cnvs, R);
DrawArrowImage(Cnvs, R, C, 4);
end;
procedure TbsSkinPopupWindow.StartScroll;
var
i: Integer;
begin
i := ParentMenu.GetPWIndex(Self);
ParentMenu.CloseMenu(i + 1);
KillTimer(Handle, 1);
SetTimer(Handle, 1, ScrollTimerInterval, nil);
end;
procedure TbsSkinPopupWindow.StopScroll;
begin
ScrollCode := 0;
DrawUpMarker(Canvas);
DrawDownMarker(Canvas);
KillTimer(Handle, 1);
end;
procedure TbsSkinPopupWindow.ScrollUp;
begin
if VisibleStartIndex > 0
then
begin
VisibleStartIndex := VisibleStartIndex - 1;
CalcItemRects;
RePaint;
end
else
if Cycle
then
begin
VisibleStartIndex := GetEndStartVisibleIndex;
CalcItemRects;
RePaint;
end;
end;
procedure TbsSkinPopupWindow.ScrollDown(Cycle: Boolean);
begin
if VisibleStartIndex + VisibleCount - 1 < ItemList.Count - 1
then
begin
VisibleStartIndex := VisibleStartIndex + 1;
CalcItemRects;
RePaint;
end
else
if Cycle
then
begin
VisibleStartIndex := 0;
CalcItemRects;
RePaint;
end;
end;
procedure TbsSkinPopupWindow.PopupKeyDown(CharCode: Integer);
var
PW: TbsSkinPopupWindow;
procedure NextItem;
var
i, j: Integer;
begin
if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex + VisibleCount - 1)
then ScrollDown(True);
OldActiveItem := ActiveItem;
if ActiveItem < 0 then j := 0 else j := ActiveItem + 1;
if j = ItemList.Count then j := 0;
for i := j to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
begin
ActiveItem := i;
Break;
end
else
begin
if Scroll and (ScrollCode = 0) and (i = VisibleStartIndex + VisibleCount - 1)
then ScrollDown(True);
end;
end;
if OldActiveItem <> ActiveItem
then
begin
if ActiveItem > -1 then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseEnter(True);
end;
if OldActiveItem > -1 then
with TbsSkinMenuItem(ItemList.Items[OldActiveItem]) do
begin
MouseLeave;
end;
end;
end;
procedure PriorItem;
var
i, j: Integer;
begin
if Scroll and (ScrollCode = 0) and (ActiveItem = VisibleStartIndex)
then ScrollUp(True);
OldActiveItem := ActiveItem;
if ActiveItem < 0 then j := ItemList.Count - 1 else j := ActiveItem - 1;
if (j = -1) then j := ItemList.Count - 1;
for i := j downto 0 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if MenuItem.Enabled and (MenuItem.Caption <> '-')
then
begin
ActiveItem := i;
Break;
end
else
begin
if Scroll and (ScrollCode = 0) and (i = VisibleStartIndex)
then ScrollUp(True);
end;
end;
if OldActiveItem <> ActiveItem
then
begin
if ActiveItem > -1 then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseEnter(True);
end;
if OldActiveItem > -1 then
with TbsSkinMenuItem(ItemList.Items[OldActiveItem]) do
begin
MouseLeave;
end;
end;
end;
function FindHotKeyItem: Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to ItemList.Count - 1 do
with TbsSkinMenuItem(ItemList.Items[i]) do
begin
if Enabled and IsAccel(CharCode, MenuItem.Caption)
then
begin
MouseEnter(False);
OldActiveItem := ActiveItem;
ActiveItem := i;
if OldActiveItem <> -1
then
TbsSkinMenuItem(ItemList.Items[OldActiveItem]).MouseLeave;
MouseDown(0, 0);
Result := True;
Break;
end;
end
end;
begin
if not Visible then Exit;
if not FindHotKeyItem
then
case CharCode of
VK_DOWN:
NextItem;
VK_UP:
PriorItem;
VK_RIGHT:
begin
if ActiveItem <> -1
then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
if MenuItem.Count <> 0 then MouseDown(0, 0);
end;
end;
VK_RETURN:
begin
if ActiveItem <> -1
then
with TbsSkinMenuItem(ItemList.Items[ActiveItem]) do
begin
MouseDown(0, 0);
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -