📄 xpmenu.pas
字号:
ACanvas.Brush.Color := HoldColor;
ACanvas.Pen.Color := HoldColor;
ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 5, X2 - 3, ARect.Bottom));
HoldColor := GetShadeColor(ACanvas, DefColor, 60 + 40);
ACanvas.Brush.Color := HoldColor;
ACanvas.Pen.Color := HoldColor;
ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 6, X2 - 5, ARect.Bottom));
//---
ACanvas.Pen.Color := DefColor;
ACanvas.MoveTo(X2 - 5, ARect.Top + 1);
ACanvas.LineTo(X2 - 1, ARect.Top + 1);
ACanvas.LineTo(X2 - 1, ARect.Top + 6);
ACanvas.MoveTo(X2 - 3, ARect.Top + 2);
ACanvas.LineTo(X2 - 2, ARect.Top + 2);
ACanvas.LineTo(X2 - 2, ARect.Top + 3);
ACanvas.LineTo(X2 - 3, ARect.Top + 3);
ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 10);
ACanvas.MoveTo(X2 - 6, ARect.Top + 3);
ACanvas.LineTo(X2 - 3, ARect.Top + 3);
ACanvas.LineTo(X2 - 3, ARect.Top + 6);
ACanvas.LineTo(X2 - 4, ARect.Top + 6);
ACanvas.LineTo(X2 - 4, ARect.Top + 3);
ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 30);
ACanvas.MoveTo(X2 - 5, ARect.Top + 5);
ACanvas.LineTo(X2 - 4, ARect.Top + 5);
ACanvas.LineTo(X2 - 4, ARect.Top + 9);
ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 40);
ACanvas.MoveTo(X2 - 6, ARect.Top + 5);
ACanvas.LineTo(X2 - 6, ARect.Top + 7);
end
else
begin
ACanvas.Pen.Color := FFSelectBorderColor;
ACanvas.Brush.Color := GetShadeColor(ACanvas, BckColor, 70);
ACanvas.MoveTo(X1, ARect.Bottom - 1);
ACanvas.LineTo(X1, ARect.Top);
ACanvas.LineTo(X2 - 3, ARect.Top);
ACanvas.LineTo(X2 - 3, ARect.Bottom);
ACanvas.Pen.Color := ACanvas.Brush.Color;
ACanvas.FillRect(Rect(X2 - 2, ARect.Top + 2, X2, ARect.Bottom));
ACanvas.Brush.Color := BckColor;
ACanvas.FillRect(Rect(X2 - 2, ARect.Top , X2, ARect.Top + 2));
end;
end;
procedure TXPMenu.DrawCheckedItem(FMenuItem: TMenuItem; Selected, Enabled,
HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
var
X1, X2: integer;
begin
if FMenuItem.RadioItem then
begin
if FMenuItem.Checked then
begin
if Enabled then
begin
ACanvas.Pen.color := FFSelectBorderColor;
if selected then
ACanvas.Brush.Color := FCheckedAreaSelectColor
else
ACanvas.Brush.Color := FCheckedAreaColor;
end
else
ACanvas.Pen.color := FFDisabledColor;
ACanvas.Brush.Style := bsSolid;
if HasImgLstBitmap then
begin
ACanvas.RoundRect(CheckedRect.Left, CheckedRect.Top,
CheckedRect.Right, CheckedRect.Bottom,
6, 6);
end
else
begin
ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top,
CheckedRect.Right, CheckedRect.Bottom);
// +jt
InflateRect(CheckedRect, -2, -2); ACanvas.Brush.color := ACanvas.Pen.Color; ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom);// +jt
end;
end;
end
else
begin
if (FMenuItem.Checked) then
if (not HasImgLstBitmap) then
begin
if Enabled then
begin
ACanvas.Pen.color := FFCheckedColor;
if selected then
ACanvas.Brush.Color := FCheckedAreaSelectColor
else
ACanvas.Brush.Color := FCheckedAreaColor; ;
end
else
ACanvas.Pen.color := FFDisabledColor;
ACanvas.Brush.Style := bsSolid;
ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
CheckedRect.Right, CheckedRect.Bottom);
if Enabled then
ACanvas.Pen.color := clBlack
else
ACanvas.Pen.color := FFDisabledColor;
x1 := CheckedRect.Left + 1;
x2 := CheckedRect.Top + 5;
ACanvas.MoveTo(x1, x2);
x1 := CheckedRect.Left + 4;
x2 := CheckedRect.Bottom - 2;
ACanvas.LineTo(x1, x2);
//--
x1 := CheckedRect.Left + 2;
x2 := CheckedRect.Top + 5;
ACanvas.MoveTo(x1, x2);
x1 := CheckedRect.Left + 4;
x2 := CheckedRect.Bottom - 3;
ACanvas.LineTo(x1, x2);
//--
x1 := CheckedRect.Left + 2;
x2 := CheckedRect.Top + 4;
ACanvas.MoveTo(x1, x2);
x1 := CheckedRect.Left + 5;
x2 := CheckedRect.Bottom - 3;
ACanvas.LineTo(x1, x2);
//-----------------
x1 := CheckedRect.Left + 4;
x2 := CheckedRect.Bottom - 3;
ACanvas.MoveTo(x1, x2);
x1 := CheckedRect.Right + 2;
x2 := CheckedRect.Top - 1;
ACanvas.LineTo(x1, x2);
//--
x1 := CheckedRect.Left + 4;
x2 := CheckedRect.Bottom - 2;
ACanvas.MoveTo(x1, x2);
x1 := CheckedRect.Right - 2;
x2 := CheckedRect.Top + 3;
ACanvas.LineTo(x1, x2);
end
else
begin
if Enabled then
begin
ACanvas.Pen.color := FFSelectBorderColor;
if selected then
ACanvas.Brush.Color := FCheckedAreaSelectColor
else
ACanvas.Brush.Color := FCheckedAreaColor; ;
end
else
ACanvas.Pen.color := FFDisabledColor;
ACanvas.Brush.Style := bsSolid;
ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
CheckedRect.Right, CheckedRect.Bottom);
end;
end;
end;
procedure TXPMenu.DrawTheText(Sender: TObject; txt, ShortCuttext: string;
ACanvas: TCanvas; TextRect: TRect;
Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean;
var TxtFont: TFont; TextFormat: integer);
var
DefColor: TColor;
B: TBitmap;
BRect: TRect;
begin
TextFormat := TextFormat + DT_EXPANDTABS;
DefColor := TxtFont.Color;
ACanvas.Font.Assign (TxtFont);
if Selected then
DefColor := FFSelectFontColor;
If not Enabled then
begin
DefColor := FFDisabledColor;
if (Sender is TToolButton) then
begin
TextRect.Top := TextRect.Top +
((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
B := TBitmap.Create;
try
B.Width := TextRect.Right - TextRect.Left;
B.Height := TextRect.Bottom - TextRect.Top;
BRect := Rect(0,0,B.Width, B.Height);
B.Canvas.Brush.Color := ACanvas.Brush.Color;
B.Canvas.FillRect (BRect);
// B.Canvas.Font := FFont; //felix added for resolving font problems in Win98
//27.08
B.Canvas.Font.color := DefColor;
DrawtextEx(B.Canvas.Handle,
PChar(txt),
Length(txt),
BRect, TextFormat + DT_VCENTER, nil);
ACanvas.CopyRect(TextRect, B.Canvas, BRect);
finally
B.Free;
end;
exit;
end;
end;
if (TopMenu and Selected) then
if FUseSystemColors then
DefColor := TopMenuFontColor(ACanvas, FFIconBackColor);
ACanvas.Font.color := DefColor; // will not affect Buttons
SetBkMode(ACanvas.Handle, TRANSPARENT);
if Default and Enabled then
begin
Inc(TextRect.Left, 1);
ACanvas.Font.color := GetShadeColor(ACanvas,
ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
Dec(TextRect.Left, 1);
Inc(TextRect.Top, 2);
Inc(TextRect.Left, 1);
Inc(TextRect.Right, 1);
ACanvas.Font.color := GetShadeColor(ACanvas,
ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
Dec(TextRect.Top, 1);
Dec(TextRect.Left, 1);
Dec(TextRect.Right, 1);
ACanvas.Font.color := GetShadeColor(ACanvas,
ACanvas.Pixels[TextRect.Left, TextRect.Top], 40);
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
Inc(TextRect.Left, 1);
Inc(TextRect.Right, 1);
ACanvas.Font.color := GetShadeColor(ACanvas,
ACanvas.Pixels[TextRect.Left, TextRect.Top], 60);
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
Dec(TextRect.Left, 1);
Dec(TextRect.Right, 1);
Dec(TextRect.Top, 1);
ACanvas.Font.color := DefColor;
end;
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
txt := ShortCutText + ' ';
{
if not Is16Bit then
ACanvas.Font.color := DefColor
else
ACanvas.Font.color := GetShadeColor(ACanvas, DefColor, -40);
}
if IsRightToLeft then
begin
Inc(TextRect.Left, 10);
TextFormat := DT_LEFT
end
else
begin
Dec(TextRect.Right, 10);
TextFormat := DT_RIGHT;
end;
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
end;
procedure TXPMenu.DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
IsRightToLeft: boolean);
var
DefColor: TColor;
X, Y: integer;
begin
if (B <> nil) and (B.Width > 0) then
begin
X := IconRect.Left;
Y := IconRect.Top + 1;
if (Sender is TMenuItem) then
begin
inc(Y, 2);
if FIconWidth > B.Width then
X := X + ((FIconWidth - B.Width) div 2) - 1
else
begin
if IsRightToLeft then
X := IconRect.Right - b.Width - 2
else
X := IconRect.Left + 2;
end;
end;
if FTopMenu then
begin
if IsRightToLeft then
X := IconRect.Right - b.Width - 5
else
X := IconRect.Left + 1;
end;
if (Hot) and (FTopMenu) and (Enabled) then
if not Selected then
begin
dec(X, 1);
dec(Y, 2);
end;
if (Hot) and (not FTopMenu) and (Enabled) and (not Checked) then
if not Selected then
begin
dec(X, 1);
dec(Y, 1);
end;
if (not Hot) and (Enabled) and (not Checked) then
if Is16Bit then
DimBitmap(B, FDimLevel{30});
if not Enabled then
begin
GrayBitmap(B, FGrayLevel );
DimBitmap(B, 40);
end;
if (Hot) and (Enabled) and (not Checked) then
begin
if (Is16Bit) and (not UseSystemColors) and (Sender is TToolButton) then
DefColor := NewColor(ACanvas, FSelectColor, 68)
else
DefColor := FFSelectColor;
DefColor := GetShadeColor(ACanvas, DefColor, 50);
DrawBitmapShadow(B, ACanvas, X + 2, Y + 2, DefColor);
end;
B.Transparent := true;
ACanvas.Draw(X, Y, B);
end;
end;
function TXPMenu.TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
var
r, g, b, avg: integer;
begin
Color := ColorToRGB(Color);
r := Color and $000000FF;
g := (Color and $0000FF00) shr 8;
b := (Color and $00FF0000) shr 16;
Avg := (r + b) div 2;
if (Avg > 150) or (g > 200) then
Result := FFont.Color
else
Result := NewColor(ACanvas, Color, 90);
end;
procedure TXPMenu.SetDisableSubclassing(const Value: boolean);
begin
if Value = FDisableSubclassing then Exit;
if XPMenuManager.ActiveXPMenu = Self then
XPMenuManager.UpdateActiveXPMenu(Self)
else
if (XPMenuManager.ActiveXPMenu = nil) an⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -