xpmenu.pas
来自「文件管理系统」· PAS 代码 · 共 2,114 行 · 第 1/5 页
PAS
2,114 行
if FMenuTitleGradient.FActiveGradient then
DrawBarClass.FillGradient(ACanvas.Handle, RECT(ARect.Left, ARect.Top, ARect.Right - 7, ARect.Bottom),
FMenuTitleGradient.FGradientEndColor,FMenuTitleGradient.FGradientBeginColor,
FMenuTitleGradientType)
else}
ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right - 7, ARect.Bottom);
//==============================================================================
end;
end;
if (FMenuItem.Checked) or (FMenuItem.RadioItem ) then //x
DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap,
ACanvas, CheckedRect);
if (B <> nil) and (B.Width > 0) then // X
DrawIcon(FMenuItem, ACanvas, B, IconRect,
Selected or DrawTopMenuBorder, False, FMenuItem.Enabled, FMenuItem.Checked,
FTopMenu, FMenu.IsRightToLeft);
if not IsLine then
begin
if FMenu.IsRightToLeft then
begin
TextFormat := DT_RIGHT + DT_RTLREADING;
Dec(TextRect.Right, 3);
end
else
begin
TextFormat := 0;
Inc(TextRect.Left, 3);
end;
TextRect.Top := TextRect.Top +
((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
DrawTheText(FMenuItem, txt, ShortCutToText(FMenuItem.ShortCut),
ACanvas, TextRect,
Selected, FMenuItem.Enabled, FMenuItem.Default,
FTopMenu, FMenu.IsRightToLeft, FFont, TextFormat);
end
else
begin
if FMenu.IsRightToLeft then
begin
X1 := TextRect.Left;
X2 := TextRect.Right - 7;
end
else
begin
X1 := TextRect.Left ;
X2 := TextRect.Right;
end;
ACanvas.Pen.Color := FFSeparatorColor;
ACanvas.MoveTo(X1,
TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2));
ACanvas.LineTo(X2,
TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2));
//==============================================================================
//Draw 3DLine //SteedSky 2003.05.27
if FS3DLine then begin
ACanvas.Pen.Color := RGB(255,255,255);
ACanvas.MoveTo(X1, TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2) + 1);
ACanvas.LineTo(X2, TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2) + 1);
end;
//SteedSky 2003.05.27
//==============================================================================
end;
// +jt
BitBlt(origcanvas.Handle,origrect.Left,origrect.Top,buff.Width,buff.Height,ACanvas.Handle,0,0,SRCCOPY); finally B.free; buff.free; ACanvas := OrigCanvas; ARect:=origrect; end;// +jt
if not (csDesigning in ComponentState) then
begin
if (FFlatMenu) and (not FTopMenu) then
begin
hDcM := ACanvas.Handle;
hWndM := WindowFromDC(hDcM);
// +jt
if (hWndM=0) and (Application.Handle<>0) then begin if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then PostMessage(Application.Handle,WM_DRAWMENUBORDER,0,Integer(FMenuItem)); end else if hWndM <> FForm.Handle then begin if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then PostMessage(Application.Handle,WM_DRAWMENUBORDER2,integer(FMenu.IsRightToLeft),Integer(hWndM)); end; end;
end;
//-----
end;
//SteedSky 2003.05.27
procedure TXPMenu.SetMenuBarGradient(const Value : TGradient) ;
begin
FMenuBarGradient := Value ;
end;
procedure TXPMenu.SetMenuSelectGradient(const Value : TGradient) ;
begin
FMenuSelectGradient := Value ;
end;
procedure TXPMenu.SetMenuGradient(const Value : TGradient) ;
begin
FMenuGradient := Value ;
end;
procedure TXPMenu.SetMenuTitleGradient(const Value : TGradient) ;
begin
FMenuTitleGradient := Value ;
end;
procedure TXPMenu.SetMenuTitleGradientType(const Value : TGradDir) ;
begin
FMenuTitleGradientType := Value ;
end;
procedure TXPMenu.SetS3DLine(const Value : Boolean) ;
begin
FS3DLine := Value ;
end;
//SteedSky 2003.05.27
{$IFDEF VER5U}
procedure TXPMenu.ToolBarDrawButton(Sender: TToolBar;
Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
var
ACanvas: TCanvas;
ARect, HoldRect: TRect;
B: TBitmap;
HasBitmap: boolean;
{Sylvain ...}
HasHotBitMap : Boolean;
HasDisBitMap : Boolean;
ImglstHand : THandle;
CanDraw : Boolean;
{... Sylvain}
BitmapWidth: integer;
TextFormat: integer;
XButton: TToolButton;
HasBorder: boolean;
HasBkg: boolean;
IsTransparent: boolean;
FBSelectColor: TColor;
procedure DrawBorder;
var
BRect, WRect: TRect;
procedure DrawRect;
begin
ACanvas.Pen.color := FFSelectBorderColor;
ACanvas.MoveTo(WRect.Left, WRect.Top);
ACanvas.LineTo(WRect.Right, WRect.Top);
ACanvas.LineTo(WRect.Right, WRect.Bottom);
ACanvas.LineTo(WRect.Left, WRect.Bottom);
ACanvas.LineTo(WRect.Left, WRect.Top);
end;
begin
BRect := HoldRect;
Dec(BRect.Bottom, 1);
Inc(BRect.Top, 1);
Dec(BRect.Right, 1);
WRect := BRect;
if Button.Style = tbsDropDown then
begin
Dec(WRect.Right, 13);
DrawRect;
WRect := BRect;
Inc(WRect.Left, WRect.Right - WRect.Left - 13);
DrawRect;
end
else
begin
DrawRect;
end;
end;
begin
B := nil;
{Added By Sylvain ...}
HasHotBitmap := (Sender.HotImages <> nil) and
(Button.ImageIndex <> -1) and
(Button.ImageIndex <= Sender.HotImages.Count - 1);
HasDisBitmap := (Sender.DisabledImages <> nil) and
(Button.ImageIndex <> -1) and
(Button.ImageIndex <= Sender.DisabledImages.Count - 1);
{...Sylvain}
HasBitmap := (Sender.Images <> nil) and
(Button.ImageIndex <> -1) and
(Button.ImageIndex <= Sender.Images.Count - 1);
IsTransparent := Sender.Transparent;
ACanvas := Sender.Canvas;
//SetGlobalColor(ACanvas);
if(FColorsChanged) then SetGlobalColor(ACanvas); // +jt
if (Is16Bit) and (not UseSystemColors) then
FBSelectColor := NewColor(ACanvas, FSelectColor, 68)
else
FBSelectColor := FFSelectColor;
HoldRect := Button.BoundsRect;
ARect := HoldRect;
if Is16Bit then
ACanvas.brush.color := NewColor(ACanvas, Sender.Color, 16)
else
ACanvas.brush.color := Sender.Color;
if not IsTransparent then
ACanvas.FillRect(ARect);
HasBorder := false;
HasBkg := false;
if (cdsHot in State) then
begin
if (cdsChecked in State) or (Button.Down) or (cdsSelected in State) then
ACanvas.Brush.Color := FCheckedAreaSelectColor
else
ACanvas.brush.color := FBSelectColor;
HasBorder := true;
HasBkg := true;
end;
if ((cdsChecked in State) and not (cdsHot in State)) then
begin
ACanvas.Brush.Color := FCheckedAreaColor;
HasBorder := true;
HasBkg := true;
end;
if (cdsIndeterminate in State) and not (cdsHot in State) then
begin
ACanvas.Brush.Color := FBSelectColor;
HasBkg := true;
end;
if (Button.MenuItem <> nil) and (State = []) then
begin
ACanvas.brush.color := Sender.Color;
if not IsTransparent then
HasBkg := true;
end;
Inc(ARect.Top, 1);
if HasBkg then
ACanvas.FillRect(ARect);
if HasBorder then
DrawBorder;
if ((Button.MenuItem <> nil) or (Button.DropdownMenu <> nil))
and (cdsSelected in State) then
begin
DrawTopMenuItem(Button, ACanvas, ARect, Sender.Color ,false);
DefaultDraw := false;
end;
ARect := HoldRect;
DefaultDraw := false;
if Button.Style = tbsDropDown then
begin
ACanvas.Pen.Color := clBlack;
DrawArrow(ACanvas, (ARect.Right - 14) + ((14 - 5) div 2),
ARect.Top + ((ARect.Bottom - ARect.Top - 3) div 2) + 1);
end;
BitmapWidth := 0;
{ Rem by Sylvain ...
if HasBitmap then
begin
... Sylvain}
try
B := TBitmap.Create;
CanDraw := False;
ImglstHand:=0;
if (cdsHot in State) AND HasHotBitmap then
begin
B.Width := Sender.HotImages.Width;
B.Height := Sender.HotImages.Height;
ImglstHand := Sender.HotImages.Handle;
CanDraw := True;
end
else if (cdsDisabled in State) and HasDisBitmap then
begin
B.Width := Sender.DisabledImages.Width;
B.Height := Sender.DisabledImages.Height;
ImglstHand := Sender.DisabledImages.Handle;
CanDraw := True;
end
else if HasBitMap then
begin
B.Width := Sender.Images.Width;
B.Height := Sender.Images.Height;
ImglstHand := Sender.Images.Handle;
CanDraw := True;
end;
if CanDraw then
begin {CanDraw}
B.Canvas.Brush.Color := TransparentColor; // ACanvas.Brush.Color; // +jt
B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
ImageList_DrawEx(ImglstHand, Button.ImageIndex,
B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
BitmapWidth := b.Width;
if Button.Style = tbsDropDown then
Dec(ARect.Right, 12);
if TToolBar(Button.Parent).List then
begin
if Button.BiDiMode = bdRightToLeft then
begin
Dec(ARect.Right, 3);
ARect.Left := ARect.Right - BitmapWidth;
end
else
begin
Inc(ARect.Left, 3);
ARect.Right := ARect.Left + BitmapWidth
end
end
else
ARect.Left := Round(ARect.Left + (ARect.Right - ARect.Left - B.Width)/2);
inc(ARect.Top, 2);
ARect.Bottom := ARect.Top + B.Height + 6;
DrawIcon(Button, ACanvas, B, ARect, (cdsHot in State),
(cdsSelected in State), Button.Enabled, (cdsChecked in State), false,
false);
end; {CanDraw}
finally
B.Free;
end;
ARect := HoldRect;
DefaultDraw := false;
{rem by sylvain ...
end;
...Sylvain}
//-----------
if Sender.ShowCaptions then
begin
if Button.Style = tbsDropDown then
Dec(ARect.Right, 12);
if not TToolBar(Button.Parent).List then
begin
TextFormat := DT_Center;
ARect.Top := ARect.Bottom - ACanvas.TextHeight(Button.Caption) - 6;
end
else
begin
TextFormat := DT_VCENTER;
if Button.BiDiMode = bdRightToLeft then
begin
TextFormat := TextFormat + DT_Right;
Dec(ARect.Right, BitmapWidth + 7);
end
else
begin
if BitmapWidth > 0 then //"Dan Downs" <dan@laserformsinc.com>
if Sender.List then //Micha雔 Moreno <michael@weatherderivs.com>
Inc(ARect.Left, BitmapWidth + 6)
else
Inc(ARect.Left, BitmapWidth);
end
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?