xpmenu.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

            end;

         if Button.BiDiMode = bdRightToLeft then
            TextFormat := TextFormat + DT_RTLREADING;

         DrawTheText(Button, Button.Caption, '',
            ACanvas, ARect,
            (cdsSelected in State), Button.Enabled, false,
            (Button.MenuItem <> nil),
            (Button.BidiMode = bdRightToLeft), FFont, TextFormat);

         ARect := HoldRect;
         DefaultDraw := false;
      end;

   if Button.Index > 0 then
      begin
         XButton := {TToolBar(Button.Parent)} Sender.Buttons[Button.Index - 1];
         if (XButton.Style = tbsDivider) or (XButton.Style = tbsSeparator) then
            begin
               ARect := XButton.BoundsRect;
               if Is16Bit then
                  ACanvas.brush.color := NewColor(ACanvas, Sender.Color, 16)
               else
                  ACanvas.brush.color := Sender.Color;

               if not IsTransparent then
                  ACanvas.FillRect(ARect);
               // if (XButton.Style = tbsDivider) then  // Can't get it.
               if XButton.Tag > 0 then
                  begin
                     Inc(ARect.Top, 2);
                     Dec(ARect.Bottom, 1);

                     ACanvas.Pen.color := GetShadeColor(ACanvas, Sender.Color, 30);
                     ARect.Left := ARect.Left + (ARect.Right - ARect.Left) div 2;
                     ACanvas.MoveTo(ARect.Left, ARect.Top);
                     ACanvas.LineTo(ARect.Left, ARect.Bottom);

                  end;
               ARect := Button.BoundsRect;
               DefaultDraw := false;
            end;

      end;

   if Button.MenuItem <> nil then
      if (xcMainMenu in XPControls) then
         ActivateMenuItem(Button.MenuItem);
end;
{$ENDIF}

// Controlbar Paint. Added by Michiel van Oudheusden (27 sep 2001)
// Paints the bands of a controlbar like the office XP style

procedure TXPMenu.ControlBarPaint(Sender: TObject; Control: TControl;
   Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);
var
   i: Integer;
   intInc: integer;
begin
   SetGlobalColor(Canvas);
   // No frame and grabber drawing. We do it ourselfes
   Options := [];

   // First background

   if Is16Bit then
      Canvas.brush.color := NewColor(Canvas, TControlBar(Sender).Color, 6)
   else
      Canvas.brush.color := TControlBar(Sender).Color;

   Canvas.FillRect(ARect);

   intInc := 30;
   for i := (ARect.Top + 5) to (ARect.Bottom - 5) do
      begin
         Canvas.Pen.Color := GetShadeColor(Canvas, TControlBar(Sender).Color, intInc);
         if i mod 2 = 0 then
            begin
               Canvas.MoveTo(ARect.Left + 3, i);
               Canvas.LineTo(ARect.Left + 6, i);
               Inc(intInc, 7);
            end;
      end;

end;

procedure TXPMenu.SetGlobalColor(ACanvas: TCanvas);
begin
   //-----

   if GetDeviceCaps(ACanvas.Handle, BITSPIXEL) < 16 then
      Is16Bit := false
   else
      Is16Bit := true;

   FFColor := FColor;
   FFIconBackColor := FIconBackColor;

   if Is16Bit then
      begin
         FFSelectColor := NewColor(ACanvas, FSelectColor, 68);
         FCheckedAreaColor := NewColor(ACanvas, FSelectColor, 80);
         FCheckedAreaSelectColor := NewColor(ACanvas, FSelectColor, 50);

         FMenuBorderColor := GetShadeColor(ACanvas, clBtnFace, 90);
         FMenuShadowColor := GetShadeColor(ACanvas, clBtnFace, 76);
      end
   else
      begin
         FFSelectColor := FSelectColor;
         FCheckedAreaColor := clWhite;
         FCheckedAreaSelectColor := clSilver;
         FMenuBorderColor := clBtnShadow;
         FMenuShadowColor := clBtnShadow;
      end;

   FFSelectBorderColor := FSelectBorderColor;
   FFSelectFontColor := FSelectFontColor;
   FFMenuBarColor := FMenuBarColor;
   FFDisabledColor := FDisabledColor;
   FFCheckedColor := FCheckedColor;
   FFSeparatorColor := FSeparatorColor;

   if FUseSystemColors then
      begin
         GetSystemMenuFont(FFont);
         FFSelectFontColor := FFont.Color;
         if not Is16Bit then
            begin
               FFColor := clWhite;
               FFIconBackColor := clBtnFace;
               FFSelectColor := clWhite;
               FFSelectBorderColor := clHighlight;
               FFMenuBarColor := FFIconBackColor;
               FFDisabledColor := clBtnShadow;
               FFCheckedColor := clHighlight;
               FFSeparatorColor := clBtnShadow;
               FCheckedAreaColor := clWhite;
               FCheckedAreaSelectColor := clWhite;

            end
         else
            begin
               FFColor := NewColor(ACanvas, clBtnFace, 86);
               FFIconBackColor := NewColor(ACanvas, clBtnFace, 16);
               FFSelectColor := NewColor(ACanvas, clHighlight, 68);
               FFSelectBorderColor := clHighlight;
               FFMenuBarColor := FMenuBarColor; //clBtnFace;

               FFDisabledColor := NewColor(ACanvas, clBtnShadow, 10);
               FFSeparatorColor := NewColor(ACanvas, clBtnShadow, 25);
               FFCheckedColor := clHighlight;
               FCheckedAreaColor := NewColor(ACanvas, clHighlight, 80);
               FCheckedAreaSelectColor := NewColor(ACanvas, clHighlight, 50);

            end;
      end;

end;

procedure TXPMenu.DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas;
   ARect: TRect; BckColor: Tcolor; IsRightToLeft: boolean);
var
   X1, X2: integer;
   DefColor, HoldColor: TColor;
begin
   X1 := ARect.Left;
   X2 := ARect.Right;

   ACanvas.brush.Style := bsSolid;
   ACanvas.brush.color := FFSelectColor;

   ACanvas.FillRect(ARect);
   ACanvas.Pen.Color := FFSelectBorderColor;

   if (not IsRightToLeft) and (Is16Bit) and (Sender is TMenuItem) then
      begin
         ACanvas.MoveTo(X1, ARect.Bottom - 1);
         ACanvas.LineTo(X1, ARect.Top);
         ACanvas.LineTo(X2 - 8, ARect.Top);
         ACanvas.LineTo(X2 - 8, ARect.Bottom);

         DefColor := FFMenuBarColor;

         HoldColor := GetShadeColor(ACanvas, DefColor, 10);
         ACanvas.Brush.Style := bsSolid;
         ACanvas.Brush.Color := HoldColor;
         ACanvas.Pen.Color := HoldColor;

         ACanvas.FillRect(Rect(X2 - 7, ARect.Top, X2, ARect.Bottom));

         HoldColor := GetShadeColor(ACanvas, DefColor, 30);
         ACanvas.Brush.Color := HoldColor;
         ACanvas.Pen.Color := HoldColor;
         ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 3, X2 - 2, ARect.Bottom));

         HoldColor := GetShadeColor(ACanvas, DefColor, 40 + 20);
         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);
                  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

   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;