xpmenu.pas

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

   if FTopMenu then
      begin
         ACanvas.brush.color := FFMenuBarColor;
         ACanvas.Pen.Color := FFMenuBarColor;

         ACanvas.FillRect(ARect);
      end
   else
      begin
         if (Is16Bit and FGradient) then
            begin
               inc(ARect.Right, 2); //needed for RightToLeft
               DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft);
               Dec(ARect.Right, 2);

            end
         else
            begin
               ACanvas.brush.color := FFColor;
               ACanvas.FillRect(ARect);

               ACanvas.brush.color := FFIconBackColor;
               ACanvas.FillRect(IconRect);
            end;

         //------------
      end;

   if FMenuItem.Enabled then
      ACanvas.Font.Color := FFont.Color
   else
      ACanvas.Font.Color := FDisabledColor;

   if Selected and FDrawSelect then
      begin
         ACanvas.brush.Style := bsSolid;
         if FTopMenu then
            begin
               DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenuBarColor, FMenu.IsRightToLeft);
            end
         else
            if FMenuItem.Enabled then
            begin

               Inc(ARect.Top, 1);
               Dec(ARect.Bottom, 1);
               if FFlatMenu then
                  Dec(ARect.Right, 1);
               ACanvas.brush.color := FFSelectColor;
               ACanvas.FillRect(ARect);
               ACanvas.Pen.color := FFSelectBorderColor;
               ACanvas.Brush.Style := bsClear;
               ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right, Arect.Bottom, 0, 0);
               Dec(ARect.Top, 1);
               Inc(ARect.Bottom, 1);
               if FFlatMenu then
                  Inc(ARect.Right, 1);
            end;
      end;

   DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap,
      ACanvas, CheckedRect);

   DrawIcon(FMenuItem, ACanvas, B, IconRect,
      Selected, 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;

         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 - 4; //7;
            end
         else
            begin
               X1 := TextRect.Left + 4; //7;
               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));
      end;

   B.free;

   if not (csDesigning in ComponentState) then
      begin
         if (FFlatMenu) and (not FTopMenu) then
            begin
               hDcM := ACanvas.Handle;
               hWndM := WindowFromDC(hDcM);
               if hWndM <> FForm.Handle then
                  begin
                     DrawWindowBorder(hWndM, FMenu.IsRightToLeft);
                  end;
            end;
      end;

   //-----
   ActivateMenuItem(FMenuItem); // check for new sub items

end;

{$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 (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 := ACanvas.Brush.Color;
            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);
            }
            ImageList_DrawEx(ImglstHand, Button.ImageIndex,
               B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_NORMAL);

            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" <[e-mail]>
                        Inc(ARect.Left, BitmapWidth + 0 {6});
                  end

            end;

         if (Button.MenuItem <> nil) then
            begin
               TextFormat := DT_Center;
               //Inc(ARect.Left, 1);